/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker
-/
import algebra.big_operators.basic
import algebra.divisibility
import algebra.invertible

/-!
# Associated, prime, and irreducible elements.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

theorem is_unit_iff_dvd_one [comm_monoid α] {x : α} : is_unit x ↔ x ∣ 1 :=
⟨by rintro ⟨u, rfl⟩; exact ⟨_, u.mul_inv.symm⟩,
 λ ⟨y, h⟩, ⟨⟨x, y, h.symm, by rw [h, mul_comm]⟩, rfl⟩⟩

theorem is_unit_iff_forall_dvd [comm_monoid α] {x : α} :
  is_unit x ↔ ∀ y, x ∣ y :=
is_unit_iff_dvd_one.trans ⟨λ h y, h.trans (one_dvd _), λ h, h _⟩

theorem is_unit_of_dvd_unit {α} [comm_monoid α] {x y : α}
  (xy : x ∣ y) (hu : is_unit y) : is_unit x :=
is_unit_iff_dvd_one.2 $ xy.trans $ is_unit_iff_dvd_one.1 hu

lemma is_unit_of_dvd_one [comm_monoid α] : ∀a ∣ 1, is_unit (a:α)
| a ⟨b, eq⟩ := ⟨units.mk_of_mul_eq_one a b eq.symm, rfl⟩

lemma dvd_and_not_dvd_iff [comm_cancel_monoid_with_zero α] {x y : α} :
  x ∣ y ∧ ¬y ∣ x ↔ dvd_not_unit x y :=
⟨λ ⟨⟨d, hd⟩, hyx⟩, ⟨λ hx0, by simpa [hx0] using hyx, ⟨d,
    mt is_unit_iff_dvd_one.1 (λ ⟨e, he⟩, hyx ⟨e, by rw [hd, mul_assoc, ← he, mul_one]⟩), hd⟩⟩,
  λ ⟨hx0, d, hdu, hdx⟩, ⟨⟨d, hdx⟩, λ ⟨e, he⟩, hdu (is_unit_of_dvd_one _
    ⟨e, mul_left_cancel₀ hx0 $ by conv {to_lhs, rw [he, hdx]};simp [mul_assoc]⟩)⟩⟩

lemma pow_dvd_pow_iff [comm_cancel_monoid_with_zero α]
  {x : α} {n m : ℕ} (h0 : x ≠ 0) (h1 : ¬ is_unit x) :
  x ^ n ∣ x ^ m ↔ n ≤ m :=
