/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import data.polynomial.ring_division
import tactic.zify
import field_theory.separable
import data.zmod.basic
import ring_theory.integral_domain
import number_theory.divisors
import field_theory.finite.basic
import group_theory.specific_groups.cyclic
import algebra.char_p.two

/-!
# Roots of unity and primitive roots of unity

We define roots of unity in the context of an arbitrary commutative monoid,
as a subgroup of the group of units. We also define a predicate `is_primitive_root` on commutative
monoids, expressing that an element is a primitive root of unity.

## Main definitions

* `roots_of_unity n M`, for `n : ℕ+` is the subgroup of the units of a commutative monoid `M`
  consisting of elements `x` that satisfy `x ^ n = 1`.
* `is_primitive_root ζ k`: an element `ζ` is a primitive `k`-th root of unity if `ζ ^ k = 1`,
  and if `l` satisfies `ζ ^ l = 1` then `k ∣ l`.
* `primitive_roots k R`: the finset of primitive `k`-th roots of unity in an integral domain `R`.

## Main results

* `roots_of_unity.is_cyclic`: the roots of unity in an integral domain form a cyclic group.
* `is_primitive_root.zmod_equiv_zpowers`: `zmod k` is equivalent to
  the subgroup generated by a primitive `k`-th root of unity.
* `is_primitive_root.zpowers_eq`: in an integral domain, the subgroup generated by
  a primitive `k`-th root of unity is equal to the `k`-th roots of unity.
* `is_primitive_root.card_primitive_roots`: if an integral domain
   has a primitive `k`-th root of unity, then it has `φ k` of them.

## Implementation details

It is desirable that `roots_of_unity` is a subgroup,
and it will mainly be applied to rings (e.g. the ring of integers in a number field) and fields.
We therefore implement it as a subgroup of the units of a commutative monoid.

We have chosen to define `roots_of_unity n` for `n : ℕ+`, instead of `n : ℕ`,
because almost all lemmas need the positivity assumption,
and in particular the type class instances for `fintype` and `is_cyclic`.

On the other hand, for primitive roots of unity, it is desirable to have a predicate
not just on units, but directly on elements of the ring/field.
For example, we want to say that `exp (2 * pi * I / n)` is a primitive `n`-th root of unity
in the complex numbers, without having to turn that number into a unit first.

This creates a little bit of friction, but lemmas like `is_primitive_root.is_unit` and
`is_primitive_root.coe_units_iff` should provide the necessary glue.

-/

open_locale classical big_operators
noncomputable theory

open polynomial
open finset

variables {M N G G₀ R S : Type*}
variables [comm_monoid M] [comm_monoid N] [comm_group G] [comm_group_with_zero G₀]

section roots_of_unity

variables {k l : ℕ+}

