/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Mario Carneiro, Sean Leather

! This file was ported from Lean 3 source module data.finset.option
! leanprover-community/mathlib commit c227d107bbada5d0d9d20287e3282c0a7f1651a0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Card

/-!
# Finite sets in `option α`

In this file we define

* `Option.toFinset`: construct an empty or singleton `Finset α` from an `Option α`;
* `Finset.insertNone`: given `s : Finset α`, lift it to a finset on `Option α` using `Option.some`
  and then insert `Option.none`;
* `Finset.eraseNone`: given `s : Finset (option α)`, returns `t : Finset α` such that
  `x ∈ t ↔ some x ∈ s`.

Then we prove some basic lemmas about these definitions.

## Tags

finset, option
-/

variable {α β : Type _}

open Function

namespace Option

/-- Construct an empty or singleton finset from an `Option` -/
def toFinset (o : Option α) : Finset α :=
  o.elim ∅ singleton
#align option.to_finset Option.toFinset

@[simp]
theorem toFinset_none : none.toFinset = (∅ : Finset α) :=
  rfl
#align option.to_finset_none Option.toFinset_none

@[simp]
theorem toFinset_some {a : α} : (some a).toFinset = {a} :=
  rfl
#align option.to_finset_some Option.toFinset_some

@[simp]

theorem card_toFinset (o : Option α) : o.toFinset.card = o.elim 0 1 := by cases o <;> rfl
#align option.card_to_finset Option.card_toFinset

end Option

namespace Finset

/-- Given a finset on `α`, lift it to being a finset on `Option α`
using `Option.some` and then insert `Option.none`. -/
def insertNone : Finset α ↪o Finset (Option α) :=
  (OrderEmbedding.ofMapLEIff fun s => cons none (s.map Embedding.some) <| by simp) fun s t => by
    rw [le_iff_subset, cons_subset_cons, map_subset_map, le_iff_subset]
#align finset.insert_none Finset.insertNone

@[simp]
theorem mem_insertNone {s : Finset α} : ∀ {o : Option α}, o ∈ insertNone s ↔ ∀ a ∈ o, a ∈ s
  | none => iff_of_true (Multiset.mem_cons_self _ _) fun a h => by cases h
  | some a => Multiset.mem_cons.trans <| by simp
#align finset.mem_insert_none Finset.mem_insertNone

theorem some_mem_insertNone {s : Finset α} {a : α} : some a ∈ insertNone s ↔ a ∈ s := by simp
#align finset.some_mem_insert_none Finset.some_mem_insertNone

@[simp]
theorem card_insertNone (s : Finset α) : s.insertNone.card = s.card + 1 := by simp [insertNone]
#align finset.card_insert_none Finset.card_insertNone

/-- Given `s : Finset (Option α)`, `eraseNone s : Finset α` is the set of `x : α` such that
`some x ∈ s`. -/
def eraseNone : Finset (Option α) →o Finset α :=
  (Finset.mapEmbedding (Equiv.optionIsSomeEquiv α).toEmbedding).toOrderHom.comp
    ⟨Finset.subtype _, subtype_mono⟩
#align finset.erase_none Finset.eraseNone

@[simp]
theorem mem_eraseNone {s : Finset (Option α)} {x : α} : x ∈ eraseNone s ↔ some x ∈ s := by
  simp [eraseNone]
#align finset.mem_erase_none Finset.mem_eraseNone

theorem eraseNone_eq_bunionᵢ [DecidableEq α] (s : Finset (Option α)) :
    eraseNone s = s.bunionᵢ Option.toFinset := by
  ext
  simp
#align finset.erase_none_eq_bUnion Finset.eraseNone_eq_bunionᵢ

@[simp]
theorem eraseNone_map_some (s : Finset α) : eraseNone (s.map Embedding.some) = s := by
  ext
  simp
#align finset.erase_none_map_some Finset.eraseNone_map_some

@[simp]
theorem eraseNone_image_some [DecidableEq (Option α)] (s : Finset α) :
    eraseNone (s.image some) = s := by simpa only [map_eq_image] using eraseNone_map_some s
#align finset.erase_none_image_some Finset.eraseNone_image_some

@[simp]
theorem coe_eraseNone (s : Finset (Option α)) : (eraseNone s : Set α) = some ⁻¹' s :=
  Set.ext fun _ => mem_eraseNone
#align finset.coe_erase_none Finset.coe_eraseNone

@[simp]
theorem eraseNone_union [DecidableEq (Option α)] [DecidableEq α] (s t : Finset (Option α)) :
    eraseNone (s ∪ t) = eraseNone s ∪ eraseNone t := by
  ext
  simp
#align finset.erase_none_union Finset.eraseNone_union

@[simp]
theorem eraseNone_inter [DecidableEq (Option α)] [DecidableEq α] (s t : Finset (Option α)) :
    eraseNone (s ∩ t) = eraseNone s ∩ eraseNone t := by
  ext
  simp
#align finset.erase_none_inter Finset.eraseNone_inter

@[simp]
theorem eraseNone_empty : eraseNone (∅ : Finset (Option α)) = ∅ := by
  ext
  simp
#align finset.erase_none_empty Finset.eraseNone_empty

@[simp]
theorem eraseNone_none : eraseNone ({none} : Finset (Option α)) = ∅ := by
  ext
  simp
#align finset.erase_none_none Finset.eraseNone_none

@[simp]
theorem image_some_eraseNone [DecidableEq (Option α)] (s : Finset (Option α)) :
    (eraseNone s).image some = s.erase none := by ext (_ | x) <;> simp
#align finset.image_some_erase_none Finset.image_some_eraseNone

@[simp]
theorem map_some_eraseNone [DecidableEq (Option α)] (s : Finset (Option α)) :
    (eraseNone s).map Embedding.some = s.erase none := by
  rw [map_eq_image, Embedding.some_apply, image_some_eraseNone]
#align finset.map_some_erase_none Finset.map_some_eraseNone

@[simp]
theorem insertNone_eraseNone [DecidableEq (Option α)] (s : Finset (Option α)) :
    insertNone (eraseNone s) = insert none s := by ext (_ | x) <;> simp
#align finset.insert_none_erase_none Finset.insertNone_eraseNone

@[simp]
theorem eraseNone_insertNone (s : Finset α) : eraseNone (insertNone s) = s := by
  ext
  simp
#align finset.erase_none_insert_none Finset.eraseNone_insertNone

end Finset


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.W.basic

/-!
# Polynomial functors

This file defines polynomial functors and the W-type construction as a
polynomial functor.  (For the M-type construction, see
pfunctor/M.lean.)
-/

universe u

/--
A polynomial functor `P` is given by a type `A` and a family `B` of types over `A`. `P` maps
any type `α` to a new type `P.obj α`, which is defined as the sigma type `Σ x, P.B x → α`.

An element of `P.obj α` is a pair `⟨a, f⟩`, where `a` is an element of a type `A` and
`f : B a → α`. Think of `a` as the shape of the object and `f` as an index to the relevant
elements of `α`.
-/

structure pfunctor :=
(A : Type u) (B : A → Type u)

namespace pfunctor

instance : inhabited pfunctor :=
⟨⟨default, default⟩⟩

variables (P : pfunctor) {α β : Type u}

/-- Applying `P` to an object of `Type` -/
def obj (α : Type*) := Σ x : P.A, P.B x → α

/-- Applying `P` to a morphism of `Type` -/
def map {α β : Type*} (f : α → β) : P.obj α → P.obj β :=
λ ⟨a, g⟩, ⟨a, f ∘ g⟩

instance obj.inhabited [inhabited P.A] [inhabited α] : inhabited (P.obj α) := ⟨⟨default, default⟩⟩
instance : functor P.obj := {map := @map P}

protected theorem map_eq {α β : Type*} (f : α → β) (a : P.A) (g : P.B a → α) :
  @functor.map P.obj _ _ _ f ⟨a, g⟩ = ⟨a, f ∘ g⟩ :=
rfl

protected theorem id_map {α : Type*} : ∀ x : P.obj α, id <$> x = id x :=
λ ⟨a, b⟩, rfl

protected theorem comp_map {α β γ : Type*} (f : α → β) (g : β → γ) :
  ∀ x : P.obj α, (g ∘ f) <$> x = g <$> (f <$> x) :=
λ ⟨a, b⟩, rfl

instance : is_lawful_functor P.obj :=
{id_map := @pfunctor.id_map P, comp_map := @pfunctor.comp_map P}

/-- re-export existing definition of W-types and
adapt it to a packaged definition of polynomial functor -/
def W := _root_.W_type P.B

/- inhabitants of W types is awkward to encode as an instance
assumption because there needs to be a value `a : P.A`
such that `P.B a` is empty to yield a finite tree -/
attribute [nolint has_inhabited_instance] W
variables {P}