begin
  split,
  { intro h, rw [← not_lt], intro hmn, apply h1,
    have : x ^ m * x ∣ x ^ m * 1,
    { rw [← pow_succ', mul_one], exact (pow_dvd_pow _ (nat.succ_le_of_lt hmn)).trans h },
    rwa [mul_dvd_mul_iff_left, ← is_unit_iff_dvd_one] at this, apply pow_ne_zero m h0 },
  { apply pow_dvd_pow }
end

section prime
variables [comm_monoid_with_zero α]

/-- prime element of a `comm_monoid_with_zero` -/
def prime (p : α) : Prop :=
p ≠ 0 ∧ ¬ is_unit p ∧ (∀a b, p ∣ a * b → p ∣ a ∨ p ∣ b)

namespace prime
variables {p : α} (hp : prime p)
include hp

lemma ne_zero : p ≠ 0 :=
hp.1

lemma not_unit : ¬ is_unit p :=
hp.2.1

lemma not_dvd_one : ¬ p ∣ 1 :=
mt (is_unit_of_dvd_one _) hp.not_unit

lemma ne_one : p ≠ 1 :=
λ h, hp.2.1 (h.symm ▸ is_unit_one)

lemma dvd_or_dvd (hp : prime p) {a b : α} (h : p ∣ a * b) :
  p ∣ a ∨ p ∣ b :=
hp.2.2 a b h

lemma dvd_of_dvd_pow (hp : prime p) {a : α} {n : ℕ} (h : p ∣ a^n) :
  p ∣ a :=
begin
  induction n with n ih,
  { rw pow_zero at h,
    have := is_unit_of_dvd_one _ h,
    have := not_unit hp,
    contradiction },
  rw pow_succ at h,
  cases dvd_or_dvd hp h with dvd_a dvd_pow,
  { assumption },
  exact ih dvd_pow
end

lemma exists_mem_multiset_dvd {s : multiset α} :
  p ∣ s.prod → ∃ a ∈ s, p ∣ a :=
multiset.induction_on s (λ h, (hp.not_dvd_one h).elim) $
λ a s ih h,
  have p ∣ a * s.prod, by simpa using h,
  match hp.dvd_or_dvd this with
  | or.inl h := ⟨a, multiset.mem_cons_self a s, h⟩
  | or.inr h := let ⟨a, has, h⟩ := ih h in ⟨a, multiset.mem_cons_of_mem has, h⟩
  end

lemma exists_mem_multiset_map_dvd {s : multiset β} {f : β → α} :
  p ∣ (s.map f).prod → ∃ a ∈ s, p ∣ f a :=
λ h, by simpa only [exists_prop, multiset.mem_map, exists_exists_and_eq_and]
  using hp.exists_mem_multiset_dvd h

lemma exists_mem_finset_dvd {s : finset β} {f : β → α} :
  p ∣ s.prod f → ∃ i ∈ s, p ∣ f i :=
hp.exists_mem_multiset_map_dvd

end prime

@[simp] lemma not_prime_zero : ¬ prime (0 : α) :=
λ h, h.ne_zero rfl

@[simp] lemma not_prime_one : ¬ prime (1 : α) :=
λ h, h.not_unit is_unit_one

end prime

lemma prime.left_dvd_or_dvd_right_of_dvd_mul [comm_cancel_monoid_with_zero α] {p : α}
  (hp : prime p) {a b : α} : a ∣ p * b → p ∣ a ∨ a ∣ b :=
begin
  rintro ⟨c, hc⟩,
  rcases hp.2.2 a c (hc ▸ dvd_mul_right _ _) with h | ⟨x, rfl⟩,
  { exact or.inl h },
  { rw [mul_left_comm, mul_right_inj' hp.ne_zero] at hc,
    exact or.inr (hc.symm ▸ dvd_mul_right _ _) }
end

/-- `irreducible p` states that `p` is non-unit and only factors into units.

We explicitly avoid stating that `p` is non-zero, this would require a semiring. Assuming only a
monoid allows us to reuse irreducible for associated elements.
-/
class irreducible [monoid α] (p : α) : Prop :=
(not_unit' : ¬ is_unit p)
(is_unit_or_is_unit' : ∀a b, p = a * b → is_unit a ∨ is_unit b)

namespace irreducible

lemma not_unit [monoid α] {p : α} (hp : irreducible p) : ¬ is_unit p :=
hp.1

lemma is_unit_or_is_unit [monoid α] {p : α} (hp : irreducible p) {a b : α} (h : p = a * b) :
  is_unit a ∨ is_unit b :=
irreducible.is_unit_or_is_unit' a b h

end irreducible

lemma irreducible_iff [monoid α] {p : α} :
  irreducible p ↔ ¬ is_unit p ∧ ∀a b, p = a * b → is_unit a ∨ is_unit b :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

@[simp] theorem not_irreducible_one [monoid α] : ¬ irreducible (1 : α) :=
by simp [irreducible_iff]

@[simp] theorem not_irreducible_zero [monoid_with_zero α] : ¬ irreducible (0 : α)
| ⟨hn0, h⟩ := have is_unit (0:α) ∨ is_unit (0:α), from h 0 0 ((mul_zero 0).symm),
  this.elim hn0 hn0

theorem irreducible.ne_zero [monoid_with_zero α] : ∀ {p:α}, irreducible p → p ≠ 0
| _ hp rfl := not_irreducible_zero hp

theorem of_irreducible_mul {α} [monoid α] {x y : α} :
  irreducible (x * y) → is_unit x ∨ is_unit y
| ⟨_, h⟩ := h _ _ rfl

theorem irreducible_or_factor {α} [monoid α] (x : α) (h : ¬ is_unit x) :
  irreducible x ∨ ∃ a b, ¬ is_unit a ∧ ¬ is_unit b ∧ a * b = x :=
begin
  haveI := classical.dec,
  refine or_iff_not_imp_right.2 (λ H, _),
  simp [h, irreducible_iff] at H ⊢,
  refine λ a b h, classical.by_contradiction $ λ o, _,
  simp [not_or_distrib] at o,
  exact H _ o.1 _ o.2 h.symm
end

protected lemma prime.irreducible [comm_cancel_monoid_with_zero α] {p : α} (hp : prime p) :
  irreducible p :=
⟨hp.not_unit, λ a b hab,
  (show a * b ∣ a ∨ a * b ∣ b, from hab ▸ hp.dvd_or_dvd (hab ▸ dvd_rfl)).elim
    (λ ⟨x, hx⟩, or.inr (is_unit_iff_dvd_one.2
      ⟨x, mul_right_cancel₀ (show a ≠ 0, from λ h, by simp [*, prime] at *)
        $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩))
    (λ ⟨x, hx⟩, or.inl (is_unit_iff_dvd_one.2
      ⟨x, mul_right_cancel₀ (show b ≠ 0, from λ h, by simp [*, prime] at *)
        $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩))⟩

lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul [comm_cancel_monoid_with_zero α]
  {p : α} (hp : prime p) {a b : α} {k l : ℕ} :
  p ^ k ∣ a → p ^ l ∣ b → p ^ ((k + l) + 1) ∣ a * b → p ^ (k + 1) ∣ a ∨ p ^ (l + 1) ∣ b :=
λ ⟨x, hx⟩ ⟨y, hy⟩ ⟨z, hz⟩,
have h : p ^ (k + l) * (x * y) = p ^ (k + l) * (p * z),
  by simpa [mul_comm, pow_add, hx, hy, mul_assoc, mul_left_comm] using hz,
have hp0: p ^ (k + l) ≠ 0, from pow_ne_zero _ hp.ne_zero,
have hpd : p ∣ x * y, from ⟨z, by rwa [mul_right_inj' hp0] at h⟩,
(hp.dvd_or_dvd hpd).elim
  (λ ⟨d, hd⟩, or.inl ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩)
  (λ ⟨d, hd⟩, or.inr ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩)

/-- If `p` and `q` are irreducible, then `p ∣ q` implies `q ∣ p`. -/
lemma irreducible.dvd_symm [monoid α] {p q : α}
  (hp : irreducible p) (hq : irreducible q) : p ∣ q → q ∣ p :=
begin
  tactic.unfreeze_local_instances,
  rintros ⟨q', rfl⟩,
  rw is_unit.mul_right_dvd (or.resolve_left (of_irreducible_mul hq) hp.not_unit),
end

lemma irreducible.dvd_comm [monoid α] {p q : α}
  (hp : irreducible p) (hq : irreducible q) : p ∣ q ↔ q ∣ p :=
⟨hp.dvd_symm hq, hq.dvd_symm hp⟩

/-- Two elements of a `monoid` are `associated` if one of them is another one
multiplied by a unit on the right. -/
def associated [monoid α] (x y : α) : Prop := ∃u:units α, x * u = y

local infix ` ~ᵤ ` : 50 := associated

namespace associated

@[refl] protected theorem refl [monoid α] (x : α) : x ~ᵤ x := ⟨1, by simp⟩

@[symm] protected theorem symm [monoid α] : ∀{x y : α}, x ~ᵤ y → y ~ᵤ x
| x _ ⟨u, rfl⟩ := ⟨u⁻¹, by rw [mul_assoc, units.mul_inv, mul_one]⟩

@[trans] protected theorem trans [monoid α] : ∀{x y z : α}, x ~ᵤ y → y ~ᵤ z → x ~ᵤ z
| x _ _ ⟨u, rfl⟩ ⟨v, rfl⟩ := ⟨u * v, by rw [units.coe_mul, mul_assoc]⟩

/-- The setoid of the relation `x ~ᵤ y` iff there is a unit `u` such that `x * u = y` -/
protected def setoid (α : Type*) [monoid α] : setoid α :=
{ r := associated, iseqv := ⟨associated.refl, λa b, associated.symm, λa b c, associated.trans⟩ }

end associated

local attribute [instance] associated.setoid

theorem unit_associated_one [monoid α] {u : units α} : (u : α) ~ᵤ 1 := ⟨u⁻¹, units.mul_inv u⟩

theorem associated_one_iff_is_unit [monoid α] {a : α} : (a : α) ~ᵤ 1 ↔ is_unit a :=
iff.intro
  (assume h, let ⟨c, h⟩ := h.symm in h ▸ ⟨c, (one_mul _).symm⟩)
  (assume ⟨c, h⟩, associated.symm ⟨c, by simp [h]⟩)

theorem associated_zero_iff_eq_zero [monoid_with_zero α] (a : α) : a ~ᵤ 0 ↔ a = 0 :=
iff.intro
  (assume h, let ⟨u, h⟩ := h.symm in by simpa using h.symm)
  (assume h, h ▸ associated.refl a)

theorem associated_one_of_mul_eq_one [comm_monoid α] {a : α} (b : α) (hab : a * b = 1) : a ~ᵤ 1 :=
show (units.mk_of_mul_eq_one a b hab : α) ~ᵤ 1, from unit_associated_one

theorem associated_one_of_associated_mul_one [comm_monoid α] {a b : α} :
  a * b ~ᵤ 1 → a ~ᵤ 1
| ⟨u, h⟩ := associated_one_of_mul_eq_one (b * u) $ by simpa [mul_assoc] using h

lemma associated_mul_unit_left {β : Type*} [monoid β] (a u : β) (hu : is_unit u) :
  associated (a * u) a :=
let ⟨u', hu⟩ := hu in ⟨u'⁻¹, hu ▸ units.mul_inv_cancel_right _ _⟩

lemma associated_unit_mul_left {β : Type*} [comm_monoid β] (a u : β) (hu : is_unit u) :
  associated (u * a) a :=
begin
  rw mul_comm,
  exact associated_mul_unit_left _ _ hu
end

lemma associated_mul_unit_right {β : Type*} [monoid β] (a u : β) (hu : is_unit u) :
  associated a (a * u) :=
(associated_mul_unit_left a u hu).symm

lemma associated_unit_mul_right {β : Type*} [comm_monoid β] (a u : β) (hu : is_unit u) :
  associated a (u * a) :=
(associated_unit_mul_left a u hu).symm

lemma associated.mul_mul [comm_monoid α] {a₁ a₂ b₁ b₂ : α} :
  a₁ ~ᵤ b₁ → a₂ ~ᵤ b₂ → (a₁ * a₂) ~ᵤ (b₁ * b₂)
| ⟨c₁, h₁⟩ ⟨c₂, h₂⟩ := ⟨c₁ * c₂, by simp [h₁.symm, h₂.symm, mul_assoc, mul_comm, mul_left_comm]⟩

lemma associated.mul_left [comm_monoid α] (a : α) {b c : α} (h : b ~ᵤ c) :
  (a * b) ~ᵤ (a * c) :=
(associated.refl a).mul_mul h

lemma associated.mul_right [comm_monoid α] {a b : α} (h : a ~ᵤ b) (c : α) :
  (a * c) ~ᵤ (b * c) :=
h.mul_mul (associated.refl c)

lemma associated.pow_pow [comm_monoid α] {a b : α} {n : ℕ} (h : a ~ᵤ b) :
  a ^ n ~ᵤ b ^ n :=
begin
  induction n with n ih, { simp [h] },
  convert h.mul_mul ih;
    rw pow_succ
end

protected lemma associated.dvd [monoid α] {a b : α} : a ~ᵤ b → a ∣ b := λ ⟨u, hu⟩, ⟨u, hu.symm⟩

protected lemma associated.dvd_dvd [monoid α] {a b : α} (h : a ~ᵤ b) : a ∣ b ∧ b ∣ a :=
⟨h.dvd, h.symm.dvd⟩

theorem associated_of_dvd_dvd [cancel_monoid_with_zero α]
  {a b : α} (hab : a ∣ b) (hba : b ∣ a) : a ~ᵤ b :=
begin
  rcases hab with ⟨c, rfl⟩,
  rcases hba with ⟨d, a_eq⟩,
  by_cases ha0 : a = 0,
  { simp [*] at * },
  have hac0 : a * c ≠ 0,
  { intro con, rw [con, zero_mul] at a_eq, apply ha0 a_eq, },
  have : a * (c * d) =  a * 1 := by rw [← mul_assoc, ← a_eq, mul_one],
  have hcd : (c * d) = 1, from mul_left_cancel₀ ha0 this,
  have : a * c * (d * c) = a * c * 1 := by rw [← mul_assoc, ← a_eq, mul_one],
  have hdc : d * c = 1, from mul_left_cancel₀ hac0 this,
  exact ⟨⟨c, d, hcd, hdc⟩, rfl⟩
end

theorem dvd_dvd_iff_associated [cancel_monoid_with_zero α] {a b : α} : a ∣ b ∧ b ∣ a ↔ a ~ᵤ b :=
⟨λ ⟨h1, h2⟩, associated_of_dvd_dvd h1 h2, associated.dvd_dvd⟩

lemma exists_associated_mem_of_dvd_prod [comm_cancel_monoid_with_zero α] {p : α}
  (hp : prime p) {s : multiset α} : (∀ r ∈ s, prime r) → p ∣ s.prod → ∃ q ∈ s, p ~ᵤ q :=
multiset.induction_on s (by simp [mt is_unit_iff_dvd_one.2 hp.not_unit])
  (λ a s ih hs hps, begin
    rw [multiset.prod_cons] at hps,
    cases hp.dvd_or_dvd hps with h h,
    { use [a, by simp],
      cases h with u hu,
      cases (((hs a (multiset.mem_cons.2 (or.inl rfl))).irreducible)
        .is_unit_or_is_unit hu).resolve_left hp.not_unit with v hv,
      exact ⟨v, by simp [hu, hv]⟩ },
    { rcases ih (λ r hr, hs _ (multiset.mem_cons.2 (or.inr hr))) h with ⟨q, hq₁, hq₂⟩,
      exact ⟨q, multiset.mem_cons.2 (or.inr hq₁), hq₂⟩ }
  end)

lemma associated.dvd_iff_dvd_left [monoid α] {a b c : α} (h : a ~ᵤ b) : a ∣ c ↔ b ∣ c :=
let ⟨u, hu⟩ := h in hu ▸ units.mul_right_dvd.symm

lemma associated.dvd_iff_dvd_right [monoid α] {a b c : α} (h : b ~ᵤ c) : a ∣ b ↔ a ∣ c :=
let ⟨u, hu⟩ := h in hu ▸ units.dvd_mul_right.symm

lemma associated.eq_zero_iff [monoid_with_zero α] {a b : α} (h : a ~ᵤ b) : a = 0 ↔ b = 0 :=
⟨λ ha, let ⟨u, hu⟩ := h in by simp [hu.symm, ha],
  λ hb, let ⟨u, hu⟩ := h.symm in by simp [hu.symm, hb]⟩

lemma associated.ne_zero_iff [monoid_with_zero α] {a b : α} (h : a ~ᵤ b) : a ≠ 0 ↔ b ≠ 0 :=
not_congr h.eq_zero_iff

protected lemma associated.prime [comm_monoid_with_zero α] {p q : α} (h : p ~ᵤ q) (hp : prime p) :
  prime q :=
⟨h.ne_zero_iff.1 hp.ne_zero,
  let ⟨u, hu⟩ := h in
    ⟨λ ⟨v, hv⟩, hp.not_unit ⟨v * u⁻¹, by simp [hv, hu.symm]⟩,
      hu ▸ by { simp [units.mul_right_dvd], intros a b, exact hp.dvd_or_dvd }⟩⟩

lemma irreducible.associated_of_dvd [cancel_monoid_with_zero α] {p q : α}
  (p_irr : irreducible p) (q_irr : irreducible q) (dvd : p ∣ q) : associated p q :=
associated_of_dvd_dvd dvd (p_irr.dvd_symm q_irr dvd)

lemma irreducible.dvd_irreducible_iff_associated [cancel_monoid_with_zero α]
  {p q : α} (pp : irreducible p) (qp : irreducible q) :
  p ∣ q ↔ associated p q :=
⟨irreducible.associated_of_dvd pp qp, associated.dvd⟩

lemma prime.associated_of_dvd [comm_cancel_monoid_with_zero α] {p q : α}
  (p_prime : prime p) (q_prime : prime q) (dvd : p ∣ q) : associated p q :=
p_prime.irreducible.associated_of_dvd q_prime.irreducible dvd

theorem prime.dvd_prime_iff_associated [comm_cancel_monoid_with_zero α]
  {p q : α} (pp : prime p) (qp : prime q) :
  p ∣ q ↔ associated p q :=
pp.irreducible.dvd_irreducible_iff_associated qp.irreducible
lemma associated.prime_iff [comm_monoid_with_zero α] {p q : α}
  (h : p ~ᵤ q) : prime p ↔ prime q :=
⟨h.prime, h.symm.prime⟩

protected lemma associated.is_unit [monoid α] {a b : α} (h :  a ~ᵤ b) : is_unit a → is_unit b :=
let ⟨u, hu⟩ := h in λ ⟨v, hv⟩, ⟨v * u, by simp [hv, hu.symm]⟩

lemma associated.is_unit_iff [monoid α] {a b : α} (h :  a ~ᵤ b) : is_unit a ↔ is_unit b :=
⟨h.is_unit, h.symm.is_unit⟩

protected lemma associated.irreducible [monoid α] {p q : α} (h : p ~ᵤ q)
  (hp : irreducible p) : irreducible q :=
⟨mt h.symm.is_unit hp.1,
  let ⟨u, hu⟩ := h in λ a b hab,
  have hpab : p = a * (b * (u⁻¹ : units α)),
    from calc p = (p * u) * (u ⁻¹ : units α) : by simp
      ... = _ : by rw hu; simp [hab, mul_assoc],
  (hp.is_unit_or_is_unit hpab).elim or.inl (λ ⟨v, hv⟩, or.inr ⟨v * u, by simp [hv]⟩)⟩

protected lemma associated.irreducible_iff [monoid α] {p q : α} (h : p ~ᵤ q) :
  irreducible p ↔ irreducible q :=
⟨h.irreducible, h.symm.irreducible⟩

lemma associated.of_mul_left [comm_cancel_monoid_with_zero α] {a b c d : α}
  (h : a * b ~ᵤ c * d) (h₁ : a ~ᵤ c) (ha : a ≠ 0) : b ~ᵤ d :=
let ⟨u, hu⟩ := h in let ⟨v, hv⟩ := associated.symm h₁ in
⟨u * (v : units α), mul_left_cancel₀ ha
  begin
    rw [← hv, mul_assoc c (v : α) d, mul_left_comm c, ← hu],
    simp [hv.symm, mul_assoc, mul_comm, mul_left_comm]
  end⟩

lemma associated.of_mul_right [comm_cancel_monoid_with_zero α] {a b c d : α} :
  a * b ~ᵤ c * d → b ~ᵤ d → b ≠ 0 → a ~ᵤ c :=
by rw [mul_comm a, mul_comm c]; exact associated.of_mul_left

section unique_units
variables [monoid α] [unique (units α)]

lemma units_eq_one (u : units α) : u = 1 := subsingleton.elim u 1

theorem associated_iff_eq {x y : α} : x ~ᵤ y ↔ x = y :=
begin
  split,
  { rintro ⟨c, rfl⟩, rw [units_eq_one c, units.coe_one, mul_one] },
  { rintro rfl, refl },
end

theorem associated_eq_eq : (associated : α → α → Prop) = eq :=
by { ext, rw associated_iff_eq }

end unique_units

/-- The quotient of a monoid by the `associated` relation. Two elements `x` and `y`
  are associated iff there is a unit `u` such that `x * u = y`. There is a natural
  monoid structure on `associates α`. -/
def associates (α : Type*) [monoid α] : Type* :=
quotient (associated.setoid α)

namespace associates
open associated

/-- The canonical quotient map from a monoid `α` into the `associates` of `α` -/
protected def mk {α : Type*} [monoid α] (a : α) : associates α :=
⟦ a ⟧

instance [monoid α] : inhabited (associates α) := ⟨⟦1⟧⟩

theorem mk_eq_mk_iff_associated [monoid α] {a b : α} :
  associates.mk a = associates.mk b ↔ a ~ᵤ b :=
iff.intro quotient.exact quot.sound

theorem quotient_mk_eq_mk [monoid α] (a : α) : ⟦ a ⟧ = associates.mk a := rfl

theorem quot_mk_eq_mk [monoid α] (a : α) : quot.mk setoid.r a = associates.mk a := rfl

theorem forall_associated [monoid α] {p : associates α → Prop} :
  (∀a, p a) ↔ (∀a, p (associates.mk a)) :=
iff.intro
  (assume h a, h _)
  (assume h a, quotient.induction_on a h)

theorem mk_surjective [monoid α] : function.surjective (@associates.mk α _) :=
forall_associated.2 (λ a, ⟨a, rfl⟩)

instance [monoid α] : has_one (associates α) := ⟨⟦ 1 ⟧⟩

theorem one_eq_mk_one [monoid α] : (1 : associates α) = associates.mk 1 := rfl

instance [monoid α] : has_bot (associates α) := ⟨1⟩

lemma exists_rep [monoid α] (a : associates α) : ∃ a0 : α, associates.mk a0 = a :=
quot.exists_rep a

section comm_monoid
variable [comm_monoid α]

instance : has_mul (associates α) :=
⟨λa' b', quotient.lift_on₂ a' b' (λa b, ⟦ a * b ⟧) $
  assume a₁ a₂ b₁ b₂ ⟨c₁, h₁⟩ ⟨c₂, h₂⟩,
  quotient.sound $ ⟨c₁ * c₂, by simp [h₁.symm, h₂.symm, mul_assoc, mul_comm, mul_left_comm]⟩⟩

theorem mk_mul_mk {x y : α} : associates.mk x * associates.mk y = associates.mk (x * y) :=
rfl

instance : comm_monoid (associates α) :=
{ one       := 1,
  mul       := (*),
  mul_one   := assume a', quotient.induction_on a' $
    assume a, show ⟦a * 1⟧ = ⟦ a ⟧, by simp,
  one_mul   := assume a', quotient.induction_on a' $
    assume a, show ⟦1 * a⟧ = ⟦ a ⟧, by simp,
  mul_assoc := assume a' b' c', quotient.induction_on₃ a' b' c' $
    assume a b c, show ⟦a * b * c⟧ = ⟦a * (b * c)⟧, by rw [mul_assoc],
  mul_comm  := assume a' b', quotient.induction_on₂ a' b' $
    assume a b, show ⟦a * b⟧ = ⟦b * a⟧, by rw [mul_comm] }

instance : preorder (associates α) :=
{ le := has_dvd.dvd,
  le_refl := dvd_refl,
  le_trans := λ a b c, dvd_trans}

@[simp] lemma mk_one : associates.mk (1 : α) = 1 := rfl

/-- `associates.mk` as a `monoid_hom`. -/
protected def mk_monoid_hom : α →* (associates α) := ⟨associates.mk, mk_one, λ x y, mk_mul_mk⟩

@[simp] lemma mk_monoid_hom_apply (a : α) : associates.mk_monoid_hom a = associates.mk a := rfl

lemma associated_map_mk {f : associates α →* α}
  (hinv : function.right_inverse f associates.mk) (a : α) :
  a ~ᵤ f (associates.mk a) :=
associates.mk_eq_mk_iff_associated.1 (hinv (associates.mk a)).symm

lemma mk_pow (a : α) (n : ℕ) : associates.mk (a ^ n) = (associates.mk a) ^ n :=
by induction n; simp [*, pow_succ, associates.mk_mul_mk.symm]

lemma dvd_eq_le : ((∣) : associates α → associates α → Prop) = (≤) := rfl

theorem prod_mk {p : multiset α} : (p.map associates.mk).prod = associates.mk p.prod :=
multiset.induction_on p (by simp; refl) $ assume a s ih, by simp [ih]; refl

theorem rel_associated_iff_map_eq_map {p q : multiset α} :
  multiset.rel associated p q ↔ p.map associates.mk = q.map associates.mk :=
by { rw [← multiset.rel_eq, multiset.rel_map], simp only [mk_eq_mk_iff_associated] }

theorem mul_eq_one_iff {x y : associates α} : x * y = 1 ↔ (x = 1 ∧ y = 1) :=
iff.intro
  (quotient.induction_on₂ x y $ assume a b h,
    have a * b ~ᵤ 1, from quotient.exact h,
    ⟨quotient.sound $ associated_one_of_associated_mul_one this,
      quotient.sound $ associated_one_of_associated_mul_one $ by rwa [mul_comm] at this⟩)
  (by simp {contextual := tt})

theorem prod_eq_one_iff {p : multiset (associates α)} :
  p.prod = 1 ↔ (∀a ∈ p, (a:associates α) = 1) :=
multiset.induction_on p
  (by simp)
  (by simp [mul_eq_one_iff, or_imp_distrib, forall_and_distrib] {contextual := tt})

theorem units_eq_one (u : units (associates α)) : u = 1 :=
units.ext (mul_eq_one_iff.1 u.val_inv).1

instance unique_units : unique (units (associates α)) :=
{ default := 1, uniq := associates.units_eq_one }

theorem coe_unit_eq_one (u : units (associates α)): (u : associates α) = 1 :=
by simp

theorem is_unit_iff_eq_one (a : associates α) : is_unit a ↔ a = 1 :=
iff.intro
  (assume ⟨u, h⟩, h ▸ coe_unit_eq_one _)
  (assume h, h.symm ▸ is_unit_one)

theorem is_unit_mk {a : α} : is_unit (associates.mk a) ↔ is_unit a :=
calc is_unit (associates.mk a) ↔ a ~ᵤ 1 :
    by rw [is_unit_iff_eq_one, one_eq_mk_one, mk_eq_mk_iff_associated]
  ... ↔ is_unit a : associated_one_iff_is_unit

section order

theorem mul_mono {a b c d : associates α} (h₁ : a ≤ b) (h₂ : c ≤ d) :
  a * c ≤ b * d :=
let ⟨x, hx⟩ := h₁, ⟨y, hy⟩ := h₂ in
⟨x * y, by simp [hx, hy, mul_comm, mul_assoc, mul_left_comm]⟩

theorem one_le {a : associates α} : 1 ≤ a :=
dvd.intro _ (one_mul a)

theorem prod_le_prod {p q : multiset (associates α)} (h : p ≤ q) : p.prod ≤ q.prod :=
begin
  haveI := classical.dec_eq (associates α),
  haveI := classical.dec_eq α,
  suffices : p.prod ≤ (p + (q - p)).prod, { rwa [add_tsub_cancel_of_le h] at this },
  suffices : p.prod * 1 ≤ p.prod * (q - p).prod, { simpa },
  exact mul_mono (le_refl p.prod) one_le
end

theorem le_mul_right {a b : associates α} : a ≤ a * b := ⟨b, rfl⟩

theorem le_mul_left {a b : associates α} : a ≤ b * a :=
by rw [mul_comm]; exact le_mul_right

instance : order_bot (associates α) :=
{ bot := 1,
  bot_le := assume a, one_le }

end order

end comm_monoid

instance [has_zero α] [monoid α] : has_zero (associates α) := ⟨⟦ 0 ⟧⟩
instance [has_zero α] [monoid α] : has_top (associates α) := ⟨0⟩

section comm_monoid_with_zero

variables [comm_monoid_with_zero α]

@[simp] theorem mk_eq_zero {a : α} : associates.mk a = 0 ↔ a = 0 :=
⟨assume h, (associated_zero_iff_eq_zero a).1 $ quotient.exact h, assume h, h.symm ▸ rfl⟩

theorem mk_ne_zero {a : α} : associates.mk a ≠ 0 ↔ a ≠ 0 :=
not_congr mk_eq_zero

instance : comm_monoid_with_zero (associates α) :=
{ zero_mul := by { rintro ⟨a⟩, show associates.mk (0 * a) = associates.mk 0, rw [zero_mul] },
  mul_zero := by { rintro ⟨a⟩, show associates.mk (a * 0) = associates.mk 0, rw [mul_zero] },
  .. associates.comm_monoid, .. associates.has_zero }

instance : order_top (associates α) :=
{ top := 0,
  le_top := assume a, ⟨0, (mul_zero a).symm⟩ }

instance : bounded_order (associates α) :=
{ .. associates.order_top,
  .. associates.order_bot }

instance [nontrivial α] : nontrivial (associates α) :=
⟨⟨0, 1,
assume h,
have (0 : α) ~ᵤ 1, from quotient.exact h,
have (0 : α) = 1, from ((associated_zero_iff_eq_zero 1).1 this.symm).symm,
zero_ne_one this⟩⟩

lemma exists_non_zero_rep {a : associates α} : a ≠ 0 → ∃ a0 : α, a0 ≠ 0 ∧ associates.mk a0 = a :=
quotient.induction_on a (λ b nz, ⟨b, mt (congr_arg quotient.mk) nz, rfl⟩)

theorem dvd_of_mk_le_mk {a b : α} : associates.mk a ≤ associates.mk b → a ∣ b
| ⟨c', hc'⟩ := (quotient.induction_on c' $ assume c hc,
    let ⟨d, hd⟩ := (quotient.exact hc).symm in
    ⟨(↑d) * c,
      calc b = (a * c) * ↑d : hd.symm
        ... = a * (↑d * c) : by ac_refl⟩) hc'

theorem mk_le_mk_of_dvd {a b : α} : a ∣ b → associates.mk a ≤ associates.mk b :=
assume ⟨c, hc⟩, ⟨associates.mk c, by simp [hc]; refl⟩

theorem mk_le_mk_iff_dvd_iff {a b : α} : associates.mk a ≤ associates.mk b ↔ a ∣ b :=
iff.intro dvd_of_mk_le_mk mk_le_mk_of_dvd

theorem mk_dvd_mk {a b : α} : associates.mk a ∣ associates.mk b ↔ a ∣ b :=
iff.intro dvd_of_mk_le_mk mk_le_mk_of_dvd

lemma prime.le_or_le {p : associates α} (hp : prime p) {a b : associates α} (h : p ≤ a * b) :
  p ≤ a ∨ p ≤ b :=
hp.2.2 a b h

lemma exists_mem_multiset_le_of_prime {s : multiset (associates α)} {p : associates α}
  (hp : prime p) :
  p ≤ s.prod → ∃a∈s, p ≤ a :=
multiset.induction_on s (assume ⟨d, eq⟩, (hp.ne_one (mul_eq_one_iff.1 eq.symm).1).elim) $
assume a s ih h,
  have p ≤ a * s.prod, by simpa using h,
  match prime.le_or_le hp this with
  | or.inl h := ⟨a, multiset.mem_cons_self a s, h⟩
  | or.inr h := let ⟨a, has, h⟩ := ih h in ⟨a, multiset.mem_cons_of_mem has, h⟩
  end

lemma prime_mk (p : α) : prime (associates.mk p) ↔ _root_.prime p :=
begin
  rw [prime, _root_.prime, forall_associated],
  transitivity,
  { apply and_congr, refl,
    apply and_congr, refl,
    apply forall_congr, assume a,
    exact forall_associated },
  apply and_congr mk_ne_zero,
  apply and_congr,
  { rw [is_unit_mk], },
  apply forall_congr, assume a,
  apply forall_congr, assume b,
  rw [mk_mul_mk, mk_dvd_mk, mk_dvd_mk, mk_dvd_mk],
end

theorem irreducible_mk (a : α) : irreducible (associates.mk a) ↔ irreducible a :=
begin
  simp only [irreducible_iff, is_unit_mk],
  apply and_congr iff.rfl,
  split,
  { rintro h x y rfl,
    simpa [is_unit_mk] using h (associates.mk x) (associates.mk y) rfl },
  { intros h x y,
    refine quotient.induction_on₂ x y (assume x y a_eq, _),
    rcases quotient.exact a_eq.symm with ⟨u, a_eq⟩,
    rw mul_assoc at a_eq,
    show is_unit (associates.mk x) ∨ is_unit (associates.mk y),
    simpa [is_unit_mk] using h _ _ a_eq.symm }
end

theorem mk_dvd_not_unit_mk_iff {a b : α} :
  dvd_not_unit (associates.mk a) (associates.mk b) ↔
  dvd_not_unit a b :=
begin
  rw [dvd_not_unit, dvd_not_unit, mk_ne_zero],
  apply and_congr_right, intro ane0,
  split,
  { contrapose!, rw forall_associated,
    intros h x hx hbax,
    rw [mk_mul_mk, mk_eq_mk_iff_associated] at hbax,
    cases hbax with u hu,
    apply h (x * ↑u⁻¹),
    { rw is_unit_mk at hx,
      rw associated.is_unit_iff,
      apply hx,
      use u,
      simp, },
    simp [← mul_assoc, ← hu] },
  { rintro ⟨x, ⟨hx, rfl⟩⟩,
    use associates.mk x,
    simp [is_unit_mk, mk_mul_mk, hx], }
end

theorem dvd_not_unit_of_lt {a b : associates α} (hlt : a < b) :
  dvd_not_unit a b :=
begin
  split, { rintro rfl, apply not_lt_of_le _ hlt, apply dvd_zero },
  rcases hlt with ⟨⟨x, rfl⟩, ndvd⟩,
  refine ⟨x, _, rfl⟩,
  contrapose! ndvd,
  rcases ndvd with ⟨u, rfl⟩,
  simp,
end

end comm_monoid_with_zero

section comm_cancel_monoid_with_zero
variable [comm_cancel_monoid_with_zero α]

instance : partial_order (associates α) :=
{ le_antisymm := λ a' b', quotient.induction_on₂ a' b' (λ a b hab hba,
  quot.sound $ associated_of_dvd_dvd (dvd_of_mk_le_mk hab) (dvd_of_mk_le_mk hba))
  .. associates.preorder }

instance : no_zero_divisors (associates α) :=
⟨λ x y,
  (quotient.induction_on₂ x y $ assume a b h,
    have a * b = 0, from (associated_zero_iff_eq_zero _).1 (quotient.exact h),
    have a = 0 ∨ b = 0, from mul_eq_zero.1 this,
    this.imp (assume h, h.symm ▸ rfl) (assume h, h.symm ▸ rfl))⟩

theorem irreducible_iff_prime_iff :
  (∀ a : α, irreducible a ↔ prime a) ↔ (∀ a : (associates α), irreducible a ↔ prime a) :=
begin
  rw forall_associated, split;
  intros h a; have ha := h a; rw irreducible_mk at *; rw prime_mk at *; exact ha,
end

lemma eq_of_mul_eq_mul_left :
  ∀(a b c : associates α), a ≠ 0 → a * b = a * c → b = c :=
begin
  rintros ⟨a⟩ ⟨b⟩ ⟨c⟩ ha h,
  rcases quotient.exact' h with ⟨u, hu⟩,
  have hu : a * (b * ↑u) = a * c, { rwa [← mul_assoc] },
  exact quotient.sound' ⟨u, mul_left_cancel₀ (mk_ne_zero.1 ha) hu⟩
end

lemma eq_of_mul_eq_mul_right :
  ∀(a b c : associates α), b ≠ 0 → a * b = c * b → a = c :=
λ a b c bne0, (mul_comm b a) ▸ (mul_comm b c) ▸ (eq_of_mul_eq_mul_left b a c bne0)

lemma le_of_mul_le_mul_left (a b c : associates α) (ha : a ≠ 0) :
  a * b ≤ a * c → b ≤ c
| ⟨d, hd⟩ := ⟨d, eq_of_mul_eq_mul_left a _ _ ha $ by rwa ← mul_assoc⟩

lemma one_or_eq_of_le_of_prime :
  ∀(p m : associates α), prime p → m ≤ p → (m = 1 ∨ m = p)
| _ m ⟨hp0, hp1, h⟩ ⟨d, rfl⟩ :=
match h m d dvd_rfl with
| or.inl h := classical.by_cases (assume : m = 0, by simp [this]) $
  assume : m ≠ 0,
  have m * d ≤ m * 1, by simpa using h,
  have d ≤ 1, from associates.le_of_mul_le_mul_left m d 1 ‹m ≠ 0› this,
  have d = 1, from bot_unique this,
  by simp [this]
| or.inr h := classical.by_cases (assume : d = 0, by simp [this] at hp0; contradiction) $
  assume : d ≠ 0,
  have d * m ≤ d * 1, by simpa [mul_comm] using h,
  or.inl $ bot_unique $ associates.le_of_mul_le_mul_left d m 1 ‹d ≠ 0› this
end

instance : comm_cancel_monoid_with_zero (associates α) :=
{ mul_left_cancel_of_ne_zero := eq_of_mul_eq_mul_left,
  mul_right_cancel_of_ne_zero := eq_of_mul_eq_mul_right,
  .. (infer_instance : comm_monoid_with_zero (associates α)) }

theorem dvd_not_unit_iff_lt {a b : associates α} :
  dvd_not_unit a b ↔ a < b :=
dvd_and_not_dvd_iff.symm

end comm_cancel_monoid_with_zero

end associates

namespace multiset

lemma prod_ne_zero_of_prime [comm_cancel_monoid_with_zero α] [nontrivial α]
 (s : multiset α) (h : ∀ x ∈ s, prime x) : s.prod ≠ 0 :=
multiset.prod_ne_zero (λ h0, prime.ne_zero (h 0 h0) rfl)

end multiset


import group_theory.subgroup data.set.finite

noncomputable theory

open set classical
local attribute [instance] prop_decidable

structure partition (S : Type*) :=
(blocks : set (set S))
(nonempty : ∀ block ∈ blocks, block ≠ ∅)
(covers : univ = ⋃ (s ∈ blocks), s)
(disj   : ∀ s t ∈ blocks, s ∩ t ≠ ∅ → s = t)

private lemma not_empty {α} {S : set α} (h : S ≠ ∅) : ∃ s : α, s ∈ S :=
begin
  by_contra hs, push_neg at hs,
  exact (push_neg.not_eq _ _).1 h (set.eq_empty_iff_forall_not_mem.2 hs)
end

namespace action

structure laction (G : Type*) [group G] (S : Type*) :=
(to_fun    : G → S → S) (map_one : ∀ s : S, to_fun 1 s = s)
(map_assoc : ∀ g h : G, ∀ s : S, to_fun g (to_fun h s) = to_fun (g * h) s)

variables {G : Type*} [group G] {S : Type*}
variables {μ : laction G S}

-- Example of a left action - The natural left action of a group acting on itself
def natural_self_laction : laction G G :=
{ to_fun := λ g h, g * h,
  map_one := one_mul,
  map_assoc := λ _ _ _, (mul_assoc _ _ _).symm }

lemma laction_mul_inv_cancel {g h : G} {s : S} :
  μ.1 g s = μ.1 h s ↔ s = μ.1 (g⁻¹ * h) s :=
begin
  split; intro hgh,
    { conv_lhs { rw ←μ.2 s },
      rw [←(mul_inv_self g⁻¹), ←μ.3, ←μ.3, ←hgh, inv_inv] },
    { conv_lhs { rw [hgh, μ.3, ←mul_assoc, mul_inv_self, one_mul] } }
end

lemma laction_mul_inv {g : G} {s t : S} : μ.1 g s = t ↔ s = μ.1 g⁻¹ t :=
begin
  split; intro h,
    rw [←h, μ.3, mul_left_inv, μ.2],
    rw [h, μ.3, mul_right_inv, μ.2]
end

@[reducible] def orbit (μ : laction G S) (s : S) : set S :=
  { m : S | ∃ g : G, m = μ.1 g s }

/-- An element of `G` is in its own orbit -/
lemma self_mem_orbit (s : S) : s ∈ orbit μ s := ⟨1, (μ.2 s).symm⟩

/-- The set of orbits of a set forms a partition -/
def orbit_partition : partition S :=
{ blocks := { o : set S | ∃ s : S, o = orbit μ s },
  nonempty := λ B hB hemp, by { rcases hB with ⟨s, rfl⟩,
    exact (eq_empty_iff_forall_not_mem.1 hemp s) (self_mem_orbit s) },
  covers := ext $ λ x,
    ⟨ λ hx, mem_Union.2 ⟨orbit μ x, mem_Union.2 ⟨⟨x, rfl⟩, ⟨1, (μ.2 _).symm⟩⟩⟩,
      λ hx, mem_univ x ⟩,
  disj :=
    begin
      rintros _ _ ⟨s₁, rfl⟩ ⟨s₂, rfl⟩ hndisj,
      rcases not_empty hndisj with ⟨x, hxs, hxt⟩,
      ext y, split,
        all_goals { intro hy,
          cases hxs with g₁ hg₁, cases hxt with g₂ hg₂, cases hy with g hg },
        { have : μ.1 g₁⁻¹ (μ.1 g₁ s₁) = μ.1 g₁⁻¹ (μ.1 g₂ s₂),
            rwa [eq.trans hg₁.symm hg₂],
          rw [μ.3, μ.3, inv_mul_self _, μ.2] at this,
          refine ⟨g * (g₁⁻¹ * g₂), _⟩,
          rw [hg, ←μ.3, this] },
        { have : μ.1 g₂⁻¹ (μ.1 g₂ s₂) = μ.1 g₂⁻¹ (μ.1 g₁ s₁),
            rwa [eq.trans hg₁.symm hg₂],
          rw [μ.3, μ.3, inv_mul_self _, μ.2] at this,
          refine ⟨g * (g₂⁻¹ * g₁), _⟩,
          rw [hg, ←μ.3, this] }
    end }

/- We define the stabilizer of an action is as a subgroup -/
@[reducible]
def stabilizer (μ : laction G S) (s : S) : subgroup G :=
{ carrier := { g : G | μ.1 g s = s },
  one_mem' := μ.2 _,
  mul_mem' := λ _ _ hg hh, by { rw mem_set_of_eq at *, rw [←μ.3, hh, hg] },
  inv_mem' := λ x hx,
    begin
      rw mem_set_of_eq at *,
      conv_lhs { rw ←hx },
      rw [μ.3, inv_mul_self _, μ.2]
    end }

-- Some lemmas about orbits that are useful

lemma in_orbit_of_in_same_orbit {s₁ s₂ s₃ : S} :
s₁ ∈ orbit μ s₃ ∧ s₂ ∈ orbit μ s₃ → s₁ ∈ orbit μ s₂ :=
begin
  rintro ⟨⟨g₁, hg₁⟩, ⟨g₂, hg₂⟩⟩,
  refine ⟨g₁ * g₂⁻¹, _⟩,
  rw [hg₁, hg₂, μ.3, mul_assoc, inv_mul_self, mul_one]
end

lemma in_orbit_of_inv {s₁ s₂ : S} {g : G} (h : s₁ = μ.1 g s₂) :
  s₂ = μ.1 g⁻¹ s₁ := by rw [h, μ.3, inv_mul_self, μ.2]

@[reducible]
def is_conjugate (H K : subgroup G) :=
  ∃ g : G, { c | ∃ h ∈ H, c = g⁻¹ * h * g } = K

/-- If `H` is the conjugate of `K`, then `K` is the conjugate of `H` -/
lemma is_conjugate_comm {H K : subgroup G} (h : is_conjugate H K) :
  is_conjugate K H :=
begin
  cases h with g hg, refine ⟨g⁻¹, _⟩,
  ext, split; intro hx,
    { rcases hx with ⟨h, hh₀, hh₁⟩,
      change h ∈ (K : set G) at hh₀,
      rw ←hg at hh₀,
      rcases hh₀ with ⟨k, hk₀, hk₁⟩,
      rw [hh₁, hk₁], simp [mul_assoc, hk₀] },
    { rw mem_set_of_eq,
      refine ⟨g⁻¹ * x * g, _, by simp [mul_assoc]⟩,
      show g⁻¹ * x * g ∈ (K : set G),
      rw ←hg, exact ⟨x, hx, rfl⟩ }
end

/-- If two elements are in the same orbit, then their stabilizers are conjugates -/
theorem conjugate_stabilizer_of_in_same_orbit {s₁ s₂ s₃ : S}
  (h : s₁ ∈ orbit μ s₃ ∧ s₂ ∈ orbit μ s₃) :
  is_conjugate (stabilizer μ s₁) (stabilizer μ s₂) :=
begin
  cases in_orbit_of_in_same_orbit h with g hg,
  refine ⟨g, _⟩,
  ext, split; intro hx,
    { show x ∈ (stabilizer μ s₂).carrier, dsimp,
      rcases hx with ⟨h, hh₀, hh₁⟩,
      rw [hh₁, ←μ.3, ←μ.3, ←hg,
        (show μ.to_fun h s₁ = s₁, by exact hh₀), hg, μ.3, inv_mul_self, μ.2] },
    { change x ∈ (stabilizer μ s₂).carrier at hx, dsimp at hx,
      exact ⟨g * x * g⁻¹, show g * x * g⁻¹ ∈ (stabilizer μ s₁).carrier, by dsimp;
        rw [←μ.3, ←(in_orbit_of_inv hg), ←μ.3, hx, hg], by simp [mul_assoc]⟩ }
end

end action

namespace order

-- We need Lagrange's theorem for Orbit-Stabilizer

/- We will use the cardinality function `fintype.card` defined for fintypes.
While we will prove most theorems in this section for general groups, we will
only consider finite groups when considering the cardinality of the group in
question. This is reflected by the [fintype G] tag in theorems regarding
cardinality.

TODO : refactor the card stuff -/

open function fintype

variables {G : Type*} [group G]
variables {H : subgroup G}

@[reducible]
def lcoset (g : G) (H : subgroup G) : set G :=
  { k : G | ∃ h ∈ H, k = g * h }
notation g ` • ` : 70 H : 70 := lcoset g H

lemma self_mem_coset (a : G) (H : subgroup G): a ∈ a • H :=
  ⟨1, H.one_mem, (mul_one a).symm⟩

/-- Two cosets `a • H`, `b • H` are equal if and only if `b⁻¹ * a ∈ H` -/
theorem lcoset_eq {a b : G} :
  a • H = b • H ↔ b⁻¹ * a ∈ H :=
begin
  split; intro h,
    { replace h : a ∈ b • H, rw ←h, exact self_mem_coset a H,
      rcases h with ⟨g, hg₀, hg₁⟩,
      rw hg₁, simp [hg₀] },
    { ext, split; intro hx,
        { rcases hx with ⟨g, hg₀, hg₁⟩, rw hg₁,
          exact ⟨b⁻¹ * a * g, H.mul_mem h hg₀, by simp [mul_assoc]⟩ },
        { rcases hx with ⟨g, hg₀, hg₁⟩, rw hg₁,
          refine ⟨a⁻¹ * b * g, H.mul_mem _ hg₀, by simp [mul_assoc]⟩,
          convert H.inv_mem h, simp } }
end

-- A corollary of this is a • H = H iff a ∈ H

/-- The coset of `H`, `1 • H` equals `H` -/
theorem lcoset_of_one : 1 • H = H :=
begin
  ext, split; intro hx,
    { rcases hx with ⟨h, hh₀, hh₁⟩,
      rwa [hh₁, one_mul] },
    { exact ⟨x, hx, (one_mul x).symm⟩ }
end

/-- A left coset `a • H` equals `H` if and only if `a ∈ H` -/
theorem lcoset_of_mem {a : G} :
  a • H = H ↔ a ∈ H := by rw [←lcoset_of_one, lcoset_eq]; simp

/-- Two left cosets `a • H` and `b • H` are equal if they are not disjoint -/
theorem lcoset_digj {a b c : G} (ha : c ∈ a • H) (hb : c ∈ b • H) :
  a • H = b • H :=
begin
  rcases ha with ⟨g₀, hg₀, hca⟩,
  rcases hb with ⟨g₁, hg₁, hcb⟩,
  rw lcoset_eq, rw (show a = c * g₀⁻¹, by simp [hca, mul_assoc]),
  rw (show b⁻¹ = g₁ * c⁻¹,
    by rw (show b = c * g₁⁻¹, by simp [hcb, mul_assoc]); simp),
  suffices : g₁ * g₀⁻¹ ∈ H, simp [mul_assoc, this],
  exact H.mul_mem hg₁ (H.inv_mem hg₀)
end

-- Now we would like to prove that all lcosets have the same order

private def aux_map (a : G) (H : subgroup G) : H → a • H :=
  λ h, ⟨a * h, h, h.2, rfl⟩

private lemma aux_map_biject {a : G} : bijective $ aux_map a H :=
begin
  split,
    { intros x y hxy,
      suffices : (x : G) = y,
        { ext, assumption },
        { simp [aux_map] at hxy, assumption } },
    { rintro ⟨y, y_prop⟩,
      rcases y_prop with ⟨h, hh₀, hh₁⟩,
      refine ⟨⟨h, hh₀⟩, by simp [aux_map, hh₁]⟩ }
end

/-- There is a bijection between `H` and its left cosets -/
theorem lcoset_equiv {a : G} : H ≃ a • H :=
equiv.of_bijective (aux_map a H) aux_map_biject

/-- The cardinality of `H` equals its left cosets-/
lemma eq_card_of_lcoset {a : G} [fintype G] : card H = card (a • H) :=
begin
  rw card_eq, by_contra h,
  exact not_nonempty_iff_imp_false.1 h lcoset_equiv
end

/-- The cardinality of all left cosets are equal -/
theorem card_of_lcoset_eq {a b : G} [fintype G] :
  card (a • H) = card (b • H) := by iterate 2 { rw ←eq_card_of_lcoset }

/-- The left cosets of a subgroup `H` form a partition -/
def lcoset_partition (G : Type*) [group G] (H : subgroup G) : partition G :=
{ blocks := { B | ∃ g : G, B = g • H },
  nonempty := λ B hB, let ⟨g, hg⟩ := hB in
    λ h, by rw [←(mem_empty_eq g), ←h, hg]; exact self_mem_coset g H,
  covers := ext $ λ x,
    ⟨λ _, mem_Union.2 ⟨x • H, mem_Union.2 ⟨⟨x, rfl⟩, self_mem_coset x H⟩⟩,
      λ _, mem_univ x⟩,
  disj := λ s t hs ht hndisj,
      let ⟨g₀, hg₀⟩ := hs in
      let ⟨g₁, hg₁⟩ := ht in
      let ⟨k, hks, hkt⟩ := not_empty hndisj in
    begin
      rw [hg₀, hg₁],
      rw hg₀ at hks, rw hg₁ at hkt,
      exact lcoset_digj hks hkt,
    end }

-- Now we prove that the card of a set equals the sum of the card of blocks

private def aux_map' {α} [fintype α] (p : partition α) :
α → ⋃ (b ∈ p.blocks), b :=  λ a, ⟨a, p.3 ▸ mem_univ _⟩

private lemma aux_map'_biject {α} [fintype α] (p : partition α) :
  bijective $ aux_map' p :=
⟨λ _ _ _, by finish [aux_map'], λ ⟨y, y_prop⟩, ⟨y, by unfold aux_map'⟩⟩

lemma Union_blocks_equiv {α} [fintype α] (p : partition α) :
  α ≃ ⋃ (b ∈ p.blocks), b :=
equiv.of_bijective (aux_map' p) (aux_map'_biject p)

/-- The cardinality of a fintype `α` equals the cardinality of its partition -/
theorem eq_card_of_partition {α} [fintype α] (p : partition α) :
  card α = card ⋃ (b ∈ p.blocks), b :=
begin
  rw card_eq, by_contra h,
  refine not_nonempty_iff_imp_false.1 h (Union_blocks_equiv p)
end

-- Thanks to Carl for these proofs!
lemma bind_of_partition_eq_univ {α} [fintype α] (p : partition α) :
  p.blocks.to_finset.bind (λ s, s.to_finset) = finset.univ :=
begin
  ext, split; intro ha,
    { exact finset.mem_univ _ },
    { rw finset.mem_bind,
      have := mem_univ a, rw [p.3, mem_Union] at this,
      cases this with s hs,
      rw mem_Union at hs,
      cases hs with hs₀ hs₁,
      refine ⟨s, mem_to_finset.2 hs₀, mem_to_finset.2 hs₁⟩
    }
end

lemma disjoint_finset_of_disjoint {α} [fintype α] {s t : set α}
  (h : disjoint s t) : disjoint s.to_finset t.to_finset :=
begin
  intros a hinter,
  have hset : a ∈ ∅,
    { rw [←bot_eq_empty, ←le_bot_iff.mp h],
      apply (mem_inter_iff a s t).mpr ,
      split,
        exact mem_to_finset.mp (finset.mem_of_mem_inter_left hinter),
        exact mem_to_finset.mp (finset.mem_of_mem_inter_right hinter) },
  exfalso, exact not_mem_empty a hset
end

/-- The cardinality of a fintype `α` equals the sum of cardinalities of blocks
in its partition -/
theorem card_eq_sum_partition {α} [fintype α] (p : partition α) :
card α = p.blocks.to_finset.sum (λ s, card s) :=
begin
  suffices : card α = p.blocks.to_finset.sum (λ s, s.to_finset.card),
    { finish [this] },
  conv_rhs { congr, skip, funext, rw finset.card_eq_sum_ones },
  rw [←finset.sum_bind _, ←finset.card_eq_sum_ones,
    bind_of_partition_eq_univ p],
  exact finset.card_univ.symm,
  intros s hs t ht hst,
  apply disjoint_finset_of_disjoint,
  suffices : s ∩ t = ∅, simp [disjoint, subset_empty_iff, this],
  by_contra hemp,
  exact hst (p.4 s t (mem_to_finset.mp hs) (mem_to_finset.mp ht) hemp)
end

/-- Let `H` be a subgroup of the finite group `G`, then the cardinality of `G`
equals the cardinality of `H` multiplied with the number of left cosets of `H` -/
theorem lagrange [fintype G] :
  card G = card { B | ∃ g : G, B = g • H } * card H :=
begin
  rw card_eq_sum_partition (lcoset_partition G H),
  dsimp [lcoset_partition],
  convert finset.sum_const_nat _, exact (to_finset_card _).symm,
  intros _ hx,
  rcases mem_to_finset.1 hx with ⟨g, rfl⟩,
  exact (@eq_card_of_lcoset _ _ H g _).symm
end

end order

namespace action

open function fintype

variables {G : Type*} [group G] {S : Type*}
variables {μ : laction G S}

-- For the Orbit-Stabilizer theorem, the general idea is to show that there is a
-- bijection between the orbit of some g ∈ G and the left cosets of its stabilizer.
-- With that it the theorem follows from Lagrange's theorem

private structure extract_struct {μ : laction G S} {a : S} (s : orbit μ a) :=
(val : G) (prop : s.1 = μ.to_fun val a)

@[reducible] private def extract {μ : laction G S} {a : S} (s : orbit μ a) :
  extract_struct s := ⟨some s.2, some_spec s.2⟩

@[reducible] private def aux_map (μ : laction G S) (a : S) :
  orbit μ a → { s | ∃ h : G, s = h • stabilizer μ a } :=
λ s, ⟨(extract s).1 • stabilizer μ a, (extract s).1, rfl⟩

private lemma aux_map_biject {a : S} : bijective $ aux_map μ a :=
begin
  split,
    { rintro ⟨x, hx⟩ ⟨y, hy⟩ hxy,
      rw [subtype.mk.inj_eq, order.lcoset_eq] at hxy,
      change ((extract ⟨y, hy⟩).val)⁻¹ * (extract ⟨x, hx⟩).val ∈
        { g : G | μ.1 g a = a } at hxy,
      rw [mem_set_of_eq, ←μ.3, ←(extract ⟨x, hx⟩).2,
        @laction_mul_inv _ _ _ μ _ x a, inv_inv, ←(extract ⟨y, hy⟩).2] at hxy,
      simp only [hxy] },
    { rintro ⟨_, g, hg⟩, refine ⟨⟨μ.1 g a, g, rfl⟩, _⟩,
      rw [subtype.mk.inj_eq, hg, order.lcoset_eq],
      show g⁻¹ * (extract ⟨μ.to_fun g a, _⟩).val ∈ { g : G | μ.1 g a = a },
      rw [mem_set_of_eq, ←μ.3, ←(extract ⟨μ.to_fun g a, _⟩).2,
        μ.3, mul_left_inv, μ.2] }
end

-- With this function defined, we see that the cardinality of orbit s equals
-- the number of left cosets of stabilizer s

lemma finite_orbit [fintype G] {a : S} : finite (orbit μ a) :=
begin
  split, split,
    swap,
    { apply finset.image,
      exact λ g, ⟨μ.1 g a, g, rfl⟩,
      exact (univ : set G).to_finset },
    { simp, -- Nonterminating simp! I promise I will fix it!
      rintro x ⟨g, rfl⟩,
      refine ⟨g, rfl⟩ }
end

lemma card_orbit_eq_num_lcoset [fintype G] {a : S} :
@card (orbit μ a) finite_orbit.fintype = card { s | ∃ h : G, s = h • stabilizer μ a } :=
begin
  rw card_eq, by_contra h,
  refine not_nonempty_iff_imp_false.1 h
    (equiv.of_bijective (aux_map μ a) aux_map_biject)
end

/-- Orbit-Stabilizer : The cardinality of a finite group `G` given a laction `μ`
on some `S` equals the cardinality of the orbit of `s` multiplied by the
cardinality of the stabilizer of `s` for any `s : S` -/
theorem orbit_stabilizer [fintype G] {a : S} (μ : laction G S) :
  card G = @card (orbit μ a) finite_orbit.fintype * card (stabilizer μ a) :=
by rw card_orbit_eq_num_lcoset; exact order.lagrange

-- Let's define the centralizer

/-- A group (left) acts on itself by conjugation -/
def conj_laction : laction G G :=
{ to_fun := λ g h, g * h * g⁻¹,
  map_one := by simp,
  map_assoc := λ g h k, by simp [mul_assoc] }

/-- The centralizer of `g` is the stabilizer of `g` with the conjugate action -/
@[reducible] def centralizer (g : G) : subgroup G := stabilizer conj_laction g

/-- Elements of the centralizer of `g : G` commutes with `g` -/
theorem comm_of_mem_centralizer {g h : G} (hc : h ∈ centralizer g) :
  g * h = h * g :=
begin
  change h * g * h⁻¹ = g at hc,
  conv_lhs { rw [←hc] }, simp
end

-- The conjugate class of `g` is the orbit of `g` with the conjugate action

-- the class equation of groups

def center (G : Type*) [group G] : set G := { x : G | ∀ y : G, x * y = y * x }

def conj_class (g : G) : set G := orbit conj_laction g

def index_subgroup [fintype G] (H : subgroup G) : ℕ := card G / card H

lemma comm_of_mem_center {g h : G} (hc : g ∈ center G) : g * h = h * g :=
begin
  rw center at hc,
  rw mem_set_of_eq at hc,
  exact hc h
end

lemma mem_conj_class_self {g : G} : g ∈ conj_class g :=
begin
  simp only [conj_class, conj_laction, mem_set_of_eq],
  use g,
  rw [mul_assoc, mul_right_inv, mul_one],
end

lemma orbit_card_one_of_mem_center [fintype G] (g : G) :
   g ∈ (center G) → card (conj_class g) = 1  :=
begin
  intro h,
  apply finset.card_eq_one.mpr,
  use g,
  { exact mem_conj_class_self },
  ext ⟨a, ha⟩, split,
  { simp only [forall_prop_of_true, finset.mem_univ, finset.mem_singleton],
    congr,
    rcases ha with ⟨x, rfl⟩,
    simp only [conj_laction],
    rw [←comm_of_mem_center h, mul_assoc, mul_right_inv, mul_one] },
  exact λ _, finset.mem_univ _,
end

theorem card_set_eq_sum_card_orbits [fintype S]
  (μ : laction G S) (reprs : finset S)
  (hcover : reprs.bind (λ s, (orbit μ s).to_finset) = finset.univ)
  (hdisjoint : ∀ x y ∈ reprs, x ≠ y → disjoint (orbit μ x) (orbit μ y)):
  card S = reprs.sum (λ s, card (orbit μ s)) :=
begin
  change finset.univ.card = _,
  conv_rhs begin congr, skip, funext, rw ← to_finset_card, end,
  rw [←hcover, finset.card_bind],
  exact λ x hx y hy hxyne, order.disjoint_finset_of_disjoint
    (hdisjoint x y hx hy hxyne),
end

lemma card_pos_of_mem {α : Type*} {s : finset α} {e : α} : e ∈ s → s.card > 0 :=
  λ h, finset.card_pos.mpr $ finset.nonempty_of_ne_empty $ finset.ne_empty_of_mem h

lemma index_centralizer (G : Type*) (s : G) [group G] [fintype G] :
  index_subgroup (centralizer s) = card (conj_class s) :=
begin
  rw [←to_finset_card, index_subgroup, centralizer,
      orbit_stabilizer conj_laction, set.to_finset_card, nat.mul_div_cancel],
  congr,
  exact card_pos_of_mem (finset.mem_univ 1),
end

theorem group_class_equation [fintype G] (reprs : finset G)
    (hcover : reprs.bind (λ s, (conj_class s).to_finset) =
      finset.univ \ (center G).to_finset)
    (hdisjoint : ∀ x y ∈ reprs, x ≠ y →
      disjoint (conj_class x) (conj_class y)) :
  card G = card (center G) + reprs.sum (λ s, index_subgroup (centralizer s)) :=
begin
  conv_rhs begin congr, skip, congr, skip, funext,
    rw [index_centralizer, conj_class] end,
  change finset.univ.card = _,
  rw [← to_finset_card, ←finset.sdiff_union_of_subset
      (center G).to_finset.subset_univ,
      finset.card_disjoint_union (finset.sdiff_disjoint),
      add_comm, add_right_inj, ←hcover,
      finset.card_bind],
  { conv_lhs begin congr, skip, funext, rw conj_class end,
    conv_rhs begin congr, skip, funext, rw ←to_finset_card end },
  { intros x hx y hy hxyne,
    exact order.disjoint_finset_of_disjoint (hdisjoint x y hx hy hxyne) },
end

end action


import data.nat.basic data.int.basic data.nat.modeq data.nat.prime data.list.perm algebra.ordered_ring
open nat

def mod_inv_aux : ℕ → ℕ → ℤ
| 0        p := 0
| (succ m) p := have (p%succ m)<succ m:=mod_lt p (succ_pos m),
(↑(gcd (succ m) p) - (mod_inv_aux (p%succ m) (succ m)*↑p))/↑(succ m)
def mod_inv : ℕ → ℕ → ℕ := λ m p, int.nat_abs (mod_inv_aux m p % (↑(p/gcd m p)))

theorem mod_inv_aux_bezout :∀ a b:ℕ,mod_inv_aux a b * ↑a +mod_inv_aux (b%a) a * ↑b = gcd a b:=begin
    assume m p,rw add_comm,apply gcd.induction m p,assume n,rw mod_zero,simp[mod_inv_aux],cases n with n,simp [mod_inv_aux],simp [mod_inv_aux],rw int.div_self,simp,
    rw [←int.coe_nat_zero,add_comm,int.coe_nat_add_one_out,ne.def,int.coe_nat_eq_coe_nat_iff],exact dec_trivial,intros m1 p1,cases m1 with m1,intros,exfalso,revert a,exact dec_trivial,
    have: mod_inv_aux (succ m1) p1 = (↑(gcd (succ m1) p1) - mod_inv_aux (p1 % succ m1) (succ m1) * ↑p1) / ↑(succ m1):=by unfold mod_inv_aux,
    rw this,assume H H1,rw [eq_comm,←sub_eq_iff_eq_add] at H1,unfold gcd,
    rw[int.coe_nat_mod,int.mod_def,mul_sub,←sub_add,eq_comm,←sub_eq_iff_eq_add,mul_comm _ (↑p1 / ↑(succ m1)),←mul_assoc,←sub_mul] at H1,rw ←H1,rw int.mul_div_cancel,rw [sub_mul,sub_eq_iff_eq_add] at H1,
    rw [sub_mul,H1,add_sub_cancel,add_comm,sub_add_cancel],rw[←int.coe_nat_zero,ne.def,int.coe_nat_eq_coe_nat_iff],exact dec_trivial,
end
theorem mod_inv_gcd (m:ℕ) {p:ℕ}:p>0→ m * mod_inv m p ≡ gcd m p [MOD p]:=begin
    unfold mod_inv,assume Hp,rw modeq.modeq_iff_dvd,
    have H2:∀ x y:ℤ, x%y = x - y * (x/y) :=begin assume x y, rw[eq_comm,sub_eq_iff_eq_add,eq_comm],apply int.mod_add_div, end,
    rw [←mod_inv_aux_bezout,int.coe_nat_mul, ←int.abs_eq_nat_abs,abs_of_nonneg, H2,mul_sub],simp,rw [←add_assoc,←add_assoc,mul_comm (↑m),add_comm (mod_inv_aux m p * ↑m)],simp,
    have : p ∣ (p/gcd m p) * m:=begin cases exists_eq_mul_right_of_dvd (and.left(gcd_dvd m p)) with c Hc,
    have : p / gcd m p * m= p /gcd m p *gcd m p * c:=by rw[mul_assoc,←Hc],rw this,rw nat.div_mul_cancel (and.right(gcd_dvd m p)),simp,end,
    apply dvd_add,simp,rw ←int.coe_nat_dvd at this,rw [←mul_assoc,←int.coe_nat_mul,mul_comm m],apply dvd_mul_of_dvd_left this,
    apply int.mod_nonneg,cases exists_eq_mul_left_of_dvd (and.right(gcd_dvd m p)) with c Hc,have :p / gcd m p=c*gcd m p/gcd m p:= by rw ←Hc,rw this,rw nat.mul_div_cancel,intro,rw [←int.coe_nat_zero,int.coe_nat_eq_coe_nat_iff] at a,rw a at Hc,simp at Hc,rw Hc at Hp,revert Hp,exact dec_trivial,
    apply gcd_pos_of_pos_right m Hp,
end
theorem mod_inv_unique :∀ m n p:ℕ,p>0→ coprime m p→ (m * n ≡ 1 [MOD p] ↔ n ≡ mod_inv m p [MOD p]):=begin
    assume m n p Hp Hc,apply iff.intro,assume H,
    have H1:= modeq.modeq_mul (modeq.refl (mod_inv m p)) H,
    rw [←mul_assoc,mul_comm _ m] at H1,have H2:=modeq.trans (modeq.symm(modeq.modeq_mul (mod_inv_gcd m Hp) (modeq.refl n))) H1,
    rw coprime.gcd_eq_one Hc at H2,simp at H2,exact H2,intro, have :=modeq.trans (modeq.modeq_mul (modeq.refl m) a) (mod_inv_gcd m Hp),
    rw coprime.gcd_eq_one Hc at this,assumption,
end
theorem modeq_mul_cancel (b c:ℕ) {a p:ℕ}:p > 0 → coprime a p → (a * b ≡ a * c [MOD p] ↔ b ≡ c [MOD p]):=begin
    assume H0 Hco,apply iff.intro,assume H, have H1:=modeq.modeq_mul (modeq.refl (mod_inv a p)) H,rw[←mul_assoc,←mul_assoc] at H1,
    have Hb:=modeq.symm (modeq.modeq_mul (mod_inv_gcd a H0) (modeq.refl b)),
    have Hc:=(modeq.modeq_mul (mod_inv_gcd a H0) (modeq.refl c)),rw [coprime.gcd_eq_one Hco,one_mul,mul_comm a] at *,
    exact modeq.trans (modeq.trans Hb H1) Hc,exact modeq.modeq_mul (modeq.refl a),
end
open list
theorem modeq_prod_list : ∀ (A B : list ℕ)(z:ℕ),(∀y:ℕ,countp (λ x,x ≡ y [MOD z]) A = countp (λ x,x ≡ y [MOD z]) B)→ prod A ≡ prod B [MOD z]:=begin
    intros A B z H,revert B,
    induction A with p A1 Hi,intros B H,
    simp,simp at H,cases B with b B,simp,exfalso, have:= H b,rw list.countp_cons_of_pos at this,
    have H:list.countp (λ (x : ℕ), x ≡ b [MOD z]) B + 1≥1:=le_add_left _ _,rw ←this at H,revert H,exact dec_trivial,
    apply modeq.refl,intros B H,have H1:= H p,rw list.countp_cons_of_pos at H1,have H2:0<list.countp (λ (x : ℕ), x ≡ p [MOD z]) A1 + 1:=le_add_left _ _,
    rw H1 at H2,rw list.countp_pos at H2,cases H2 with q Hq,cases Hq with Hq Hq1,
    have H2:(∀ (y : ℕ),list.countp (λ (x : ℕ), x ≡ y [MOD z]) A1 = list.countp (λ (x : ℕ), x ≡ y [MOD z]) (list.erase B q)):=begin
        intro y,have H2:= H y,have H3:=list.perm_erase Hq,have H4:=perm_countp (λ (x : ℕ), x ≡ y [MOD z]) H3,
        cases classical.em (p ≡ y [MOD z]) with A A,rw countp_cons_of_pos at H2,rw[H4,countp_cons_of_pos] at H2,apply add_right_cancel H2,exact modeq.trans Hq1 A,assumption,
        rw list.countp_cons_of_neg at H2,rwa[H4,countp_cons_of_neg] at H2,intro,have H3:=modeq.symm Hq1,exact A (modeq.trans H3 a),assumption,
    end,have H3:=Hi(list.erase B q) H2,have H4:=prod_eq_of_perm (perm_erase Hq),rw [H4,prod_cons,prod_cons],exact modeq.modeq_mul (modeq.symm Hq1) H3,apply modeq.refl,
end
#print axioms modeq_prod_list
def Lb : ℕ → ℕ → list ℕ
| 0 b := list.nil
| (succ n) b := (b*succ n):: Lb n b
theorem modeq_mod_cancel:∀ a p:nat, a % p ≡ a [MOD p] :=begin
    assume a p,rw modeq.modeq_iff_dvd,rw [int.coe_nat_mod,int.mod_def],simp,
end
theorem modeq_iff_eq:∀ c a b p:ℕ,coprime c p →a>0→a<p→b>0→b<p→p>0→(c*a ≡ c*b [MOD p] ↔ a = b):=begin
    assume c a b p Hco Ha0 Hap Hb0 Hbp Hp0,apply iff.intro,
    assume Hc,have:=modeq_mul_cancel b a Hp0 Hco,have Hc1:=modeq.symm Hc,rw this at Hc1,clear Hc,
    simp[modeq] at Hc1,rw [mod_eq_of_lt Hap,mod_eq_of_lt Hbp] at Hc1,rw Hc1,intro,rw a_1,
end
theorem fact_list :∀ p k:ℕ,p>0→prod (Lb p k)=k^p*fact p:=begin
    assume p k,induction p with p1,simp [(dec_trivial:¬0>0)],cases p1 with p2,simp[Lb],simp[Lb,fact,pow],simp[Lb,fact,pow] at p_ih,intro,
    have:=p_ih dec_trivial,rw this,cc,
end
theorem prime_not_dvd_fact : ∀ p k:ℕ,k<p → prime p→¬p∣fact k:=begin
    assume p k, induction k with k1,simp [fact,prime],intros,intro,rw a_3 at a_1,revert a_1,exact dec_trivial,
    assume H H1,simp[fact],assume H3,rw prime.dvd_mul H1 at H3,cases H3,
    rw [dvd_iff_mod_eq_zero] at H3,rw mod_eq_of_lt H at H3,revert H3,exact dec_trivial,
    exact k_ih (lt_trans (lt_succ_self _) H) H1 H3,
end
theorem countp_rw {A : list ℕ} {p q:ℕ→Prop} [hq:decidable_pred q] [hp:decidable_pred p]:(∀a:ℕ,a∈A→(p a↔q a))→countp p A= countp q A:=begin
    induction A with a A1 hi,simp,assume H,have h1:=hi (λn Hn,H n (mem_cons_of_mem a Hn)),have h2:=H a (mem_cons_self a A1),cases decidable.em (p a),rw [countp_cons_of_pos A1 h,countp_cons_of_pos A1 (iff.elim_left h2 h)],
    rw h1,rw countp_cons_of_neg A1 h,rw h2 at h,rwa countp_cons_of_neg A1 h,
end

theorem count_Lb {b:ℕ} (p k:ℕ):b>0→(k>0→k≤p→countp (eq (b * k)) (Lb p b)=1)∧(k>p→countp (eq (b * k)) (Lb p b) =0):=begin
    induction p with p hi,
    simp[Lb],intros,exact not_lt_of_ge a_2 a_1,simp[Lb],intros hb,apply and.intro,intros hk hk1,cases lt_or_eq_of_le hk1,
    have:=(hi hb).left hk (le_of_succ_le_succ (succ_le_of_lt h)),rwa countp_cons_of_neg _ (ne_of_lt(iff.elim_right (@mul_lt_mul_left _ _ k (succ p) b hb) h)),
    rw[h,countp_cons_of_pos],rw h at hi,rw (hi hb).right (lt_succ_self p),exact rfl,intro,
    rw[countp_cons_of_neg _ (ne.symm(ne_of_lt (iff.elim_right (@mul_lt_mul_left _ _  (succ p) k b hb) a))),(hi hb).right (lt_trans (lt_succ_self p) a)]
end
theorem pos_mod_inv{x p:ℕ}: ¬p∣x→ p>0→ mod_inv x p > 0:=begin
    assume h hp,cases classical.em (mod_inv x p = 0),have:=mod_inv_gcd x hp,rw [h_1,mul_zero] at this,have:=modeq.symm this,rw modeq.modeq_zero_iff at this,have:=dvd_trans this (gcd_dvd _ _).left,contradiction,
    cases mod_inv x p,revert h_1,simp,exact dec_trivial,
end
theorem counts_eq :∀ b p y:ℕ,b>0→coprime p b→ prime p→countp (λx,x ≡ y [MOD p]) (Lb (p-1) 1) = countp (λx,x ≡ y [MOD p]) (Lb (p-1) b):=begin
    have h:∀ x p b:ℕ,x∈Lb (p-1) b → ∃ c:ℕ, 0<c∧c<p∧x=b*c:=begin
        assume x p b H,cases  p with p,simp [Lb] at H,exfalso,exact H,induction p with p hi,simp[Lb] at H,exfalso,exact H,
        simp[Lb] at H,cases H,existsi (succ p),simp[H,(dec_trivial:0<succ p),lt_succ_self (succ p)],rw succ_sub_one at hi,cases hi H,existsi w,exact ⟨h.left,lt_trans h.right.left (lt_succ_self (succ p)),h.right.right⟩,
    end,
    have:∀ x b p y:ℕ,coprime p b → prime p→x∈Lb (p-1) b → (x ≡ y [MOD p] ↔ eq (b * ((mod_inv b p * y)%p)) x):=begin
        assume x b p y  Hco Hp Hx,apply iff.intro,assume Hxy,cases h x p b Hx,have Hp0:=lt_trans (dec_trivial:0<1) (prime.gt_one Hp),
        have:b * w ≡ b * (mod_inv b p * y % p) [MOD p]:=begin rw ←h_1.right.right,
        suffices h2:x ≡ b * (mod_inv b p * y)  [MOD p],exact modeq.trans h2 (modeq.symm (modeq.modeq_mul (modeq.refl b) (modeq_mod_cancel (mod_inv b p * y) p))), rw ←mul_assoc,
        have:=modeq.modeq_mul (modeq.symm (mod_inv_gcd b Hp0)) Hxy,rwa[coprime.gcd_eq_one (coprime.symm Hco),one_mul] at this,end,
        rw modeq_iff_eq b w (mod_inv b p * y % p) p (coprime.symm Hco) h_1.left h_1.right.left at this,rw [h_1.right.right,this],rw modeq_mul_cancel _ _ Hp0 (coprime.symm Hco) at this,cases (mod_inv b p * y % p),
        exfalso, rw [modeq.modeq_zero_iff,dvd_iff_mod_eq_zero,mod_eq_of_lt h_1.right.left] at this,rw this at h_1,simp[(dec_trivial:¬0<0)] at h_1,assumption,exact dec_trivial,exact mod_lt (mod_inv b p * y) Hp0,exact Hp0,
        intro hx,rw [←hx],have:=modeq.modeq_mul (modeq.refl b) (modeq_mod_cancel (mod_inv b p * y) p),suffices hb: b * (mod_inv b p * y) ≡ y [MOD p],exact modeq.trans this hb,
        rw ← mul_assoc,have:=mod_inv_gcd b (prime.pos Hp),rw coprime.gcd_eq_one (coprime.symm Hco) at this,have:=modeq.modeq_mul this (modeq.refl y),rwa one_mul at this,
    end,
    assume b p y Hb Hco Hp,
    have h1:=@count_Lb 1 (p-1) (mod_inv 1 p * y % p), have h2:=@count_Lb b (p-1) (mod_inv b p * y % p),
    cases classical.em (coprime p y),have hzero:∀ c, coprime c p→mod_inv c p * y % p > 0:=begin assume c hc,cases classical.em (mod_inv c p * y % p= 0),rw [← dvd_iff_mod_eq_zero,←modeq.modeq_zero_iff] at h_2,
    have h1:=modeq.modeq_mul (modeq.refl c) h_2,rw ←mul_assoc at h1,have h2:=modeq.symm (modeq.modeq_mul (mod_inv_gcd c (prime.pos Hp)) (modeq.refl y)),rw [coprime.gcd_eq_one hc,one_mul] at h2,
    have h3:=modeq.trans h2 h1,simp at h3,rw [modeq.modeq_zero_iff] at h3,rw prime.coprime_iff_not_dvd at h_1,contradiction,exact Hp,cases mod_inv c p * y % p,contradiction,exact dec_trivial,
    end,
    rw [countp_rw (λ x,this x b p y Hco Hp),countp_rw (λ x,this x 1 p y (coprime_one_right _)Hp)],
    rw [(h1 dec_trivial).left (hzero 1 (coprime_one_left p)),(h2 Hb).left (hzero b (coprime.symm Hco))],
    have:=succ_le_of_lt (mod_lt (mod_inv b p * y) (prime.pos Hp)),apply le_of_succ_le_succ,rwa[←succ_sub,succ_sub_one],exact le_trans (dec_trivial:1≤2) (prime.ge_two Hp),
    have:=succ_le_of_lt (mod_lt (mod_inv 1 p * y) (prime.pos Hp)),apply le_of_succ_le_succ,rwa[←succ_sub,succ_sub_one],exact le_trans (dec_trivial:1≤2) (prime.ge_two Hp),
    rw [countp_rw (λ x,this x b p y Hco Hp),countp_rw (λx,this x 1 p y (coprime_one_right _)Hp)],rw [prime.coprime_iff_not_dvd,not_not] at h_1,
    have h11:=mod_eq_zero_of_dvd (dvd_mul_of_dvd_right h_1 (mod_inv 1 p)),have hbb:=mod_eq_zero_of_dvd (dvd_mul_of_dvd_right h_1 (mod_inv b p)),rw[h11,hbb],clear Hp Hco h h_1 h1 h2 h11 hbb this,
    induction p with p hi,simp [Lb],cases p with p,simp[Lb],simp[Lb] at *,rwa[countp_cons_of_neg _,countp_cons_of_neg _],have:=ne_of_lt(mul_lt_mul_of_pos_left (dec_trivial:succ p >0) Hb),rwa mul_zero at this,exact dec_trivial, assumption,
end
theorem fermats_little_theorem1 :∀ a p:ℕ,prime p→ coprime a p → a^(p-1) ≡ 1 [MOD p]:=begin
    assume b p Hp Hpc,have Hp1:(p-1)>0:=nat.sub_pos_of_lt (lt_of_lt_of_le (dec_trivial:1<2) Hp.left),
    have Hp0:p>0:=by unfold prime at Hp;exact lt_of_lt_of_le (dec_trivial:0<2) Hp.left,
    rw [←modeq_mul_cancel  (b^(p-1)) 1 Hp0,mul_comm,mul_comm (fact (p-1)),←fact_list _ _ Hp1],have:∀ p:ℕ, 1=1^p := begin assume p,induction p,simp,rw nat.pow_succ,simp,assumption, end,
    have H:1 * fact (p - 1) = 1^(p-1) * fact(p-1):=by rw ←this,rw H, clear H this,rw ←fact_list _ _ Hp1,
    suffices: (∀y:ℕ,countp (λ x,x ≡ y [MOD p]) (Lb (p - 1) b) = countp (λ x,x ≡ y [MOD p]) (Lb (p - 1) 1)),
    exact modeq_prod_list (Lb (p - 1) b) (Lb (p - 1) 1) p this,revert b, assume c Hpc,have Hc0:c>0,cases c,unfold coprime gcd at Hpc,have:= prime.gt_one Hp,rw Hpc at this,simp[(dec_trivial:¬1>1)] at this,contradiction,exact dec_trivial,
    exact λ y,eq.symm (counts_eq c p y Hc0 (coprime.symm Hpc) Hp),
    have Hp3:(p-1)<p:= nat.sub_lt_self (lt_trans (dec_trivial:0<1) (prime.gt_one Hp)) (dec_trivial:1>0), have:=prime_not_dvd_fact p (p-1) Hp3 Hp, rw ←prime.coprime_iff_not_dvd Hp at this, exact coprime.symm this,
end
theorem fermats_little_theorem : ∀ b p:ℕ,prime p → b ^p ≡ b [MOD p]:=begin
    assume b p,cases classical.em (p ∣ b) with A A,
    have H:∀x y z:ℕ, 1≤z→x ∣ y → y^z ≡ 0 [MOD x] :=begin
        intros x y z H H1,
        induction z with z1 Hi,exfalso,revert H,exact dec_trivial,
        cases z1 with z2,simp,rwa nat.modeq.modeq_zero_iff,
        rw nat.pow_succ,have H2:= Hi dec_trivial,rw nat.modeq.modeq_zero_iff at H2,
        rw nat.modeq.modeq_zero_iff, exact dvd_mul_of_dvd_left H2 _,
    end,intro H1,have :1≤ p:=by {unfold nat.prime at H1,exact le_trans (dec_trivial:1≤2) (and.left H1)},
    have := H p b p this A,rw ←modeq.modeq_zero_iff at A,have A:= modeq.symm A,exact modeq.trans this A,
    assume Hp,rw ←prime.coprime_iff_not_dvd Hp at A,have Hp0:p>0:=begin unfold prime at Hp, exact lt_of_lt_of_le (dec_trivial:0<2) (Hp.left) end,
    suffices :b^(p-1)≡ 1 [MOD p],have h:= modeq.modeq_mul this (modeq.refl b),rwa [one_mul,←nat.pow_succ,←succ_sub,succ_sub_one ]at h,
    exact le_trans (dec_trivial:1≤2) (prime.ge_two Hp),apply fermats_little_theorem1 b p Hp (coprime.symm A),
end


import data.list tactic defs single

@[simp]
lemma height_ge1 : ∀ t : bintree, height t ≥ 1 :=
begin
  intros t,
  destruct t,
  repeat {
    try {intros t H}, try {intros H}, rewrite H, repeat { unfold height }, omega
  }
end

@[simp]
lemma height_ne0 : ∀ t : bintree, ¬(height t = 0) :=
begin
  intros t contra,
  have ht : height t ≥ 1 := by simp,
  rewrite contra at ht, cases ht
end

@[simp]
lemma height_nle0 : ∀ t : bintree, ¬(height t ≤ 0) :=
begin
  intros t contra,
  have ht : height t = 0, omega,
  eapply height_ne0, assumption
end

meta def pos_height : tactic unit :=
do
  tactic.exfalso,
  tactic.try (
    do tactic.eapplyc `height_ne0,
       tactic.assumption
  ),
  tactic.try (
    do tactic.eapplyc `height_nle0,
       tactic.assumption
  )

lemma height_le1_single : ∀ t : bintree, height t ≤ 1 → t = ● :=
begin
  intros t h1,
  have h2 : height t ≥ 1, simp,
  have ht : height t = 1, omega,
  cases t,
  trivial,
  repeat {
    unfold height at ht, have ht' : height t = 0, omega,
    pos_height,
  },
  begin
    unfold height at ht, have ht' : max (height t_a) (height t_a_1) = 0, omega,
    have ht'' : height t_a ≤ max (height t_a) (height t_a_1), apply le_max_left,
    rewrite ht' at ht'',
    pos_height,
  end
end

lemma grow_height : ∀ t' t : bintree, (t ↣ t') → height t ≤ height t' :=
begin
  intros t', induction t',
  begin -- single
    intros, unfold height,
    rewrite (single_grow _ a), unfold height
  end,
  begin -- left
    intros t h1,
    cases t,
    begin unfold height, apply ge.le, omega, end,
    begin
      unfold height,
      have h2 : (t ↣ t'_a), cases h1, repeat {assumption},
      simp, apply t'_ih, assumption
    end,
    repeat {cases h1},
  end,
  begin -- right
    intros t h1,
    cases t,
    begin unfold height, apply ge.le, omega, end,
    cases h1,
    begin
      unfold height,
      have h2 : (t ↣ t'_a), cases h1, repeat {assumption},
      simp, apply t'_ih, assumption
    end,
    cases h1
  end,
  begin -- full
    intros t h1,
    cases t,
    begin unfold height, omega end,
    cases h1,
    cases h1,
    begin
      unfold height, cases h1,
      have h3 : height t_a ≤ height t'_a, apply t'_ih_a, assumption,
      have h3' : height t_a_1 ≤ height t'_a_1, apply t'_ih_a_1, assumption,
      have h4 : max (height t_a) (height t_a_1) ≤ max (height t'_a) (height t'_a_1), apply max_le_max, repeat {assumption},
      omega
    end
  end
end

lemma iso_height : ∀ t t' : bintree, (t = t') → height t = height t' :=
begin
  intros, rewrite a
end

lemma height_neq_niso : ∀ t t' : bintree, height t ≠ height t' → t ≠ t' :=
begin
  intros, intro contra, apply a, rewrite contra
end

@[simp]
def height_bound : list bintree → ℕ
| [] := 1
| (t :: l) := max (height t) (height_bound l)

lemma height_bound_correct : ∀ l t, t ∈ l → height t ≤ height_bound l :=
begin
  intros l t h,
  induction l,
  begin cases h end,
  begin
    unfold height_bound,
    cases h,
    begin rewrite h, apply le_max_left end,
    begin
      eapply le_trans,
      apply l_ih, assumption,
      apply le_max_right
    end
  end
end

lemma height_bound_ge1 : ∀ l, height_bound l ≥ 1 :=
begin
  intros l,
  induction l,
  unfold height_bound, omega,
  unfold height_bound, eapply ge_trans,
  begin apply has_le.le.ge, apply le_max_right end,
  begin assumption end
end


theorem eq_zero_or_eq_zero_of_mul_eq_zero (a b : mynat) (h : a * b = 0) :
  a = 0 ∨ b = 0 :=
begin
cases a,
left,
refl,
cases b,
right,
refl,
rwa [mul_succ, add_succ] at h,
exfalso,
exact succ_ne_zero _ h,
end


import Smt.Reconstruction.Env
import Smt.Reconstruction.Rules
import Smt.Reconstruction.Term

open Types
open Rules
open proof
open term
open sort

def p: term := const 1000 boolSort
def q: term := const 1001 boolSort

def mpDE: term := implies p (implies (implies p q) q)
def notMpDE := not mpDE

theorem th0: followsFrom notMpDE bot := λ lean_a0 =>
  have lean_s0 := notImplies2 lean_a0
  have lean_s1 := notImplies1 lean_s0
  have lean_s2 := impliesElim lean_s1
  have lean_s4 := notImplies1 lean_a0
  have lean_s6 := R1 (conjunction lean_s2 lean_s4)
  have lean_s9 := notImplies2 lean_s0
  contradiction (conjunction lean_s9 lean_s6)

noncomputable def envMP (x y : Prop) : Environment := λ i Δ s =>
  match s with
  | boolSort => if i == 1000 then x else y
  | s' => defaultValue Δ s'

theorem notMpDEFalse: ∀ {Γ: Environment} {Δ: SEnvironment}, ¬ validWith Γ Δ notMpDE :=
  followsBot th0

theorem mpDETrue: ∀ {Γ: Environment} {Δ: SEnvironment}, validWith Γ Δ mpDE :=
  have mpDEIsBool : isBool mpDE := rfl
  interpNotTerm mpDEIsBool notMpDEFalse

def curryModusPonens (x y: Prop) : Prop := x → (x → y) → y

theorem mp: ∀ (x y: Prop), curryModusPonens x y := λ x y =>
  @mpDETrue (envMP x y) defaultSEnvironment

theorem mp' (x y : Prop) : curryModusPonens x y := λ h₁ h₂ => h₂ h₁

#check mp'


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer

! This file was ported from Lean 3 source module ring_theory.polynomial.dickson
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Invertible
import Mathbin.Data.Zmod.Basic
import Mathbin.RingTheory.Localization.FractionRing
import Mathbin.RingTheory.Polynomial.Chebyshev
import Mathbin.RingTheory.Ideal.LocalRing

/-!
# Dickson polynomials

The (generalised) Dickson polynomials are a family of polynomials indexed by `ℕ × ℕ`,
with coefficients in a commutative ring `R` depending on an element `a∈R`. More precisely, the
they satisfy the recursion `dickson k a (n + 2) = X * (dickson k a n + 1) - a * (dickson k a n)`
with starting values `dickson k a 0 = 3 - k` and `dickson k a 1 = X`. In the literature,
`dickson k a n` is called the `n`-th Dickson polynomial of the `k`-th kind associated to the
parameter `a : R`. They are closely related to the Chebyshev polynomials in the case that `a=1`.
When `a=0` they are just the family of monomials `X ^ n`.

## Main definition

* `polynomial.dickson`: the generalised Dickson polynomials.

## Main statements

* `polynomial.dickson_one_one_mul`, the `(m * n)`-th Dickson polynomial of the first kind for
  parameter `1 : R` is the composition of the `m`-th and `n`-th Dickson polynomials of the first
  kind for `1 : R`.
* `polynomial.dickson_one_one_char_p`, for a prime number `p`, the `p`-th Dickson polynomial of the
  first kind associated to parameter `1 : R` is congruent to `X ^ p` modulo `p`.

## References

* [R. Lidl, G. L. Mullen and G. Turnwald, _Dickson polynomials_][MR1237403]

## TODO

* Redefine `dickson` in terms of `linear_recurrence`.
* Show that `dickson 2 1` is equal to the characteristic polynomial of the adjacency matrix of a
  type A Dynkin diagram.
* Prove that the adjacency matrices of simply laced Dynkin diagrams are precisely the adjacency
  matrices of simple connected graphs which annihilate `dickson 2 1`.
-/

noncomputable section

namespace Polynomial

open Polynomial

variable {R S : Type _} [CommRing R] [CommRing S] (k : ℕ) (a : R)

/-- `dickson` is the `n`the (generalised) Dickson polynomial of the `k`-th kind associated to the
element `a ∈ R`. -/
noncomputable def dickson : ℕ → R[X]
  | 0 => 3 - k
  | 1 => X
  | n + 2 => X * dickson (n + 1) - C a * dickson n
#align polynomial.dickson Polynomial.dickson

@[simp]
theorem dickson_zero : dickson k a 0 = 3 - k :=
  rfl
#align polynomial.dickson_zero Polynomial.dickson_zero

@[simp]
theorem dickson_one : dickson k a 1 = X :=
  rfl
#align polynomial.dickson_one Polynomial.dickson_one

theorem dickson_two : dickson k a 2 = X ^ 2 - C a * (3 - k) := by simp only [dickson, sq]
#align polynomial.dickson_two Polynomial.dickson_two

@[simp]
theorem dickson_add_two (n : ℕ) :
    dickson k a (n + 2) = X * dickson k a (n + 1) - C a * dickson k a n := by rw [dickson]
#align polynomial.dickson_add_two Polynomial.dickson_add_two

theorem dickson_of_two_le {n : ℕ} (h : 2 ≤ n) :
    dickson k a n = X * dickson k a (n - 1) - C a * dickson k a (n - 2) :=
  by
  obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le h
  rw [add_comm]
  exact dickson_add_two k a n
#align polynomial.dickson_of_two_le Polynomial.dickson_of_two_le

variable {R S k a}

theorem map_dickson (f : R →+* S) : ∀ n : ℕ, map f (dickson k a n) = dickson k (f a) n
  | 0 => by
    simp only [dickson_zero, Polynomial.map_sub, Polynomial.map_nat_cast, bit1, bit0,
      Polynomial.map_add, Polynomial.map_one]
  | 1 => by simp only [dickson_one, map_X]
  | n + 2 =>
    by
    simp only [dickson_add_two, Polynomial.map_sub, Polynomial.map_mul, map_X, map_C]
    rw [map_dickson, map_dickson]
#align polynomial.map_dickson Polynomial.map_dickson

variable {R}

@[simp]
theorem dickson_two_zero : ∀ n : ℕ, dickson 2 (0 : R) n = X ^ n
  | 0 => by
    simp only [dickson_zero, pow_zero]
    norm_num
  | 1 => by simp only [dickson_one, pow_one]
  | n + 2 => by
    simp only [dickson_add_two, C_0, MulZeroClass.zero_mul, sub_zero]
    rw [dickson_two_zero, pow_add X (n + 1) 1, mul_comm, pow_one]
#align polynomial.dickson_two_zero Polynomial.dickson_two_zero

section Dickson

/-!

### A Lambda structure on `ℤ[X]`

Mathlib doesn't currently know what a Lambda ring is.
But once it does, we can endow `ℤ[X]` with a Lambda structure
in terms of the `dickson 1 1` polynomials defined below.
There is exactly one other Lambda structure on `ℤ[X]` in terms of binomial polynomials.

-/

variable {R}

theorem dickson_one_one_eval_add_inv (x y : R) (h : x * y = 1) :
    ∀ n, (dickson 1 (1 : R) n).eval (x + y) = x ^ n + y ^ n
  | 0 => by
    simp only [bit0, eval_one, eval_add, pow_zero, dickson_zero]
    norm_num
  | 1 => by simp only [eval_X, dickson_one, pow_one]
  | n + 2 =>
    by
    simp only [eval_sub, eval_mul, dickson_one_one_eval_add_inv, eval_X, dickson_add_two, C_1,
      eval_one]
    conv_lhs => simp only [pow_succ, add_mul, mul_add, h, ← mul_assoc, mul_comm y x, one_mul]
    ring
#align polynomial.dickson_one_one_eval_add_inv Polynomial.dickson_one_one_eval_add_inv

variable (R)

theorem dickson_one_one_eq_chebyshev_t [Invertible (2 : R)] :
    ∀ n, dickson 1 (1 : R) n = 2 * (Chebyshev.T R n).comp (C (⅟ 2) * X)
  | 0 => by
    simp only [chebyshev.T_zero, mul_one, one_comp, dickson_zero]
    norm_num
  | 1 => by
    rw [dickson_one, chebyshev.T_one, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul, mul_invOf_self,
      C_1, one_mul]
  | n + 2 =>
    by
    simp only [dickson_add_two, chebyshev.T_add_two, dickson_one_one_eq_chebyshev_T (n + 1),
      dickson_one_one_eq_chebyshev_T n, sub_comp, mul_comp, add_comp, X_comp, bit0_comp, one_comp]
    simp only [← C_1, ← C_bit0, ← mul_assoc, ← C_mul, mul_invOf_self]
    rw [C_1, one_mul]
    ring
#align polynomial.dickson_one_one_eq_chebyshev_T Polynomial.dickson_one_one_eq_chebyshev_t

theorem chebyshev_t_eq_dickson_one_one [Invertible (2 : R)] (n : ℕ) :
    Chebyshev.T R n = C (⅟ 2) * (dickson 1 1 n).comp (2 * X) :=
  by
  rw [dickson_one_one_eq_chebyshev_T]
  simp only [comp_assoc, mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul]
  rw [invOf_mul_self, C_1, one_mul, one_mul, comp_X]
#align polynomial.chebyshev_T_eq_dickson_one_one Polynomial.chebyshev_t_eq_dickson_one_one

/-- The `(m * n)`-th Dickson polynomial of the first kind is the composition of the `m`-th and
`n`-th. -/
theorem dickson_one_one_mul (m n : ℕ) :
    dickson 1 (1 : R) (m * n) = (dickson 1 1 m).comp (dickson 1 1 n) :=
  by
  have h : (1 : R) = Int.castRingHom R 1
  simp only [eq_intCast, Int.cast_one]
  rw [h]
  simp only [← map_dickson (Int.castRingHom R), ← map_comp]
  congr 1
  apply map_injective (Int.castRingHom ℚ) Int.cast_injective
  simp only [map_dickson, map_comp, eq_intCast, Int.cast_one, dickson_one_one_eq_chebyshev_T,
    chebyshev.T_mul, two_mul, ← add_comp]
  simp only [← two_mul, ← comp_assoc]
  apply eval₂_congr rfl rfl
  rw [comp_assoc]
  apply eval₂_congr rfl _ rfl
  rw [mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul, invOf_mul_self, C_1, one_mul]
#align polynomial.dickson_one_one_mul Polynomial.dickson_one_one_mul

theorem dickson_one_one_comp_comm (m n : ℕ) :
    (dickson 1 (1 : R) m).comp (dickson 1 1 n) = (dickson 1 1 n).comp (dickson 1 1 m) := by
  rw [← dickson_one_one_mul, mul_comm, dickson_one_one_mul]
#align polynomial.dickson_one_one_comp_comm Polynomial.dickson_one_one_comp_comm

theorem dickson_one_one_zMod_p (p : ℕ) [Fact p.Prime] : dickson 1 (1 : ZMod p) p = X ^ p :=
  by
  -- Recall that `dickson_eval_add_inv` characterises `dickson 1 1 p`
  -- as a polynomial that maps `x + x⁻¹` to `x ^ p + (x⁻¹) ^ p`.
  -- Since `X ^ p` also satisfies this property in characteristic `p`,
  -- we can use a variant on `polynomial.funext` to conclude that these polynomials are equal.
  -- For this argument, we need an arbitrary infinite field of characteristic `p`.
  obtain ⟨K, _, _, H⟩ : ∃ (K : Type)(_ : Field K), ∃ _ : CharP K p, Infinite K :=
    by
    let K := FractionRing (Polynomial (ZMod p))
    let f : ZMod p →+* K := (algebraMap _ (FractionRing _)).comp C
    have : CharP K p := by
      rw [← f.char_p_iff_char_p]
      infer_instance
    haveI : Infinite K :=
      Infinite.of_injective (algebraMap (Polynomial (ZMod p)) (FractionRing (Polynomial (ZMod p))))
        (IsFractionRing.injective _ _)
    refine' ⟨K, _, _, _⟩ <;> infer_instance
  skip
  apply map_injective (ZMod.castHom (dvd_refl p) K) (RingHom.injective _)
  rw [map_dickson, Polynomial.map_pow, map_X]
  apply eq_of_infinite_eval_eq
  -- The two polynomials agree on all `x` of the form `x = y + y⁻¹`.
  apply @Set.Infinite.mono _ { x : K | ∃ y, x = y + y⁻¹ ∧ y ≠ 0 }
  · rintro _ ⟨x, rfl, hx⟩
    simp only [eval_X, eval_pow, Set.mem_setOf_eq, @add_pow_char K _ p,
      dickson_one_one_eval_add_inv _ _ (mul_inv_cancel hx), inv_pow, ZMod.castHom_apply,
      ZMod.cast_one']
  -- Now we need to show that the set of such `x` is infinite.
  -- If the set is finite, then we will show that `K` is also finite.
  · intro h
    rw [← Set.infinite_univ_iff] at H
    apply H
    -- To each `x` of the form `x = y + y⁻¹`
    -- we `bind` the set of `y` that solve the equation `x = y + y⁻¹`.
    -- For every `x`, that set is finite (since it is governed by a quadratic equation).
    -- For the moment, we claim that all these sets together cover `K`.
    suffices
      (Set.univ : Set K) =
        { x : K | ∃ y : K, x = y + y⁻¹ ∧ y ≠ 0 } >>= fun x => { y | x = y + y⁻¹ ∨ y = 0 }
      by
      rw [this]
      clear this
      refine' h.bUnion fun x hx => _
      -- The following quadratic polynomial has as solutions the `y` for which `x = y + y⁻¹`.
      let φ : K[X] := X ^ 2 - C x * X + 1
      have hφ : φ ≠ 0 := by
        intro H
        have : φ.eval 0 = 0 := by rw [H, eval_zero]
        simpa [eval_X, eval_one, eval_pow, eval_sub, sub_zero, eval_add, eval_mul,
          MulZeroClass.mul_zero, sq, zero_add, one_ne_zero]
      classical
        convert(φ.roots ∪ {0}).toFinset.finite_toSet using 1
        ext1 y
        simp only [Multiset.mem_toFinset, Set.mem_setOf_eq, Finset.mem_coe, Multiset.mem_union,
          mem_roots hφ, is_root, eval_add, eval_sub, eval_pow, eval_mul, eval_X, eval_C, eval_one,
          Multiset.mem_singleton]
        by_cases hy : y = 0
        · simp only [hy, eq_self_iff_true, or_true_iff]
        apply or_congr _ Iff.rfl
        rw [← mul_left_inj' hy, eq_comm, ← sub_eq_zero, add_mul, inv_mul_cancel hy]
        apply eq_iff_eq_cancel_right.mpr
        ring
    -- Finally, we prove the claim that our finite union of finite sets covers all of `K`.
    · apply (Set.eq_univ_of_forall _).symm
      intro x
      simp only [exists_prop, Set.mem_unionᵢ, Set.bind_def, Ne.def, Set.mem_setOf_eq]
      by_cases hx : x = 0
      · simp only [hx, and_true_iff, eq_self_iff_true, inv_zero, or_true_iff]
        exact ⟨_, 1, rfl, one_ne_zero⟩
      · simp only [hx, or_false_iff, exists_eq_right]
        exact ⟨_, rfl, hx⟩
#align polynomial.dickson_one_one_zmod_p Polynomial.dickson_one_one_zMod_p

theorem dickson_one_one_charP (p : ℕ) [Fact p.Prime] [CharP R p] : dickson 1 (1 : R) p = X ^ p :=
  by
  have h : (1 : R) = ZMod.castHom (dvd_refl p) R 1
  simp only [ZMod.castHom_apply, ZMod.cast_one']
  rw [h, ← map_dickson (ZMod.castHom (dvd_refl p) R), dickson_one_one_zmod_p, Polynomial.map_pow,
    map_X]
#align polynomial.dickson_one_one_char_p Polynomial.dickson_one_one_charP

end Dickson

end Polynomial


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.box_integral.box.basic
import analysis.specific_limits.basic

/-!
# Induction on subboxes

In this file we prove the following induction principle for `box_integral.box`, see
`box_integral.box.subbox_induction_on`. Let `p` be a predicate on `box_integral.box ι`, let `I` be a
box. Suppose that the following two properties hold true.

* Consider a smaller box `J ≤ I`. The hyperplanes passing through the center of `J` split it into
  `2 ^ n` boxes. If `p` holds true on each of these boxes, then it is true on `J`.
* For each `z` in the closed box `I.Icc` there exists a neighborhood `U` of `z` within `I.Icc` such
  that for every box `J ≤ I` such that `z ∈ J.Icc ⊆ U`, if `J` is homothetic to `I` with a
  coefficient of the form `1 / 2 ^ m`, then `p` is true on `J`.

Then `p I` is true.

## Tags

rectangular box, induction
-/

open set finset function filter metric
open_locale classical topological_space filter ennreal
noncomputable theory

namespace box_integral

namespace box

variables {ι : Type*} {I J : box ι}

/-- For a box `I`, the hyperplanes passing through its center split `I` into `2 ^ card ι` boxes.
`box_integral.box.split_center_box I s` is one of these boxes. See also
`box_integral.partition.split_center` for the corresponding `box_integral.partition`. -/
def split_center_box (I : box ι) (s : set ι) : box ι :=
{ lower := s.piecewise (λ i, (I.lower i + I.upper i) / 2) I.lower,
  upper := s.piecewise I.upper (λ i, (I.lower i + I.upper i) / 2),
  lower_lt_upper := λ i, by { dunfold set.piecewise, split_ifs;
    simp only [left_lt_add_div_two, add_div_two_lt_right, I.lower_lt_upper] } }

lemma mem_split_center_box {s : set ι} {y : ι → ℝ} :
  y ∈ I.split_center_box s ↔ y ∈ I ∧ ∀ i, (I.lower i + I.upper i) / 2 < y i ↔ i ∈ s :=
begin
  simp only [split_center_box, mem_def, ← forall_and_distrib],
  refine forall_congr (λ i, _),
  dunfold set.piecewise,
  split_ifs with hs; simp only [hs, iff_true, iff_false, not_lt],
  exacts [⟨λ H, ⟨⟨(left_lt_add_div_two.2 (I.lower_lt_upper i)).trans H.1, H.2⟩, H.1⟩,
    λ H, ⟨H.2, H.1.2⟩⟩,
    ⟨λ H, ⟨⟨H.1, H.2.trans (add_div_two_lt_right.2 (I.lower_lt_upper i)).le⟩, H.2⟩,
      λ H, ⟨H.1.1, H.2⟩⟩]
end

lemma split_center_box_le (I : box ι) (s : set ι) : I.split_center_box s ≤ I :=
λ x hx, (mem_split_center_box.1 hx).1

lemma disjoint_split_center_box (I : box ι) {s t : set ι} (h : s ≠ t) :
  disjoint (I.split_center_box s : set (ι → ℝ)) (I.split_center_box t) :=
begin
  rintro y ⟨hs, ht⟩, apply h,
  ext i,
  rw [mem_coe, mem_split_center_box] at hs ht,
  rw [← hs.2, ← ht.2]
end

lemma injective_split_center_box (I : box ι) : injective I.split_center_box :=
λ s t H, by_contra $ λ Hne, (I.disjoint_split_center_box Hne).ne (nonempty_coe _).ne_empty (H ▸ rfl)

@[simp] lemma exists_mem_split_center_box {I : box ι} {x : ι → ℝ} :
  (∃ s, x ∈ I.split_center_box s) ↔ x ∈ I :=
⟨λ ⟨s, hs⟩, I.split_center_box_le s hs,
  λ hx, ⟨{i | (I.lower i + I.upper i) / 2 < x i}, mem_split_center_box.2 ⟨hx, λ i, iff.rfl⟩⟩⟩

/-- `box_integral.box.split_center_box` bundled as a `function.embedding`. -/
@[simps] def split_center_box_emb (I : box ι) : set ι ↪ box ι :=
⟨split_center_box I, injective_split_center_box I⟩

@[simp]

@[simp] lemma upper_sub_lower_split_center_box (I : box ι) (s : set ι) (i : ι) :
  (I.split_center_box s).upper i - (I.split_center_box s).lower i = (I.upper i - I.lower i) / 2 :=
by by_cases hs : i ∈ s; field_simp [split_center_box, hs, mul_two, two_mul]

/-- Let `p` be a predicate on `box ι`, let `I` be a box. Suppose that the following two properties
hold true.

* `H_ind` : Consider a smaller box `J ≤ I`. The hyperplanes passing through the center of `J` split
  it into `2 ^ n` boxes. If `p` holds true on each of these boxes, then it true on `J`.

* `H_nhds` : For each `z` in the closed box `I.Icc` there exists a neighborhood `U` of `z` within
  `I.Icc` such that for every box `J ≤ I` such that `z ∈ J.Icc ⊆ U`, if `J` is homothetic to `I`
  with a coefficient of the form `1 / 2 ^ m`, then `p` is true on `J`.

Then `p I` is true. See also `box_integral.box.subbox_induction_on` for a version using
`box_integral.prepartition.split_center` instead of `box_integral.box.split_center_box`.

The proof still works if we assume `H_ind` only for subboxes `J ≤ I` that are homothetic to `I` with
a coefficient of the form `2⁻ᵐ` but we do not need this generalization yet. -/
@[elab_as_eliminator]
lemma subbox_induction_on' {p : box ι → Prop} (I : box ι)
  (H_ind : ∀ J ≤ I, (∀ s, p (split_center_box J s)) → p J)
  (H_nhds : ∀ z ∈ I.Icc, ∃ (U ∈ 𝓝[I.Icc] z), ∀ (J ≤ I) (m : ℕ), z ∈ J.Icc → J.Icc ⊆ U →
    (∀ i, J.upper i - J.lower i = (I.upper i - I.lower i) / 2 ^ m) → p J) :
  p I :=
begin
  by_contra hpI,
  -- First we use `H_ind` to construct a decreasing sequence of boxes such that `∀ m, ¬p (J m)`.
  replace H_ind := λ J hJ, not_imp_not.2 (H_ind J hJ),
  simp only [exists_imp_distrib, not_forall] at H_ind,
  choose! s hs using H_ind,
  set J : ℕ → box ι := λ m, (λ J, split_center_box J (s J))^[m] I,
  have J_succ : ∀ m, J (m + 1) = split_center_box (J m) (s $ J m) := λ m, iterate_succ_apply' _ _ _,
  -- Now we prove some properties of `J`
  have hJmono : antitone J,
    from antitone_nat_of_succ_le (λ n, by simpa [J_succ] using split_center_box_le _ _),
  have hJle : ∀ m, J m ≤ I, from λ m, hJmono (zero_le m),
  have hJp : ∀ m, ¬p (J m),
    from λ m, nat.rec_on m hpI (λ m, by simpa only [J_succ] using hs (J m) (hJle m)),
  have hJsub : ∀ m i, (J m).upper i - (J m).lower i = (I.upper i - I.lower i) / 2 ^ m,
  { intros m i, induction m with m ihm, { simp [J] },
    simp only [pow_succ', J_succ, upper_sub_lower_split_center_box, ihm, div_div_eq_div_mul] },
  have h0 : J 0 = I, from rfl,
  -- Now we clear unneeded assumptions
  clear_value J, clear hpI hs J_succ s,
  -- Let `z` be the unique common point of all `(J m).Icc`. Then `H_nhds` proves `p (J m)` for
  -- sufficiently large `m`. This contradicts `hJp`.
  set z : ι → ℝ := ⨆ m, (J m).lower,
  have hzJ : ∀ m, z ∈ (J m).Icc,
    from mem_Inter.1 (csupr_mem_Inter_Icc_of_antitone_Icc
      ((@box.Icc ι).monotone.comp_antitone hJmono) (λ m, (J m).lower_le_upper)),
  have hJl_mem : ∀ m, (J m).lower ∈ I.Icc, from λ m, le_iff_Icc.1 (hJle m) (J m).lower_mem_Icc,
  have hJu_mem : ∀ m, (J m).upper ∈ I.Icc, from λ m, le_iff_Icc.1 (hJle m) (J m).upper_mem_Icc,
  have hJlz : tendsto (λ m, (J m).lower) at_top (𝓝 z),
    from tendsto_at_top_csupr (antitone_lower.comp hJmono)
      ⟨I.upper, λ x ⟨m, hm⟩, hm ▸ (hJl_mem m).2⟩,
  have hJuz : tendsto (λ m, (J m).upper) at_top (𝓝 z),
  { suffices : tendsto (λ m, (J m).upper - (J m).lower) at_top (𝓝 0), by simpa using hJlz.add this,
    refine tendsto_pi_nhds.2 (λ i, _),
    simpa [hJsub] using tendsto_const_nhds.div_at_top
      (tendsto_pow_at_top_at_top_of_one_lt (@one_lt_two ℝ _ _)) },
  replace hJlz : tendsto (λ m, (J m).lower) at_top (𝓝[Icc I.lower I.upper] z),
    from tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ hJlz
      (eventually_of_forall hJl_mem),
  replace hJuz : tendsto (λ m, (J m).upper) at_top (𝓝[Icc I.lower I.upper] z),
    from tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ hJuz
      (eventually_of_forall hJu_mem),
  rcases H_nhds z (h0 ▸ hzJ 0) with ⟨U, hUz, hU⟩,
  rcases (tendsto_lift'.1 (hJlz.Icc hJuz) U hUz).exists with ⟨m, hUm⟩,
  exact hJp m (hU (J m) (hJle m) m (hzJ m) hUm (hJsub m))
end

end box

end box_integral


/-
Copyright (c) 2020 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_ring_action.basic
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Ring.Equiv
import Mathbin.Algebra.Field.Defs
import Mathbin.GroupTheory.GroupAction.Group

/-!
# Group action on rings

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

This file defines the typeclass of monoid acting on semirings `mul_semiring_action M R`,
and the corresponding typeclass of invariant subrings.

Note that `algebra` does not satisfy the axioms of `mul_semiring_action`.

## Implementation notes

There is no separate typeclass for group acting on rings, group acting on fields, etc.
They are all grouped under `mul_semiring_action`.

## Tags

group action, invariant subring

-/

universe u v

#print MulSemiringAction /-
/-- Typeclass for multiplicative actions by monoids on semirings.

This combines `distrib_mul_action` with `mul_distrib_mul_action`. -/
class MulSemiringAction (M : Type u) (R : Type v) [Monoid M] [Semiring R] extends
  DistribMulAction M R where
  smul_one : ∀ g : M, (g • 1 : R) = 1
  smul_mul : ∀ (g : M) (x y : R), g • (x * y) = g • x * g • y
#align mul_semiring_action MulSemiringAction
-/

section Semiring

variable (M N G : Type _) [Monoid M] [Monoid N] [Group G]

variable (A R S F : Type v) [AddMonoid A] [Semiring R] [CommSemiring S] [DivisionRing F]

#print MulSemiringAction.toMulDistribMulAction /-
-- note we could not use `extends` since these typeclasses are made with `old_structure_cmd`
instance (priority := 100) MulSemiringAction.toMulDistribMulAction [h : MulSemiringAction M R] :
    MulDistribMulAction M R :=
  { h with }
#align mul_semiring_action.to_mul_distrib_mul_action MulSemiringAction.toMulDistribMulAction
-/

#print MulSemiringAction.toRingHom /-
/-- Each element of the monoid defines a semiring homomorphism. -/
@[simps]
def MulSemiringAction.toRingHom [MulSemiringAction M R] (x : M) : R →+* R :=
  { MulDistribMulAction.toMonoidHom R x, DistribMulAction.toAddMonoidHom R x with }
#align mul_semiring_action.to_ring_hom MulSemiringAction.toRingHom
-/

/- warning: to_ring_hom_injective -> toRingHom_injective is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u2}) [_inst_1 : Monoid.{u2} M] (R : Type.{u1}) [_inst_5 : Semiring.{u1} R] [_inst_8 : MulSemiringAction.{u2, u1} M R _inst_1 _inst_5] [_inst_9 : FaithfulSMul.{u2, u1} M R (SMulZeroClass.toHasSmul.{u2, u1} M R (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddMonoidWithOne.toAddMonoid.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))))) (DistribSMul.toSmulZeroClass.{u2, u1} M R (AddMonoid.toAddZeroClass.{u1} R (AddMonoidWithOne.toAddMonoid.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5))))) (DistribMulAction.toDistribSMul.{u2, u1} M R _inst_1 (AddMonoidWithOne.toAddMonoid.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))) (MulSemiringAction.toDistribMulAction.{u2, u1} M R _inst_1 _inst_5 _inst_8))))], Function.Injective.{succ u2, succ u1} M (RingHom.{u1, u1} R R (Semiring.toNonAssocSemiring.{u1} R _inst_5) (Semiring.toNonAssocSemiring.{u1} R _inst_5)) (MulSemiringAction.toRingHom.{u1, u2} M _inst_1 R _inst_5 _inst_8)
but is expected to have type
  forall (M : Type.{u1}) [_inst_1 : Monoid.{u1} M] (R : Type.{u2}) [_inst_5 : Semiring.{u2} R] [_inst_8 : MulSemiringAction.{u1, u2} M R _inst_1 _inst_5] [_inst_9 : FaithfulSMul.{u1, u2} M R (SMulZeroClass.toSMul.{u1, u2} M R (MonoidWithZero.toZero.{u2} R (Semiring.toMonoidWithZero.{u2} R _inst_5)) (DistribSMul.toSMulZeroClass.{u1, u2} M R (AddMonoid.toAddZeroClass.{u2} R (AddMonoidWithOne.toAddMonoid.{u2} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u2} R (NonAssocSemiring.toAddCommMonoidWithOne.{u2} R (Semiring.toNonAssocSemiring.{u2} R _inst_5))))) (DistribMulAction.toDistribSMul.{u1, u2} M R _inst_1 (AddMonoidWithOne.toAddMonoid.{u2} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u2} R (NonAssocSemiring.toAddCommMonoidWithOne.{u2} R (Semiring.toNonAssocSemiring.{u2} R _inst_5)))) (MulSemiringAction.toDistribMulAction.{u1, u2} M R _inst_1 _inst_5 _inst_8))))], Function.Injective.{succ u1, succ u2} M (RingHom.{u2, u2} R R (Semiring.toNonAssocSemiring.{u2} R _inst_5) (Semiring.toNonAssocSemiring.{u2} R _inst_5)) (MulSemiringAction.toRingHom.{u2, u1} M _inst_1 R _inst_5 _inst_8)