/-- `roots_of_unity k M` is the subgroup of elements `m : units M` that satisfy `m ^ k = 1` -/
def roots_of_unity (k : ℕ+) (M : Type*) [comm_monoid M] : subgroup (units M) :=
{ carrier := { ζ | ζ ^ (k : ℕ) = 1 },
  one_mem' := one_pow _,
  mul_mem' := λ ζ ξ hζ hξ, by simp only [*, set.mem_set_of_eq, mul_pow, one_mul] at *,
  inv_mem' := λ ζ hζ, by simp only [*, set.mem_set_of_eq, inv_pow, one_inv] at * }

@[simp] lemma mem_roots_of_unity (k : ℕ+) (ζ : units M) :
  ζ ∈ roots_of_unity k M ↔ ζ ^ (k : ℕ) = 1 := iff.rfl

lemma roots_of_unity_le_of_dvd (h : k ∣ l) : roots_of_unity k M ≤ roots_of_unity l M :=
begin
  obtain ⟨d, rfl⟩ := h,
  intros ζ h,
  simp only [mem_roots_of_unity, pnat.mul_coe, pow_mul, one_pow, *] at *,
end

lemma map_roots_of_unity (f : units M →* units N) (k : ℕ+) :
  (roots_of_unity k M).map f ≤ roots_of_unity k N :=
begin
  rintros _ ⟨ζ, h, rfl⟩,
  simp only [←monoid_hom.map_pow, *, mem_roots_of_unity, set_like.mem_coe, monoid_hom.map_one] at *
end

variables [comm_ring R]

@[norm_cast]
lemma roots_of_unity.coe_pow (ζ : roots_of_unity k R) (m : ℕ) : ↑(ζ ^ m) = (ζ ^ m : R) :=
begin
  change ↑(↑(ζ ^ m) : units R) = ↑(ζ : units R) ^ m,
  rw [subgroup.coe_pow, units.coe_pow],
end

variables [comm_ring S]

/-- Restrict a ring homomorphism between integral domains to the nth roots of unity -/
def ring_hom.restrict_roots_of_unity (σ : R →+* S) (n : ℕ+) :
  roots_of_unity n R →* roots_of_unity n S :=
let h : ∀ ξ : roots_of_unity n R, (σ ξ) ^ (n : ℕ) = 1 := λ ξ, by
{ change (σ (ξ : units R)) ^ (n : ℕ) = 1,
  rw [←σ.map_pow, ←units.coe_pow, show ((ξ : units R) ^ (n : ℕ) = 1), from ξ.2,
      units.coe_one, σ.map_one] } in
{ to_fun := λ ξ, ⟨@unit_of_invertible _ _ _ (invertible_of_pow_eq_one _ _ (h ξ) n.2),
    by { ext, rw units.coe_pow, exact h ξ }⟩,
  map_one' := by { ext, exact σ.map_one },
  map_mul' := λ ξ₁ ξ₂, by { ext, rw [subgroup.coe_mul, units.coe_mul], exact σ.map_mul _ _ } }

@[simp] lemma ring_hom.restrict_roots_of_unity_coe_apply (σ : R →+* S) (ζ : roots_of_unity k R) :
  ↑(σ.restrict_roots_of_unity k ζ) = σ ↑ζ :=
rfl

/-- Restrict a ring isomorphism between integral domains to the nth roots of unity -/
def ring_equiv.restrict_roots_of_unity (σ : R ≃+* S) (n : ℕ+) :
  roots_of_unity n R ≃* roots_of_unity n S :=
{ to_fun := σ.to_ring_hom.restrict_roots_of_unity n,
  inv_fun := σ.symm.to_ring_hom.restrict_roots_of_unity n,
  left_inv := λ ξ, by { ext, exact σ.symm_apply_apply ξ },
  right_inv := λ ξ, by { ext, exact σ.apply_symm_apply ξ },
  map_mul' := (σ.to_ring_hom.restrict_roots_of_unity n).map_mul }

@[simp] lemma ring_equiv.restrict_roots_of_unity_coe_apply (σ : R ≃+* S) (ζ : roots_of_unity k R) :
  ↑(σ.restrict_roots_of_unity k ζ) = σ ↑ζ :=
rfl

@[simp] lemma ring_equiv.restrict_roots_of_unity_symm (σ : R ≃+* S) :
  (σ.restrict_roots_of_unity k).symm = σ.symm.restrict_roots_of_unity k :=
rfl

variables [is_domain R]

lemma mem_roots_of_unity_iff_mem_nth_roots {ζ : units R} :
  ζ ∈ roots_of_unity k R ↔ (ζ : R) ∈ nth_roots k (1 : R) :=
by simp only [mem_roots_of_unity, mem_nth_roots k.pos, units.ext_iff, units.coe_one, units.coe_pow]

variables (k R)

/-- Equivalence between the `k`-th roots of unity in `R` and the `k`-th roots of `1`.

This is implemented as equivalence of subtypes,
because `roots_of_unity` is a subgroup of the group of units,
whereas `nth_roots` is a multiset. -/
def roots_of_unity_equiv_nth_roots :
  roots_of_unity k R ≃ {x // x ∈ nth_roots k (1 : R)} :=
begin
  refine
  { to_fun := λ x, ⟨x, mem_roots_of_unity_iff_mem_nth_roots.mp x.2⟩,
    inv_fun := λ x, ⟨⟨x, x ^ (k - 1 : ℕ), _, _⟩, _⟩,
    left_inv := _,
    right_inv := _ },
  swap 4, { rintro ⟨x, hx⟩, ext, refl },
  swap 4, { rintro ⟨x, hx⟩, ext, refl },
  all_goals
  { rcases x with ⟨x, hx⟩, rw [mem_nth_roots k.pos] at hx,
    simp only [subtype.coe_mk, ← pow_succ, ← pow_succ', hx,
      tsub_add_cancel_of_le (show 1 ≤ (k : ℕ), from k.one_le)] },
  { show (_ : units R) ^ (k : ℕ) = 1,
    simp only [units.ext_iff, hx, units.coe_mk, units.coe_one, subtype.coe_mk, units.coe_pow] }
end

variables {k R}

@[simp] lemma roots_of_unity_equiv_nth_roots_apply (x : roots_of_unity k R) :
  (roots_of_unity_equiv_nth_roots R k x : R) = x :=
rfl

@[simp] lemma roots_of_unity_equiv_nth_roots_symm_apply (x : {x // x ∈ nth_roots k (1 : R)}) :
  ((roots_of_unity_equiv_nth_roots R k).symm x : R) = x :=
rfl

variables (k R)

instance roots_of_unity.fintype : fintype (roots_of_unity k R) :=
fintype.of_equiv {x // x ∈ nth_roots k (1 : R)} $ (roots_of_unity_equiv_nth_roots R k).symm

instance roots_of_unity.is_cyclic : is_cyclic (roots_of_unity k R) :=
is_cyclic_of_subgroup_is_domain ((units.coe_hom R).comp (roots_of_unity k R).subtype)
  (units.ext.comp subtype.val_injective)

lemma card_roots_of_unity : fintype.card (roots_of_unity k R) ≤ k :=
calc  fintype.card (roots_of_unity k R)
    = fintype.card {x // x ∈ nth_roots k (1 : R)} :
          fintype.card_congr (roots_of_unity_equiv_nth_roots R k)
... ≤ (nth_roots k (1 : R)).attach.card           : multiset.card_le_of_le (multiset.erase_dup_le _)
... = (nth_roots k (1 : R)).card                  : multiset.card_attach
... ≤ k                                           : card_nth_roots k 1

variables {k R}

lemma ring_hom.map_root_of_unity_eq_pow_self (σ : R →+* R) (ζ : roots_of_unity k R) :
  ∃ m : ℕ, σ ζ = ζ ^ m :=
begin
  obtain ⟨m, hm⟩ := (σ.restrict_roots_of_unity k).map_cyclic,
  rw [←σ.restrict_roots_of_unity_coe_apply, hm, zpow_eq_mod_order_of, ←int.to_nat_of_nonneg
      (m.mod_nonneg (int.coe_nat_ne_zero.mpr (pos_iff_ne_zero.mp (order_of_pos ζ)))),
      zpow_coe_nat, roots_of_unity.coe_pow],
  exact ⟨(m % (order_of ζ)).to_nat, rfl⟩,
end

end roots_of_unity

/-- An element `ζ` is a primitive `k`-th root of unity if `ζ ^ k = 1`,
and if `l` satisfies `ζ ^ l = 1` then `k ∣ l`. -/
structure is_primitive_root (ζ : M) (k : ℕ) : Prop :=
(pow_eq_one : ζ ^ (k : ℕ) = 1)
(dvd_of_pow_eq_one : ∀ l : ℕ, ζ ^ l = 1 → k ∣ l)

section primitive_roots
variables {k : ℕ}

/-- `primitive_roots k R` is the finset of primitive `k`-th roots of unity
in the integral domain `R`. -/
def primitive_roots (k : ℕ) (R : Type*) [comm_ring R] [is_domain R] : finset R :=
(nth_roots k (1 : R)).to_finset.filter (λ ζ, is_primitive_root ζ k)

variables [comm_ring R] [is_domain R]

@[simp] lemma mem_primitive_roots {ζ : R} (h0 : 0 < k) :
  ζ ∈ primitive_roots k R ↔ is_primitive_root ζ k :=
begin
  rw [primitive_roots, mem_filter, multiset.mem_to_finset, mem_nth_roots h0, and_iff_right_iff_imp],
  exact is_primitive_root.pow_eq_one
end

end primitive_roots

namespace is_primitive_root

variables {k l : ℕ}

lemma iff_def (ζ : M) (k : ℕ) :
  is_primitive_root ζ k ↔ (ζ ^ k = 1) ∧ (∀ l : ℕ, ζ ^ l = 1 → k ∣ l) :=
⟨λ ⟨h1, h2⟩, ⟨h1, h2⟩, λ ⟨h1, h2⟩, ⟨h1, h2⟩⟩

lemma mk_of_lt (ζ : M) (hk : 0 < k) (h1 : ζ ^ k = 1) (h : ∀ l : ℕ, 0 < l →  l < k → ζ ^ l ≠ 1) :
  is_primitive_root ζ k :=
begin
  refine ⟨h1, _⟩,
  intros l hl,
  apply dvd_trans _ (k.gcd_dvd_right l),
  suffices : k.gcd l = k, { rw this },
  rw eq_iff_le_not_lt,
  refine ⟨nat.le_of_dvd hk (k.gcd_dvd_left l), _⟩,
  intro h', apply h _ (nat.gcd_pos_of_pos_left _ hk) h',
  exact pow_gcd_eq_one _ h1 hl
end

section comm_monoid

variables {ζ : M} (h : is_primitive_root ζ k)

@[nontriviality] lemma of_subsingleton [subsingleton M] (x : M) : is_primitive_root x 1 :=
⟨subsingleton.elim _ _, λ _ _, one_dvd _⟩

lemma pow_eq_one_iff_dvd (l : ℕ) : ζ ^ l = 1 ↔ k ∣ l :=
⟨h.dvd_of_pow_eq_one l,
by { rintro ⟨i, rfl⟩, simp only [pow_mul, h.pow_eq_one, one_pow, pnat.mul_coe] }⟩

lemma is_unit (h : is_primitive_root ζ k) (h0 : 0 < k) : is_unit ζ :=
begin
  apply is_unit_of_mul_eq_one ζ (ζ ^ (k - 1)),
  rw [← pow_succ, tsub_add_cancel_of_le h0.nat_succ_le, h.pow_eq_one]
end

lemma pow_ne_one_of_pos_of_lt (h0 : 0 < l) (hl : l < k) : ζ ^ l ≠ 1 :=
mt (nat.le_of_dvd h0 ∘ h.dvd_of_pow_eq_one _) $ not_le_of_lt hl

lemma pow_inj (h : is_primitive_root ζ k) ⦃i j : ℕ⦄ (hi : i < k) (hj : j < k) (H : ζ ^ i = ζ ^ j) :
  i = j :=
begin
  wlog hij : i ≤ j,
  apply le_antisymm hij,
  rw ← tsub_eq_zero_iff_le,
  apply nat.eq_zero_of_dvd_of_lt _ (lt_of_le_of_lt tsub_le_self hj),
  apply h.dvd_of_pow_eq_one,
  rw [← ((h.is_unit (lt_of_le_of_lt (nat.zero_le _) hi)).pow i).mul_left_inj,
      ← pow_add, tsub_add_cancel_of_le hij, H, one_mul]
end

lemma one : is_primitive_root (1 : M) 1 :=
{ pow_eq_one := pow_one _,
  dvd_of_pow_eq_one := λ l hl, one_dvd _ }

@[simp] lemma one_right_iff : is_primitive_root ζ 1 ↔ ζ = 1 :=
begin
  split,
  { intro h, rw [← pow_one ζ, h.pow_eq_one] },
  { rintro rfl, exact one }
end

@[simp] lemma coe_units_iff {ζ : units M} :
  is_primitive_root (ζ : M) k ↔ is_primitive_root ζ k :=
by simp only [iff_def, units.ext_iff, units.coe_pow, units.coe_one]

lemma pow_of_coprime (h : is_primitive_root ζ k) (i : ℕ) (hi : i.coprime k) :
  is_primitive_root (ζ ^ i) k :=
begin
  by_cases h0 : k = 0,
  { subst k, simp only [*, pow_one, nat.coprime_zero_right] at * },
  rcases h.is_unit (nat.pos_of_ne_zero h0) with ⟨ζ, rfl⟩,
  rw [← units.coe_pow],
  rw coe_units_iff at h ⊢,
  refine
  { pow_eq_one := by rw [← pow_mul', pow_mul, h.pow_eq_one, one_pow],
    dvd_of_pow_eq_one := _ },
  intros l hl,
  apply h.dvd_of_pow_eq_one,
  rw [← pow_one ζ, ← zpow_coe_nat ζ, ← hi.gcd_eq_one, nat.gcd_eq_gcd_ab, zpow_add,
      mul_pow, ← zpow_coe_nat, ← zpow_mul, mul_right_comm],
  simp only [zpow_mul, hl, h.pow_eq_one, one_zpow, one_pow, one_mul, zpow_coe_nat]
end

lemma pow_of_prime (h : is_primitive_root ζ k) {p : ℕ} (hprime : nat.prime p) (hdiv : ¬ p ∣ k) :
  is_primitive_root (ζ ^ p) k :=
h.pow_of_coprime p (hprime.coprime_iff_not_dvd.2 hdiv)

lemma pow_iff_coprime (h : is_primitive_root ζ k) (h0 : 0 < k) (i : ℕ) :
  is_primitive_root (ζ ^ i) k ↔ i.coprime k :=
begin
  refine ⟨_, h.pow_of_coprime i⟩,
  intro hi,
  obtain ⟨a, ha⟩ := i.gcd_dvd_left k,
  obtain ⟨b, hb⟩ := i.gcd_dvd_right k,
  suffices : b = k,
  { rwa [this, ← one_mul k, nat.mul_left_inj h0, eq_comm] at hb { occs := occurrences.pos [1] } },
  rw [ha] at hi,
  rw [mul_comm] at hb,
  apply nat.dvd_antisymm ⟨i.gcd k, hb⟩ (hi.dvd_of_pow_eq_one b _),
  rw [← pow_mul', ← mul_assoc, ← hb, pow_mul, h.pow_eq_one, one_pow]
end

protected lemma order_of (ζ : M) : is_primitive_root ζ (order_of ζ) :=
⟨pow_order_of_eq_one ζ, λ l, order_of_dvd_of_pow_eq_one⟩

lemma unique {ζ : M} (hk : is_primitive_root ζ k) (hl : is_primitive_root ζ l) : k = l :=
begin
  wlog hkl : k ≤ l,
  rcases hkl.eq_or_lt with rfl | hkl,
  { refl },
  rcases k.eq_zero_or_pos with rfl | hk',
  { exact (zero_dvd_iff.mp $ hk.dvd_of_pow_eq_one l hl.pow_eq_one).symm },
  exact absurd hk.pow_eq_one (hl.pow_ne_one_of_pos_of_lt hk' hkl)
end

lemma eq_order_of : k = order_of ζ := h.unique (is_primitive_root.order_of ζ)

protected lemma iff (hk : 0 < k) :
  is_primitive_root ζ k ↔ ζ ^ k = 1 ∧ ∀ l : ℕ, 0 < l → l < k → ζ ^ l ≠ 1 :=
begin
  refine ⟨λ h, ⟨h.pow_eq_one, λ l hl' hl, _⟩, λ ⟨hζ, hl⟩, is_primitive_root.mk_of_lt ζ hk hζ hl⟩,
  rw h.eq_order_of at hl,
  exact pow_ne_one_of_lt_order_of' hl'.ne' hl,
end

protected lemma not_iff : ¬ is_primitive_root ζ k ↔ order_of ζ ≠ k :=
⟨λ h hk, h $ hk ▸ is_primitive_root.order_of ζ,
 λ h hk, h.symm $ hk.unique $ is_primitive_root.order_of ζ⟩

end comm_monoid

section comm_monoid_with_zero

variables {M₀ : Type*} [comm_monoid_with_zero M₀]

lemma zero [nontrivial M₀] : is_primitive_root (0 : M₀) 0 :=
⟨pow_zero 0, λ l hl, by simpa [zero_pow_eq, show ∀ p, ¬p → false ↔ p, from @not_not] using hl⟩

end comm_monoid_with_zero

section comm_group

variables {ζ : G}

lemma zpow_eq_one (h : is_primitive_root ζ k) : ζ ^ (k : ℤ) = 1 :=
by { rw zpow_coe_nat, exact h.pow_eq_one }

lemma zpow_eq_one_iff_dvd (h : is_primitive_root ζ k) (l : ℤ) :
  ζ ^ l = 1 ↔ (k : ℤ) ∣ l :=
begin
  by_cases h0 : 0 ≤ l,
  { lift l to ℕ using h0, rw [zpow_coe_nat], norm_cast, exact h.pow_eq_one_iff_dvd l },
  { have : 0 ≤ -l, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
    lift -l to ℕ using this with l' hl',
    rw [← dvd_neg, ← hl'],
    norm_cast,
    rw [← h.pow_eq_one_iff_dvd, ← inv_inj, ← zpow_neg, ← hl', zpow_coe_nat, one_inv] }
end

lemma inv (h : is_primitive_root ζ k) : is_primitive_root ζ⁻¹ k :=
{ pow_eq_one := by simp only [h.pow_eq_one, one_inv, eq_self_iff_true, inv_pow],
  dvd_of_pow_eq_one :=
  begin
    intros l hl,
    apply h.dvd_of_pow_eq_one l,
    rw [← inv_inj, ← inv_pow, hl, one_inv]
  end }

@[simp] lemma inv_iff : is_primitive_root ζ⁻¹ k ↔ is_primitive_root ζ k :=
by { refine ⟨_, λ h, inv h⟩, intro h, rw [← inv_inv ζ], exact inv h }

lemma zpow_of_gcd_eq_one (h : is_primitive_root ζ k) (i : ℤ) (hi : i.gcd k = 1) :
  is_primitive_root (ζ ^ i) k :=
begin
  by_cases h0 : 0 ≤ i,
  { lift i to ℕ using h0,
    rw zpow_coe_nat,
    exact h.pow_of_coprime i hi },
  have : 0 ≤ -i, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
  lift -i to ℕ using this with i' hi',
  rw [← inv_iff, ← zpow_neg, ← hi', zpow_coe_nat],
  apply h.pow_of_coprime,
  rw [int.gcd, ← int.nat_abs_neg, ← hi'] at hi,
  exact hi
end

@[simp] lemma coe_subgroup_iff (H : subgroup G) {ζ : H} :
  is_primitive_root (ζ : G) k ↔ is_primitive_root ζ k :=
by simp only [iff_def, ← subgroup.coe_pow, ← H.coe_one, ← subtype.ext_iff]

end comm_group

section comm_group_with_zero

variables {ζ : G₀}

lemma zpow_eq_one₀ (h : is_primitive_root ζ k) : ζ ^ (k : ℤ) = 1 :=
by { rw zpow_coe_nat, exact h.pow_eq_one }

lemma zpow_eq_one_iff_dvd₀ (h : is_primitive_root ζ k) (l : ℤ) :
  ζ ^ l = 1 ↔ (k : ℤ) ∣ l :=
begin
  by_cases h0 : 0 ≤ l,
  { lift l to ℕ using h0, rw [zpow_coe_nat], norm_cast, exact h.pow_eq_one_iff_dvd l },
  { have : 0 ≤ -l, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
    lift -l to ℕ using this with l' hl',
    rw [← dvd_neg, ← hl'],
    norm_cast,
    rw [← h.pow_eq_one_iff_dvd, ← inv_inj₀, ← zpow_neg₀, ← hl', zpow_coe_nat, inv_one] }
end

lemma inv' (h : is_primitive_root ζ k) : is_primitive_root ζ⁻¹ k :=
{ pow_eq_one := by simp only [h.pow_eq_one, inv_one, eq_self_iff_true, inv_pow₀],
  dvd_of_pow_eq_one :=
  begin
    intros l hl,
    apply h.dvd_of_pow_eq_one l,
    rw [← inv_inj₀, ← inv_pow₀, hl, inv_one]
  end }

@[simp] lemma inv_iff' : is_primitive_root ζ⁻¹ k ↔ is_primitive_root ζ k :=
by { refine ⟨_, λ h, inv' h⟩, intro h, rw [← inv_inv₀ ζ], exact inv' h }

lemma zpow_of_gcd_eq_one₀ (h : is_primitive_root ζ k) (i : ℤ) (hi : i.gcd k = 1) :
  is_primitive_root (ζ ^ i) k :=
begin
  by_cases h0 : 0 ≤ i,
  { lift i to ℕ using h0,
    rw zpow_coe_nat,
    exact h.pow_of_coprime i hi },
  have : 0 ≤ -i, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
  lift -i to ℕ using this with i' hi',
  rw [← inv_iff', ← zpow_neg₀, ← hi', zpow_coe_nat],
  apply h.pow_of_coprime,
  rw [int.gcd, ← int.nat_abs_neg, ← hi'] at hi,
  exact hi
end

end comm_group_with_zero

section comm_semiring

variables [comm_semiring R] [comm_semiring S] {f : R →+* S} {ζ : R}

open function

lemma map_of_injective (hf : injective f) (h : is_primitive_root ζ k) : is_primitive_root (f ζ) k :=
{ pow_eq_one := by rw [←f.map_pow, h.pow_eq_one, f.map_one],
  dvd_of_pow_eq_one := begin
    rw h.eq_order_of,
    intros l hl,
    rw [←f.map_pow, ←f.map_one] at hl,
    exact order_of_dvd_of_pow_eq_one (hf hl)
  end }

lemma of_map_of_injective (hf : injective f) (h : is_primitive_root (f ζ) k) :
  is_primitive_root ζ k :=
{ pow_eq_one := by { apply_fun f, rw [f.map_pow, f.map_one, h.pow_eq_one] },
  dvd_of_pow_eq_one := begin
    rw h.eq_order_of,
    intros l hl,
    apply_fun f at hl,
    rw [f.map_pow, f.map_one] at hl,
    exact order_of_dvd_of_pow_eq_one hl
  end }

lemma map_iff_of_injective (hf : injective f) : is_primitive_root (f ζ) k ↔ is_primitive_root ζ k :=
⟨λ h, h.of_map_of_injective hf, λ h, h.map_of_injective hf⟩

end comm_semiring

section is_domain

variables {ζ : R}
variables [comm_ring R] [is_domain R]

@[simp] lemma primitive_roots_zero : primitive_roots 0 R = ∅ :=
begin
  rw [← finset.val_eq_zero, ← multiset.subset_zero, ← nth_roots_zero (1 : R), primitive_roots],
    simp only [finset.not_mem_empty, forall_const, forall_prop_of_false, multiset.to_finset_zero,
    finset.filter_true_of_mem, finset.empty_val, not_false_iff,
    multiset.zero_subset, nth_roots_zero]
end

@[simp] lemma primitive_roots_one : primitive_roots 1 R = {(1 : R)} :=
begin
  apply finset.eq_singleton_iff_unique_mem.2,
  split,
  { simp only [is_primitive_root.one_right_iff, mem_primitive_roots zero_lt_one] },
  { intros x hx,
    rw [mem_primitive_roots zero_lt_one, is_primitive_root.one_right_iff] at hx,
    exact hx }
end

lemma eq_neg_one_of_two_right (h : is_primitive_root ζ 2) : ζ = -1 :=
begin
  apply (eq_or_eq_neg_of_sq_eq_sq ζ 1 _).resolve_left,
  { rw [← pow_one ζ], apply h.pow_ne_one_of_pos_of_lt; dec_trivial },
  { simp only [h.pow_eq_one, one_pow] }
end

end is_domain

section is_domain

variables [comm_ring R]
variables {ζ : units R} (h : is_primitive_root ζ k)

lemma neg_one (p : ℕ) [nontrivial R] [h : char_p R p] (hp : p ≠ 2) : is_primitive_root (-1 : R) 2 :=
begin
  convert is_primitive_root.order_of (-1 : R),
  rw [order_of_neg_one, if_neg],
  rwa ring_char.eq_iff.mpr h
end

protected
lemma mem_roots_of_unity {n : ℕ+} (h : is_primitive_root ζ n) : ζ ∈ roots_of_unity n R :=
h.pow_eq_one

/-- The (additive) monoid equivalence between `zmod k`
and the powers of a primitive root of unity `ζ`. -/
def zmod_equiv_zpowers (h : is_primitive_root ζ k) : zmod k ≃+ additive (subgroup.zpowers ζ) :=
add_equiv.of_bijective
  (add_monoid_hom.lift_of_right_inverse (int.cast_add_hom $ zmod k) _ zmod.int_cast_right_inverse
    ⟨{ to_fun := λ i, additive.of_mul (⟨_, i, rfl⟩ : subgroup.zpowers ζ),
      map_zero' := by { simp only [zpow_zero], refl },
      map_add' := by { intros i j, simp only [zpow_add], refl } },
    (λ i hi,
    begin
      simp only [add_monoid_hom.mem_ker, char_p.int_cast_eq_zero_iff (zmod k) k,
        add_monoid_hom.coe_mk, int.coe_cast_add_hom] at hi ⊢,
      obtain ⟨i, rfl⟩ := hi,
      simp only [zpow_mul, h.pow_eq_one, one_zpow, zpow_coe_nat],
      refl
    end)⟩)
  begin
    split,
    { rw add_monoid_hom.injective_iff,
      intros i hi,
      rw subtype.ext_iff at hi,
      have := (h.zpow_eq_one_iff_dvd _).mp hi,
      rw [← (char_p.int_cast_eq_zero_iff (zmod k) k _).mpr this, eq_comm],
      exact zmod.int_cast_right_inverse i },
    { rintro ⟨ξ, i, rfl⟩,
      refine ⟨int.cast_add_hom _ i, _⟩,
      rw [add_monoid_hom.lift_of_right_inverse_comp_apply],
      refl }
  end

@[simp] lemma zmod_equiv_zpowers_apply_coe_int (i : ℤ) :
  h.zmod_equiv_zpowers i = additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ) :=
add_monoid_hom.lift_of_right_inverse_comp_apply _ _ zmod.int_cast_right_inverse _ _

@[simp] lemma zmod_equiv_zpowers_apply_coe_nat (i : ℕ) :
  h.zmod_equiv_zpowers i = additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ) :=
begin
  have : (i : zmod k) = (i : ℤ), by norm_cast,
  simp only [this, zmod_equiv_zpowers_apply_coe_int, zpow_coe_nat],
  refl
end

@[simp] lemma zmod_equiv_zpowers_symm_apply_zpow (i : ℤ) :
  h.zmod_equiv_zpowers.symm (additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ)) = i :=
by rw [← h.zmod_equiv_zpowers.symm_apply_apply i, zmod_equiv_zpowers_apply_coe_int]

@[simp] lemma zmod_equiv_zpowers_symm_apply_zpow' (i : ℤ) :
  h.zmod_equiv_zpowers.symm ⟨ζ ^ i, i, rfl⟩ = i :=
h.zmod_equiv_zpowers_symm_apply_zpow i

@[simp] lemma zmod_equiv_zpowers_symm_apply_pow (i : ℕ) :
  h.zmod_equiv_zpowers.symm (additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ)) = i :=
by rw [← h.zmod_equiv_zpowers.symm_apply_apply i, zmod_equiv_zpowers_apply_coe_nat]

@[simp] lemma zmod_equiv_zpowers_symm_apply_pow' (i : ℕ) :
  h.zmod_equiv_zpowers.symm ⟨ζ ^ i, i, rfl⟩ = i :=
h.zmod_equiv_zpowers_symm_apply_pow i

/-- If there is a `n`-th primitive root of unity in `R` and `b` divides `n`,
then there is a `b`-th primitive root of unity in `R`. -/
lemma pow {ζ : R} {n : ℕ} {a b : ℕ}
  (hn : 0 < n) (h : is_primitive_root ζ n) (hprod : n = a * b) :
  is_primitive_root (ζ ^ a) b :=
begin
  subst n,
  simp only [iff_def, ← pow_mul, h.pow_eq_one, eq_self_iff_true, true_and],
  intros l hl,
  have ha0 : a ≠ 0, { rintro rfl, simpa only [nat.not_lt_zero, zero_mul] using hn },
  rwa ← mul_dvd_mul_iff_left ha0,
  exact h.dvd_of_pow_eq_one _ hl
end

variables [is_domain R]

lemma zpowers_eq {k : ℕ+} {ζ : units R} (h : is_primitive_root ζ k) :
  subgroup.zpowers ζ = roots_of_unity k R :=
begin
  apply set_like.coe_injective,
  haveI : fact (0 < (k : ℕ)) := ⟨k.pos⟩,
  haveI F : fintype (subgroup.zpowers ζ) := fintype.of_equiv _ (h.zmod_equiv_zpowers).to_equiv,
  refine @set.eq_of_subset_of_card_le (units R) (subgroup.zpowers ζ) (roots_of_unity k R)
    F (roots_of_unity.fintype R k)
    (subgroup.zpowers_subset $ show ζ ∈ roots_of_unity k R, from h.pow_eq_one) _,
  calc fintype.card (roots_of_unity k R)
      ≤ k                                 : card_roots_of_unity R k
  ... = fintype.card (zmod k)             : (zmod.card k).symm
  ... = fintype.card (subgroup.zpowers ζ) : fintype.card_congr (h.zmod_equiv_zpowers).to_equiv
end

lemma eq_pow_of_mem_roots_of_unity {k : ℕ+} {ζ ξ : units R}
  (h : is_primitive_root ζ k) (hξ : ξ ∈ roots_of_unity k R) :
  ∃ (i : ℕ) (hi : i < k), ζ ^ i = ξ :=
begin
  obtain ⟨n, rfl⟩ : ∃ n : ℤ, ζ ^ n = ξ, by rwa [← h.zpowers_eq] at hξ,
  have hk0 : (0 : ℤ) < k := by exact_mod_cast k.pos,
  let i := n % k,
  have hi0 : 0 ≤ i := int.mod_nonneg _ (ne_of_gt hk0),
  lift i to ℕ using hi0 with i₀ hi₀,
  refine ⟨i₀, _, _⟩,
  { zify, rw [hi₀], exact int.mod_lt_of_pos _ hk0 },
  { have aux := h.zpow_eq_one, rw [← coe_coe] at aux,
    rw [← zpow_coe_nat, hi₀, ← int.mod_add_div n k, zpow_add, zpow_mul,
        aux, one_zpow, mul_one] }
end

lemma eq_pow_of_pow_eq_one {k : ℕ} {ζ ξ : R}
  (h : is_primitive_root ζ k) (hξ : ξ ^ k = 1) (h0 : 0 < k) :
  ∃ i < k, ζ ^ i = ξ :=
begin
  obtain ⟨ζ, rfl⟩ := h.is_unit h0,
  obtain ⟨ξ, rfl⟩ := is_unit_of_pow_eq_one ξ k hξ h0,
  obtain ⟨k, rfl⟩ : ∃ k' : ℕ+, k = k' := ⟨⟨k, h0⟩, rfl⟩,
  simp only [← units.coe_pow, ← units.ext_iff],
  rw coe_units_iff at h,
  apply h.eq_pow_of_mem_roots_of_unity,
  rw [mem_roots_of_unity, units.ext_iff, units.coe_pow, hξ, units.coe_one]
end

lemma is_primitive_root_iff' {k : ℕ+} {ζ ξ : units R} (h : is_primitive_root ζ k) :
  is_primitive_root ξ k ↔ ∃ (i < (k : ℕ)) (hi : i.coprime k), ζ ^ i = ξ :=
begin
  split,
  { intro hξ,
    obtain ⟨i, hik, rfl⟩ := h.eq_pow_of_mem_roots_of_unity hξ.pow_eq_one,
    rw h.pow_iff_coprime k.pos at hξ,
    exact ⟨i, hik, hξ, rfl⟩ },
  { rintro ⟨i, -, hi, rfl⟩, exact h.pow_of_coprime i hi }
end

lemma is_primitive_root_iff {k : ℕ} {ζ ξ : R} (h : is_primitive_root ζ k) (h0 : 0 < k) :
  is_primitive_root ξ k ↔ ∃ (i < k) (hi : i.coprime k), ζ ^ i = ξ :=
begin
  split,
  { intro hξ,
    obtain ⟨i, hik, rfl⟩ := h.eq_pow_of_pow_eq_one hξ.pow_eq_one h0,
    rw h.pow_iff_coprime h0 at hξ,
    exact ⟨i, hik, hξ, rfl⟩ },
  { rintro ⟨i, -, hi, rfl⟩, exact h.pow_of_coprime i hi }
end

lemma card_roots_of_unity' {n : ℕ+} (h : is_primitive_root ζ n) :
  fintype.card (roots_of_unity n R) = n :=
begin
  haveI : fact (0 < ↑n) := ⟨n.pos⟩,
  let e := h.zmod_equiv_zpowers,
  haveI F : fintype (subgroup.zpowers ζ) := fintype.of_equiv _ e.to_equiv,
  calc fintype.card (roots_of_unity n R)
      = fintype.card (subgroup.zpowers ζ) : fintype.card_congr $ by rw h.zpowers_eq
  ... = fintype.card (zmod n)             : fintype.card_congr e.to_equiv.symm
  ... = n                                 : zmod.card n
end

lemma card_roots_of_unity {ζ : R} {n : ℕ+} (h : is_primitive_root ζ n) :
  fintype.card (roots_of_unity n R) = n :=
begin
  obtain ⟨ζ, hζ⟩ := h.is_unit n.pos,
  rw [← hζ, is_primitive_root.coe_units_iff] at h,
  exact h.card_roots_of_unity'
end

/-- The cardinality of the multiset `nth_roots ↑n (1 : R)` is `n`
if there is a primitive root of unity in `R`. -/
lemma card_nth_roots {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
  (nth_roots n (1 : R)).card = n :=
begin
  cases nat.eq_zero_or_pos n with hzero hpos,
  { simp only [hzero, multiset.card_zero, nth_roots_zero] },
  rw eq_iff_le_not_lt,
  use card_nth_roots n 1,
  { rw [not_lt],
    have hcard : fintype.card {x // x ∈ nth_roots n (1 : R)}
      ≤ (nth_roots n (1 : R)).attach.card := multiset.card_le_of_le (multiset.erase_dup_le _),
    rw multiset.card_attach at hcard,
    rw ← pnat.to_pnat'_coe hpos at hcard h ⊢,
    set m := nat.to_pnat' n,
    rw [← fintype.card_congr (roots_of_unity_equiv_nth_roots R m), card_roots_of_unity h] at hcard,
    exact hcard }
end

/-- The multiset `nth_roots ↑n (1 : R)` has no repeated elements
if there is a primitive root of unity in `R`. -/
lemma nth_roots_nodup {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) : (nth_roots n (1 : R)).nodup :=
begin
  cases nat.eq_zero_or_pos n with hzero hpos,
  { simp only [hzero, multiset.nodup_zero, nth_roots_zero] },
  apply (@multiset.erase_dup_eq_self R _ _).1,
  rw eq_iff_le_not_lt,
  split,
  { exact multiset.erase_dup_le (nth_roots n (1 : R)) },
  { by_contra ha,
    replace ha := multiset.card_lt_of_lt ha,
    rw card_nth_roots h at ha,
    have hrw : (nth_roots n (1 : R)).erase_dup.card =
      fintype.card {x // x ∈ (nth_roots n (1 : R))},
    { set fs := (⟨(nth_roots n (1 : R)).erase_dup, multiset.nodup_erase_dup _⟩ : finset R),
      rw [← finset.card_mk, ← fintype.card_of_subtype fs _],
      intro x,
      simp only [multiset.mem_erase_dup, finset.mem_mk] },
    rw ← pnat.to_pnat'_coe hpos at h hrw ha,
    set m := nat.to_pnat' n,
    rw [hrw, ← fintype.card_congr (roots_of_unity_equiv_nth_roots R m),
        card_roots_of_unity h] at ha,
    exact nat.lt_asymm ha ha }
end

@[simp] lemma card_nth_roots_finset {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
  (nth_roots_finset n R).card = n :=
by rw [nth_roots_finset, ← multiset.to_finset_eq (nth_roots_nodup h), card_mk, h.card_nth_roots]

open_locale nat

/-- If an integral domain has a primitive `k`-th root of unity, then it has `φ k` of them. -/
lemma card_primitive_roots {ζ : R} {k : ℕ} (h : is_primitive_root ζ k) (h0 : 0 < k) :
  (primitive_roots k R).card = φ k :=
begin
  symmetry,
  refine finset.card_congr (λ i _, ζ ^ i) _ _ _,
  { simp only [true_and, and_imp, mem_filter, mem_range, mem_univ],
    rintro i - hi,
    rw mem_primitive_roots h0,
    exact h.pow_of_coprime i hi.symm },
  { simp only [true_and, and_imp, mem_filter, mem_range, mem_univ],
    rintro i j hi - hj - H,
    exact h.pow_inj hi hj H },
  { simp only [exists_prop, true_and, mem_filter, mem_range, mem_univ],
    intros ξ hξ,
    rw [mem_primitive_roots h0, h.is_primitive_root_iff h0] at hξ,
    rcases hξ with ⟨i, hin, hi, H⟩,
    exact ⟨i, ⟨hin, hi.symm⟩, H⟩ }
end

/-- The sets `primitive_roots k R` are pairwise disjoint. -/
lemma disjoint {k l : ℕ} (hk : 0 < k) (hl : 0 < l) (h : k ≠ l) :
  disjoint (primitive_roots k R) (primitive_roots l R) :=
begin
  intro z,
  simp only [finset.inf_eq_inter, finset.mem_inter, mem_primitive_roots, hk, hl, iff_def],
  rintro ⟨⟨hzk, Hzk⟩, ⟨hzl, Hzl⟩⟩,
  apply_rules [h, nat.dvd_antisymm, Hzk, Hzl, hzk, hzl]
end

/-- `nth_roots n` as a `finset` is equal to the union of `primitive_roots i R` for `i ∣ n`
if there is a primitive root of unity in `R`. -/
lemma nth_roots_one_eq_bUnion_primitive_roots' {ζ : R} {n : ℕ+} (h : is_primitive_root ζ n) :
  nth_roots_finset n R = (nat.divisors ↑n).bUnion (λ i, (primitive_roots i R)) :=
begin
  symmetry,
  apply finset.eq_of_subset_of_card_le,
  { intros x,
    simp only [nth_roots_finset, ← multiset.to_finset_eq (nth_roots_nodup h),
      exists_prop, finset.mem_bUnion, finset.mem_filter, finset.mem_range, mem_nth_roots,
      finset.mem_mk, nat.mem_divisors, and_true, ne.def, pnat.ne_zero, pnat.pos, not_false_iff],
    rintro ⟨a, ⟨d, hd⟩, ha⟩,
    have hazero : 0 < a,
    { contrapose! hd with ha0,
      simp only [nonpos_iff_eq_zero, zero_mul, *] at *,
      exact n.ne_zero },
    rw mem_primitive_roots hazero at ha,
    rw [hd, pow_mul, ha.pow_eq_one, one_pow] },
  { apply le_of_eq,
    rw [h.card_nth_roots_finset, finset.card_bUnion],
    { rw [← nat.sum_totient n, nat.filter_dvd_eq_divisors (pnat.ne_zero n), sum_congr rfl]
        { occs := occurrences.pos [1] },
      simp only [finset.mem_filter, finset.mem_range, nat.mem_divisors],
      rintro k ⟨H, hk⟩,
      have hdvd := H,
      rcases H with ⟨d, hd⟩,
      rw mul_comm at hd,
      rw (h.pow n.pos hd).card_primitive_roots (pnat.pos_of_div_pos hdvd) },
    { intros i hi j hj hdiff,
      simp only [nat.mem_divisors, and_true, ne.def, pnat.ne_zero, not_false_iff] at hi hj,
      exact disjoint (pnat.pos_of_div_pos hi) (pnat.pos_of_div_pos hj) hdiff } }
end

/-- `nth_roots n` as a `finset` is equal to the union of `primitive_roots i R` for `i ∣ n`
if there is a primitive root of unity in `R`. -/
lemma nth_roots_one_eq_bUnion_primitive_roots {ζ : R} {n : ℕ} (hpos : 0 < n)
  (h : is_primitive_root ζ n) :
  nth_roots_finset n R = (nat.divisors n).bUnion (λ i, (primitive_roots i R)) :=
@nth_roots_one_eq_bUnion_primitive_roots' _ _ _ _ ⟨n, hpos⟩ h

end is_domain

section minpoly

open minpoly

variables {n : ℕ} {K : Type*} [field K] {μ : K} (h : is_primitive_root μ n) (hpos : 0 < n)

include n μ h hpos

/--`μ` is integral over `ℤ`. -/
lemma is_integral : is_integral ℤ μ :=
begin
  use (X ^ n - 1),
  split,
  { exact (monic_X_pow_sub_C 1 (ne_of_lt hpos).symm) },
  { simp only [((is_primitive_root.iff_def μ n).mp h).left, eval₂_one, eval₂_X_pow, eval₂_sub,
      sub_self] }
end

variables [char_zero K]

/--The minimal polynomial of a root of unity `μ` divides `X ^ n - 1`. -/
lemma minpoly_dvd_X_pow_sub_one : minpoly ℤ μ ∣ X ^ n - 1 :=
begin
  apply minpoly.gcd_domain_dvd ℚ (is_integral h hpos) (polynomial.monic.is_primitive
    (monic_X_pow_sub_C 1 (ne_of_lt hpos).symm)),
  simp only [((is_primitive_root.iff_def μ n).mp h).left, aeval_X_pow, ring_hom.eq_int_cast,
  int.cast_one, aeval_one, alg_hom.map_sub, sub_self]
end

/-- The reduction modulo `p` of the minimal polynomial of a root of unity `μ` is separable. -/
lemma separable_minpoly_mod {p : ℕ} [fact p.prime] (hdiv : ¬p ∣ n) :
  separable (map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ)) :=
begin
  have hdvd : (map (int.cast_ring_hom (zmod p))
    (minpoly ℤ μ)) ∣ X ^ n - 1,
  { simpa [map_pow, map_X, polynomial.map_one, polynomial.map_sub] using
      ring_hom.map_dvd (map_ring_hom (int.cast_ring_hom (zmod p)))
        (minpoly_dvd_X_pow_sub_one h hpos) },
  refine separable.of_dvd (separable_X_pow_sub_C 1 _ one_ne_zero) hdvd,
  by_contra hzero,
  exact hdiv ((zmod.nat_coe_zmod_eq_zero_iff_dvd n p).1 hzero)
end

/-- The reduction modulo `p` of the minimal polynomial of a root of unity `μ` is squarefree. -/
lemma squarefree_minpoly_mod {p : ℕ} [fact p.prime] (hdiv : ¬ p ∣ n) :
  squarefree (map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ)) :=
(separable_minpoly_mod h hpos hdiv).squarefree

/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `expand ℤ p Q`. -/
lemma minpoly_dvd_expand {p : ℕ} (hprime : nat.prime p) (hdiv : ¬ p ∣ n) :
  minpoly ℤ μ ∣
  expand ℤ p (minpoly ℤ (μ ^ p)) :=
begin
  apply minpoly.gcd_domain_dvd ℚ (h.is_integral hpos),
  { apply monic.is_primitive,
    rw [polynomial.monic, leading_coeff, nat_degree_expand, mul_comm, coeff_expand_mul'
        (nat.prime.pos hprime), ← leading_coeff, ← polynomial.monic],
    exact minpoly.monic (is_integral (pow_of_prime h hprime hdiv) hpos) },
  { rw [aeval_def, coe_expand, ← comp, eval₂_eq_eval_map, map_comp, map_pow, map_X, eval_comp,
      eval_pow, eval_X, ← eval₂_eq_eval_map, ← aeval_def],
    exact minpoly.aeval _ _ }
end

/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `Q ^ p` modulo `p`. -/
lemma minpoly_dvd_pow_mod {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
  map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ) ∣
  map (int.cast_ring_hom (zmod p)) (minpoly ℤ (μ ^ p)) ^ p :=
begin
  set Q := minpoly ℤ (μ ^ p),
  have hfrob : map (int.cast_ring_hom (zmod p)) Q ^ p =
    map (int.cast_ring_hom (zmod p)) (expand ℤ p Q),
  by rw [← zmod.expand_card, map_expand hprime.1.pos],
  rw [hfrob],
  apply ring_hom.map_dvd (map_ring_hom (int.cast_ring_hom (zmod p))),
  exact minpoly_dvd_expand h hpos hprime.1 hdiv
end

/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `Q` modulo `p`. -/
lemma minpoly_dvd_mod_p {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
  map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ) ∣
  map (int.cast_ring_hom (zmod p)) (minpoly ℤ (μ ^ p)) :=
(unique_factorization_monoid.dvd_pow_iff_dvd_of_squarefree (squarefree_minpoly_mod h
  hpos hdiv) hprime.1.ne_zero).1 (minpoly_dvd_pow_mod h hpos hdiv)

/-- If `p` is a prime that does not divide `n`,
then the minimal polynomials of a primitive `n`-th root of unity `μ`
and of `μ ^ p` are the same. -/
lemma minpoly_eq_pow {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
  minpoly ℤ μ = minpoly ℤ (μ ^ p) :=
begin
  by_contra hdiff,
  set P := minpoly ℤ μ,
  set Q := minpoly ℤ (μ ^ p),
  have Pmonic : P.monic := minpoly.monic (h.is_integral hpos),
  have Qmonic : Q.monic := minpoly.monic ((h.pow_of_prime hprime.1 hdiv).is_integral hpos),
  have Pirr : irreducible P := minpoly.irreducible (h.is_integral hpos),
  have Qirr : irreducible Q :=
    minpoly.irreducible ((h.pow_of_prime hprime.1 hdiv).is_integral hpos),
  have PQprim : is_primitive (P * Q) := Pmonic.is_primitive.mul Qmonic.is_primitive,
  have prod : P * Q ∣ X ^ n - 1,
  { rw [(is_primitive.int.dvd_iff_map_cast_dvd_map_cast (P * Q) (X ^ n - 1) PQprim
      (monic_X_pow_sub_C (1 : ℤ) (ne_of_gt hpos)).is_primitive), polynomial.map_mul],
    refine is_coprime.mul_dvd _ _ _,
    { have aux := is_primitive.int.irreducible_iff_irreducible_map_cast Pmonic.is_primitive,
      refine (dvd_or_coprime _ _ (aux.1 Pirr)).resolve_left _,
      rw map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Pmonic,
      intro hdiv,
      refine hdiff (eq_of_monic_of_associated Pmonic Qmonic _),
      exact associated_of_dvd_dvd hdiv (Pirr.dvd_symm Qirr hdiv) },
    { apply (map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Pmonic).2,
      exact minpoly_dvd_X_pow_sub_one h hpos },
    { apply (map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Qmonic).2,
      exact minpoly_dvd_X_pow_sub_one (pow_of_prime h hprime.1 hdiv) hpos } },
  replace prod := ring_hom.map_dvd ((map_ring_hom (int.cast_ring_hom (zmod p)))) prod,
  rw [coe_map_ring_hom, polynomial.map_mul, polynomial.map_sub,
      polynomial.map_one, map_pow, map_X] at prod,
  obtain ⟨R, hR⟩ := minpoly_dvd_mod_p h hpos hdiv,
  rw [hR, ← mul_assoc, ← polynomial.map_mul, ← sq, map_pow] at prod,
  have habs : map (int.cast_ring_hom (zmod p)) P ^ 2 ∣ map (int.cast_ring_hom (zmod p)) P ^ 2 * R,
  { use R },
  replace habs := lt_of_lt_of_le (enat.coe_lt_coe.2 one_lt_two)
    (multiplicity.le_multiplicity_of_pow_dvd (dvd_trans habs prod)),
  have hfree : squarefree (X ^ n - 1 : polynomial (zmod p)),
  { exact (separable_X_pow_sub_C 1
          (λ h, hdiv $ (zmod.nat_coe_zmod_eq_zero_iff_dvd n p).1 h) one_ne_zero).squarefree },
  cases (multiplicity.squarefree_iff_multiplicity_le_one (X ^ n - 1)).1 hfree
    (map (int.cast_ring_hom (zmod p)) P) with hle hunit,
  { rw nat.cast_one at habs, exact hle.not_lt habs },
  { replace hunit := degree_eq_zero_of_is_unit hunit,
    rw degree_map_eq_of_leading_coeff_ne_zero (int.cast_ring_hom (zmod p)) _ at hunit,
    { exact (minpoly.degree_pos (is_integral h hpos)).ne' hunit },
    simp only [Pmonic, ring_hom.eq_int_cast, monic.leading_coeff, int.cast_one, ne.def,
      not_false_iff, one_ne_zero] }
end

/-- If `m : ℕ` is coprime with `n`,
then the minimal polynomials of a primitive `n`-th root of unity `μ`
and of `μ ^ m` are the same. -/
lemma minpoly_eq_pow_coprime {m : ℕ} (hcop : nat.coprime m n) :
  minpoly ℤ μ = minpoly ℤ (μ ^ m) :=
begin
  revert n hcop,
  refine unique_factorization_monoid.induction_on_prime m _ _ _,
  { intros n hn h hpos,
    congr,
    simpa [(nat.coprime_zero_left n).mp hn] using h },
  { intros u hunit n hcop h hpos,
    congr,
    simp [nat.is_unit_iff.mp hunit] },
  { intros a p ha hprime hind n hcop h hpos,
    rw hind (nat.coprime.coprime_mul_left hcop) h hpos, clear hind,
    replace hprime := nat.prime_iff.2 hprime,
    have hdiv := (nat.prime.coprime_iff_not_dvd hprime).1 (nat.coprime.coprime_mul_right hcop),
    haveI := fact.mk hprime,
    rw [minpoly_eq_pow
      (h.pow_of_coprime a (nat.coprime.coprime_mul_left hcop)) hpos hdiv],
    congr' 1,
    ring_exp }
end

/-- If `m : ℕ` is coprime with `n`,
then the minimal polynomial of a primitive `n`-th root of unity `μ`
has `μ ^ m` as root. -/
lemma pow_is_root_minpoly {m : ℕ} (hcop : nat.coprime m n) :
  is_root (map (int.cast_ring_hom K) (minpoly ℤ μ)) (μ ^ m) :=
by simpa [minpoly_eq_pow_coprime h hpos hcop, eval_map, aeval_def (μ ^ m) _]
  using minpoly.aeval ℤ (μ ^ m)

/-- `primitive_roots n K` is a subset of the roots of the minimal polynomial of a primitive
`n`-th root of unity `μ`. -/
lemma is_roots_of_minpoly : primitive_roots n K ⊆ (map (int.cast_ring_hom K)
  (minpoly ℤ μ)).roots.to_finset :=
begin
  intros x hx,
  obtain ⟨m, hle, hcop, rfl⟩ := (is_primitive_root_iff h hpos).1 ((mem_primitive_roots hpos).1 hx),
  simpa [multiset.mem_to_finset,
    mem_roots (map_monic_ne_zero $ minpoly.monic $ is_integral h hpos)]
    using pow_is_root_minpoly h hpos hcop
end

/-- The degree of the minimal polynomial of `μ` is at least `totient n`. -/
lemma totient_le_degree_minpoly : nat.totient n ≤ (minpoly ℤ μ).nat_degree :=
let P : polynomial ℤ := minpoly ℤ μ,-- minimal polynomial of `μ`
    P_K : polynomial K := map (int.cast_ring_hom K) P -- minimal polynomial of `μ` sent to `K[X]`
in calc
n.totient = (primitive_roots n K).card : (h.card_primitive_roots hpos).symm
... ≤ P_K.roots.to_finset.card : finset.card_le_of_subset (is_roots_of_minpoly h hpos)
... ≤ P_K.roots.card : multiset.to_finset_card_le _
... ≤ P_K.nat_degree : (card_roots' $ map_monic_ne_zero
        (minpoly.monic $ is_integral h hpos))
... ≤ P.nat_degree : nat_degree_map_le _ _

end minpoly

end is_primitive_root


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes

The gaussian integers ℤ[i].
-/

import data.zsqrtd.basic data.complex.basic algebra.euclidean_domain algebra.associated
open zsqrtd complex

@[reducible] def gaussian_int : Type := zsqrtd (-1)

local notation `ℤ[i]` := gaussian_int

namespace gaussian_int

instance : has_repr ℤ[i] := ⟨λ x, "⟨" ++ repr x.re ++ ", " ++ repr x.im ++ "⟩"⟩

instance : comm_ring ℤ[i] := zsqrtd.comm_ring

def to_complex (x : ℤ[i]) : ℂ := x.re + x.im * I

instance : has_coe (ℤ[i]) ℂ := ⟨to_complex⟩

lemma to_complex_def (x : ℤ[i]) : (x : ℂ) = x.re + x.im * I := rfl

lemma to_complex_def' (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ) = x + y * I := by simp [to_complex_def]

lemma to_complex_def₂ (x : ℤ[i]) : (x : ℂ) = ⟨x.re, x.im⟩ :=
by apply complex.ext; simp [to_complex_def]

instance to_complex.is_ring_hom : is_ring_hom to_complex:=
by refine_struct {..}; intros; apply complex.ext; simp [to_complex]

instance : is_ring_hom (coe : ℤ[i] → ℂ) := to_complex.is_ring_hom

@[simp] lemma to_real_re (x : ℤ[i]) : ((x.re : ℤ) : ℝ) = (x : ℂ).re := by simp [to_complex_def]
@[simp] lemma to_real_im (x : ℤ[i]) : ((x.im : ℤ) : ℝ) = (x : ℂ).im := by simp [to_complex_def]
@[simp] lemma to_complex_re (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).re = x := by simp [to_complex_def]
@[simp] lemma to_complex_im (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).im = y := by simp [to_complex_def]
@[simp] lemma to_complex_add (x y : ℤ[i]) : ((x + y : ℤ[i]) : ℂ) = x + y := is_ring_hom.map_add coe
@[simp] lemma to_complex_mul (x y : ℤ[i]) : ((x * y : ℤ[i]) : ℂ) = x * y := is_ring_hom.map_mul coe
@[simp] lemma to_complex_one : ((1 : ℤ[i]) : ℂ) = 1 := is_ring_hom.map_one coe
@[simp] lemma to_complex_zero : ((0 : ℤ[i]) : ℂ) = 0 := is_ring_hom.map_zero coe
@[simp] lemma to_complex_neg (x : ℤ[i]) : ((-x : ℤ[i]) : ℂ) = -x := is_ring_hom.map_neg coe
@[simp] lemma to_complex_sub (x y : ℤ[i]) : ((x - y : ℤ[i]) : ℂ) = x - y := is_ring_hom.map_sub coe

@[simp] lemma to_complex_inj {x y : ℤ[i]} : (x : ℂ) = y ↔ x = y :=
by cases x; cases y; simp [to_complex_def₂]

@[simp] lemma to_complex_eq_zero {x : ℤ[i]} : (x : ℂ) = 0 ↔ x = 0 :=
by rw [← to_complex_zero, to_complex_inj]

@[simp] lemma nat_cast_real_norm (x : ℤ[i]) : (x.norm : ℝ) = (x : ℂ).norm_sq :=
by rw [norm, norm_sq]; simp

@[simp] lemma nat_cast_complex_norm (x : ℤ[i]) : (x.norm : ℂ) = (x : ℂ).norm_sq :=
by cases x; rw [norm, norm_sq]; simp

lemma norm_nonneg (x : ℤ[i]) : 0 ≤ norm x := norm_nonneg trivial _

@[simp] lemma norm_eq_zero {x : ℤ[i]} : norm x = 0 ↔ x = 0 :=
by rw [← @int.cast_inj ℝ _ _ _]; simp

lemma norm_pos {x : ℤ[i]} : 0 < norm x ↔ x ≠ 0 :=
by rw [lt_iff_le_and_ne, ne.def, eq_comm, norm_eq_zero]; simp [norm_nonneg]

@[simp] lemma coe_nat_abs_norm (x : ℤ[i]) : (x.norm.nat_abs : ℤ) = x.norm :=
int.nat_abs_of_nonneg (norm_nonneg _)

@[simp] lemma nat_cast_nat_abs_norm {α : Type*} [ring α]
  (x : ℤ[i]) : (x.norm.nat_abs : α) = x.norm :=
by rw [← int.cast_coe_nat, coe_nat_abs_norm]

lemma nat_abs_norm_eq (x : ℤ[i]) : x.norm.nat_abs =
  x.re.nat_abs * x.re.nat_abs + x.im.nat_abs * x.im.nat_abs :=
int.coe_nat_inj $ begin simp, simp [norm] end

protected def div (x y : ℤ[i]) : ℤ[i] :=
⟨round ((x * conj y).re / norm y : ℚ),
 round ((x * conj y).im / norm y : ℚ)⟩

instance : has_div ℤ[i] := ⟨gaussian_int.div⟩

lemma div_def (x y : ℤ[i]) : x / y = ⟨round ((x * conj y).re / norm y : ℚ),
 round ((x * conj y).im / norm y : ℚ)⟩ := rfl

lemma to_complex_div_re (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).re = round ((x / y : ℂ).re) :=
by rw [div_def, ← @rat.cast_round ℝ _ _];
  simp [-rat.cast_round, mul_assoc, div_eq_mul_inv, mul_add, add_mul]

lemma to_complex_div_im (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).im = round ((x / y : ℂ).im) :=
by rw [div_def, ← @rat.cast_round ℝ _ _, ← @rat.cast_round ℝ _ _];
  simp [-rat.cast_round, mul_assoc, div_eq_mul_inv, mul_add, add_mul]

local notation `abs'` := _root_.abs

lemma norm_sq_le_norm_sq_of_re_le_of_im_le {x y : ℂ} (hre : abs' x.re ≤ abs' y.re)
  (him : abs' x.im ≤ abs' y.im) : x.norm_sq ≤ y.norm_sq :=
by rw [norm_sq, norm_sq, ← _root_.abs_mul_self, _root_.abs_mul,
  ← _root_.abs_mul_self y.re, _root_.abs_mul y.re,
  ← _root_.abs_mul_self x.im, _root_.abs_mul x.im,
  ← _root_.abs_mul_self y.im, _root_.abs_mul y.im]; exact
(add_le_add (mul_self_le_mul_self (abs_nonneg _) hre)
  (mul_self_le_mul_self (abs_nonneg _) him))

lemma norm_sq_div_sub_div_lt_one (x y : ℤ[i]) :
  ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).norm_sq < 1 :=
calc ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).norm_sq =
    ((x / y : ℂ).re - ((x / y : ℤ[i]) : ℂ).re +
    ((x / y : ℂ).im - ((x / y : ℤ[i]) : ℂ).im) * I : ℂ).norm_sq :
      congr_arg _ $ by apply complex.ext; simp
  ... ≤ (1 / 2 + 1 / 2 * I).norm_sq :
  have abs' (2 / (2 * 2) : ℝ) = 1 / 2, by rw _root_.abs_of_nonneg; norm_num,
  norm_sq_le_norm_sq_of_re_le_of_im_le
    (by rw [to_complex_div_re]; simp [norm_sq, this];
      simpa using abs_sub_round (x / y : ℂ).re)
    (by rw [to_complex_div_im]; simp [norm_sq, this];
      simpa using abs_sub_round (x / y : ℂ).im)
  ... < 1 : by simp [norm_sq]; norm_num

protected def mod (x y : ℤ[i]) : ℤ[i] := x - y * (x / y)

instance : has_mod ℤ[i] := ⟨gaussian_int.mod⟩

lemma mod_def (x y : ℤ[i]) : x % y = x - y * (x / y) := rfl

lemma norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) : (x % y).norm < y.norm :=
have (y : ℂ) ≠ 0, by rwa [ne.def, ← to_complex_zero, to_complex_inj],
(@int.cast_lt ℝ _ _ _).1 $
  calc ↑(norm (x % y)) = (x - y * (x / y : ℤ[i]) : ℂ).norm_sq : by simp [mod_def]
  ... = (y : ℂ).norm_sq * (((x / y) - (x / y : ℤ[i])) : ℂ).norm_sq :
    by rw [← norm_sq_mul, mul_sub, mul_div_cancel' _ this]
  ... < (y : ℂ).norm_sq * 1 : mul_lt_mul_of_pos_left (norm_sq_div_sub_div_lt_one _ _)
    (norm_sq_pos.2 this)
  ... = norm y : by simp

lemma nat_abs_norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
  (x % y).norm.nat_abs < y.norm.nat_abs :=
int.coe_nat_lt.1 (by simp [-int.coe_nat_lt, norm_mod_lt x hy])

lemma norm_le_norm_mul_left (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
  (norm x).nat_abs ≤ (norm (x * y)).nat_abs :=
by rw [norm_mul, int.nat_abs_mul];
  exact le_mul_of_ge_one_right' (nat.zero_le _)
    (int.coe_nat_le.1 (by rw [coe_nat_abs_norm]; exact norm_pos.2 hy))

instance : nonzero_comm_ring ℤ[i] :=
{ zero_ne_one := dec_trivial, ..gaussian_int.comm_ring }

instance : euclidean_domain ℤ[i] :=
{ quotient := (/),
  remainder := (%),
  quotient_zero := λ _, by simp [div_def]; refl,
  quotient_mul_add_remainder_eq := λ _ _, by simp [mod_def],
  r := _,
  r_well_founded := measure_wf (int.nat_abs ∘ norm),
  remainder_lt := nat_abs_norm_mod_lt,
  mul_left_not_lt := λ a b hb0, not_lt_of_ge $ norm_le_norm_mul_left a hb0 }

end gaussian_int


-- jensen.lean
-- @authors: Colin J Fan, Brandon H Gomes, Yasa Syed

/-!
# Jensen's Inequality

In this file, we prove a famous and important inequality. The file is self-contained and
requires no other definitions other than those in the Lean core.

We first state the classical Jensen's Inequality:

- Theorem. Let `μ` be a positive measure on a σ-algebra `𝔐` in a set `Ω`, so that
  `μ(Ω) = 1`. If `f` is a real function in `L¹(μ)` such that `∀x ∈ Ω, f(x) ∈ (a,b)` and if
  `φ` is convex on `(a,b)`, then `φ (∫_Ω f dμ) ≤ ∫_Ω (φ ∘ f) dμ`. More succinctly,
  `φ (∫ f) ≤ ∫ (φ ∘ f)`.

The inequality follows from certain facts about integration, real numbers, convex
functions, ... etc. The theorem we prove is a strict generalization in which we state the
theorem in as high of an abstract form as possible from facts about subtraction and
partial orders. We will define a type-theoretic analogue of integration theory and of the
theory of convex functions. More details are discussed below.

This theorem has some important corollaries for real analysis, measure theory, probability
theory, statistics, and statistical physics:

- Corollary 1 (AM-GM). Fix `n ∈ ℕ`. It follows that for any `a₁, a₂, ..., aₙ ∈ ℝ₀` that
  `ⁿ√(a₁a₂ ⋯ aₙ) ≤ (a₁ + a₂ + ⋯ + aₙ) / n`.

- Corollary 2 (Young's Inequality). Fix `a b ∈ ℝ₀` and `p q ∈ ℝ` such that `p > 1`, and
  `1/p + 1/q = 1`. Then, `ab ≤ a^p / p + b^q / q`.

- Corollary 3 (Hölder's Inequality). Fix `p q ∈ ℝ` such that `p > 1`, and `1/p + 1/q = 1`.
  If `X` is a measure space, with measure `μ` and `f`,`g` measurable functions on `X` with
  codomain `[0,∞]`, then `∫ fg dμ ≤ (∫ f^p dμ)^1/p * (∫ g^q dμ)^1/q` where the integrals
  are taken over `X`.

- Corollary 4 (Minkowski's Inequality). With the same assumptions as Hölder's Inequality
  we have `(∫ (f+g)^p dμ)^1/p ≤ (∫ f^p dμ)^1/p + (∫ g^p dμ)^1/p`. In particular, for
  `p > 1`, the map `f ↦ (∫ |f|^p dμ)^1/p` is a norm for `f` (up to a relevant equivalence
  relation) such that all `f` have finite `p`-norm.

- Corollary 5 (Chandler): `e^(E[X]) ≤ E[e^X]`.

- Corollary 6 (Gibb's Inequality). `D_KL(P||Q) ≥ 0`.

- Corollary 7: Rao-Blackwell Theorem.

Now, we begin our discussion with power sets.
-/

--———————————————————————————————————————————————————————————————————————————————————————--
/--
`Power X` (`𝒫 X`) The powerset of a type.

Given a type `X : 𝒰i` we can consider the type of functions from `X` into a fixed type
universe `𝒰j`.

One can view this type of functions `𝒫 X` as the space of characteristic functions on `X`.
Classically, we can associate any subset `A ⊆ S` to an appropriate characteristic function
`χ_A : S → {0,1}` which takes value `1` on `A` and `0` elsewhere in `S`. This association
is a "bijective correspondence", that is, we can freely change our interpretation of the
subset `A` either as an actual subset or as a characteristic function. In the language of
types there is no natural notion of "subset" but there is a natural (but non-canonical
since it depends on the universe level `j`) notion of a characteristic function.

In general `𝒫 X` behaves like the classical power set of `X`, i.e. a complete lattice:
  - Bottom:                 `⊥ := λ x, 𝟘`
  - Top:                    `⊤ := λ x, 𝟙`
  - Union:                  `P ∪ Q := λ x, P x ∨ Q x`
  - Intersection:           `P ∩ Q := λ x, P x ∧ Q x`
  - Aribtrary Union:        `⋃ ℱ := λ x, Σ i, (ℱ i) x`
  - Aribtrary Intersection: `⋂ ℱ := λ x, Π i, (ℱ i) x`

where `𝟘` and `𝟙` are the empty type (the type with no terms) and unit type (the type with
one canonical term) respectively. The `⊥` element can be called the "empty set" and the
`⊤` element can be called the "total space" and can be associated to `X` itself.
Classically one can think of the union as the sum of characteristic functions `χ_P + χ_Q`
and the intersection as the product `χ_P * χ_Q`. There is a similar story for the
arbitrary union/intersection.

NB: To know that a term `x : X` is contained in the subset `A : 𝒫 X`, we need a witness of
the form `w : A x`, since `A` is a function and concatenation is function application.

We will be using the `Power` construction many times throughout since partial functions
play an important role in the `jensen_inequality` and also in the theory of integration in
general; partial functions only make sense if we have defined the notion of power set.
-/
definition {𝒰i 𝒰j} Power (X : Type 𝒰i)
    := X → Type 𝒰j
notation `𝒫` X := Power X

/--
`const b` (`↓b`) The constant function at a point.

Given a type `X` and a pointed type `⟨Y, b⟩`, we can consider the constant function which
takes every point of `X` to the basepoint `b`.

Such functions are important for the `jensen_inequality`, and are also important in the
study of pointed spaces in general.
-/
definition {𝒰x 𝒰y} const {X : Type 𝒰x} {Y : Type 𝒰y}
    := λ b:Y, (λ x:X, b)
notation `↓`:max y:max := const y

section difference_domain --—————————————————————————————————————————————————————————————--
universes 𝒰y
variables (Y : Type 𝒰y)

/--
`DifferenceDomain Y extends has_zero Y, has_sub Y` A good place to do subtraction.

A `DifferenceDomain` is a minimal structure that admits a version of subtraction like the
one we are familiar with from abelian groups. The main property that distingushes
subtraction is that image of the diagonal always vanishes. This property is called
`vanishing_diagonal` below.

There are other axioms which would make sense to add like the following two:
  - `zero_is_right_id  : Π y, y - 0 = y`
  - `sub_associativity : Π a b c, a - (b - c) = (a - b) - (0 - c)`

which make the subtraction more like the inverse of some addition operation like
`a + b := a - (0 - b)`, but such details are not considered here. For the
`jensen_inequality`, we need only the `vanishing_diagonal` property.
-/
class DifferenceDomain extends has_zero Y, has_sub Y
    := (vanishing_diagonal : Π y, y - y = zero)

/--
`OrderedDifferenceDomain Y extends has_le Y, DifferenceDomain Y`

We will need an order structure on `Y` to state and prove the `jensen_inequality` so we
add it here. There are no asumptions on the behavior of `≤` like reflexivity/transitivity.
-/
class OrderedDifferenceDomain
    extends has_le Y, DifferenceDomain Y

end difference_domain --—————————————————————————————————————————————————————————————————--

section reduction --—————————————————————————————————————————————————————————————————————--
universes 𝒰y 𝒰x
variables {Y : Type 𝒰y} {X : Type 𝒰x} (ℱ : 𝒫 (X → Y))

/--
`Reduction` A generalized functional.

Given types `X` and `Y`, a `Reduction` is a partial function from the type of functions
`X → Y` to the type `Y`. The domain of this function is denoted `ℱ` throughout. One reads
the definition of reduction as "a type which takes a function `f : X → Y` and a proof that
`f` is contained in the family `ℱ` (`p : ℱ f`, see `Power` above) and sends this pair to
term of type `Y`".

Examples of reductions:
  - evaluation at a point (`x₀ : X`, `eval : (X → Y) → Y := λ f, f x₀`)
      (`ℱ` can be taken to be the total or "everywhere true" predicate)
  - integration (`∫_Ω (—) dμ : (X → Y) → Y`)
      (`ℱ` is the appropriate subset corresponding to the integrable functions on `Ω`)
  - limit of a sequence (`lim : (ℕ → R) → R`)
      (`ℱ` is the appropriate subset corresponding to the convergent sequences)

For the `jensen_inequality` we will be using something like the second example as we want
to imitate a weak kind of integration.

For a fixed reduction we call a function `f` *reducible* if it is contained in the family
corresponding to that reduction, i.e. `reducible f := ℱ f`. We say that a reduction
*admits (a reduction of) a function `f`* if `f` is reducible with respect to the family
corresponding to the given reduction.
-/
definition Reduction
    := Π f, ℱ f → Y

/--
`left_closed_at ℱ f g` Left closedness of `g` at `f`.

We say that a function `g : Y → Y` is *left closed at `f` with respect to `ℱ`* when the
reducibility of `f` implies the reducibility of the composition `g ∘ f` with respect to
the fixed family `ℱ`.
-/
definition left_closed_at (f : X → Y) (g : Y → Y)
    := ℱ f → ℱ (g ∘ f)

/--
`left_closed ℱ g` Left closedness of `g`.

We say that a function `g : Y → Y` is *left closed with respect to `ℱ`* when it is left
closed at every function `f : X → Y`.
-/
definition left_closed (g : Y → Y)
    := Π f, left_closed_at ℱ f g

/--
`PointFamily` Family of functions which contains all constant functions.

A reasonable reduction family might admit constant functions as a trivial case of some
more interesting property.
-/
class PointFamily
    := (has_constants : Π y, ℱ ↓y)

section subtraction --———————————————————————————————————————————————————————————————————--

/--
`pointwise_subtraction` Lifting codomain subtraction to pointwise subtraction.

If `Y` has a subtraction structure then for any type `X`, the function space `X → Y` has a
canonical pointwise subtraction. This `instance` is added to simplify the notation below.
-/
instance pointwise_subtraction [has_sub Y] : has_sub (X → Y)
    := ⟨λ f g, (λ x, f x - g x)⟩

/--
`DifferenceFamily` Family of functions closed under pointwise subtraction.
-/
class DifferenceFamily [has_sub Y]
    := (closure : Π f g (fℱ : ℱ f) (gℱ : ℱ g), ℱ (f - g))

--———————————————————————————————————————————————————————————————————————————————————————--
/--
We fix `Int : Reduction ℱ` which will be written symbolically `∫` to conote something like
an integral. This reduction will be used below.
-/
variables (Int : Reduction ℱ)

/--
`left_factors ℱ β lc_β` Left factorizability of `β`.

We say that a left closed function `β` *left factors with respect to `Int`* when for every
reducible `f` we have the identity `∫ (β ∘ f) = β (∫ f)`.
-/
definition left_factors (β : Y → Y) (lc_β : left_closed ℱ β)
    := Π f (fℱ : ℱ f), Int (β ∘ f) (lc_β f fℱ) = β (Int f fℱ)

--———————————————————————————————————————————————————————————————————————————————————————--
/-- For the rest of this section we assume `ℱ` is a `PointFamily`. -/
variables [PointFamily ℱ]

/--
`UnitalReduction` A reduction which is friendly to constant functions.

We say that a reduction is unital if it admits all constant functions and that the
reduction of a constant function is the constant which defines it, i.e. `∫ ↓y = y`.
-/
class UnitalReduction
    := (constant_reduction : Π y, Int ↓y (PointFamily.has_constants ℱ y) = y)

--———————————————————————————————————————————————————————————————————————————————————————--
/-- For the rest of this section we assume `Y` has a `≤` structure. -/
variables [has_le Y]

/--
`pointwise_le` Lifting codomain order to pointwise order.

If `Y` has an order structure `≤` then for any type `X`, the function space `X → Y` has a
canonical pointwise order. This `instance` is added to simplify the notation below.
-/
instance pointwise_le : has_le (X → Y)
    := ⟨λ f g, (Π x, f x ≤ g x)⟩

/--
`MonotonicReduction Y` A reduction which is functorial over `≤`.

We can also make a reduction functorial over the order structure on the space of
functions `X → Y` (restricted to `ℱ`) by requiring that `Int` be a monotonic operator.
-/
class MonotonicReduction
    := (monotonicity : Π f g {fℱ gℱ}, (f ≤ g) → (Int f fℱ ≤ Int g gℱ))

--———————————————————————————————————————————————————————————————————————————————————————--
/--
For the rest of this section we assume `Y` has a zero element and subtraction structure
and that `ℱ` is a `DifferenceFamily`. We want to consider a reduction that interacts with
a subtraction structure on its codomain.
-/
variables [has_zero Y] [has_sub Y] [DifferenceFamily ℱ]

/--
`constant_difference_property` A weak homomorphism property.

For a reduction compatible with subtraction, we would like to have that reductions are
homomorphisms of difference domains but this turns out to be too strong of a property. In
the case of classical integration we do not have in general the property
`∫ (f - g) = (∫ f) - (∫ g)` since both integrals on the right may take value at `±∞` so
the subtraction is not well defined. We instead use the weaker property that we can
commute with subtraction of a constant function.
-/
definition constant_difference_property
    := Π f k {fℱ},
        Int (f - ↓k) (DifferenceFamily.closure f ↓k fℱ (PointFamily.has_constants ℱ k))
      = Int f fℱ - Int ↓k (PointFamily.has_constants ℱ k)

/--
`translation_invariance_property` A weak translation property across inequalities.

For a reduction compatible with subtraction, we would like to capture the property from
the classical integral that the integral of a difference `f - g` is in the positive cone,
then `∫ g ≤ ∫ f`.
-/
definition translation_invariance_property
    := Π f g {fℱ gℱ}, 0 ≤ Int (g - f) (DifferenceFamily.closure g f gℱ fℱ)
                         → Int f fℱ ≤ Int g gℱ

/--
`TranslativeReduction` A reduction which is compatible with subtraction.

We call a reduction a `TranslativeReduction` when it satisfies the
`constant_difference_property` and the `translation_invariance_property` defined above.
-/
class TranslativeReduction
    := (constant_difference    : constant_difference_property ℱ Int)
       (translation_invariance : translation_invariance_property ℱ Int)

end subtraction --———————————————————————————————————————————————————————————————————————--
end reduction --—————————————————————————————————————————————————————————————————————————--

section subdifferential --———————————————————————————————————————————————————————————————--
universes 𝒰y
variables {Y : Type 𝒰y} [has_zero Y] [has_sub Y] [has_le Y]
          (φ : Y → Y) (t : Y) (𝒩 : 𝒫 Y)

/--
`SubDifferential φ t 𝒩` The subdifferential property.

The primary role of convexity in the classical inequality is the following. Given a convex
function `φ` on `(a,b)` we know that for any `s,t,u ∈ (a,b)` such that `s < t < u`, it
follows that
    `(φ t - φ s) / (t - s) ≤ (φ u - φ t) / (u - t)`
From this we can deduce that there exists the supremum
    `β := sup_{s ∈ (a,t)} (φ t - φ s) / (t - s)`
which then gives us the following inequality:
    `β ⬝ (s - t) ≤ φ s - φ t`

To generalize this to a domain of discourse that does not have convex functions, we
instead accept the last inequality by hypothesis and generalize multiplication by `β` from
the left to function application. To ensure that this function application behaves well
with zero we need that it vanish there which is analogous to the fact that `y ⬝ 0 = 0` in
the real numbers.

Since the inequality above holds only in `(a,b)` in the classical case, not on all of `ℝ`,
we need to restrict the inequality to a specific subset of `Y`. We call this subset `𝒩`.
-/
structure SubDifferential
    := (map                  : Y → Y)
       (root_at_zero         : map 0 = 0)
       (lower_bound_property : Π s, 𝒩 s → map (s - t) ≤ (φ s) - (φ t))

--———————————————————————————————————————————————————————————————————————————————————————--
universes 𝒰x
variables {X : Type 𝒰x} (ℱ : 𝒫 (X → Y)) (Int : Reduction ℱ)

/--
`LeftFactorSubDifferential φ t 𝒩` A left factorizable subdifferential.

If we have `β` a subdifferential corresponding to `φ`, `t`, and `𝒩`, then we say that it
is a *left factor subdifferential* when `β` left factors with respect to the family `ℱ`.
-/
structure LeftFactorSubDifferential extends SubDifferential φ t 𝒩
    := (is_left_closed : left_closed ℱ map)
       (left_factors   : left_factors ℱ Int map is_left_closed)

end subdifferential --———————————————————————————————————————————————————————————————————--

section jensen_inequality --—————————————————————————————————————————————————————————————--
universes 𝒰y 𝒰x
variables {Y : Type 𝒰y} [OrderedDifferenceDomain Y]
          {X : Type 𝒰x}
          (ℱ : 𝒫 (X → Y)) [PointFamily ℱ] [DifferenceFamily ℱ]
          (Int : Reduction ℱ)

/--
`JensenReduction` A reduction which is strong enough to prove Jensen's Inequality.

We have the following properties inherited from the individual structures:
  - `UnitalReduction`
      - `∫ ↓t = t`
  - `MonotonicReduction`
      - `(Π x, f x ≤ g x) → (∫ f ≤ ∫ g)`
  - `TranslativeReduction`
      - `∫ (f - ↓k) = (∫ f) - (∫ ↓k)`
      - `(0 ≤ ∫ (g - f)) → (∫ f ≤ ∫ g)`
-/
class JensenReduction
    extends UnitalReduction      ℱ Int,
            MonotonicReduction   ℱ Int,
            TranslativeReduction ℱ Int

/--
`jensen_inequality` Jensen's Inequality (`φ (∫ f) ≤ ∫ (φ ∘ f)`).

The theorem exactly generalizes the classical Jensen inequality and so it is sufficient to
prove that the measure-theoretic integral is a `JensenReduction` and that convex functions
have the `LeftFactorSubDifferential` property to apply the following proof to the
classical case. Proof sketches for these two facts are discussed above.

NB: In this proof, we will be working to find a term which has the type of the goal
    instead of modifying the goal directly, so it is not necessary to look at the goals.
    Instead, follow the proof by reading the commentary which describes the change in the
    main term `inequality` which will satisfy the goal in the end. For simplicity the
    reducibility proofs are left unspecified while following the main term.
-/
theorem jensen_inequality
    -- Proof that Int is a nice reduction.
    [JensenReduction ℱ Int]

    -- A reducible function f.
    (f : X → Y) (fℱ : ℱ f)

    -- A distinguished superset of the image of f.
    (𝒩 : 𝒫 Y) (image_contained_in_𝒩 : Π x, 𝒩 (f x))

    -- A function φ which is left closed at f and has a LeftFactorSubDifferential at the
    -- reduction of f with the above distinguished superset 𝒩.
    (φ : Y → Y) (φfℱ : ℱ (φ ∘ f))
    (subdifferential : LeftFactorSubDifferential φ (Int f fℱ) 𝒩 ℱ Int)

    -- From above, the Jensen Inequality follows:
    : φ (Int f fℱ) ≤ Int (φ ∘ f) φfℱ

:= begin -- We begin by introducing some relevant variables:

    -- The reduction of f.
    let t := Int f fℱ,

    -- The function F := λ x, f x - t and its proof of reducibility.
    let F := f - ↓t,
    let Fℱ := DifferenceFamily.closure f ↓t _ _,

    -- The subderivative of φ.
    let β := subdifferential.map,

    /-
    Π s, 𝒩 s → β (s - t) ≤ (φ s) - (φ t)
    —————————————————————————————————————— image_contained_in_𝒩
       Π x, β (F x) ≤ (φ (f x)) - (φ t)

    To begin the proof, we use the fact that the subdifferential has the lower bound
    property inside of 𝒩 which contains the image of f, so we have that the inequality
    holds for all points of X. This is the main term to follow throughout the proof.
    -/
    let inequality
        := λ x, subdifferential.lower_bound_property (f x) (image_contained_in_𝒩 x),

    /-
    Π x, β (F x) ≤ (φ (f x)) - (φ t)
    ————————————————————————————————— monotonicity
      ∫ β ∘ F ≤ ∫ (φ ∘ f - ↓(φ t))

    Next, we use the fact that the reduction is monotonic to "integrate" both sides.
    -/
    let inequality
        := MonotonicReduction.monotonicity Int (β ∘ F) (φ ∘ f - ↓(φ t)) inequality,

    /-
    ∫ β ∘ F ≤ ∫ (φ ∘ f - ↓(φ t))
    ————————————————————————————— left_factors
    β (∫ F) ≤ ∫ (φ ∘ f - ↓(φ t))

    Here we use the fact that the subdifferential left factors with respect to the
    reduction family.
    -/
    rewrite subdifferential.left_factors F Fℱ at inequality,

    /-
         β (∫ F) ≤ ∫ (φ ∘ f - ↓(φ t))
    ———————————————————————————————————————— constant_difference
    β ((∫ f) - (∫ ↓t)) ≤ ∫ (φ ∘ f - ↓(φ t))

    Now we use the fact that our reduction has the constant difference property to
    distribute the reduction over the difference of functions.
    -/
    rewrite TranslativeReduction.constant_difference Int at inequality,

    /-
    β ((∫ f) - (∫ ↓t)) ≤ ∫ (φ ∘ f - ↓(φ t))
    ———————————————————————————————————————— constant_reduction
      β ((∫ f) - t) ≤ ∫ (φ ∘ f - ↓(φ t))

    Since our reduction is unital we can replace the reduction of the constant function
    with the defining constant.
    -/
    rewrite UnitalReduction.constant_reduction Int at inequality,

    /-
    β ((∫ f) - t) ≤ ∫ (φ ∘ f - ↓(φ t))
    ——————————————————————————————————— vanishing_diagonal
        β 0 ≤ ∫ (φ ∘ f - ↓(φ t))

    Since
        t := ∫ f
    we have that,
        (∫ f) - t := (∫ f) - (∫ f)
    so we can cancel like terms using the fact that Y is a difference domain.
    -/
    rewrite DifferenceDomain.vanishing_diagonal at inequality,

    /-
    β 0 ≤ ∫ (φ ∘ f - ↓(φ t))
    ————————————————————————— root_at_zero
     0 ≤ ∫ (φ ∘ f - ↓(φ t))

    To simplify the left hand side of the inequality we use the fact that the
    subderivative has a root at zero.
    -/
    rewrite subdifferential.root_at_zero at inequality,

    /-
    0 ≤ ∫ (φ ∘ f - ↓(φ t))
    ——————————————————————— translation_invariance
     ∫ ↓(φ t) ≤ ∫ (φ ∘ f)

    To split the reduction of a difference, we use the translation invariance property
    because our reduction is translative.
    -/
    let inequality
        := TranslativeReduction.translation_invariance Int ↓(φ t) (φ ∘ f) inequality,

    /-
    ∫ ↓(φ t) ≤ ∫ (φ ∘ f)
    ————————————————————— constant_reduction
      φ t ≤ ∫ (φ ∘ f)

    Again we use the fact that out reduction is unital to pull out the constant on the
    left hand side.
    -/
    rewrite UnitalReduction.constant_reduction Int at inequality,

    /-
      φ t ≤ ∫ (φ ∘ f)
    ———————————————————— definition
    φ (∫ f) ≤ ∫ (φ ∘ f)

    And now the proof is complete. The inequality has the correct type to satisfy the main
    goal. All other goals can be deduced canonically by the proof assistant since the
    relevant proof terms are in the given context.
    -/
    exact inequality,
end --                                                                                □
end jensen_inequality --—————————————————————————————————————————————————————————————————--


theorem test1 {α} (a b : α) (as bs : List α) (h : a::as = b::bs) : a = b :=
by {
  injection h;
  assumption;
}

theorem test2 {α} (a b : α) (as bs : List α) (h : a::as = b::bs) : a = b :=
by {
  injection h with h1 h2;
  exact h1
}

theorem test3 {α} (a b : α) (as bs : List α) (h : (x : List α) → (y : List α) → x = y) : as = bs :=
have : a::as = b::bs := h (a::as) (b::bs);
by {
  injection this with h1 h2;
  exact h2
}

theorem test4 {α} (a b : α) (as bs : List α) (h : (x : List α) → (y : List α) → x = y) : as = bs :=
by {
  injection h (a::as) (b::bs) with h1 h2;
  exact h2
}

theorem test5 {α} (a : α) (as : List α) (h : a::as = []) : 0 > 1 :=
by {
  injection h
}

theorem test6 (n : Nat) (h : n+1 = 0) : 0 > 1 :=
by {
  injection h
}

theorem test7 (n m k : Nat) (h : n + 1 = m + 1) : m = k → n = k :=
by {
  injection h with h₁;
  subst h₁;
  intro h₂;
  exact h₂
}


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro
-/
import algebra.hom.ring

/-!
# Division (semi)rings and (semi)fields

This file introduces fields and division rings (also known as skewfields) and proves some basic
statements about them. For a more extensive theory of fields, see the `field_theory` folder.

## Main definitions

* `division_semiring`: Nontrivial semiring with multiplicative inverses for nonzero elements.
* `division_ring`: : Nontrivial ring with multiplicative inverses for nonzero elements.
* `semifield`: Commutative division semiring.
* `field`: Commutative division ring.
* `is_field`: Predicate on a (semi)ring that it is a (semi)field, i.e. that the multiplication is
  commutative, that it has more than one element and that all non-zero elements have a
  multiplicative inverse. In contrast to `field`, which contains the data of a function associating
  to an element of the field its multiplicative inverse, this predicate only assumes the existence
  and can therefore more easily be used to e.g. transfer along ring isomorphisms.

## Implementation details

By convention `0⁻¹ = 0` in a field or division ring. This is due to the fact that working with total
functions has the advantage of not constantly having to check that `x ≠ 0` when writing `x⁻¹`. With
this convention in place, some statements like `(a + b) * c⁻¹ = a * c⁻¹ + b * c⁻¹` still remain
true, while others like the defining property `a * a⁻¹ = 1` need the assumption `a ≠ 0`. If you are
a beginner in using Lean and are confused by that, you can read more about why this convention is
taken in Kevin Buzzard's
[blogpost](https://xenaproject.wordpress.com/2020/07/05/division-by-zero-in-type-theory-a-faq/)

A division ring or field is an example of a `group_with_zero`. If you cannot find
a division ring / field lemma that does not involve `+`, you can try looking for
a `group_with_zero` lemma instead.

## Tags

field, division ring, skew field, skew-field, skewfield
-/

open function set

set_option old_structure_cmd true

universe u
variables {α β K : Type*}

/-- A `division_semiring` is a `semiring` with multiplicative inverses for nonzero elements. -/
@[protect_proj, ancestor semiring group_with_zero]
class division_semiring (α : Type*) extends semiring α, group_with_zero α

/-- A `division_ring` is a `ring` with multiplicative inverses for nonzero elements. -/
@[protect_proj, ancestor ring division_semiring]
class division_ring (α : Type*) extends ring α, div_inv_monoid α, nontrivial α :=
(mul_inv_cancel : ∀ {a : α}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : α)⁻¹ = 0)

/-- A `semifield` is a `comm_semiring` with multiplicative inverses for nonzero elements. -/
@[protect_proj, ancestor comm_semiring division_semiring comm_group_with_zero]
class semifield (α : Type*) extends comm_semiring α, division_semiring α, comm_group_with_zero α

/-- A `field` is a `comm_ring` with multiplicative inverses for nonzero elements. -/
@[protect_proj, ancestor comm_ring division_ring]
class field (α : Type*) extends comm_ring α, division_ring α

@[priority 100] -- see Note [lower instance priority]
instance division_ring.to_division_semiring [division_ring α] : division_semiring α :=
{ ..‹division_ring α›, ..(infer_instance : semiring α) }

section division_semiring
variables [division_semiring α] {a b c : α}

lemma add_div (a b c : α) : (a + b) / c = a / c + b / c := by simp_rw [div_eq_mul_inv, add_mul]

@[field_simps] lemma div_add_div_same (a b c : α) : a / c + b / c = (a + b) / c :=
(add_div _ _ _).symm

lemma same_add_div (h : b ≠ 0) : (b + a) / b = 1 + a / b := by rw [←div_self h, add_div]
lemma div_add_same (h : b ≠ 0) : (a + b) / b = a / b + 1 := by rw [←div_self h, add_div]
lemma one_add_div (h : b ≠ 0 ) : 1 + a / b = (b + a) / b := (same_add_div h).symm
lemma div_add_one (h : b ≠ 0) : a / b + 1 = (a + b) / b := (div_add_same h).symm

lemma one_div_mul_add_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) :
  (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b :=
by rw [mul_add, one_div_mul_cancel ha, add_mul, one_mul, mul_assoc, mul_one_div_cancel hb, mul_one,
  add_comm]

lemma add_div_eq_mul_add_div (a b : α) (hc : c ≠ 0) : a + b / c = (a * c + b) / c :=
(eq_div_iff_mul_eq hc).2 $ by rw [right_distrib, (div_mul_cancel _ hc)]

@[field_simps] lemma add_div' (a b c : α) (hc : c ≠ 0) : b + a / c = (b * c + a) / c :=
by rw [add_div, mul_div_cancel _ hc]

@[field_simps] lemma div_add' (a b c : α) (hc : c ≠ 0) : a / c + b = (a + b * c) / c :=
by rwa [add_comm, add_div', add_comm]

end division_semiring

section division_ring
variables [division_ring K] {a b : K}

local attribute [simp]
  division_def mul_comm mul_assoc
  mul_left_comm mul_inv_cancel inv_mul_cancel

lemma one_div_neg_one_eq_neg_one : (1:K) / (-1) = -1 :=
have (-1) * (-1) = (1:K), by rw [neg_mul_neg, one_mul],
eq.symm (eq_one_div_of_mul_eq_one_right this)

lemma one_div_neg_eq_neg_one_div (a : K) : 1 / (- a) = - (1 / a) :=
calc
  1 / (- a) = 1 / ((-1) * a)        : by rw neg_eq_neg_one_mul
        ... = (1 / a) * (1 / (- 1)) : by rw one_div_mul_one_div_rev
        ... = (1 / a) * (-1)        : by rw one_div_neg_one_eq_neg_one
        ... = - (1 / a)             : by rw [mul_neg, mul_one]

lemma div_neg_eq_neg_div (a b : K) : b / (- a) = - (b / a) :=
calc
  b / (- a) = b * (1 / (- a)) : by rw [← inv_eq_one_div, division_def]
        ... = b * -(1 / a)    : by rw one_div_neg_eq_neg_one_div
        ... = -(b * (1 / a))  : by rw neg_mul_eq_mul_neg
        ... = - (b / a)       : by rw mul_one_div

lemma neg_div (a b : K) : (-b) / a = - (b / a) :=
by rw [neg_eq_neg_one_mul, mul_div_assoc, ← neg_eq_neg_one_mul]

@[field_simps] lemma neg_div' (a b : K) : - (b / a) = (-b) / a :=
by simp [neg_div]

lemma neg_div_neg_eq (a b : K) : (-a) / (-b) = a / b :=
by rw [div_neg_eq_neg_div, neg_div, neg_neg]

@[simp] lemma div_neg_self {a : K} (h : a ≠ 0) : a / -a = -1 :=
by rw [div_neg_eq_neg_div, div_self h]

@[simp] lemma neg_div_self {a : K} (h : a ≠ 0) : (-a) / a = -1 :=
by rw [neg_div, div_self h]

lemma div_sub_div_same (a b c : K) : (a / c) - (b / c) = (a - b) / c :=
by rw [sub_eq_add_neg, ← neg_div, div_add_div_same, sub_eq_add_neg]

lemma same_sub_div {a b : K} (h : b ≠ 0) : (b - a) / b = 1 - a / b :=
by simpa only [← @div_self _ _ b h] using (div_sub_div_same b a b).symm

lemma one_sub_div {a b : K} (h : b ≠ 0) : 1 - a / b = (b - a) / b := (same_sub_div h).symm

lemma div_sub_same {a b : K} (h : b ≠ 0) : (a - b) / b = a / b - 1 :=
by simpa only [← @div_self _ _ b h] using (div_sub_div_same a b b).symm

lemma div_sub_one {a b : K} (h : b ≠ 0) : a / b - 1 = (a - b) / b := (div_sub_same h).symm

lemma neg_inv : - a⁻¹ = (- a)⁻¹ :=
by rw [inv_eq_one_div, inv_eq_one_div, div_neg_eq_neg_div]

lemma sub_div (a b c : K) : (a - b) / c = a / c - b / c :=
(div_sub_div_same _ _ _).symm

lemma div_neg (a : K) : a / -b = -(a / b) :=
by rw [← div_neg_eq_neg_div]

lemma inv_neg : (-a)⁻¹ = -(a⁻¹) :=
by rw neg_inv

lemma one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) :
          (1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b :=
by rw [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel ha), mul_sub_right_distrib,
       one_mul, mul_assoc, (mul_one_div_cancel hb), mul_one]

@[priority 100] -- see Note [lower instance priority]
instance division_ring.is_domain : is_domain K :=
{ ..‹division_ring K›,
  ..(by apply_instance : no_zero_divisors K) }

end division_ring

section semifield
variables [semifield α] {a b c d : α}

lemma div_add_div (a : α) (c : α) (hb : b ≠ 0) (hd : d ≠ 0) :
  (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) :=
by rw [← mul_div_mul_right _ b hd, ← mul_div_mul_left c d hb, div_add_div_same]

lemma one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) :=
by rw [div_add_div _ _ ha hb, one_mul, mul_one, add_comm]

lemma inv_add_inv (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ + b⁻¹ = (a + b) / (a * b) :=
by rw [inv_eq_one_div, inv_eq_one_div, one_div_add_one_div ha hb]

end semifield

section field

variable [field K]

@[priority 100] -- see Note [lower instance priority]
instance field.to_semifield : semifield K :=
{ .. ‹field K›, .. (infer_instance : semiring K) }

local attribute [simp] mul_assoc mul_comm mul_left_comm

@[field_simps] lemma div_sub_div (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0) (hd : d ≠ 0) :
  (a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) :=
begin
  simp [sub_eq_add_neg],
  rw [neg_eq_neg_one_mul, ← mul_div_assoc, div_add_div _ _ hb hd,
      ← mul_assoc, mul_comm b, mul_assoc, ← neg_eq_neg_one_mul]
end

lemma inv_sub_inv {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ - b⁻¹ = (b - a) / (a * b) :=
by rw [inv_eq_one_div, inv_eq_one_div, div_sub_div _ _ ha hb, one_mul, mul_one]

@[field_simps] lemma sub_div' (a b c : K) (hc : c ≠ 0) : b - a / c = (b * c - a) / c :=
by simpa using div_sub_div b a one_ne_zero hc

@[field_simps] lemma div_sub' (a b c : K) (hc : c ≠ 0) : a / c - b = (a - c * b) / c :=
by simpa using div_sub_div a b hc one_ne_zero

@[priority 100] -- see Note [lower instance priority]
instance field.is_domain : is_domain K :=
{ ..division_ring.is_domain }

end field

section is_field

/-- A predicate to express that a (semi)ring is a (semi)field.

This is mainly useful because such a predicate does not contain data,
and can therefore be easily transported along ring isomorphisms.
Additionaly, this is useful when trying to prove that
a particular ring structure extends to a (semi)field. -/
structure is_field (R : Type u) [semiring R] : Prop :=
(exists_pair_ne : ∃ (x y : R), x ≠ y)
(mul_comm : ∀ (x y : R), x * y = y * x)
(mul_inv_cancel : ∀ {a : R}, a ≠ 0 → ∃ b, a * b = 1)

/-- Transferring from `semifield` to `is_field`. -/
lemma semifield.to_is_field (R : Type u) [semifield R] : is_field R :=
{ mul_inv_cancel := λ a ha, ⟨a⁻¹, mul_inv_cancel ha⟩,
  ..‹semifield R› }

/-- Transferring from `field` to `is_field`. -/
lemma field.to_is_field (R : Type u) [field R] : is_field R := semifield.to_is_field _

@[simp] lemma is_field.nontrivial {R : Type u} [semiring R] (h : is_field R) : nontrivial R :=
⟨h.exists_pair_ne⟩

@[simp] lemma not_is_field_of_subsingleton (R : Type u) [semiring R] [subsingleton R] :
  ¬is_field R :=
λ h, let ⟨x, y, h⟩ := h.exists_pair_ne in h (subsingleton.elim _ _)

open_locale classical

/-- Transferring from `is_field` to `semifield`. -/
noncomputable def is_field.to_semifield {R : Type u} [semiring R] (h : is_field R) : semifield R :=
{ inv := λ a, if ha : a = 0 then 0 else classical.some (is_field.mul_inv_cancel h ha),
  inv_zero := dif_pos rfl,
  mul_inv_cancel := λ a ha,
    begin
      convert classical.some_spec (is_field.mul_inv_cancel h ha),
      exact dif_neg ha
    end,
  .. ‹semiring R›, ..h }

/-- Transferring from `is_field` to `field`. -/
noncomputable def is_field.to_field {R : Type u} [ring R] (h : is_field R) : field R :=
{ .. ‹ring R›, ..is_field.to_semifield h }

/-- For each field, and for each nonzero element of said field, there is a unique inverse.
Since `is_field` doesn't remember the data of an `inv` function and as such,
a lemma that there is a unique inverse could be useful.
-/
lemma uniq_inv_of_is_field (R : Type u) [ring R] (hf : is_field R) :
  ∀ (x : R), x ≠ 0 → ∃! (y : R), x * y = 1 :=
begin
  intros x hx,
  apply exists_unique_of_exists_of_unique,
  { exact hf.mul_inv_cancel hx },
  { intros y z hxy hxz,
    calc y = y * (x * z) : by rw [hxz, mul_one]
       ... = (x * y) * z : by rw [← mul_assoc, hf.mul_comm y x]
       ... = z           : by rw [hxy, one_mul] }
end

end is_field

namespace ring_hom
section semiring
variables [semiring α] [division_semiring β]

@[simp] lemma map_units_inv (f : α →+* β) (u : αˣ) : f ↑u⁻¹ = (f ↑u)⁻¹ :=
(f : α →* β).map_units_inv u

variables [nontrivial α] (f : β →+* α) {a : β}

@[simp] lemma map_eq_zero : f a = 0 ↔ a = 0 := f.to_monoid_with_zero_hom.map_eq_zero
lemma map_ne_zero : f a ≠ 0 ↔ a ≠ 0 := f.to_monoid_with_zero_hom.map_ne_zero

end semiring

section division_semiring
variables [division_semiring α] [division_semiring β] (f : α →+* β) (a b : α)

lemma map_inv : f a⁻¹ = (f a)⁻¹ := f.to_monoid_with_zero_hom.map_inv _
lemma map_div : f (a / b) = f a / f b := f.to_monoid_with_zero_hom.map_div _ _

end division_semiring

protected lemma injective [division_ring α] [semiring β] [nontrivial β] (f : α →+* β) :
  injective f :=
(injective_iff_map_eq_zero f).2 $ λ x, f.map_eq_zero.1

end ring_hom

section noncomputable_defs

variables {R : Type*} [nontrivial R]

/-- Constructs a `division_ring` structure on a `ring` consisting only of units and 0. -/
noncomputable def division_ring_of_is_unit_or_eq_zero [hR : ring R]
  (h : ∀ (a : R), is_unit a ∨ a = 0) : division_ring R :=
{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hR }

/-- Constructs a `field` structure on a `comm_ring` consisting only of units and 0.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def field_of_is_unit_or_eq_zero [hR : comm_ring R]
  (h : ∀ (a : R), is_unit a ∨ a = 0) : field R :=
{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hR }

end noncomputable_defs

/-- Pullback a `division_semiring` along an injective function. -/
@[reducible] -- See note [reducible non-instances]
protected def function.injective.division_semiring [division_semiring β] [has_zero α] [has_mul α]
  [has_add α] [has_one α] [has_inv α] [has_div α] [has_scalar ℕ α] [has_pow α ℕ] [has_pow α ℤ]
  [has_nat_cast α]
  (f : α → β) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y)
  (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x)
  (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n)
  (nat_cast : ∀ n : ℕ, f n = n) :
  division_semiring α :=
{ .. hf.group_with_zero f zero one mul inv div npow zpow,
  .. hf.semiring f zero one add mul nsmul npow nat_cast }

/-- Pullback a `division_ring` along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.division_ring [division_ring K] {K'}
  [has_zero K'] [has_one K'] [has_add K'] [has_mul K'] [has_neg K'] [has_sub K'] [has_inv K']
  [has_div K'] [has_scalar ℕ K'] [has_scalar ℤ K'] [has_pow K' ℕ] [has_pow K' ℤ]
  [has_nat_cast K'] [has_int_cast K']
  (f : K' → K) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y)
  (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x)
  (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n)
  (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) :
  division_ring K' :=
{ .. hf.group_with_zero f zero one mul inv div npow zpow,
  .. hf.ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast }

/-- Pullback a `field` along an injective function. -/
@[reducible] -- See note [reducible non-instances]
protected def function.injective.semifield [semifield β] [has_zero α] [has_mul α] [has_add α]
  [has_one α] [has_inv α] [has_div α] [has_scalar ℕ α] [has_pow α ℕ] [has_pow α ℤ]
  [has_nat_cast α]
  (f : α → β) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y)
  (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x)
  (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n)
  (nat_cast : ∀ n : ℕ, f n = n) :
  semifield α :=
{ .. hf.comm_group_with_zero f zero one mul inv div npow zpow,
  .. hf.comm_semiring f zero one add mul nsmul npow nat_cast }

/-- Pullback a `field` along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.field [field K] {K'}
  [has_zero K'] [has_mul K'] [has_add K'] [has_neg K'] [has_sub K'] [has_one K'] [has_inv K']
  [has_div K'] [has_scalar ℕ K'] [has_scalar ℤ K'] [has_pow K' ℕ] [has_pow K' ℤ]
  [has_nat_cast K'] [has_int_cast K']
  (f : K' → K) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y)
  (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x)
  (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n)
  (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) :
  field K' :=
{ .. hf.comm_group_with_zero f zero one mul inv div npow zpow,
  .. hf.comm_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast }


/-
Taken from Patrick Johnson (original source at
https://github.com/user7230724/lean-projects/blob/master/src/list_diff_map/main.lean)
in response to
https://leanprover-community.github.io/archive/stream/113489-new-members/topic/Generalization.20of.20map_diff.html

There's a much shorter version of this that uses multisets by Junyan Xu.
-/
import tactic
import tactic.induction
import data.list.basic
import data.multiset.basic

noncomputable theory
open_locale classical
open_locale big_operators

lemma nat.pred_eq_self_iff {n : ℕ} : n.pred = n ↔ n = 0 :=
begin
  cases n; simp,
  exact (nat.succ_ne_self _).symm,
end

lemma list.count_erase {α : Type*} {l : list α} {x : α} :
  (l.erase x).count x = l.count x - (ite (x ∈ l) 1 0) :=
begin
  split_ifs with h,
  { rw list.count_erase_self, refl },
  { have h₁ : x ∉ l.erase x,
    { contrapose! h, exact list.mem_of_mem_erase h },
    rw [list.count_eq_zero_of_not_mem h, list.count_eq_zero_of_not_mem h₁] },
end

lemma list.mem_diff_iff {α : Type*} {l₁ l₂ : list α} {x : α} :
  x ∈ l₁ \ l₂ ↔ l₂.count x < l₁.count x :=
begin
  change x ∈ list.diff _ _ ↔ _,
  induction l₂ with hd l₂ ih generalizing l₁; simp,
  rw [ih, list.count_cons], split_ifs,
  { subst h, split; intro h,
    { rw list.count_erase at h, split_ifs at h with h₁,
      { cases list.count x l₁,
        { cases h },
        { rwa nat.succ_lt_succ_iff } },
      { rw ←list.count_pos at h₁, push_neg at h₁,
        rw nat.le_zero_iff at h₁, rw h₁ at h, cases h }},
    { rw list.count_erase, split_ifs with h₁,
      { rwa lt_tsub_iff_right },
      { rw ←list.count_pos at h₁, push_neg at h₁,
        rw nat.le_zero_iff at h₁, rw h₁ at h, cases h }}},
  { rw list.count_erase_of_ne h },
end

lemma finset.sum_le_sum_of_le {α : Type*} {f g : α → ℕ} {s : finset α}
  (h : ∀ (a : α), a ∈ s → f a ≤ g a) :
  ∑ (a : α) in s, f a ≤ ∑ (a : α) in s, g a :=
begin
  revert h, apply s.induction_on; simp,
  rintro a s h₁ h₂ h₃ h₄, specialize h₂ h₄,
  simp_rw finset.sum_insert h₁, exact add_le_add h₃ h₂,
end

lemma list.sum_count_cons_diff_singleton {α : Type*} {l : list α} {x : α} :
  ∑ (a : α) in l.to_finset \ {x}, (x :: l).count a =
  ∑ (a : α) in l.to_finset \ {x}, l.count a :=
begin
  apply finset.sum_congr rfl, rintro a h, rw [list.count_cons, if_neg],
  rintro rfl, rw [finset.mem_sdiff, finset.mem_singleton] at h, exact h.2 rfl,
end

lemma list.sum_count_cons {α : Type*} {l : list α} {x : α} :
  ∑ (a : α) in l.to_finset, (x :: l).count a =
  ∑ (a : α) in l.to_finset, l.count a + ite (x ∈ l) 1 0 :=
begin
  simp_rw ←list.mem_to_finset, split_ifs,
  { simp_rw finset.sum_eq_sum_diff_singleton_add h,
    rw [list.sum_count_cons_diff_singleton, add_assoc],
    congr, rw [list.count_cons, if_pos rfl] },
  { have h₁ : l.to_finset = l.to_finset \ {x},
    { exact (finset.sdiff_singleton_not_mem_eq_self _ h).symm },
    rw h₁, exact list.sum_count_cons_diff_singleton },
end

lemma list.length_eq_sum_count {α : Type*} {l : list α} :
  l.length = ∑ (x : α) in l.to_finset, l.count x :=
begin
  induction l with hd l ih; simp, by_cases h : hd ∈ l.to_finset,
  { rw finset.insert_eq_of_mem h,
    rw finset.sum_eq_sum_diff_singleton_add h at ih ⊢,
    rw [list.sum_count_cons_diff_singleton, list.count_cons, if_pos rfl, ih],
    refl },
  { have h₁ : hd ∈ insert hd l.to_finset := finset.mem_insert_self _ _,
    rw finset.sum_eq_sum_diff_singleton_add h₁, have h₂ : hd ∉ l,
    { rwa list.mem_to_finset at h },
    have h₃ : insert hd l.to_finset \ {hd} = l.to_finset,
    { ext x, by_cases h₃ : x = hd,
      { subst h₃, simpa [h₁] },
      { simp [h₃] }},
    rw h₃, have h₃ : list.count hd (hd :: l) = 1,
    { rw [list.count_cons, if_pos rfl, list.count_eq_zero_of_not_mem h₂] },
    rw h₃, congr, rw [ih, list.sum_count_cons, if_neg h₂], refl },
end

lemma list.sum_union_eq_sum {α : Type*} {l : list α} {s : finset α} :
  ∑ (x : α) in l.to_finset ∪ s, l.count x = ∑ (x : α) in l.to_finset, l.count x :=
begin
  apply s.induction_on; simp, rintro a s h₁ ih,
  by_cases h₃ : a ∈ l.to_finset ∪ s,
  { rwa finset.insert_eq_of_mem h₃ },
  { rw [finset.sum_insert h₃, ih], have h₄ : a ∉ l,
    { contrapose! h₃, apply finset.mem_union_left, rwa list.mem_to_finset },
    rw [list.count_eq_zero_of_not_mem h₄, zero_add] },
end

lemma list.length_le_length_of_count_le_count {α : Type*}
  {l₁ l₂ : list α} (h : ∀ (a : α), l₁.count a ≤ l₂.count a) :
  l₁.length ≤ l₂.length :=
begin
  simp_rw list.length_eq_sum_count,
  let s := l₁.to_finset ∪ l₂.to_finset,
  suffices h₁ : ∑ (x : α) in s, l₁.count x ≤ ∑ (x : α) in s, l₂.count x,
  { change s with _ ∪ _ at h₁, nth_rewrite 1 finset.union_comm at h₁,
    simp_rw list.sum_union_eq_sum at h₁, exact h₁ },
  replace h : ∀ (a : α), a ∈ s → l₁.count a ≤ l₂.count a,
  { rintro a h₁, apply h },
  exact finset.sum_le_sum_of_le h,
end

lemma list.count_map_eq_length_filter {α β : Type*} {f : α → β}
  {l : list α} {y : β} :
  (l.map f).count y = (l.filter (λ (x : α), f x = y)).length :=
begin
  induction l with hd l ih; simp,
  rw list.count_cons, rw ih, clear ih,
  split_ifs; rw list.filter,
  { rw if_pos h.symm, refl },
  { rw if_neg, tauto },
end

lemma list.count_filter_eq_ite {α : Type*} {P : α → Prop}
  {l : list α} {x : α} : (l.filter P).count x = ite (P x) (l.count x) 0 :=
begin
  split_ifs,
  { exact list.count_filter h },
  { apply list.count_eq_zero_of_not_mem,
    contrapose! h, exact list.of_mem_filter h },
end

-----

theorem list.diff_map_subset {α β : Type*} {f : α → β} {l₁ l₂ : list α} :
  l₁.map f \ l₂.map f ⊆ (l₁ \ l₂).map f :=
begin
  rintro y h,
  rw list.mem_diff_iff at h,
  rw list.mem_map,
  contrapose! h, simp_rw [list.mem_diff_iff, imp_not_comm, not_lt] at h,
  let s₁ := l₁.filter (λ x, f x = y), let s₂ := l₂.filter (λ x, f x = y),
  have hs₁ : ∀ (a : α), s₁.count a = ite (f a = y) (l₁.count a) 0,
  { exact λ _, list.count_filter_eq_ite },
  have hs₂ : ∀ (a : α), s₂.count a = ite (f a = y) (l₂.count a) 0,
  { exact λ _, list.count_filter_eq_ite },
  replace h : ∀ (a : α), s₁.count a ≤ s₂.count a,
  { rintro a, specialize h a, rw [hs₁, hs₂],
    split_ifs with h₁,
    { exact h h₁ },
    { refl }},
  have hh₁ : (l₁.map f).count y = s₁.length := list.count_map_eq_length_filter,
  have hh₂ : (l₂.map f).count y = s₂.length := list.count_map_eq_length_filter,
  rw [hh₁, hh₂], exact list.length_le_length_of_count_le_count h,
end