/-- root element  of a W tree -/
def W.head : W P → P.A
| ⟨a, f⟩ := a

/-- children of the root of a W tree -/
def W.children : Π x : W P, P.B (W.head x) → W P
| ⟨a, f⟩ := f

/-- destructor for W-types -/
def W.dest : W P → P.obj (W P)
| ⟨a, f⟩ := ⟨a, f⟩

/-- constructor for W-types -/
def W.mk : P.obj (W P) → W P
| ⟨a, f⟩ := ⟨a, f⟩

@[simp] theorem W.dest_mk (p : P.obj (W P)) : W.dest (W.mk p) = p :=
by cases p; reflexivity

@[simp] theorem W.mk_dest (p : W P) : W.mk (W.dest p) = p :=
by cases p; reflexivity

variables (P)

/-- `Idx` identifies a location inside the application of a pfunctor.
For `F : pfunctor`, `x : F.obj α` and `i : F.Idx`, `i` can designate
one part of `x` or is invalid, if `i.1 ≠ x.1` -/
def Idx := Σ x : P.A, P.B x

instance Idx.inhabited [inhabited P.A] [inhabited (P.B default)] : inhabited P.Idx :=
⟨⟨default, default⟩⟩

variables {P}

/-- `x.iget i` takes the component of `x` designated by `i` if any is or returns
a default value -/
def obj.iget [decidable_eq P.A] {α} [inhabited α] (x : P.obj α) (i : P.Idx) : α :=
if h : i.1 = x.1
  then x.2 (cast (congr_arg _ h) i.2)
  else default

@[simp]
lemma fst_map {α β : Type u} (x : P.obj α) (f : α → β) :
  (f <$> x).1 = x.1 := by { cases x; refl }

@[simp]
lemma iget_map [decidable_eq P.A] {α β : Type u} [inhabited α] [inhabited β]
  (x : P.obj α) (f : α → β) (i : P.Idx)
  (h : i.1 = x.1) :
  (f <$> x).iget i = f (x.iget i) :=
by { simp only [obj.iget, fst_map, *, dif_pos, eq_self_iff_true],
     cases x, refl }

end pfunctor

/-
Composition of polynomial functors.
-/

namespace pfunctor

/-- functor composition for polynomial functors -/
def comp (P₂ P₁ : pfunctor.{u}) : pfunctor.{u} :=
⟨ Σ a₂ : P₂.1, P₂.2 a₂ → P₁.1,
  λ a₂a₁, Σ u : P₂.2 a₂a₁.1, P₁.2 (a₂a₁.2 u) ⟩

/-- constructor for composition -/
def comp.mk (P₂ P₁ : pfunctor.{u}) {α : Type} (x : P₂.obj (P₁.obj α)) : (comp P₂ P₁).obj α :=
⟨ ⟨ x.1, sigma.fst ∘ x.2 ⟩, λ a₂a₁, (x.2 a₂a₁.1).2 a₂a₁.2  ⟩

/-- destructor for composition -/
def comp.get (P₂ P₁ : pfunctor.{u}) {α : Type} (x : (comp P₂ P₁).obj α) : P₂.obj (P₁.obj α) :=
⟨ x.1.1, λ a₂, ⟨x.1.2 a₂, λ a₁, x.2 ⟨a₂,a₁⟩ ⟩ ⟩

end pfunctor

/-
Lifting predicates and relations.
-/

namespace pfunctor
variables {P : pfunctor.{u}}
open functor

theorem liftp_iff {α : Type u} (p : α → Prop) (x : P.obj α) :
  liftp p x ↔ ∃ a f, x = ⟨a, f⟩ ∧ ∀ i, p (f i) :=
begin
  split,
  { rintros ⟨y, hy⟩, cases h : y with a f,
    refine ⟨a, λ i, (f i).val, _, λ i, (f i).property⟩,
    rw [←hy, h, pfunctor.map_eq] },
  rintros ⟨a, f, xeq, pf⟩,
  use ⟨a, λ i, ⟨f i, pf i⟩⟩,
  rw [xeq], reflexivity
end

theorem liftp_iff' {α : Type u} (p : α → Prop) (a : P.A) (f : P.B a → α) :
  @liftp.{u} P.obj _ α p ⟨a,f⟩ ↔ ∀ i, p (f i) :=
begin
  simp only [liftp_iff, sigma.mk.inj_iff]; split; intro,
  { casesm* [Exists _, _ ∧ _], subst_vars, assumption },
  repeat { constructor <|> assumption }
end

theorem liftr_iff {α : Type u} (r : α → α → Prop) (x y : P.obj α) :
  liftr r x y ↔ ∃ a f₀ f₁, x = ⟨a, f₀⟩ ∧ y = ⟨a, f₁⟩ ∧ ∀ i, r (f₀ i) (f₁ i) :=
begin
  split,
  { rintros ⟨u, xeq, yeq⟩, cases h : u with a f,
    use [a, λ i, (f i).val.fst, λ i, (f i).val.snd],
    split, { rw [←xeq, h], refl },
    split, { rw [←yeq, h], refl },
    intro i, exact (f i).property },
  rintros ⟨a, f₀, f₁, xeq, yeq, h⟩,
  use ⟨a, λ i, ⟨(f₀ i, f₁ i), h i⟩⟩,
  split,
  { rw [xeq], refl },
  rw [yeq], refl
end

open set

theorem supp_eq {α : Type u} (a : P.A) (f : P.B a → α) :
  @supp.{u} P.obj _ α  (⟨a,f⟩ : P.obj α) = f '' univ :=