Case conversion may be inaccurate. Consider using '#align to_ring_hom_injective toRingHom_injectiveₓ'. -/
theorem toRingHom_injective [MulSemiringAction M R] [FaithfulSMul M R] :
    Function.Injective (MulSemiringAction.toRingHom M R) := fun m₁ m₂ h =>
  eq_of_smul_eq_smul fun r => RingHom.ext_iff.1 h r
#align to_ring_hom_injective toRingHom_injective

/- warning: mul_semiring_action.to_ring_equiv -> MulSemiringAction.toRingEquiv is a dubious translation:
lean 3 declaration is
  forall (G : Type.{u2}) [_inst_3 : Group.{u2} G] (R : Type.{u1}) [_inst_5 : Semiring.{u1} R] [_inst_8 : MulSemiringAction.{u2, u1} G R (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_3)) _inst_5], G -> (RingEquiv.{u1, u1} R R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))) (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))))
but is expected to have type
  forall (G : Type.{u2}) [_inst_3 : Group.{u2} G] (R : Type.{u1}) [_inst_5 : Semiring.{u1} R] [_inst_8 : MulSemiringAction.{u2, u1} G R (DivInvMonoid.toMonoid.{u2} G (Group.toDivInvMonoid.{u2} G _inst_3)) _inst_5], G -> (RingEquiv.{u1, u1} R R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5))) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_5)))))
Case conversion may be inaccurate. Consider using '#align mul_semiring_action.to_ring_equiv MulSemiringAction.toRingEquivₓ'. -/
/-- Each element of the group defines a semiring isomorphism. -/
@[simps]
def MulSemiringAction.toRingEquiv [MulSemiringAction G R] (x : G) : R ≃+* R :=
  { DistribMulAction.toAddEquiv R x, MulSemiringAction.toRingHom G R x with }
#align mul_semiring_action.to_ring_equiv MulSemiringAction.toRingEquiv

section

variable {M N}

#print MulSemiringAction.compHom /-
/-- Compose a `mul_semiring_action` with a `monoid_hom`, with action `f r' • m`.
See note [reducible non-instances]. -/
@[reducible]
def MulSemiringAction.compHom (f : N →* M) [MulSemiringAction M R] : MulSemiringAction N R :=
  { DistribMulAction.compHom R f, MulDistribMulAction.compHom R f with smul := SMul.comp.smul f }
#align mul_semiring_action.comp_hom MulSemiringAction.compHom
-/

end

section SimpLemmas

variable {M G A R F}

attribute [simp] smul_one smul_mul' smul_zero smul_add

/- warning: smul_inv'' -> smul_inv'' is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u2}} [_inst_1 : Monoid.{u2} M] {F : Type.{u1}} [_inst_7 : DivisionRing.{u1} F] [_inst_8 : MulSemiringAction.{u2, u1} M F _inst_1 (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7))] (x : M) (m : F), Eq.{succ u1} F (SMul.smul.{u2, u1} M F (SMulZeroClass.toHasSmul.{u2, u1} M F (AddZeroClass.toHasZero.{u1} F (AddMonoid.toAddZeroClass.{u1} F (AddMonoidWithOne.toAddMonoid.{u1} F (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} F (NonAssocSemiring.toAddCommMonoidWithOne.{u1} F (Semiring.toNonAssocSemiring.{u1} F (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7)))))))) (DistribSMul.toSmulZeroClass.{u2, u1} M F (AddMonoid.toAddZeroClass.{u1} F (AddMonoidWithOne.toAddMonoid.{u1} F (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} F (NonAssocSemiring.toAddCommMonoidWithOne.{u1} F (Semiring.toNonAssocSemiring.{u1} F (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7))))))) (DistribMulAction.toDistribSMul.{u2, u1} M F _inst_1 (AddMonoidWithOne.toAddMonoid.{u1} F (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} F (NonAssocSemiring.toAddCommMonoidWithOne.{u1} F (Semiring.toNonAssocSemiring.{u1} F (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7)))))) (MulSemiringAction.toDistribMulAction.{u2, u1} M F _inst_1 (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7)) _inst_8)))) x (Inv.inv.{u1} F (DivInvMonoid.toHasInv.{u1} F (DivisionRing.toDivInvMonoid.{u1} F _inst_7)) m)) (Inv.inv.{u1} F (DivInvMonoid.toHasInv.{u1} F (DivisionRing.toDivInvMonoid.{u1} F _inst_7)) (SMul.smul.{u2, u1} M F (SMulZeroClass.toHasSmul.{u2, u1} M F (AddZeroClass.toHasZero.{u1} F (AddMonoid.toAddZeroClass.{u1} F (AddMonoidWithOne.toAddMonoid.{u1} F (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} F (NonAssocSemiring.toAddCommMonoidWithOne.{u1} F (Semiring.toNonAssocSemiring.{u1} F (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7)))))))) (DistribSMul.toSmulZeroClass.{u2, u1} M F (AddMonoid.toAddZeroClass.{u1} F (AddMonoidWithOne.toAddMonoid.{u1} F (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} F (NonAssocSemiring.toAddCommMonoidWithOne.{u1} F (Semiring.toNonAssocSemiring.{u1} F (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7))))))) (DistribMulAction.toDistribSMul.{u2, u1} M F _inst_1 (AddMonoidWithOne.toAddMonoid.{u1} F (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} F (NonAssocSemiring.toAddCommMonoidWithOne.{u1} F (Semiring.toNonAssocSemiring.{u1} F (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7)))))) (MulSemiringAction.toDistribMulAction.{u2, u1} M F _inst_1 (Ring.toSemiring.{u1} F (DivisionRing.toRing.{u1} F _inst_7)) _inst_8)))) x m))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Monoid.{u1} M] {F : Type.{u2}} [_inst_7 : DivisionRing.{u2} F] [_inst_8 : MulSemiringAction.{u1, u2} M F _inst_1 (DivisionSemiring.toSemiring.{u2} F (DivisionRing.toDivisionSemiring.{u2} F _inst_7))] (x : M) (m : F), Eq.{succ u2} F (HSMul.hSMul.{u1, u2, u2} M F F (instHSMul.{u1, u2} M F (SMulZeroClass.toSMul.{u1, u2} M F (MonoidWithZero.toZero.{u2} F (Semiring.toMonoidWithZero.{u2} F (DivisionSemiring.toSemiring.{u2} F (DivisionRing.toDivisionSemiring.{u2} F _inst_7)))) (DistribSMul.toSMulZeroClass.{u1, u2} M F (AddMonoid.toAddZeroClass.{u2} F (AddMonoidWithOne.toAddMonoid.{u2} F (AddGroupWithOne.toAddMonoidWithOne.{u2} F (Ring.toAddGroupWithOne.{u2} F (DivisionRing.toRing.{u2} F _inst_7))))) (DistribMulAction.toDistribSMul.{u1, u2} M F _inst_1 (AddMonoidWithOne.toAddMonoid.{u2} F (AddGroupWithOne.toAddMonoidWithOne.{u2} F (Ring.toAddGroupWithOne.{u2} F (DivisionRing.toRing.{u2} F _inst_7)))) (MulSemiringAction.toDistribMulAction.{u1, u2} M F _inst_1 (Ring.toSemiring.{u2} F (DivisionRing.toRing.{u2} F _inst_7)) _inst_8))))) x (Inv.inv.{u2} F (DivisionRing.toInv.{u2} F _inst_7) m)) (Inv.inv.{u2} F (DivisionRing.toInv.{u2} F _inst_7) (HSMul.hSMul.{u1, u2, u2} M F F (instHSMul.{u1, u2} M F (SMulZeroClass.toSMul.{u1, u2} M F (MonoidWithZero.toZero.{u2} F (Semiring.toMonoidWithZero.{u2} F (DivisionSemiring.toSemiring.{u2} F (DivisionRing.toDivisionSemiring.{u2} F _inst_7)))) (DistribSMul.toSMulZeroClass.{u1, u2} M F (AddMonoid.toAddZeroClass.{u2} F (AddMonoidWithOne.toAddMonoid.{u2} F (AddGroupWithOne.toAddMonoidWithOne.{u2} F (Ring.toAddGroupWithOne.{u2} F (DivisionRing.toRing.{u2} F _inst_7))))) (DistribMulAction.toDistribSMul.{u1, u2} M F _inst_1 (AddMonoidWithOne.toAddMonoid.{u2} F (AddGroupWithOne.toAddMonoidWithOne.{u2} F (Ring.toAddGroupWithOne.{u2} F (DivisionRing.toRing.{u2} F _inst_7)))) (MulSemiringAction.toDistribMulAction.{u1, u2} M F _inst_1 (Ring.toSemiring.{u2} F (DivisionRing.toRing.{u2} F _inst_7)) _inst_8))))) x m))
Case conversion may be inaccurate. Consider using '#align smul_inv'' smul_inv''ₓ'. -/
/-- Note that `smul_inv'` refers to the group case, and `smul_inv` has an additional inverse
on `x`. -/
@[simp]
theorem smul_inv'' [MulSemiringAction M F] (x : M) (m : F) : x • m⁻¹ = (x • m)⁻¹ :=
  map_inv₀ (MulSemiringAction.toRingHom M F x) _
#align smul_inv'' smul_inv''

end SimpLemmas

end Semiring