begin
  ext, simp only [supp, image_univ, mem_range, mem_set_of_eq],
  split; intro h,
  { apply @h (λ x, ∃ (y : P.B a), f y = x),
    rw liftp_iff', intro, refine ⟨_,rfl⟩ },
  { simp only [liftp_iff'], cases h, subst x,
    tauto }
end

end pfunctor


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
  begin
    assume m : ℕ,
    assume hm : m < n,
    induction m with m hm,
    {
      show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from by auto [polynomial.bernoulli, eval_add, eval_one, eval_mul, eval_pow, eval_C, eval_X, pow_zero, pow_one, pow_add, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_zero, pow_one, pow_
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    simp [polynomial.bernoulli, polynomial.eval_C],
    ring,
  },
  {
    have h1 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from hd,
    have h2 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h3 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h4 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h5 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h6 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h7 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h8 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h9 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h10 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h11 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h12 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h13 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h14 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h15 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h16 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h17 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h18 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h19 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h20 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_X, polynomial.eval_C, polynomial.eval_one],
    have h21 : (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d, from by auto [polynomial.eval_add
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    simp [polynomial.bernoulli],
  },
  {
    have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h2 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h3 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h4 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h5 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h6 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h7 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h8 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h9 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h10 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h11 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h12 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h13 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h14 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h15 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h16 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h17 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h18 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h19 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h20 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h21 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h22 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h23 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h24 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h25 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h26 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h27 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h28 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h29 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h30 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h31 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by auto [add_mul],
    have h32 : (d + 1) * (1
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin, Scott Morrison

! This file was ported from Lean 3 source module algebra.category.Module.simple
! leanprover-community/mathlib commit 4ed0bcaef698011b0692b93a042a2282f490f6b6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Simple
import Mathbin.Algebra.Category.Module.Subobject
import Mathbin.Algebra.Category.Module.Algebra
import Mathbin.RingTheory.SimpleModule
import Mathbin.LinearAlgebra.FiniteDimensional

/-!
# Simple objects in the category of `R`-modules

We prove simple modules are exactly simple objects in the category of `R`-modules.
-/

variable {R M : Type _} [Ring R] [AddCommGroup M] [Module R M]

open CategoryTheory ModuleCat

theorem simple_iff_isSimpleModule : Simple (of R M) ↔ IsSimpleModule R M :=
  (simple_iff_subobject_isSimpleOrder _).trans (subobjectModule (of R M)).isSimpleOrder_iff
#align simple_iff_is_simple_module simple_iff_isSimpleModule

theorem simple_iff_is_simple_module' (M : ModuleCat R) : Simple M ↔ IsSimpleModule R M :=
  (Simple.iff_of_iso (ofSelfIso M).symm).trans simple_iff_isSimpleModule
#align simple_iff_is_simple_module' simple_iff_is_simple_module'

/-- A simple module is a simple object in the category of modules. -/
instance simple_of_isSimpleModule [IsSimpleModule R M] : Simple (of R M) :=
  simple_iff_isSimpleModule.mpr ‹_›
#align simple_of_is_simple_module simple_of_isSimpleModule

/-- A simple object in the category of modules is a simple module. -/
instance isSimpleModule_of_simple (M : ModuleCat R) [Simple M] : IsSimpleModule R M :=
  simple_iff_isSimpleModule.mp (Simple.of_iso (ofSelfIso M))
#align is_simple_module_of_simple isSimpleModule_of_simple

open FiniteDimensional

attribute [local instance] module_of_algebra_Module is_scalar_tower_of_algebra_Module

/-- Any `k`-algebra module which is 1-dimensional over `k` is simple. -/
theorem simple_of_finrank_eq_one {k : Type _} [Field k] [Algebra k R] {V : ModuleCat R}
    (h : finrank k V = 1) : Simple V :=
  (simple_iff_is_simple_module' V).mpr (is_simple_module_of_finrank_eq_one h)
#align simple_of_finrank_eq_one simple_of_finrank_eq_one


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

! This file was ported from Lean 3 source module algebra.group.opposite
! leanprover-community/mathlib commit 76de8ae01554c3b37d66544866659ff174e66e1f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.InjSurj
import Mathlib.Algebra.Group.Commute
import Mathlib.Algebra.Hom.Equiv.Basic
import Mathlib.Algebra.Opposites
import Mathlib.Data.Int.Cast.Defs

/-!
# Group structures on the multiplicative and additive opposites
-/

universe u v

variable (α : Type u)

namespace MulOpposite

/-!
### Additive structures on `αᵐᵒᵖ`
-/

@[to_additive]
instance natCast [NatCast α] : NatCast αᵐᵒᵖ :=
  ⟨fun n => op n⟩

@[to_additive]
instance intCast [IntCast α] : IntCast αᵐᵒᵖ :=
  ⟨fun n => op n⟩

instance addSemigroup [AddSemigroup α] : AddSemigroup αᵐᵒᵖ :=
  unop_injective.addSemigroup _ fun _ _ => rfl

instance addLeftCancelSemigroup [AddLeftCancelSemigroup α] : AddLeftCancelSemigroup αᵐᵒᵖ :=
  unop_injective.addLeftCancelSemigroup _ fun _ _ => rfl

instance addRightCancelSemigroup [AddRightCancelSemigroup α] : AddRightCancelSemigroup αᵐᵒᵖ :=
  unop_injective.addRightCancelSemigroup _ fun _ _ => rfl

instance addCommSemigroup [AddCommSemigroup α] : AddCommSemigroup αᵐᵒᵖ :=
  unop_injective.addCommSemigroup _ fun _ _ => rfl

instance addZeroClass [AddZeroClass α] : AddZeroClass αᵐᵒᵖ :=
  unop_injective.addZeroClass _ (by exact rfl) fun _ _ => rfl

instance addMonoid [AddMonoid α] : AddMonoid αᵐᵒᵖ :=
  unop_injective.addMonoid _ (by exact rfl) (fun _ _ => rfl) fun _ _ => rfl

instance addCommMonoid [AddCommMonoid α] : AddCommMonoid αᵐᵒᵖ :=
  unop_injective.addCommMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl

instance addMonoidWithOne [AddMonoidWithOne α] : AddMonoidWithOne αᵐᵒᵖ :=
  { MulOpposite.addMonoid α, MulOpposite.one α, MulOpposite.natCast _ with
    natCast_zero := show op ((0 : ℕ) : α) = 0 by rw [Nat.cast_zero, op_zero]
    natCast_succ := show ∀ n, op ((n + 1 : ℕ) : α) = op ↑(n : ℕ) + 1 by simp }

instance addCommMonoidWithOne [AddCommMonoidWithOne α] : AddCommMonoidWithOne αᵐᵒᵖ :=
  { MulOpposite.addMonoidWithOne α, MulOpposite.addCommMonoid α with }

instance subNegMonoid [SubNegMonoid α] : SubNegMonoid αᵐᵒᵖ :=
  unop_injective.subNegMonoid _ (by exact rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl

instance addGroup [AddGroup α] : AddGroup αᵐᵒᵖ :=
  unop_injective.addGroup _ (by exact rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
  (fun _ _ => rfl) fun _ _ => rfl

instance addCommGroup [AddCommGroup α] : AddCommGroup αᵐᵒᵖ :=
  unop_injective.addCommGroup _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl

instance addGroupWithOne [AddGroupWithOne α] : AddGroupWithOne αᵐᵒᵖ :=
  { MulOpposite.addMonoidWithOne α, MulOpposite.addGroup α with
    intCast := fun n => op n,
    intCast_ofNat := fun n => show op ((n : ℤ) : α) = op (n : α) by rw [Int.cast_ofNat],
    intCast_negSucc := fun n =>
      show op _ = op (-unop (op ((n + 1 : ℕ) : α))) by simp }

instance addCommGroupWithOne [AddCommGroupWithOne α] : AddCommGroupWithOne αᵐᵒᵖ :=
  { MulOpposite.addGroupWithOne α, MulOpposite.addCommGroup α with }

/-!
### Multiplicative structures on `αᵐᵒᵖ`

We also generate additive structures on `αᵃᵒᵖ` using `to_additive`
-/

@[to_additive]
instance semigroup [Semigroup α] : Semigroup αᵐᵒᵖ :=
  { MulOpposite.mul α with
    mul_assoc := fun x y z => unop_injective <| Eq.symm <| mul_assoc (unop z) (unop y) (unop x) }

@[to_additive]
instance leftCancelSemigroup [RightCancelSemigroup α] : LeftCancelSemigroup αᵐᵒᵖ :=
  { MulOpposite.semigroup α with
    mul_left_cancel := fun _ _ _ H => unop_injective <| mul_right_cancel <| op_injective H }

@[to_additive]
instance rightCancelSemigroup [LeftCancelSemigroup α] : RightCancelSemigroup αᵐᵒᵖ :=
  { MulOpposite.semigroup α with
    mul_right_cancel := fun _ _ _ H => unop_injective <| mul_left_cancel <| op_injective H }

@[to_additive]
instance commSemigroup [CommSemigroup α] : CommSemigroup αᵐᵒᵖ :=
  { MulOpposite.semigroup α with
    mul_comm := fun x y => unop_injective <| mul_comm (unop y) (unop x) }

@[to_additive]
instance mulOneClass [MulOneClass α] : MulOneClass αᵐᵒᵖ :=
  { MulOpposite.mul α, MulOpposite.one α with
    one_mul := fun x => unop_injective <| mul_one <| unop x,
    mul_one := fun x => unop_injective <| one_mul <| unop x }

@[to_additive]
instance monoid [Monoid α] : Monoid αᵐᵒᵖ :=
  { MulOpposite.semigroup α, MulOpposite.mulOneClass α with
    npow := fun n x => op <| x.unop ^ n,
    npow_zero := fun x => unop_injective <| Monoid.npow_zero x.unop,
    npow_succ := fun n x => unop_injective <| pow_succ' x.unop n }

@[to_additive]
instance leftCancelMonoid [RightCancelMonoid α] : LeftCancelMonoid αᵐᵒᵖ :=
  { MulOpposite.leftCancelSemigroup α, MulOpposite.monoid α with }

@[to_additive]
instance rightCancelMonoid [LeftCancelMonoid α] : RightCancelMonoid αᵐᵒᵖ :=
  { MulOpposite.rightCancelSemigroup α, MulOpposite.monoid α with }

@[to_additive]
instance cancelMonoid [CancelMonoid α] : CancelMonoid αᵐᵒᵖ :=
  { MulOpposite.rightCancelMonoid α, MulOpposite.leftCancelMonoid α with }

@[to_additive]
instance commMonoid [CommMonoid α] : CommMonoid αᵐᵒᵖ :=
  { MulOpposite.monoid α, MulOpposite.commSemigroup α with }

@[to_additive]
instance cancelCommMonoid [CancelCommMonoid α] : CancelCommMonoid αᵐᵒᵖ :=
  { MulOpposite.cancelMonoid α, MulOpposite.commMonoid α with }

@[to_additive AddOpposite.subNegMonoid]
instance divInvMonoid [DivInvMonoid α] : DivInvMonoid αᵐᵒᵖ :=
  { MulOpposite.monoid α, MulOpposite.inv α with
    zpow := fun n x => op <| x.unop ^ n,
    zpow_zero' := fun x => unop_injective <| DivInvMonoid.zpow_zero' x.unop,
    zpow_succ' := fun n x => unop_injective <| by
      simp only [Int.ofNat_eq_coe]
      rw [unop_op, zpow_ofNat, pow_succ', unop_mul, unop_op, zpow_ofNat],
    zpow_neg' := fun z x => unop_injective <| DivInvMonoid.zpow_neg' z x.unop }

@[to_additive AddOpposite.subtractionMonoid]
instance divisionMonoid [DivisionMonoid α] : DivisionMonoid αᵐᵒᵖ :=
  { MulOpposite.divInvMonoid α, MulOpposite.involutiveInv α with
    mul_inv_rev := fun _ _ => unop_injective <| mul_inv_rev _ _,
    inv_eq_of_mul := fun _ _ h => unop_injective <| inv_eq_of_mul_eq_one_left <| congr_arg unop h }

@[to_additive AddOpposite.subtractionCommMonoid]
instance divisionCommMonoid [DivisionCommMonoid α] : DivisionCommMonoid αᵐᵒᵖ :=
  { MulOpposite.divisionMonoid α, MulOpposite.commSemigroup α with }

@[to_additive]
instance group [Group α] : Group αᵐᵒᵖ :=
  { MulOpposite.divInvMonoid α with
    mul_left_inv := fun x => unop_injective <| mul_inv_self <| unop x }

@[to_additive]
instance commGroup [CommGroup α] : CommGroup αᵐᵒᵖ :=
  { MulOpposite.group α, MulOpposite.commMonoid α with }

variable {α}
@[to_additive (attr := simp, norm_cast)]
theorem op_natCast [NatCast α] (n : ℕ) : op (n : α) = n :=
  rfl
#align mul_opposite.op_nat_cast MulOpposite.op_natCast
#align add_opposite.op_nat_cast AddOpposite.op_natCast

@[to_additive (attr := simp, norm_cast)]
theorem op_intCast [IntCast α] (n : ℤ) : op (n : α) = n :=
  rfl
#align mul_opposite.op_int_cast MulOpposite.op_intCast
#align add_opposite.op_int_cast AddOpposite.op_intCast

@[to_additive (attr := simp, norm_cast)]
theorem unop_natCast [NatCast α] (n : ℕ) : unop (n : αᵐᵒᵖ) = n :=
  rfl
#align mul_opposite.unop_nat_cast MulOpposite.unop_natCast
#align add_opposite.unop_nat_cast AddOpposite.unop_natCast

@[to_additive (attr := simp, norm_cast)]
theorem unop_intCast [IntCast α] (n : ℤ) : unop (n : αᵐᵒᵖ) = n :=
  rfl
#align mul_opposite.unop_int_cast MulOpposite.unop_intCast
#align add_opposite.unop_int_cast AddOpposite.unop_intCast

@[to_additive (attr := simp)]
theorem unop_div [DivInvMonoid α] (x y : αᵐᵒᵖ) : unop (x / y) = (unop y)⁻¹ * unop x :=
  rfl
#align mul_opposite.unop_div MulOpposite.unop_div
#align add_opposite.unop_sub AddOpposite.unop_sub

@[to_additive (attr := simp)]
theorem op_div [DivInvMonoid α] (x y : α) : op (x / y) = (op y)⁻¹ * op x := by simp [div_eq_mul_inv]
#align mul_opposite.op_div MulOpposite.op_div
#align add_opposite.op_sub AddOpposite.op_sub

@[to_additive (attr := simp)]
theorem semiconjBy_op [Mul α] {a x y : α} : SemiconjBy (op a) (op y) (op x) ↔ SemiconjBy a x y :=
  by simp only [SemiconjBy, ← op_mul, op_inj, eq_comm]
#align mul_opposite.semiconj_by_op MulOpposite.semiconjBy_op
#align add_opposite.semiconj_by_op AddOpposite.semiconjBy_op

@[to_additive (attr := simp, nolint simpComm)]
theorem semiconjBy_unop [Mul α] {a x y : αᵐᵒᵖ} :
    SemiconjBy (unop a) (unop y) (unop x) ↔ SemiconjBy a x y := by
  conv_rhs => rw [← op_unop a, ← op_unop x, ← op_unop y, semiconjBy_op]
#align mul_opposite.semiconj_by_unop MulOpposite.semiconjBy_unop
#align add_opposite.semiconj_by_unop AddOpposite.semiconjBy_unop

attribute [nolint simpComm] AddOpposite.semiconjBy_unop

@[to_additive]
theorem _root_.SemiconjBy.op [Mul α] {a x y : α} (h : SemiconjBy a x y) :
    SemiconjBy (op a) (op y) (op x) :=
  semiconjBy_op.2 h
#align semiconj_by.op SemiconjBy.op
#align add_semiconj_by.op AddSemiconjBy.op

@[to_additive]
theorem _root_.SemiconjBy.unop [Mul α] {a x y : αᵐᵒᵖ} (h : SemiconjBy a x y) :
    SemiconjBy (unop a) (unop y) (unop x) :=
  semiconjBy_unop.2 h
#align semiconj_by.unop SemiconjBy.unop
#align add_semiconj_by.unop AddSemiconjBy.unop

@[to_additive]
theorem _root_.Commute.op [Mul α] {x y : α} (h : Commute x y) : Commute (op x) (op y) :=
  SemiconjBy.op h
#align commute.op Commute.op
#align add_commute.op AddCommute.op

@[to_additive]
theorem Commute.unop [Mul α] {x y : αᵐᵒᵖ} (h : Commute x y) : Commute (unop x) (unop y) :=
  h.unop
#align mul_opposite.commute.unop MulOpposite.Commute.unop
#align add_opposite.commute.unop AddOpposite.Commute.unop

@[to_additive (attr := simp)]
theorem commute_op [Mul α] {x y : α} : Commute (op x) (op y) ↔ Commute x y :=
  semiconjBy_op
#align mul_opposite.commute_op MulOpposite.commute_op
#align add_opposite.commute_op AddOpposite.commute_op

@[to_additive (attr := simp, nolint simpComm)]
theorem commute_unop [Mul α] {x y : αᵐᵒᵖ} : Commute (unop x) (unop y) ↔ Commute x y :=
  semiconjBy_unop
#align mul_opposite.commute_unop MulOpposite.commute_unop
#align add_opposite.commute_unop AddOpposite.commute_unop

attribute [nolint simpComm] AddOpposite.commute_unop

/-- The function `MulOpposite.op` is an additive equivalence. -/
@[simps! (config := { fullyApplied := false, simpRhs := true }) apply symm_apply]
def opAddEquiv [Add α] : α ≃+ αᵐᵒᵖ :=
  { opEquiv with map_add' := fun _ _ => rfl }
#align mul_opposite.op_add_equiv MulOpposite.opAddEquiv
#align mul_opposite.op_add_equiv_apply MulOpposite.opAddEquiv_apply
#align mul_opposite.op_add_equiv_symm_apply MulOpposite.opAddEquiv_symm_apply

@[simp]
theorem opAddEquiv_toEquiv [Add α] : ((opAddEquiv : α ≃+ αᵐᵒᵖ) : α ≃ αᵐᵒᵖ) = opEquiv := rfl

#align mul_opposite.op_add_equiv_to_equiv MulOpposite.opAddEquiv_toEquiv

end MulOpposite

/-!
### Multiplicative structures on `αᵃᵒᵖ`
-/

namespace AddOpposite

instance semigroup [Semigroup α] : Semigroup αᵃᵒᵖ :=
  unop_injective.semigroup _ fun _ _ => rfl

instance leftCancelSemigroup [LeftCancelSemigroup α] : LeftCancelSemigroup αᵃᵒᵖ :=
  unop_injective.leftCancelSemigroup _ fun _ _ => rfl

instance rightCancelSemigroup [RightCancelSemigroup α] : RightCancelSemigroup αᵃᵒᵖ :=
  unop_injective.rightCancelSemigroup _ fun _ _ => rfl

instance commSemigroup [CommSemigroup α] : CommSemigroup αᵃᵒᵖ :=
  unop_injective.commSemigroup _ fun _ _ => rfl

instance mulOneClass [MulOneClass α] : MulOneClass αᵃᵒᵖ :=
  unop_injective.mulOneClass _ (by exact rfl) fun _ _ => rfl

instance pow {β} [Pow α β] : Pow αᵃᵒᵖ β where pow a b := op (unop a ^ b)

@[simp]
theorem op_pow {β} [Pow α β] (a : α) (b : β) : op (a ^ b) = op a ^ b :=
  rfl
#align add_opposite.op_pow AddOpposite.op_pow

@[simp]
theorem unop_pow {β} [Pow α β] (a : αᵃᵒᵖ) (b : β) : unop (a ^ b) = unop a ^ b :=
  rfl
#align add_opposite.unop_pow AddOpposite.unop_pow

instance monoid [Monoid α] : Monoid αᵃᵒᵖ :=
  unop_injective.monoid _ (by exact rfl) (fun _ _ => rfl) fun _ _ => rfl

instance commMonoid [CommMonoid α] : CommMonoid αᵃᵒᵖ :=
  unop_injective.commMonoid _ (by exact rfl) (fun _ _ => rfl) fun _ _ => rfl

instance divInvMonoid [DivInvMonoid α] : DivInvMonoid αᵃᵒᵖ :=
  unop_injective.divInvMonoid _ (by exact rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl

instance group [Group α] : Group αᵃᵒᵖ :=
  unop_injective.group _ (by exact rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl

instance commGroup [CommGroup α] : CommGroup αᵃᵒᵖ :=
  unop_injective.commGroup _ (by exact rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl

-- NOTE: `addMonoidWithOne α → addMonoidWithOne αᵃᵒᵖ` does not hold
instance addCommMonoidWithOne [AddCommMonoidWithOne α] : AddCommMonoidWithOne αᵃᵒᵖ :=
  { AddOpposite.addCommMonoid α, AddOpposite.one, AddOpposite.natCast α with
    natCast_zero := show op ((0 : ℕ) : α) = 0 by rw [Nat.cast_zero, op_zero]
    natCast_succ := show ∀ n, op ((n + 1 : ℕ) : α) = op ↑(n : ℕ) + 1 by simp [add_comm] }

instance addCommGroupWithOne [AddCommGroupWithOne α] : AddCommGroupWithOne αᵃᵒᵖ :=
  { AddOpposite.addCommMonoidWithOne α, AddOpposite.addCommGroup α, AddOpposite.intCast α with
    intCast_ofNat := λ _ ↦ congr_arg op $ Int.cast_ofNat _
    intCast_negSucc := λ _ ↦ congr_arg op $ Int.cast_negSucc _ }

variable {α}

/-- The function `AddOpposite.op` is a multiplicative equivalence. -/
@[simps! (config := { fullyApplied := false, simpRhs := true })]
def opMulEquiv [Mul α] : α ≃* αᵃᵒᵖ :=
  { opEquiv with map_mul' := fun _ _ => rfl }
#align add_opposite.op_mul_equiv AddOpposite.opMulEquiv
#align add_opposite.op_mul_equiv_symm_apply AddOpposite.opMulEquiv_symm_apply

@[simp]
theorem opMulEquiv_toEquiv [Mul α] : ((opMulEquiv : α ≃* αᵃᵒᵖ) : α ≃ αᵃᵒᵖ) = opEquiv :=
  rfl
#align add_opposite.op_mul_equiv_to_equiv AddOpposite.opMulEquiv_toEquiv

end AddOpposite

open MulOpposite

/-- Inversion on a group is a `MulEquiv` to the opposite group. When `G` is commutative, there is
`MulEquiv.inv`. -/
@[to_additive (attr := simps! (config := { fullyApplied := false, simpRhs := true }))
      "Negation on an additive group is an `AddEquiv` to the opposite group. When `G`
      is commutative, there is `AddEquiv.inv`."]
def MulEquiv.inv' (G : Type _) [DivisionMonoid G] : G ≃* Gᵐᵒᵖ :=
  { (Equiv.inv G).trans opEquiv with map_mul' := fun x y => unop_injective <| mul_inv_rev x y }
#align mul_equiv.inv' MulEquiv.inv'
#align add_equiv.neg' AddEquiv.neg'
#align mul_equiv.inv'_symm_apply MulEquiv.inv'_symm_apply
#align add_equiv.inv'_symm_apply AddEquiv.neg'_symm_apply

/-- A semigroup homomorphism `f : M →ₙ* N` such that `f x` commutes with `f y` for all `x, y`
defines a semigroup homomorphism to `Nᵐᵒᵖ`. -/
@[to_additive (attr := simps (config := { fullyApplied := false }))
      "An additive semigroup homomorphism `f : AddHom M N` such that `f x` additively
      commutes with `f y` for all `x, y` defines an additive semigroup homomorphism to `Sᵃᵒᵖ`."]
def MulHom.toOpposite {M N : Type _} [Mul M] [Mul N] (f : M →ₙ* N)
    (hf : ∀ x y, Commute (f x) (f y)) : M →ₙ* Nᵐᵒᵖ where
  toFun := op ∘ f
  map_mul' x y := by simp [(hf x y).eq]
#align mul_hom.to_opposite MulHom.toOpposite
#align add_hom.to_opposite AddHom.toOpposite
#align mul_hom.to_opposite_apply MulHom.toOpposite_apply
#align add_hom.to_opposite_apply AddHom.toOpposite_apply

/-- A semigroup homomorphism `f : M →ₙ* N` such that `f x` commutes with `f y` for all `x, y`
defines a semigroup homomorphism from `Mᵐᵒᵖ`. -/
@[to_additive (attr := simps (config := { fullyApplied := false }))
      "An additive semigroup homomorphism `f : AddHom M N` such that `f x` additively
      commutes with `f y` for all `x`, `y` defines an additive semigroup homomorphism from `Mᵃᵒᵖ`."]
def MulHom.fromOpposite {M N : Type _} [Mul M] [Mul N] (f : M →ₙ* N)
    (hf : ∀ x y, Commute (f x) (f y)) : Mᵐᵒᵖ →ₙ* N where
  toFun := f ∘ MulOpposite.unop
  map_mul' _ _ := (f.map_mul _ _).trans (hf _ _).eq
#align mul_hom.from_opposite MulHom.fromOpposite
#align add_hom.from_opposite AddHom.fromOpposite
#align mul_hom.from_opposite_apply MulHom.fromOpposite_apply
#align add_hom.from_opposite_apply AddHom.fromOpposite_apply

/-- A monoid homomorphism `f : M →* N` such that `f x` commutes with `f y` for all `x, y` defines
a monoid homomorphism to `Nᵐᵒᵖ`. -/
@[to_additive (attr := simps (config := { fullyApplied := false }))
      "An additive monoid homomorphism `f : M →+ N` such that `f x` additively commutes
      with `f y` for all `x, y` defines an additive monoid homomorphism to `Sᵃᵒᵖ`."]
def MonoidHom.toOpposite {M N : Type _} [MulOneClass M] [MulOneClass N] (f : M →* N)
    (hf : ∀ x y, Commute (f x) (f y)) : M →* Nᵐᵒᵖ where
  toFun := op ∘ f
  map_one' := congrArg op f.map_one
  map_mul' x y := by simp [(hf x y).eq]
#align monoid_hom.to_opposite MonoidHom.toOpposite
#align add_monoid_hom.to_opposite AddMonoidHom.toOpposite
#align monoid_hom.to_opposite_apply MonoidHom.toOpposite_apply
#align add_monoid_hom.to_opposite_apply AddMonoidHom.toOpposite_apply

/-- A monoid homomorphism `f : M →* N` such that `f x` commutes with `f y` for all `x, y` defines
a monoid homomorphism from `Mᵐᵒᵖ`. -/
@[to_additive (attr := simps (config := { fullyApplied := false }))
      "An additive monoid homomorphism `f : M →+ N` such that `f x` additively commutes
      with `f y` for all `x`, `y` defines an additive monoid homomorphism from `Mᵃᵒᵖ`."]
def MonoidHom.fromOpposite {M N : Type _} [MulOneClass M] [MulOneClass N] (f : M →* N)
    (hf : ∀ x y, Commute (f x) (f y)) : Mᵐᵒᵖ →* N where
  toFun := f ∘ MulOpposite.unop
  map_one' := f.map_one
  map_mul' _ _ := (f.map_mul _ _).trans (hf _ _).eq
#align monoid_hom.from_opposite MonoidHom.fromOpposite
#align add_monoid_hom.from_opposite AddMonoidHom.fromOpposite
#align monoid_hom.from_opposite_apply MonoidHom.fromOpposite_apply
#align add_monoid_hom.from_opposite_apply AddMonoidHom.fromOpposite_apply

/-- The units of the opposites are equivalent to the opposites of the units. -/
@[to_additive
      "The additive units of the additive opposites are equivalent to the additive opposites
      of the additive units."]
def Units.opEquiv {M} [Monoid M] : Mᵐᵒᵖˣ ≃* Mˣᵐᵒᵖ where
  toFun u := op ⟨unop u, unop ↑u⁻¹, op_injective u.4, op_injective u.3⟩
  invFun := MulOpposite.rec' fun u => ⟨op ↑u, op ↑u⁻¹, unop_injective <| u.4, unop_injective u.3⟩
  map_mul' x y := unop_injective <| Units.ext <| rfl
  left_inv x := Units.ext <| by simp
  right_inv x := unop_injective <| Units.ext <| rfl
#align units.op_equiv Units.opEquiv
#align add_units.op_equiv AddUnits.opEquiv

@[to_additive (attr := simp)]
theorem Units.coe_unop_opEquiv {M} [Monoid M] (u : Mᵐᵒᵖˣ) :
    ((Units.opEquiv u).unop : M) = unop (u : Mᵐᵒᵖ) :=
  rfl
#align units.coe_unop_op_equiv Units.coe_unop_opEquiv
#align add_units.coe_unop_op_equiv AddUnits.coe_unop_opEquiv

@[to_additive (attr := simp)]
theorem Units.coe_opEquiv_symm {M} [Monoid M] (u : Mˣᵐᵒᵖ) :
    (Units.opEquiv.symm u : Mᵐᵒᵖ) = op (u.unop : M) :=
  rfl
#align units.coe_op_equiv_symm Units.coe_opEquiv_symm
#align add_units.coe_op_equiv_symm AddUnits.coe_opEquiv_symm

/-- A semigroup homomorphism `M →ₙ* N` can equivalently be viewed as a semigroup homomorphism
`Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/
@[to_additive (attr := simps)
      "An additive semigroup homomorphism `AddHom M N` can equivalently be viewed as an
      additive semigroup homomorphism `AddHom Mᵃᵒᵖ Nᵃᵒᵖ`. This is the action of the
      (fully faithful)`ᵃᵒᵖ`-functor on morphisms."]
def MulHom.op {M N} [Mul M] [Mul N] : (M →ₙ* N) ≃ (Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ) where
  toFun f :=
    { toFun := MulOpposite.op ∘ f ∘ unop,
      map_mul' := fun x y => unop_injective (f.map_mul y.unop x.unop) }
  invFun f :=
    { toFun := unop ∘ f ∘ MulOpposite.op,
      map_mul' := fun x y => congrArg unop (f.map_mul (MulOpposite.op y) (MulOpposite.op x)) }
  left_inv _ := rfl
  right_inv _ := rfl
#align mul_hom.op MulHom.op
#align add_hom.op AddHom.op
#align mul_hom.op_symm_apply_apply MulHom.op_symm_apply_apply
#align mul_hom.op_apply_apply MulHom.op_apply_apply
#align add_hom.op_symm_apply_apply AddHom.op_symm_apply_apply
#align add_hom.op_apply_apply AddHom.op_apply_apply

/-- The 'unopposite' of a semigroup homomorphism `Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ`. Inverse to `MulHom.op`. -/
@[to_additive (attr := simp)
      "The 'unopposite' of an additive semigroup homomorphism `Mᵃᵒᵖ →ₙ+ Nᵃᵒᵖ`. Inverse
      to `AddHom.op`."]
def MulHom.unop {M N} [Mul M] [Mul N] : (Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ) ≃ (M →ₙ* N) :=
  MulHom.op.symm
#align mul_hom.unop MulHom.unop
#align add_hom.unop AddHom.unop

/-- An additive semigroup homomorphism `AddHom M N` can equivalently be viewed as an additive
homomorphism `AddHom Mᵐᵒᵖ Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on
morphisms. -/
@[simps]
def AddHom.mulOp {M N} [Add M] [Add N] : AddHom M N ≃ AddHom Mᵐᵒᵖ Nᵐᵒᵖ where
  toFun f :=
    { toFun := MulOpposite.op ∘ f ∘ MulOpposite.unop,
      map_add' := fun x y => unop_injective (f.map_add x.unop y.unop) }
  invFun f :=
    { toFun := MulOpposite.unop ∘ f ∘ MulOpposite.op,
      map_add' :=
        fun x y => congrArg MulOpposite.unop (f.map_add (MulOpposite.op x) (MulOpposite.op y)) }
  left_inv _ := rfl
  right_inv _ := rfl
#align add_hom.mul_op AddHom.mulOp
#align add_hom.mul_op_symm_apply_apply AddHom.mulOp_symm_apply_apply
#align add_hom.mul_op_apply_apply AddHom.mulOp_apply_apply

/-- The 'unopposite' of an additive semigroup hom `αᵐᵒᵖ →+ βᵐᵒᵖ`. Inverse to
`AddHom.mul_op`. -/
@[simp]
def AddHom.mulUnop {α β} [Add α] [Add β] : AddHom αᵐᵒᵖ βᵐᵒᵖ ≃ AddHom α β :=
  AddHom.mulOp.symm
#align add_hom.mul_unop AddHom.mulUnop

/-- A monoid homomorphism `M →* N` can equivalently be viewed as a monoid homomorphism
`Mᵐᵒᵖ →* Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/
@[to_additive (attr := simps)
      "An additive monoid homomorphism `M →+ N` can equivalently be viewed as an
      additive monoid homomorphism `Mᵃᵒᵖ →+ Nᵃᵒᵖ`. This is the action of the (fully faithful)
      `ᵃᵒᵖ`-functor on morphisms."]
def MonoidHom.op {M N} [MulOneClass M] [MulOneClass N] : (M →* N) ≃ (Mᵐᵒᵖ →* Nᵐᵒᵖ) where
  toFun f :=
    { toFun := MulOpposite.op ∘ f ∘ unop, map_one' := congrArg MulOpposite.op f.map_one,
      map_mul' := fun x y => unop_injective (f.map_mul y.unop x.unop) }
  invFun f :=
    { toFun := unop ∘ f ∘ MulOpposite.op, map_one' := congrArg unop f.map_one,
      map_mul' := fun x y => congrArg unop (f.map_mul (MulOpposite.op y) (MulOpposite.op x)) }
  left_inv _ := rfl
  right_inv _ := rfl
#align monoid_hom.op MonoidHom.op
#align add_monoid_hom.op AddMonoidHom.op
#align monoid_hom.op_apply_apply MonoidHom.op_apply_apply
#align monoid_hom.op_symm_apply_apply MonoidHom.op_symm_apply_apply
#align add_monoid_hom.op_apply_apply AddMonoidHom.op_apply_apply
#align add_monoid_hom.op_symm_apply_apply AddMonoidHom.op_symm_apply_apply

/-- The 'unopposite' of a monoid homomorphism `Mᵐᵒᵖ →* Nᵐᵒᵖ`. Inverse to `MonoidHom.op`. -/
@[to_additive (attr := simp)
      "The 'unopposite' of an additive monoid homomorphism `Mᵃᵒᵖ →+ Nᵃᵒᵖ`. Inverse to
      `AddMonoidHom.op`."]
def MonoidHom.unop {M N} [MulOneClass M] [MulOneClass N] : (Mᵐᵒᵖ →* Nᵐᵒᵖ) ≃ (M →* N) :=
  MonoidHom.op.symm
#align monoid_hom.unop MonoidHom.unop
#align add_monoid_hom.unop AddMonoidHom.unop

/-- An additive homomorphism `M →+ N` can equivalently be viewed as an additive homomorphism
`Mᵐᵒᵖ →+ Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/
@[simps]
def AddMonoidHom.mulOp {M N} [AddZeroClass M] [AddZeroClass N] : (M →+ N) ≃ (Mᵐᵒᵖ →+  Nᵐᵒᵖ) where
  toFun f :=
    { toFun := MulOpposite.op ∘ f ∘ MulOpposite.unop, map_zero' := unop_injective f.map_zero,
      map_add' := fun x y => unop_injective (f.map_add x.unop y.unop) }
  invFun f :=
    { toFun := MulOpposite.unop ∘ f ∘ MulOpposite.op,
      map_zero' := congrArg MulOpposite.unop f.map_zero,
      map_add' :=
        fun x y => congrArg MulOpposite.unop (f.map_add (MulOpposite.op x) (MulOpposite.op y)) }
  left_inv _ := rfl
  right_inv _ := rfl
#align add_monoid_hom.mul_op AddMonoidHom.mulOp
#align add_monoid_hom.mul_op_symm_apply_apply AddMonoidHom.mulOp_symm_apply_apply
#align add_monoid_hom.mul_op_apply_apply AddMonoidHom.mulOp_apply_apply

/-- The 'unopposite' of an additive monoid hom `αᵐᵒᵖ →+ βᵐᵒᵖ`. Inverse to
`AddMonoidHom.mul_op`. -/
@[simp]
def AddMonoidHom.mulUnop {α β} [AddZeroClass α] [AddZeroClass β] : (αᵐᵒᵖ →+ βᵐᵒᵖ) ≃ (α →+ β) :=
  AddMonoidHom.mulOp.symm
#align add_monoid_hom.mul_unop AddMonoidHom.mulUnop

/-- A iso `α ≃+ β` can equivalently be viewed as an iso `αᵐᵒᵖ ≃+ βᵐᵒᵖ`. -/
@[simps]
def AddEquiv.mulOp {α β} [Add α] [Add β] : α ≃+ β ≃ (αᵐᵒᵖ ≃+ βᵐᵒᵖ) where
  toFun f := opAddEquiv.symm.trans (f.trans opAddEquiv)
  invFun f := opAddEquiv.trans (f.trans opAddEquiv.symm)
  left_inv _ := rfl
  right_inv _ := rfl
#align add_equiv.mul_op AddEquiv.mulOp
#align add_equiv.mul_op_apply AddEquiv.mulOp_apply
#align add_equiv.mul_op_symm_apply AddEquiv.mulOp_symm_apply

/-- The 'unopposite' of an iso `αᵐᵒᵖ ≃+ βᵐᵒᵖ`. Inverse to `AddEquiv.mul_op`. -/
@[simp]
def AddEquiv.mulUnop {α β} [Add α] [Add β] : αᵐᵒᵖ ≃+ βᵐᵒᵖ ≃ (α ≃+ β) :=
  AddEquiv.mulOp.symm
#align add_equiv.mul_unop AddEquiv.mulUnop

/-- A iso `α ≃* β` can equivalently be viewed as an iso `αᵐᵒᵖ ≃* βᵐᵒᵖ`. -/
@[to_additive (attr := simps) "A iso `α ≃+ β` can equivalently be viewed as an iso `αᵃᵒᵖ ≃+ βᵃᵒᵖ`."]
def MulEquiv.op {α β} [Mul α] [Mul β] : α ≃* β ≃ (αᵐᵒᵖ ≃* βᵐᵒᵖ) where
  toFun f :=
    { toFun := MulOpposite.op ∘ f ∘ unop, invFun := MulOpposite.op ∘ f.symm ∘ unop,
      left_inv := fun x => unop_injective (f.symm_apply_apply x.unop),
      right_inv := fun x => unop_injective (f.apply_symm_apply x.unop),
      map_mul' := fun x y => unop_injective (f.map_mul y.unop x.unop) }
  invFun f :=
    { toFun := unop ∘ f ∘ MulOpposite.op, invFun := unop ∘ f.symm ∘ MulOpposite.op,
      left_inv := fun x => by simp,
      right_inv := fun x => by simp,
      map_mul' := fun x y => congr_arg unop (f.map_mul (MulOpposite.op y) (MulOpposite.op x)) }
  left_inv _ := rfl
  right_inv _ := rfl
#align mul_equiv.op MulEquiv.op
#align add_equiv.op AddEquiv.op
#align mul_equiv.op_symm_apply_symm_apply MulEquiv.op_symm_apply_symm_apply
#align mul_equiv.op_apply_apply MulEquiv.op_apply_apply
#align mul_equiv.op_apply_symm_apply MulEquiv.op_apply_symm_apply
#align mul_equiv.op_symm_apply_apply MulEquiv.op_symm_apply_apply
#align add_equiv.op_symm_apply_symm_apply AddEquiv.op_symm_apply_symm_apply
#align add_equiv.op_apply_apply AddEquiv.op_apply_apply
#align add_equiv.op_apply_symm_apply AddEquiv.op_apply_symm_apply
#align add_equiv.op_symm_apply_apply AddEquiv.op_symm_apply_apply

/-- The 'unopposite' of an iso `αᵐᵒᵖ ≃* βᵐᵒᵖ`. Inverse to `MulEquiv.op`. -/
@[to_additive (attr := simp)
  "The 'unopposite' of an iso `αᵃᵒᵖ ≃+ βᵃᵒᵖ`. Inverse to `AddEquiv.op`."]
def MulEquiv.unop {α β} [Mul α] [Mul β] : αᵐᵒᵖ ≃* βᵐᵒᵖ ≃ (α ≃* β) :=
  MulEquiv.op.symm
#align mul_equiv.unop MulEquiv.unop
#align add_equiv.unop AddEquiv.unop

section Ext

/-- This ext lemma changes equalities on `αᵐᵒᵖ →+ β` to equalities on `α →+ β`.
This is useful because there are often ext lemmas for specific `α`s that will apply
to an equality of `α →+ β` such as `Finsupp.addHom_ext'`. -/
@[ext]
theorem AddMonoidHom.mul_op_ext {α β} [AddZeroClass α] [AddZeroClass β] (f g : αᵐᵒᵖ →+ β)
    (h :
      f.comp (opAddEquiv : α ≃+ αᵐᵒᵖ).toAddMonoidHom =
        g.comp (opAddEquiv : α ≃+ αᵐᵒᵖ).toAddMonoidHom) :
    f = g :=
  AddMonoidHom.ext <| MulOpposite.rec fun x => (FunLike.congr_fun h : _) x
#align add_monoid_hom.mul_op_ext AddMonoidHom.mul_op_ext

end Ext


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.module.basic
import algebra.gcd_monoid.basic
import algebra.group_ring_action.basic
import group_theory.group_action.defs
import order.complete_boolean_algebra

/-!
# Instances on punit

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file collects facts about algebraic structures on the one-element type, e.g. that it is a
commutative ring.
-/

universes u

namespace punit
variables {R S : Type*} (x y : punit.{u+1}) (s : set punit.{u+1})

@[to_additive]
instance : comm_group punit :=
by refine_struct
{ mul := λ _ _, star,
  one := star,
  inv := λ _, star,
  div := λ _ _, star,
  npow := λ _ _, star,
  zpow := λ _ _, star,
  .. };
intros; exact subsingleton.elim _ _

@[simp, to_additive] lemma one_eq : (1 : punit) = star := rfl
@[simp, to_additive] lemma mul_eq : x * y = star := rfl
-- `sub_eq` simplifies `punit.sub_eq`, but the latter is eligible for `dsimp`
@[simp, nolint simp_nf, to_additive] lemma div_eq : x / y = star := rfl
-- `neg_eq` simplifies `punit.neg_eq`, but the latter is eligible for `dsimp`
@[simp, nolint simp_nf, to_additive] lemma inv_eq : x⁻¹ = star := rfl

instance : comm_ring punit :=
by refine
{ nat_cast := λ _, punit.star,
  .. punit.comm_group,
  .. punit.add_comm_group,
  .. };
intros; exact subsingleton.elim _ _

instance : cancel_comm_monoid_with_zero punit :=
by refine
{ .. punit.comm_ring,
  .. };
intros; exact subsingleton.elim _ _

instance : normalized_gcd_monoid punit :=
by refine
{ gcd := λ _ _, star,
  lcm := λ _ _, star,
  norm_unit := λ x, 1,
  gcd_dvd_left := λ _ _, ⟨star, subsingleton.elim _ _⟩,
  gcd_dvd_right := λ _ _, ⟨star, subsingleton.elim _ _⟩,
  dvd_gcd := λ _ _ _ _ _, ⟨star, subsingleton.elim _ _⟩,
  gcd_mul_lcm := λ _ _, ⟨1, subsingleton.elim _ _⟩,
  .. };
intros; exact subsingleton.elim _ _

@[simp] lemma gcd_eq : gcd x y = star := rfl
@[simp] lemma lcm_eq : lcm x y = star := rfl
@[simp] lemma norm_unit_eq : norm_unit x = 1 := rfl

instance : canonically_ordered_add_monoid punit :=
by refine
{ exists_add_of_le := λ _ _ _, ⟨star, subsingleton.elim _ _⟩,
  .. punit.comm_ring, .. punit.complete_boolean_algebra, .. };
intros; trivial

instance : linear_ordered_cancel_add_comm_monoid punit :=
{ le_of_add_le_add_left := λ _ _ _ _, trivial,
  .. punit.canonically_ordered_add_monoid, ..punit.linear_order }

instance : linear_ordered_add_comm_monoid_with_top punit :=
{ top_add' := λ _, rfl,
  ..punit.complete_boolean_algebra,
  ..punit.linear_ordered_cancel_add_comm_monoid }

@[to_additive] instance : has_smul R punit := ⟨λ _ _, star⟩

@[simp, to_additive] lemma smul_eq (r : R) : r • y = star := rfl

@[to_additive] instance : is_central_scalar R punit := ⟨λ _ _, rfl⟩
@[to_additive] instance : smul_comm_class R S punit := ⟨λ _ _ _, rfl⟩
@[to_additive] instance [has_smul R S] : is_scalar_tower R S punit := ⟨λ _ _ _, rfl⟩

instance [has_zero R] : smul_with_zero R punit :=
by refine { ..punit.has_smul, .. };
intros; exact subsingleton.elim _ _

instance [monoid R] : mul_action R punit :=
by refine { ..punit.has_smul, .. };
intros; exact subsingleton.elim _ _

instance [monoid R] : distrib_mul_action R punit :=
by refine { ..punit.mul_action, .. };
intros; exact subsingleton.elim _ _

instance [monoid R] : mul_distrib_mul_action R punit :=
by refine { ..punit.mul_action, .. };
intros; exact subsingleton.elim _ _

instance [semiring R] : mul_semiring_action R punit :=
{ ..punit.distrib_mul_action, ..punit.mul_distrib_mul_action }

instance [monoid_with_zero R] : mul_action_with_zero R punit :=
{ .. punit.mul_action, .. punit.smul_with_zero }

instance [semiring R] : module R punit :=
by refine { .. punit.distrib_mul_action, .. };
intros; exact subsingleton.elim _ _

end punit


/-
Apache 2, because everyone else is doing it
Written by Kevin Buzzard summer 2021 in his shed.
Powered by `mathlib` and the leanprover-community, without which
nothing would have happened.
Thanks to Leo and everyone at Microsoft Research for Lean.
-/
-- This imports all user tactics and a whole bunch of basic mathematics
import tactic
/-!

# Level 1 : Groups

In this level we demonstrate how a mathematician works with groups
in Lean. I will assume that the user has the basic group theory
knowledge which would be taught in a first course at university.
-/

/-

## Introduction

When a mathematician says "Let $G$ be a group" they mean the following.
They are postulating the existence of a `Type` (or a `Set`, it makes no
difference) called `G`, which has

* Structure
such as `1 : G`, `⁻¹ : G → G` and `* : G → G → G`
* Axioms and theorems
such as
`mul_assoc g h k : (g * h) * k = g * (h * k)`
`mul_one g : g * 1 = g`
`mul_inv_rev g h : (g * h)⁻¹ = h⁻¹ * g⁻¹`

In this Lean file, I'll explain how to say "Let $G$ be a group" in Lean 3.

## Section 1.1 : Let $G$ be a group.

Here's how we say "let $G$ be a group with `*` as group law" in Lean.

`variables (G : Type) [group G]`

Ignorable note: the `[group G]` part means "We let Lean's square bracket system,
a.k.a. its typeclass system,  handle the fact that `G` is a group".

Here's how we say "let $g$ and $h$ be elements of $G$":

`variables (g h : G)`

Let's start by playing with these ideas. Feel free to try your
own stuff.
-/

/-

## Exercise 1.1 : play with #check

`#check` tells you the type of a term. The computer science colon
notation `g : G` is pronounced "`g` is a term of type `G`",
so if you put `#check g` you'll get `G`. Try it! Click on
some of the #check s below (underlined in blue) and look at the output
in the infoview. Ask yourself some questions in group theory.
Can you make them `#check`?

Tip : there should never be any *errors* in your file. Check on the
bottom left that it says 0 by the x, and that there are no red dots
on the right of that little scrollbar. If something doesn't work,
just comment it out and leave a note if you don't understand why.
Don't leave the error in the file.

-/

-- let G be a group, and let g, h, k be elements
variables (G : Type) [group G] (g h k : G)

#check g * h -- works! Infoview reports that `g * h` is in `G`
#check (g * 1 * g * h⁻¹)^3 -- also works

#check ∀ a : G, a ^ 2 = 1 -- a Proposition

-- What can you make? Does `g / h` make sense? What do you think it means?

/-

### Technical note

Jump straight to Section 2 if you're only interested in the maths.

In Lean, actual function names aren't allowed to contain fancy maths
symbols and they always act on the left like $f(x,y)$ instead of being an
infix operator like `*` which takes its arguments one on either side.
In fact `1`, `*`, `⁻¹` and even the lesser-used `/` are notation for the
following functions:

-/

example : has_mul.mul g h = g * h := begin refl end
example : has_inv.inv g = g ⁻¹ := begin refl end
example : (has_one.one : G) = 1 := begin refl end
example : has_div.div g h = g / h := begin refl end
-- what do you think g/h is equal to?

/-

## Section 1.2 : theorems about elements of a group

The axioms of a group and theorems about groups in Lean look like
`∀ g h k, (g * h) * k = g * (h * k)` and `∀ g, 1 * g = g`. It doesn't
matter to us where that second one is an axiom or a theorem -- what we
are concerned with right now is figuring out how to get access to the proofs
of these useful-looking results. And to get access to them, you need
to know their names.

### `library_search`

If what you want is a (proof of a) basic and standard fact about groups
such as `g * 1 = g` then you can be guaranteed that this will already be
in the library. Here's a very easy way of finding the name of this
theorem.
-/
example : g * 1 = g :=
begin
  -- click on the blue line below. Then click where it says "Try this!"
  -- and the proof will change
  library_search,
end

/-

You discover from this exercise that the theorem is called `mul_one`. Now
look at the statement of the theorem and start to learn the conventions
which we use in mathlib when naming theorems in group theory.
-/

/-

## Exercise 1.2 : playing with `library_search`

Remove all the sorrys below. Either use `library_search`, or, if you're
feeling lucky, `exact <name_I_guessed>`.

If you want to know more about the naming conventions used here, check out
the Lean prover community website's page on theorem names in Lean:
https://leanprover-community.github.io/contribute/naming.html

Tip : I use `sorry`s in the below so I don't get errors. Use them yourself to
fill in boring parts of proofs if you want to experiment and don't want errors
everywhere.
-/

variables {G g h k} -- don't need them explicit

-- Try guessing this one
example : 1 * g = g :=
begin
  sorry
end

-- Try solving this one with `library_search`
theorem foobar : g = h * k⁻¹ ↔ g * k = h :=
begin
  sorry
end

-- Try library_search on this one too.
example : g * k = h ↔ g = h * k⁻¹ :=
begin
  sorry -- compare the name of this one with the last one.
  -- technical note: that's `iff.symm` and dot notation
end

-- the library tends to not have equalities or iffs where the RHS
-- is more complicated than the left hand side.
-- Can you use `eq.symm` and dot notation in a short term mode proof?
example : g = g * 1 :=
begin
  sorry
end

-- For example, if you want the best chance of finding the fact
-- that g⁻¹⁻¹ and g are equal, then your best chance is to put
-- the more complex term on the left
example : g⁻¹⁻¹ = g :=
begin
  sorry
end

-- Try `library_search` on this one
example : g⁻¹ = h → h⁻¹ = g :=
begin
  sorry
end
-- What just happened?
-- `iff.mp` means "turn `P ↔ Q` into `P → Q`". The theorem was in the
-- library, but only in the `↔` form. Check out the clever use of dot
-- notation

/-

### Technical note : dot notation

If you're just interested in the maths, skip this part.

If `h : P ↔ Q`, i.e. if `h` is a proof of `P ↔ Q` then, because `↔` is
actually just notation, `h` is actually a term of type `iff P Q`.
This means that you can use "dot notation" -- for example `h.mp`
will be interpreted by Lean as `iff.mp h`, because `iff` is the "head term"
in the type of `h`. If you `#check iff.mp` this might be enough
information for you to deduce that `h.mp` will be a proof of `P → Q`.

-/

/-

## Section 1.3 : Prove some theorems!

Let's prove that if G is a group and if $g^2=1$ for all $g \in G$ then $G$
is abelian.

First let's write down a clear maths proof which doesn't skip anything.

Sublemma : if g^2=1 then g⁻¹ = g . Proof: easy.

Remark: In fact it's iff. Hence Another way of asking this question would
be the following: Assume `G` is a group where the inverse function is equal to
the identity function. Prove that `G` is commutative.

Proof of main result : xy=(xy)⁻¹=y⁻¹x⁻¹=yx

Now let's do it in Lean.
-/

example : g^2 = g * g := sq g -- guess how I found that function
-- (hint : I used tactic mode to start with)

lemma inv_eq : g * g = 1 → g⁻¹ = g :=
begin
  exact inv_eq_of_mul_eq_one, -- guess how I found that
end

-- in the middle of the proof of the big theorem below I needed a lemma
-- so I just popped out here to find what it was called

example : (g * h) ⁻¹ = h⁻¹ * g⁻¹ := by library_search

theorem big_theorem (hyp : ∀ (g : G), g^2 = 1) : ∀ a b : G, a * b = b * a :=
begin
  -- let a and b be arbitrary
  intros a b,
  -- now make the sublemma
  have sublemma : ∀ g : G, g⁻¹ = g,
  { -- proof of the sublemma in squiggly brackets
    -- assume g in G
    intro g,
    -- use `inv_eq` above
    apply inv_eq,
    -- notice the square problem
    rw [← sq g],
    -- now it follows from h
    apply hyp,
    -- done
  },
  -- now the main proof. LHS is a * b, RHS is b * a. Let's work on LHS.
  rw ← sublemma (a * b),
  -- It's now (ab)⁻¹
  rw mul_inv_rev,
  -- it's now b⁻¹a⁻¹
  rw [sublemma a, sublemma b],
  --  it's now ba, which is the RHS,
  -- and because `rw` tries a sneaky `refl` at the end,we're done
  -- goals accomplished 🎉
end

/-

## Exercise 1.3 : Prove a theorem in group theory

-/

-- think of a theorem. Doesn't matter if it's easy. All you need is
-- a maths proof, `library_search` and `rw` and you can do loads of things.
-- Try proving that `g * h * 1 * h⁻¹ = g`. It might be harder
-- than you think with rewrites! Try some tactics. Do you know about `simp`?