/-
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`.
* `is_primitive_root.aut_to_pow`: the monoid hom that takes an automorphism of a ring to the power
  it sends that specific primitive root, as a member of `(zmod n)ˣ`.

## 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 polynomial
noncomputable theory

open polynomial
open finset

variables {M N G G₀ R S F : 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 : Mˣ` that satisfy `m ^ k = 1` -/
def roots_of_unity (k : ℕ+) (M : Type*) [comm_monoid M] : subgroup 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 : ℕ+) (ζ : Mˣ) :
  ζ ∈ roots_of_unity k M ↔ ζ ^ (k : ℕ) = 1 := iff.rfl

lemma roots_of_unity.coe_injective {n : ℕ+} : function.injective (coe : (roots_of_unity n M) → M) :=
units.ext.comp (λ x y, subtype.ext)

/-- Make an element of `roots_of_unity` from a member of the base ring, and a proof that it has
a positive power equal to one. -/
@[simps coe_coe] def roots_of_unity.mk_of_pow_eq (ζ : M) {n : ℕ+} (h : ζ ^ (n : ℕ) = 1) :
  roots_of_unity n M :=
⟨units.mk_of_mul_eq_one ζ (ζ ^ n.nat_pred) $
  by rwa [←pow_one ζ, ←pow_mul, ←pow_add, one_mul, pnat.one_add_nat_pred],
units.ext $ by simpa⟩

@[simp] lemma roots_of_unity.coe_mk_of_pow_eq {ζ : M} {n : ℕ+}
  (h : ζ ^ (n : ℕ) = 1) : (roots_of_unity.mk_of_pow_eq _ h : M) = ζ := 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 : Mˣ →* Nˣ) (k : ℕ+) :
  (roots_of_unity k M).map f ≤ roots_of_unity k N :=
begin
  rintros _ ⟨ζ, h, rfl⟩,
  simp only [←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) : Rˣ) = ↑(ζ : 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 restrict_roots_of_unity [ring_hom_class F R S] (σ : F) (n : ℕ+) :
  roots_of_unity n R →* roots_of_unity n S :=
let h : ∀ ξ : roots_of_unity n R, (σ ξ) ^ (n : ℕ) = 1 := λ ξ, by
{ change (σ (ξ : Rˣ)) ^ (n : ℕ) = 1,
  rw [←map_pow, ←units.coe_pow, show ((ξ : 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 restrict_roots_of_unity_coe_apply [ring_hom_class F R S] (σ : F)
  (ζ : 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 := restrict_roots_of_unity σ.to_ring_hom n,
  inv_fun :=restrict_roots_of_unity σ.symm.to_ring_hom n,
  left_inv := λ ξ, by { ext, exact σ.symm_apply_apply ξ },
  right_inv := λ ξ, by { ext, exact σ.apply_symm_apply ξ },
  map_mul' := (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 {ζ : 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 (_ : 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.dedup_le _)
... = (nth_roots k (1 : R)).card                  : multiset.card_attach
... ≤ k                                           : card_nth_roots k 1

variables {k R}

lemma map_root_of_unity_eq_pow_self [ring_hom_class F R R] (σ : F) (ζ : roots_of_unity k R) :
  ∃ m : ℕ, σ ζ = ζ ^ m :=
begin
  obtain ⟨m, hm⟩ := monoid_hom.map_cyclic (restrict_roots_of_unity σ k),
  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)

/-- Turn a primitive root μ into a member of the `roots_of_unity` subgroup. -/
@[simps] def is_primitive_root.to_roots_of_unity {μ : M} {n : ℕ+} (h : is_primitive_root μ n) :
  roots_of_unity n M := roots_of_unity.mk_of_pow_eq μ h.pow_eq_one

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 {ζ : 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 ζ⟩

lemma pow_of_dvd (h : is_primitive_root ζ k) {p : ℕ} (hp : p ≠ 0) (hdiv : p ∣ k) :
  is_primitive_root (ζ ^ p) (k / p) :=
begin
  suffices : order_of (ζ ^ p) = k / p,
  { exact this ▸ is_primitive_root.order_of (ζ ^ p) },
  rw [order_of_pow' _ hp, ← eq_order_of h, nat.gcd_eq_right hdiv]
end

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 : F} {ζ : R}

open function

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

lemma of_map_of_injective [monoid_hom_class F R S] (h : is_primitive_root (f ζ) k)
  (hf : injective f) : is_primitive_root ζ k :=
{ pow_eq_one := by { apply_fun f, rw [map_pow, _root_.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 [map_pow, _root_.map_one] at hl,
    exact order_of_dvd_of_pow_eq_one hl
  end }

lemma map_iff_of_injective [monoid_hom_class F R S] (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 {ζ : 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 : ℕ+} {ζ : 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 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 : ℕ+} {ζ ξ : 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 : ℕ+} {ζ ξ : 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.dedup_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.dedup_eq_self R _ _).1,
  rw eq_iff_le_not_lt,
  split,
  { exact multiset.dedup_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)).dedup.card =
      fintype.card {x // x ∈ (nth_roots n (1 : R))},
    { set fs := (⟨(nth_roots n (1 : R)).dedup, multiset.nodup_dedup _⟩ : finset R),
      rw [← finset.card_mk, ← fintype.card_of_subtype fs _],
      intro x,
      simp only [multiset.mem_dedup, 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) :
  (primitive_roots k R).card = φ k :=
begin
  by_cases h0 : k = 0,
  { simp [h0], },
  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 (nat.pos_of_ne_zero 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 (nat.pos_of_ne_zero h0),
      h.is_primitive_root_iff (nat.pos_of_ne_zero 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 : ℕ} (h : k ≠ l) :
  disjoint (primitive_roots k R) (primitive_roots l R) :=
begin
  by_cases hk : k = 0, { simp [hk], },
  by_cases hl : l = 0, { simp [hl], },
  intro z,
  simp only [finset.inf_eq_inter, finset.mem_inter, mem_primitive_roots,
    nat.pos_of_ne_zero hk, nat.pos_of_ne_zero 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`.
This holds for any `nat`, not just `pnat`, see `nth_roots_one_eq_bUnion_primitive_roots`. -/
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 },
    { intros i hi j hj hdiff,
      exact disjoint 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 : ℕ}
  (h : is_primitive_root ζ n) :
  nth_roots_finset n R = (nat.divisors n).bUnion (λ i, (primitive_roots i R)) :=
begin
  by_cases hn : n = 0,
  { simp [hn], },
  exact @nth_roots_one_eq_bUnion_primitive_roots' _ _ _ _ ⟨n, nat.pos_of_ne_zero hn⟩ h
end

end is_domain

section minpoly

open minpoly

section comm_ring
variables {n : ℕ} {K : Type*} [comm_ring 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
end comm_ring

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

include n μ h hpos

variables [char_zero K]

omit hpos
/--The minimal polynomial of a root of unity `μ` divides `X ^ n - 1`. -/
lemma minpoly_dvd_X_pow_sub_one : minpoly ℤ μ ∣ X ^ n - 1 :=
begin
  by_cases hpos : n = 0, { simp [hpos], },
  apply minpoly.gcd_domain_dvd ℚ (is_integral h (nat.pos_of_ne_zero hpos))
    (polynomial.monic.is_primitive (monic_X_pow_sub_C 1 (ne_of_lt (nat.pos_of_ne_zero 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 [polynomial.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) },
  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 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
  by_cases hn : n = 0, { simp * at *, },
  have hpos := nat.pos_of_ne_zero hn,
  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, polynomial.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],
  rw [hfrob],
  apply ring_hom.map_dvd (map_ring_hom (int.cast_ring_hom (zmod p))),
  exact minpoly_dvd_expand h 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
  hdiv) hprime.1.ne_zero).1 (minpoly_dvd_pow_mod h 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_cases hn : n = 0, { simp * at *, },
  have hpos := nat.pos_of_ne_zero hn,
  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 },
    { 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) } },
  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, polynomial.map_pow, map_X] at prod,
  obtain ⟨R, hR⟩ := minpoly_dvd_mod_p h hdiv,
  rw [hR, ← mul_assoc, ← polynomial.map_mul, ← sq, polynomial.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 : (zmod p)[X]),
  { 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,
    congr,
    simpa [(nat.coprime_zero_left n).mp hn] using h },
  { intros u hunit n hcop h,
    congr,
    simp [nat.is_unit_iff.mp hunit] },
  { intros a p ha hprime hind n hcop h,
    rw hind (nat.coprime.coprime_mul_left hcop) h, 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)) 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 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
  by_cases hn : n = 0, { simp * at *, },
  have hpos := nat.pos_of_ne_zero hn,
  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 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 : ℤ[X] := minpoly ℤ μ,-- minimal polynomial of `μ`
    P_K : K[X] := 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.symm
... ≤ P_K.roots.to_finset.card : finset.card_le_of_subset (is_roots_of_minpoly h)
... ≤ P_K.roots.card : multiset.to_finset_card_le _
... ≤ P_K.nat_degree : card_roots' _
... ≤ P.nat_degree : nat_degree_map_le _ _

end minpoly

section automorphisms

variables {S} [comm_ring S] [is_domain S] {μ : S} {n : ℕ+} (hμ : is_primitive_root μ n)
          (R) [comm_ring R] [algebra R S]

/-- The `monoid_hom` that takes an automorphism to the power of μ that μ gets mapped to under it. -/
@[simps {attrs := []}] noncomputable def aut_to_pow : (S ≃ₐ[R] S) →* (zmod n)ˣ :=
let μ' := hμ.to_roots_of_unity in
have ho : order_of μ' = n :=
  by rw [hμ.eq_order_of, ←hμ.coe_to_roots_of_unity_coe, order_of_units, order_of_subgroup],
monoid_hom.to_hom_units
{ to_fun := λ σ, (map_root_of_unity_eq_pow_self σ.to_alg_hom μ').some,
  map_one' := begin
    generalize_proofs h1,
    have h := h1.some_spec,
    dsimp only [alg_equiv.one_apply, alg_equiv.to_ring_equiv_eq_coe, ring_equiv.to_ring_hom_eq_coe,
                ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv] at *,
    replace h : μ' = μ' ^ h1.some := roots_of_unity.coe_injective
                 (by simpa only [roots_of_unity.coe_pow] using h),
    rw ←pow_one μ' at h {occs := occurrences.pos [1]},
    rw [←@nat.cast_one $ zmod n, zmod.nat_coe_eq_nat_coe_iff, ←ho, ←pow_eq_pow_iff_modeq μ', h]
  end,
  map_mul' := begin
    generalize_proofs hxy' hx' hy',
    have hxy := hxy'.some_spec,
    have hx := hx'.some_spec,
    have hy := hy'.some_spec,
    dsimp only [alg_equiv.to_ring_equiv_eq_coe, ring_equiv.to_ring_hom_eq_coe,
                ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv, alg_equiv.mul_apply] at *,
    replace hxy : x (↑μ' ^ hy'.some) = ↑μ' ^ hxy'.some := hy ▸ hxy,
    rw x.map_pow at hxy,
    replace hxy : ((μ' : S) ^ hx'.some) ^ hy'.some = μ' ^ hxy'.some := hx ▸ hxy,
    rw ←pow_mul at hxy,
    replace hxy : μ' ^ (hx'.some * hy'.some) = μ' ^ hxy'.some := roots_of_unity.coe_injective
                                           (by simpa only [roots_of_unity.coe_pow] using hxy),
    rw [←nat.cast_mul, zmod.nat_coe_eq_nat_coe_iff, ←ho, ←pow_eq_pow_iff_modeq μ', hxy]
  end }

@[simp] lemma aut_to_pow_spec (f : S ≃ₐ[R] S) :
  μ ^ (hμ.aut_to_pow R f : zmod n).val = f μ :=
begin
  rw is_primitive_root.coe_aut_to_pow_apply,
  generalize_proofs h,
  have := h.some_spec,
  dsimp only [alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_alg_hom] at this,
  refine (_ : ↑hμ.to_roots_of_unity ^ _ = _).trans this.symm,
  rw [←roots_of_unity.coe_pow, ←roots_of_unity.coe_pow],
  congr' 1,
  rw [pow_eq_pow_iff_modeq, ←order_of_subgroup, ←order_of_units, hμ.coe_to_roots_of_unity_coe,
      ←hμ.eq_order_of, zmod.val_nat_cast],
  exact nat.mod_modeq _ _
end

end automorphisms

end is_primitive_root


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Eric Wieser
-/
import algebra.order.module
import data.real.basic

/-!
# Pointwise operations on sets of reals

This file relates `Inf (a • s)`/`Sup (a • s)` with `a • Inf s`/`a • Sup s` for `s : set ℝ`.

From these, it relates `⨅ i, a • f i` / `⨆ i, a • f i` with `a • (⨅ i, f i)` / `a • (⨆ i, f i)`,
and provides lemmas about distributing `*` over `⨅` and `⨆`.

# TODO

This is true more generally for conditionally complete linear order whose default value is `0`. We
don't have those yet.
-/

open set
open_locale pointwise

variables {ι : Sort*} {α : Type*} [linear_ordered_field α]

section mul_action_with_zero
variables [mul_action_with_zero α ℝ] [ordered_smul α ℝ] {a : α}

lemma real.Inf_smul_of_nonneg (ha : 0 ≤ a) (s : set ℝ) : Inf (a • s) = a • Inf s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Inf_empty, smul_zero'] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cInf_singleton 0 },
  by_cases bdd_below s,
  { exact ((order_iso.smul_left ℝ ha').map_cInf' hs h).symm },
  { rw [real.Inf_of_not_bdd_below (mt (bdd_below_smul_iff_of_pos ha').1 h),
      real.Inf_of_not_bdd_below h, smul_zero'] }
end

lemma real.smul_infi_of_nonneg (ha : 0 ≤ a) (f : ι → ℝ) :
  a • (⨅ i, f i) = ⨅ i, a • f i :=
(real.Inf_smul_of_nonneg ha _).symm.trans $ congr_arg Inf $ (range_comp _ _).symm

lemma real.Sup_smul_of_nonneg (ha : 0 ≤ a) (s : set ℝ) : Sup (a • s) = a • Sup s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Sup_empty, smul_zero'] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cSup_singleton 0 },
  by_cases bdd_above s,
  { exact ((order_iso.smul_left ℝ ha').map_cSup' hs h).symm },
  { rw [real.Sup_of_not_bdd_above (mt (bdd_above_smul_iff_of_pos ha').1 h),
      real.Sup_of_not_bdd_above h, smul_zero'] }
end

lemma real.smul_supr_of_nonneg (ha : 0 ≤ a) (f : ι → ℝ) :
  a • (⨆ i, f i) = ⨆ i, a • f i :=
(real.Sup_smul_of_nonneg ha _).symm.trans $ congr_arg Sup $ (range_comp _ _).symm

end mul_action_with_zero

section module
variables [module α ℝ] [ordered_smul α ℝ] {a : α}

lemma real.Inf_smul_of_nonpos (ha : a ≤ 0) (s : set ℝ) : Inf (a • s) = a • Sup s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Inf_empty, real.Sup_empty, smul_zero'] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cInf_singleton 0 },
  by_cases bdd_above s,
  { exact ((order_iso.smul_left_dual ℝ ha').map_cSup' hs h).symm },
  { rw [real.Inf_of_not_bdd_below (mt (bdd_below_smul_iff_of_neg ha').1 h),
      real.Sup_of_not_bdd_above h, smul_zero'] }
end

lemma real.smul_supr_of_nonpos (ha : a ≤ 0) (f : ι → ℝ) :
  a • (⨆ i, f i) = ⨅ i, a • f i :=
(real.Inf_smul_of_nonpos ha _).symm.trans $ congr_arg Inf $ (range_comp _ _).symm

lemma real.Sup_smul_of_nonpos (ha : a ≤ 0) (s : set ℝ) : Sup (a • s) = a • Inf s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Sup_empty, real.Inf_empty, smul_zero] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cSup_singleton 0 },
  by_cases bdd_below s,
  { exact ((order_iso.smul_left_dual ℝ ha').map_cInf' hs h).symm },
  { rw [real.Sup_of_not_bdd_above (mt (bdd_above_smul_iff_of_neg ha').1 h),
      real.Inf_of_not_bdd_below h, smul_zero] }
end

lemma real.smul_infi_of_nonpos (ha : a ≤ 0) (f : ι → ℝ) :
  a • (⨅ i, f i) = ⨆ i, a • f i :=
(real.Sup_smul_of_nonpos ha _).symm.trans $ congr_arg Sup $ (range_comp _ _).symm

end module

/-! ## Special cases for real multiplication -/

section mul

variables {r : ℝ}

lemma real.mul_infi_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : r * (⨅ i, f i) = ⨅ i, r * f i :=
real.smul_infi_of_nonneg ha f

lemma real.mul_supr_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : r * (⨆ i, f i) = ⨆ i, r * f i :=
real.smul_supr_of_nonneg ha f

lemma real.mul_infi_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : r * (⨅ i, f i) = ⨆ i, r * f i :=
real.smul_infi_of_nonpos ha f

lemma real.mul_supr_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : r * (⨆ i, f i) = ⨅ i, r * f i :=
real.smul_supr_of_nonpos ha f

lemma real.infi_mul_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : (⨅ i, f i) * r = ⨅ i, f i * r :=
by simp only [real.mul_infi_of_nonneg ha, mul_comm]

lemma real.supr_mul_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : (⨆ i, f i) * r = ⨆ i, f i * r :=
by simp only [real.mul_supr_of_nonneg ha, mul_comm]

lemma real.infi_mul_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : (⨅ i, f i) * r = ⨆ i, f i * r :=
by simp only [real.mul_infi_of_nonpos ha, mul_comm]

lemma real.supr_mul_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : (⨆ i, f i) * r = ⨅ i, f i * r :=
by simp only [real.mul_supr_of_nonpos ha, mul_comm]

end mul


import measure_theory.integration
import measure_theory.bochner_integration
import measure_theory.lebesgue_measure
import measure_theory.interval_integral

open measure_theory filter set
open_locale ennreal nnreal topological_space

section growing_family

variables {α : Type*} [measurable_space α] (μ : measure α)

structure growing_family (φ : ℕ → set α) : Prop :=
(ae_eventually_mem : ∀ᵐ x ∂μ, ∀ᶠ n in at_top, x ∈ φ n)
(mono : monotone φ)
(measurable : ∀ n, measurable_set $ φ n)

variables {μ}

section Icc

variables [preorder α] [topological_space α] [order_closed_topology α] [opens_measurable_space α]
  {a b : ℕ → α} (ha₁ : ∀ ⦃x y⦄, x ≤ y → a y ≤ a x) (ha₂ : tendsto a at_top at_bot)
  (hb₁ : monotone b) (hb₂ : tendsto b at_top at_top)

lemma growing_family_Icc : growing_family μ (λ n, Icc (a n) (b n)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_le_at_bot x).mp $
    (hb₂.eventually $ eventually_ge_at_top x).mono $
    λ n hbn han, ⟨han, hbn⟩ ),
  mono := λ i j hij, Icc_subset_Icc (ha₁ hij) (hb₁ hij),
  measurable := λ n, measurable_set_Icc }

end Icc

section Ixx

variables [linear_order α] [topological_space α] [order_closed_topology α] [opens_measurable_space α]
  {a b : ℕ → α} (ha₁ : ∀ ⦃x y⦄, x ≤ y → a y ≤ a x) (ha₂ : tendsto a at_top at_bot)
  (hb₁ : monotone b) (hb₂ : tendsto b at_top at_top)

lemma growing_family_Ioo [no_bot_order α] [no_top_order α] :
  growing_family μ (λ n, Ioo (a n) (b n)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_lt_at_bot x).mp $
    (hb₂.eventually $ eventually_gt_at_top x).mono $
    λ n hbn han, ⟨han, hbn⟩ ),
  mono := λ i j hij, Ioo_subset_Ioo (ha₁ hij) (hb₁ hij),
  measurable := λ n, measurable_set_Ioo }

lemma growing_family_Ioc [no_bot_order α] : growing_family μ (λ n, Ioc (a n) (b n)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_lt_at_bot x).mp $
    (hb₂.eventually $ eventually_ge_at_top x).mono $
    λ n hbn han, ⟨han, hbn⟩ ),
  mono := λ i j hij, Ioc_subset_Ioc (ha₁ hij) (hb₁ hij),
  measurable := λ n, measurable_set_Ioc }

lemma growing_family_Ico [no_top_order α] : growing_family μ (λ n, Ico (a n) (b n)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_le_at_bot x).mp $
    (hb₂.eventually $ eventually_gt_at_top x).mono $
    λ n hbn han, ⟨han, hbn⟩ ),
  mono := λ i j hij, Ico_subset_Ico (ha₁ hij) (hb₁ hij),
  measurable := λ n, measurable_set_Ico }

end Ixx

section Ixi_Iix

lemma growing_family_Ici [preorder α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] {a : ℕ → α} (ha₁ : ∀ ⦃x y⦄, x ≤ y → a y ≤ a x)
  (ha₂ : tendsto a at_top at_bot) :
  growing_family μ (λ n, Ici $ a n) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_le_at_bot x).mono $
    λ n han, han ),
  mono := λ i j hij, Ici_subset_Ici.mpr (ha₁ hij),
  measurable := λ n, measurable_set_Ici }

lemma growing_family_Ioi [linear_order α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] {a : ℕ → α} (ha₁ : ∀ ⦃x y⦄, x ≤ y → a y ≤ a x)
  (ha₂ : tendsto a at_top at_bot) [no_bot_order α] :
  growing_family μ (λ n, Ioi $ a n) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_lt_at_bot x).mono $
    λ n han, han ),
  mono := λ i j hij, Ioi_subset_Ioi (ha₁ hij),
  measurable := λ n, measurable_set_Ioi }

lemma growing_family_Iic [preorder α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] {a : ℕ → α} (ha₁ : monotone a)
  (ha₂ : tendsto a at_top at_top) :
  growing_family μ (λ n, Iic $ a n) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_ge_at_top x).mono $
    λ n han, han ),
  mono := λ i j hij, Iic_subset_Iic.mpr (ha₁ hij),
  measurable := λ n, measurable_set_Iic }

lemma growing_family_Iio [linear_order α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] {a : ℕ → α} (ha₁ : monotone a)
  (ha₂ : tendsto a at_top at_top) [no_top_order α] :
  growing_family μ (λ n, Iio $ a n) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha₂.eventually $ eventually_gt_at_top x).mono $
    λ n han, han ),
  mono := λ i j hij, Iio_subset_Iio (ha₁ hij),
  measurable := λ n, measurable_set_Iio }

end Ixi_Iix

lemma growing_family.ae_tendsto_indicator {β : Type*} [has_zero β] [topological_space β]
  {f : α → β} {φ : ℕ → set α} (hφ : growing_family μ φ) :
  ∀ᵐ x ∂μ, tendsto (λ n, (φ n).indicator f x) at_top (𝓝 $ f x) :=
hφ.ae_eventually_mem.mono (λ x hx, tendsto_const_nhds.congr' $
  hx.mono $ λ n hn, (indicator_of_mem hn _).symm)

lemma growing_family_restrict_of_ae_imp {s : set α} {φ : ℕ → set α}
  (hs : measurable_set s) (ae_eventually_mem : ∀ᵐ x ∂μ, x ∈ s → ∀ᶠ n in at_top, x ∈ φ n)
  (mono : monotone φ) (measurable : ∀ n, measurable_set $ φ n) :
  growing_family (μ.restrict s) φ :=
{ ae_eventually_mem := by rwa ae_restrict_iff' hs,
  mono := mono,
  measurable := measurable }

lemma growing_family.inter_restrict {φ : ℕ → set α} (hφ : growing_family μ φ)
  {s : set α} (hs : measurable_set s) :
  growing_family (μ.restrict s) (λ n, φ n ∩ s) :=
growing_family_restrict_of_ae_imp hs
  (hφ.ae_eventually_mem.mono (λ x hx hxs, hx.mono $ λ n hn, ⟨hn, hxs⟩))
  (λ i j hij, inter_subset_inter_left s (hφ.mono hij))
  (λ n, (hφ.measurable n).inter hs)

end growing_family

section integral_limits

variables {α : Type*} [measurable_space α] {μ : measure α}

lemma lintegral_eq_supr {φ : ℕ → set α} (hφ : growing_family μ φ) {f : α → ℝ≥0∞}
  (hfm : measurable f) :
  ∫⁻ x, f x ∂μ = ⨆ (n : ℕ), ∫⁻ x in φ n, f x ∂μ :=
begin
  let F := λ n, indicator (φ n) f,
  have F_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, F n x) at_top (𝓝 $ f x) :=
    hφ.ae_tendsto_indicator,
  have F_mono : ∀ x, monotone (λ n, F n x) :=
    λ x i j hij, indicator_le_indicator_of_subset (hφ.mono hij) (λ _, zero_le _) x,
  have f_eq_supr_F : ∀ᵐ x ∂μ, f x = ⨆ (n : ℕ), F n x :=
    F_tendsto.mono (λ x hx, tendsto_nhds_unique hx
      (tendsto_at_top_csupr (F_mono x) ⟨⊤, λ _ _, le_top⟩)),
  have lintegral_F_eq : ∀ n, ∫⁻ (x : α), F n x ∂μ = ∫⁻ x in φ n, f x ∂μ :=
    λ n, lintegral_indicator _ (hφ.measurable n),
  rw lintegral_congr_ae f_eq_supr_F,
  conv_rhs {congr, funext, rw ← lintegral_F_eq},
  exact lintegral_supr (λ n, hfm.indicator $ hφ.measurable n) (λ i j hij x, F_mono x hij)
end

lemma tendsto_set_lintegral_of_monotone_set {φ : ℕ → set α} (hφ : monotone φ) {f : α → ℝ≥0∞} :
  tendsto (λ n, ∫⁻ x in φ n, f x ∂μ) at_top (𝓝 $ ⨆ (n : ℕ), ∫⁻ x in φ n, f x ∂μ) :=
tendsto_at_top_csupr
  (λ i j hij, lintegral_mono' (measure.restrict_mono (hφ hij) (le_refl _)) (le_refl _))
  ⟨⊤, λ _ _, le_top⟩

lemma lintegral_eq_of_tendsto_lintegral {φ : ℕ → set α} (hφ : growing_family μ φ) {f : α → ℝ≥0∞} (I : ℝ≥0∞)
  (hfm : measurable f) (h : tendsto (λ n, ∫⁻ x in φ n, f x ∂μ) at_top (𝓝 I)) :
  ∫⁻ x, f x ∂μ = I :=
begin
  convert lintegral_eq_supr hφ hfm,
  refine tendsto_nhds_unique h (tendsto_set_lintegral_of_monotone_set hφ.mono)
end

lemma eventually_ne_of_tendsto_nhds {β : Type*} [topological_space β] [t1_space β] {f : α → β} {b b' : β}
  (hbb' : b ≠ b') {l : filter α} (hf : tendsto f l (𝓝 b)) : ∀ᶠ x in l, f x ≠ b' :=
hf (compl_singleton_mem_nhds hbb')

lemma eventually_le_of_tendsto_of_tendsto_of_lt {β : Type*} [linear_order β] [topological_space β]
  [order_topology β] {f g : α → β} {b b' : β} (hbb' : b < b') {l : filter α}
  (hf : tendsto f l (𝓝 b)) (hg : tendsto g l (𝓝 b')) :
  f ≤ᶠ[l] g :=
begin
  rcases order_separated hbb' with ⟨u, v, hu, hv, hub, hvb', huv⟩,
  have hfu : f ⁻¹' u ∈ l := hf (mem_nhds_sets hu hub),
  have hgv : g ⁻¹' v ∈ l := hg (mem_nhds_sets hv hvb'),
  exact eventually_of_mem (inter_mem_sets hfu hgv) (λ x ⟨hxu, hxv⟩, (huv _ hxu _ hxv).le),
end

lemma le_of_tendsto_of_monotone {β : Type*} [preorder α] [linear_order β] [topological_space β]
  [order_closed_topology β] {f : ℕ → β} {b : β} (hmono : monotone f)
  (hf : tendsto f at_top (𝓝 b)) :
  ∀ x, f x ≤ b :=
λ x, ge_of_tendsto hf ((eventually_ge_at_top x).mono $ λ _ h, hmono h)

lemma ge_of_tendsto_of_antimono {β : Type*} [preorder α] [linear_order β] [topological_space β]
  [order_closed_topology β] {f : ℕ → β} {b : β} (hanti : ∀ ⦃x y⦄, x ≤ y → f y ≤ f x)
  (hf : tendsto f at_top (𝓝 b)) :
  ∀ x, b ≤ f x :=
λ x, le_of_tendsto hf ((eventually_ge_at_top x).mono $ λ _ h, hanti h)

variables {E : Type*} [normed_group E] [topological_space.second_countable_topology E] [normed_space ℝ E]
  [complete_space E] [measurable_space E] [borel_space E]

lemma integrable_of_tendsto_lintegral_nnnorm {φ : ℕ → set α}
  (hφ : growing_family μ φ) {f : α → E} (I : ℝ) (hfm : measurable f)
  (h : tendsto (λ n, ∫⁻ x in φ n, nnnorm (f x) ∂μ) at_top (𝓝 $ ennreal.of_real I)) :
  integrable f μ :=
begin
  refine ⟨hfm.ae_measurable, _⟩,
  unfold has_finite_integral,
  rw lintegral_eq_of_tendsto_lintegral hφ _
    (measurable_ennreal_coe_iff.mpr (measurable_nnnorm.comp hfm)) h,
  exact ennreal.of_real_lt_top
end

lemma integrable_of_tendsto_lintegral_nnnorm' {φ : ℕ → set α}
  (hφ : growing_family μ φ) {f : α → E} (I : ℝ≥0) (hfm : measurable f)
  (h : tendsto (λ n, ∫⁻ x in φ n, nnnorm (f x) ∂μ) at_top (𝓝 I)) :
  integrable f μ :=
begin
  refine integrable_of_tendsto_lintegral_nnnorm hφ (I : ℝ) hfm _,
  convert h,
  exact ennreal.of_real_coe_nnreal
end

lemma integrable_of_tendsto_integral_norm {φ : ℕ → set α} (hφ : growing_family μ φ) {f : α → E} (I : ℝ) (hfm : measurable f)
  (hfi : ∀ n, integrable_on f (φ n) μ)
  (h : tendsto (λ n, ∫ x in φ n, ∥f x∥ ∂μ) at_top (𝓝 I)) :
  integrable f μ :=
begin
  conv at h in (integral _ _)
  { rw integral_eq_lintegral_of_nonneg_ae (ae_of_all _ (λ x, @norm_nonneg E _ (f x)))
    hfm.norm.ae_measurable },
  conv at h in (ennreal.of_real _) { dsimp, rw ← coe_nnnorm, rw ennreal.of_real_coe_nnreal },
  have h' : tendsto (λ (n : ℕ), (∫⁻ (a : α) in φ n, nnnorm (f a) ∂μ)) at_top (𝓝 $ ennreal.of_real I),
  { convert ennreal.tendsto_of_real h,
    ext n : 1,
    rw ennreal.of_real_to_real _,
    exact ne_top_of_lt (hfi n).2 },
  exact integrable_of_tendsto_lintegral_nnnorm hφ I hfm h'
end

lemma integrable_of_tendsto_integral_of_nonneg_ae {φ : ℕ → set α}
  (hφ : growing_family μ φ) {f : α → ℝ} (I : ℝ) (hf : 0 ≤ᵐ[μ] f) (hfm : measurable f) (hfi : ∀ n, integrable_on f (φ n) μ)
  (h : tendsto (λ n, ∫ x in φ n, f x ∂μ) at_top (𝓝 I)) : integrable f μ :=
integrable_of_tendsto_integral_norm hφ I hfm hfi
  (h.congr $ λ n, integral_congr_ae $ ae_restrict_of_ae $ hf.mono $
    λ x hx, (real.norm_of_nonneg hx).symm)

lemma integral_eq_supr_max_sub_supr_min {φ : ℕ → set α} (hφ : growing_family μ φ) {f : α → ℝ}
  (hfm : measurable f) (hfi : integrable f μ) :
  ∫ x, f x ∂μ = (⨆ (n : ℕ), ∫⁻ x in φ n, ennreal.of_real (max (f x) 0) ∂μ).to_real -
    (⨆ (n : ℕ), ∫⁻ x in φ n, ennreal.of_real (- min (f x) 0) ∂μ).to_real :=
begin
  rw [integral_eq_lintegral_max_sub_lintegral_min hfi,
      lintegral_eq_supr hφ _, lintegral_eq_supr hφ _],
  { exact ennreal.measurable_of_real.comp (measurable_neg.comp $ hfm.min measurable_zero) },
  { exact ennreal.measurable_of_real.comp (hfm.max measurable_zero) }
end

lemma integral_eq_of_tendsto_integral {φ : ℕ → set α} (hφ : growing_family μ φ) {f : α → E} (I : E)
  (hfm : measurable f) (hfi : integrable f μ)
  (h : tendsto (λ n, ∫ x in φ n, f x ∂μ) at_top (𝓝 I)) :
  ∫ x, f x ∂μ = I :=
begin
  refine tendsto_nhds_unique _ h,
  suffices : tendsto (λ (n : ℕ), ∫ (x : α), (φ n).indicator f x ∂μ) at_top (𝓝 (∫ (x : α), f x ∂μ)),
  { convert this,
    ext n,
    rw integral_indicator (hφ.measurable n) },
  exact tendsto_integral_of_dominated_convergence (λ x, ∥f x∥)
    (λ n, (hfm.indicator $ hφ.measurable n).ae_measurable) hfm.ae_measurable hfi.norm
    (λ n, ae_of_all _ $ norm_indicator_le_norm_self f) hφ.ae_tendsto_indicator
end

lemma integral_eq_of_tendsto_integral_of_nonneg_ae {φ : ℕ → set α}
  (hφ : growing_family μ φ) {f : α → ℝ} (I : ℝ) (hf : 0 ≤ᵐ[μ] f) (hfm : measurable f) (hfi : ∀ n, integrable_on f (φ n) μ)
  (h : tendsto (λ n, ∫ x in φ n, f x ∂μ) at_top (𝓝 I)) :
  ∫ x, f x ∂μ = I :=
have hfi' : integrable f μ,
  from integrable_of_tendsto_integral_of_nonneg_ae hφ I hf hfm hfi h,
integral_eq_of_tendsto_integral hφ I hfm hfi' h

end integral_limits

section interval_integral

variables {α : Type*} {E : Type*} [topological_space α] [linear_order α] [order_closed_topology α]
  [measurable_space α] [no_bot_order α] [opens_measurable_space α] [measurable_space E]
  [normed_group E] [topological_space.second_countable_topology E] [complete_space E]
  [normed_space ℝ E] [borel_space E] {μ : measure α} {a b : ℕ → α}
  (ha₁ : ∀ ⦃x y⦄, x ≤ y → a y ≤ a x) (hb₁ : monotone b) {f : α → E} (hfm : measurable f)

include ha₁ hb₁

lemma monotone_ite_le_interval :
  monotone (λ n, if a n ≤ b n then Ioc (a n) (b n) else ∅) :=
begin
  intros i j hij,
  by_cases hi : a i ≤ b i,
  { have hj : a j ≤ b j := (ha₁ hij).trans (hi.trans (hb₁ hij)),
    simp [hi, hj, Ioc_subset_Ioc (ha₁ hij) (hb₁ hij)] },
  { by_cases hj : a j ≤ b j;
    simp[hi, hj] }
end

include hfm

-- TODO : unduplicate proofs

lemma integral_eq_of_tendsto_interval_integral (I : E)
  (hfi : integrable f μ) (ha₂ : tendsto a at_top at_bot) (hb₂ : tendsto b at_top at_top)
  (h : tendsto (λ n, ∫ x in a n .. b n, f x ∂μ) at_top (𝓝 $ I)) :
  ∫ x, f x ∂μ = I :=
begin
  let φ := λ n, Ioc (a n) (b n),
  have hφ : growing_family μ φ := growing_family_Ioc ha₁ ha₂ hb₁ hb₂,
  refine integral_eq_of_tendsto_integral hφ _ hfm hfi (h.congr' _),
  filter_upwards [ha₂.eventually (eventually_le_at_bot $ b 0)],
  intros n han,
  have : a n ≤ b n := han.trans (hb₁ $ zero_le n),
  exact interval_integral.integral_of_le this
end

lemma integrable_of_tendsto_interval_integral_norm (I : ℝ)
  (hfi : ∀ n, integrable_on f (Ioc (a n) (b n)) μ)
  (ha₂ : tendsto a at_top at_bot) (hb₂ : tendsto b at_top at_top)
  (h : tendsto (λ n, ∫ x in a n .. b n, ∥f x∥ ∂μ) at_top (𝓝 $ I)) :
  integrable f μ :=
begin
  let φ := λ n, Ioc (a n) (b n),
  have hφ : growing_family μ φ := growing_family_Ioc ha₁ ha₂ hb₁ hb₂,
  refine integrable_of_tendsto_integral_norm hφ _ hfm hfi (h.congr' _),
  filter_upwards [ha₂.eventually (eventually_le_at_bot $ b 0)],
  intros n han,
  have : a n ≤ b n := han.trans (hb₁ $ zero_le n),
  exact interval_integral.integral_of_le this
end

omit hb₁

lemma integral_Iic_eq_of_tendsto_interval_integral (I : E) (b : α)
  (hfi : integrable_on f (Iic b) μ) (ha₂ : tendsto a at_top at_bot)
  (h : tendsto (λ n, ∫ x in a n .. b, f x ∂μ) at_top (𝓝 $ I)) :
  ∫ x in Iic b, f x ∂μ = I :=
begin
  let φ := λ n, Ioi (a n),
  have hφ : growing_family (μ.restrict $ Iic b) φ := growing_family_Ioi ha₁ ha₂,
  refine integral_eq_of_tendsto_integral hφ _ hfm hfi (h.congr' _),
  filter_upwards [ha₂.eventually (eventually_le_at_bot $ b)],
  intros n han,
  rw [interval_integral.integral_of_le han, measure.restrict_restrict (hφ.measurable n)],
  refl
end

lemma integrable_on_Iic_of_tendsto_interval_integral_norm (I : ℝ) (b : α)
  (hfi : ∀ n, integrable_on f (Ioc (a n) b) μ) (ha₂ : tendsto a at_top at_bot)
  (h : tendsto (λ n, ∫ x in a n .. b, ∥f x∥ ∂μ) at_top (𝓝 $ I)) :
  integrable_on f (Iic b) μ :=
begin
  let φ := λ n, Ioi (a n),
  have hφ : growing_family (μ.restrict $ Iic b) φ := growing_family_Ioi ha₁ ha₂,
  have hfi : ∀ n, integrable_on f (φ n) (μ.restrict $ Iic b),
  { intro n,
    rw [integrable_on, measure.restrict_restrict (hφ.measurable n)],
    exact hfi n },
  refine integrable_of_tendsto_integral_norm hφ _ hfm hfi (h.congr' _),
  filter_upwards [ha₂.eventually (eventually_le_at_bot $ b)],
  intros n han,
  rw [interval_integral.integral_of_le han, measure.restrict_restrict (hφ.measurable n)],
  refl
end

omit ha₁
include hb₁

lemma integral_Ioi_eq_of_tendsto_interval_integral (I : E) (a : α)
  (hfi : integrable_on f (Ioi a) μ) (hb₂ : tendsto b at_top at_top)
  (h : tendsto (λ n, ∫ x in a .. b n, f x ∂μ) at_top (𝓝 $ I)) :
  ∫ x in Ioi a, f x ∂μ = I :=
begin
  let φ := λ n, Iic (b n),
  have hφ : growing_family (μ.restrict $ Ioi a) φ := growing_family_Iic hb₁ hb₂,
  refine integral_eq_of_tendsto_integral hφ _ hfm hfi (h.congr' _),
  filter_upwards [hb₂.eventually (eventually_ge_at_top $ a)],
  intros n hbn,
  rw [interval_integral.integral_of_le hbn, measure.restrict_restrict (hφ.measurable n),
      inter_comm],
  refl
end

lemma integrable_on_Ioi_of_tendsto_interval_integral_norm (I : ℝ) (a : α)
  (hfi : ∀ n, integrable_on f (Ioc a (b n)) μ) (hb₂ : tendsto b at_top at_top)
  (h : tendsto (λ n, ∫ x in a .. b n, ∥f x∥ ∂μ) at_top (𝓝 $ I)) :
  integrable_on f (Ioi a) μ :=
begin
  let φ := λ n, Iic (b n),
  have hφ : growing_family (μ.restrict $ Ioi a) φ := growing_family_Iic hb₁ hb₂,
  have hfi : ∀ n, integrable_on f (φ n) (μ.restrict $ Ioi a),
  { intro n,
    rw [integrable_on, measure.restrict_restrict (hφ.measurable n), inter_comm],
    exact hfi n },
  refine integrable_of_tendsto_integral_norm hφ _ hfm hfi (h.congr' _),
  filter_upwards [hb₂.eventually (eventually_ge_at_top $ a)],
  intros n hbn,
  rw [interval_integral.integral_of_le hbn, measure.restrict_restrict (hφ.measurable n),
      inter_comm],
  refl
end

--lemma interval_integral_eq_of_tendsto_interval_integral [order_topology α]
--  [has_no_atoms μ] {la lb : α} (hl : la < lb)
--  (hfi : interval_integrable f μ la lb) (ha₂ : tendsto a at_top (𝓝 la))
--  (hb₂ : tendsto b at_top (𝓝 lb))
--  (h : tendsto (λ n, ∫ x in a n .. b n, f x ∂μ) at_top (𝓝 $ I)) :
--  ∫ x in la..lb, f x ∂μ = I :=
--begin
--  let φ := λ n, if a n ≤ b n then Ioc (a n) (b n) else ∅,
--  have hφ : growing_family (μ.restrict $ Ioc la lb) φ :=
--    growing_family_restrict_of_ae_imp measurable_set_Ioc
--      (
--        begin
--          refine Ioo_ae_eq_Ioc.mono (λ x (heq : (x ∈ Ioo la lb) = (x ∈ Ioc la lb)) hx, _),
--          have hx : x ∈ Ioo la lb := heq.symm ▸ hx,
--          refine (eventually_le_of_tendsto_lt hx.1 ha₂).mp _,
--          refine (eventually_ge_of_tendsto_gt hx.2 hb₂).mono _,
--          intros n hbx hax,
--          dsimp only [φ],
--          split_ifs,
--        end
--      )
--      (monotone_ite_le_interval ha₁ hb₁)
--      _,
--  rw interval_integral.integral_of_le hl.le,
--  refine integral_eq_of_tendsto_integral hφ _ hfm hfi.1 (h.congr' _),
--  filter_upwards [eventually_le_of_tendsto_of_tendsto_of_lt hl ha₂ hb₂],
--  intros n han,
--  have hφ₂ : φ n = Ioc (a n) (b n),
--  { dsimp only [φ],
--    split_ifs,
--    refl },
--  have ha₃ := ge_of_tendsto_of_antimono ha₁ ha₂ n,
--  have hb₃ := le_of_tendsto_of_monotone hb₁ hb₂ n,
--  have : φ n ⊆ Ioc la lb := hφ₂.symm ▸ Ioc_subset_Ioc ha₃ hb₃,
--  rw [measure.restrict_restrict, inter_eq_self_of_subset_left this, hφ₂],
--  exact interval_integral.integral_of_le han,
--end

end interval_integral


/-
Copyright (c) 2019 Chris Hughes All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Junyan Xu
-/
import analysis.complex.liouville
import field_theory.is_alg_closed.basic

/-!
# The fundamental theorem of algebra

This file proves that every nonconstant complex polynomial has a root using Liouville's theorem.

As a consequence, the complex numbers are algebraically closed.
-/

open polynomial
open_locale polynomial

namespace complex

/-- **Fundamental theorem of algebra**: every non constant complex polynomial
  has a root -/
lemma exists_root {f : ℂ[X]} (hf : 0 < degree f) : ∃ z : ℂ, is_root f z :=
begin
  contrapose! hf,
  obtain ⟨c, hc⟩ := (f.differentiable.inv hf).exists_const_forall_eq_of_bounded _,
  { obtain rfl : f = C c⁻¹ := polynomial.funext (λ z, by rw [eval_C, ← hc z, inv_inv]),
    exact degree_C_le },
  { obtain ⟨z₀, h₀⟩ := f.exists_forall_norm_le,
    simp only [bounded_iff_forall_norm_le, set.forall_range_iff, norm_inv],
    exact ⟨‖eval z₀ f‖⁻¹, λ z, inv_le_inv_of_le (norm_pos_iff.2 $ hf z₀) (h₀ z)⟩ },
end

instance is_alg_closed : is_alg_closed ℂ :=
is_alg_closed.of_exists_root _ $ λ p _ hp, complex.exists_root $ degree_pos_of_irreducible hp

end complex


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

! This file was ported from Lean 3 source module topology.sober
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Separation

/-!
# Sober spaces

A quasi-sober space is a topological space where every
irreducible closed subset has a generic point.
A sober space is a quasi-sober space where every irreducible closed subset
has a *unique* generic point. This is if and only if the space is T0, and thus sober spaces can be
stated via `[QuasiSober α] [T0Space α]`.

## Main definition

* `IsGenericPoint` : `x` is the generic point of `S` if `S` is the closure of `x`.
* `QuasiSober` : A space is quasi-sober if every irreducible closed subset has a generic point.

-/

open Set

variable {α β : Type _} [TopologicalSpace α] [TopologicalSpace β]

section genericPoint

/-- `x` is a generic point of `S` if `S` is the closure of `x`. -/
def IsGenericPoint (x : α) (S : Set α) : Prop :=
  closure ({x} : Set α) = S
#align is_generic_point IsGenericPoint

theorem isGenericPoint_def {x : α} {S : Set α} : IsGenericPoint x S ↔ closure ({x} : Set α) = S :=
  Iff.rfl
#align is_generic_point_def isGenericPoint_def

theorem IsGenericPoint.def {x : α} {S : Set α} (h : IsGenericPoint x S) :
    closure ({x} : Set α) = S :=
  h
#align is_generic_point.def IsGenericPoint.def

theorem isGenericPoint_closure {x : α} : IsGenericPoint x (closure ({x} : Set α)) :=
  refl _
#align is_generic_point_closure isGenericPoint_closure

variable {x y : α} {S U Z : Set α}

theorem isGenericPoint_iff_specializes : IsGenericPoint x S ↔ ∀ y, x ⤳ y ↔ y ∈ S := by
  simp only [specializes_iff_mem_closure, IsGenericPoint, Set.ext_iff]
#align is_generic_point_iff_specializes isGenericPoint_iff_specializes

namespace IsGenericPoint

theorem specializes_iff_mem (h : IsGenericPoint x S) : x ⤳ y ↔ y ∈ S :=
  isGenericPoint_iff_specializes.1 h y
#align is_generic_point.specializes_iff_mem IsGenericPoint.specializes_iff_mem

protected theorem specializes (h : IsGenericPoint x S) (h' : y ∈ S) : x ⤳ y :=
  h.specializes_iff_mem.2 h'
#align is_generic_point.specializes IsGenericPoint.specializes

protected theorem mem (h : IsGenericPoint x S) : x ∈ S :=
  h.specializes_iff_mem.1 specializes_rfl
#align is_generic_point.mem IsGenericPoint.mem

protected theorem isClosed (h : IsGenericPoint x S) : IsClosed S :=
  h.def ▸ isClosed_closure
#align is_generic_point.is_closed IsGenericPoint.isClosed

protected theorem isIrreducible (h : IsGenericPoint x S) : IsIrreducible S :=
  h.def ▸ isIrreducible_singleton.closure
#align is_generic_point.is_irreducible IsGenericPoint.isIrreducible

protected theorem inseparable (h : IsGenericPoint x S) (h' : IsGenericPoint y S) :
    Inseparable x y :=
  (h.specializes h'.mem).antisymm (h'.specializes h.mem)

/-- In a T₀ space, each set has at most one generic point. -/
protected theorem eq [T0Space α] (h : IsGenericPoint x S) (h' : IsGenericPoint y S) : x = y :=
  (h.inseparable h').eq
#align is_generic_point.eq IsGenericPoint.eq

theorem mem_open_set_iff (h : IsGenericPoint x S) (hU : IsOpen U) : x ∈ U ↔ (S ∩ U).Nonempty :=
  ⟨fun h' => ⟨x, h.mem, h'⟩, fun ⟨_y, hyS, hyU⟩ => (h.specializes hyS).mem_open hU hyU⟩
#align is_generic_point.mem_open_set_iff IsGenericPoint.mem_open_set_iff

theorem mem_closed_set_iff (h : IsGenericPoint x S) (hZ : IsClosed Z) : x ∈ Z ↔ S ⊆ Z := by
  rw [← h.def, hZ.closure_subset_iff, singleton_subset_iff]
#align is_generic_point.mem_closed_set_iff IsGenericPoint.mem_closed_set_iff

protected theorem image (h : IsGenericPoint x S) {f : α → β} (hf : Continuous f) :
    IsGenericPoint (f x) (closure (f '' S)) := by
  rw [isGenericPoint_def, ← h.def, ← image_singleton, closure_image_closure hf]
#align is_generic_point.image IsGenericPoint.image

end IsGenericPoint

theorem isGenericPoint_iff_forall_closed (hS : IsClosed S) (hxS : x ∈ S) :
    IsGenericPoint x S ↔ ∀ Z : Set α, IsClosed Z → x ∈ Z → S ⊆ Z := by
  have : closure {x} ⊆ S := closure_minimal (singleton_subset_iff.2 hxS) hS
  simp_rw [IsGenericPoint, subset_antisymm_iff, this, true_and_iff, closure, subset_interₛ_iff,
    mem_setOf_eq, and_imp, singleton_subset_iff]
#align is_generic_point_iff_forall_closed isGenericPoint_iff_forall_closed

end genericPoint

section Sober

/-- A space is sober if every irreducible closed subset has a generic point. -/
@[mk_iff quasiSober_iff]
class QuasiSober (α : Type _) [TopologicalSpace α] : Prop where
  sober : ∀ {S : Set α}, IsIrreducible S → IsClosed S → ∃ x, IsGenericPoint x S
#align quasi_sober QuasiSober

/-- A generic point of the closure of an irreducible space. -/
noncomputable def IsIrreducible.genericPoint [QuasiSober α] {S : Set α} (hS : IsIrreducible S) :
    α :=
  (QuasiSober.sober hS.closure isClosed_closure).choose
#align is_irreducible.generic_point IsIrreducible.genericPoint

theorem IsIrreducible.genericPoint_spec [QuasiSober α] {S : Set α} (hS : IsIrreducible S) :
    IsGenericPoint hS.genericPoint (closure S) :=
  (QuasiSober.sober hS.closure isClosed_closure).choose_spec
#align is_irreducible.generic_point_spec IsIrreducible.genericPoint_spec

@[simp]
theorem IsIrreducible.genericPoint_closure_eq [QuasiSober α] {S : Set α} (hS : IsIrreducible S) :
    closure ({hS.genericPoint} : Set α) = closure S :=
  hS.genericPoint_spec
#align is_irreducible.generic_point_closure_eq IsIrreducible.genericPoint_closure_eq

variable (α)

/-- A generic point of a sober irreducible space. -/
noncomputable def genericPoint [QuasiSober α] [IrreducibleSpace α] : α :=
  (IrreducibleSpace.isIrreducible_univ α).genericPoint
#align generic_point genericPoint

theorem genericPoint_spec [QuasiSober α] [IrreducibleSpace α] : IsGenericPoint (genericPoint α) ⊤ :=
  by simpa using (IrreducibleSpace.isIrreducible_univ α).genericPoint_spec
#align generic_point_spec genericPoint_spec

@[simp]
theorem genericPoint_closure [QuasiSober α] [IrreducibleSpace α] :
    closure ({genericPoint α} : Set α) = ⊤ :=
  genericPoint_spec α
#align generic_point_closure genericPoint_closure

variable {α}

theorem genericPoint_specializes [QuasiSober α] [IrreducibleSpace α] (x : α) : genericPoint α ⤳ x :=
  (IsIrreducible.genericPoint_spec _).specializes (by simp)
#align generic_point_specializes genericPoint_specializes

attribute [local instance] specializationOrder

/-- The closed irreducible subsets of a sober space bijects with the points of the space. -/
noncomputable def irreducibleSetEquivPoints [QuasiSober α] [T0Space α] :
    { s : Set α | IsIrreducible s ∧ IsClosed s } ≃o α where
  toFun s := s.prop.1.genericPoint
  invFun x := ⟨closure ({x} : Set α), isIrreducible_singleton.closure, isClosed_closure⟩
  left_inv s := Subtype.eq <| Eq.trans s.prop.1.genericPoint_spec <|
    closure_eq_iff_isClosed.mpr s.2.2
  right_inv x := isIrreducible_singleton.closure.genericPoint_spec.eq
      (by rw [closure_closure]; exact isGenericPoint_closure)
  map_rel_iff' := by
    rintro ⟨s, hs⟩ ⟨t, ht⟩
    refine specializes_iff_closure_subset.trans ?_
    simp [hs.2.closure_eq, ht.2.closure_eq]
#align irreducible_set_equiv_points irreducibleSetEquivPoints

theorem ClosedEmbedding.quasiSober {f : α → β} (hf : ClosedEmbedding f) [QuasiSober β] :
    QuasiSober α where
  sober hS hS' := by
    have hS'' := hS.image f hf.continuous.continuousOn
    obtain ⟨x, hx⟩ := QuasiSober.sober hS'' (hf.isClosedMap _ hS')
    obtain ⟨y, -, rfl⟩ := hx.mem
    use y
    apply image_injective.mpr hf.inj
    rw [← hx.def, ← hf.closure_image_eq, image_singleton]
#align closed_embedding.quasi_sober ClosedEmbedding.quasiSober

theorem OpenEmbedding.quasiSober {f : α → β} (hf : OpenEmbedding f) [QuasiSober β] :
    QuasiSober α where
  sober hS hS' := by
    have hS'' := hS.image f hf.continuous.continuousOn
    obtain ⟨x, hx⟩ := QuasiSober.sober hS''.closure isClosed_closure
    obtain ⟨T, hT, rfl⟩ := hf.toInducing.isClosed_iff.mp hS'
    rw [image_preimage_eq_inter_range] at hx hS''
    have hxT : x ∈ T := by
      rw [← hT.closure_eq]
      exact closure_mono (inter_subset_left _ _) hx.mem
    obtain ⟨y, rfl⟩ : x ∈ range f := by
      rw [hx.mem_open_set_iff hf.open_range]
      refine' Nonempty.mono _ hS''.1
      simpa using subset_closure
    use y
    change _ = _
    rw [hf.toEmbedding.closure_eq_preimage_closure_image, image_singleton, show _ = _ from hx]
    apply image_injective.mpr hf.inj
    ext z
    simp only [image_preimage_eq_inter_range, mem_inter_iff, and_congr_left_iff]
    exact fun hy => ⟨fun h => hT.closure_eq ▸ closure_mono (inter_subset_left _ _) h,
      fun h => subset_closure ⟨h, hy⟩⟩
#align open_embedding.quasi_sober OpenEmbedding.quasiSober

/-- A space is quasi sober if it can be covered by open quasi sober subsets. -/
theorem quasiSober_of_open_cover (S : Set (Set α)) (hS : ∀ s : S, IsOpen (s : Set α))
    [hS' : ∀ s : S, QuasiSober s] (hS'' : ⋃₀ S = ⊤) : QuasiSober α := by
  rw [quasiSober_iff]
  intro t h h'
  obtain ⟨x, hx⟩ := h.1
  obtain ⟨U, hU, hU'⟩ : x ∈ ⋃₀ S := by
    rw [hS'']
    trivial
  haveI : QuasiSober U := hS' ⟨U, hU⟩
  have H : IsPreirreducible ((↑) ⁻¹' t : Set U) :=
    h.2.preimage (hS ⟨U, hU⟩).openEmbedding_subtype_val
  replace H : IsIrreducible ((↑) ⁻¹' t : Set U) := ⟨⟨⟨x, hU'⟩, by simpa using hx⟩, H⟩
  use H.genericPoint
  have := continuous_subtype_val.closure_preimage_subset _ H.genericPoint_spec.mem
  rw [h'.closure_eq] at this
  apply le_antisymm
  · apply h'.closure_subset_iff.mpr
    simpa using this
  rw [← image_singleton, ← closure_image_closure continuous_subtype_val, H.genericPoint_spec.def]
  refine' (subset_closure_inter_of_isPreirreducible_of_isOpen h.2 (hS ⟨U, hU⟩) ⟨x, hx, hU'⟩).trans
    (closure_mono _)
  rw [← Subtype.image_preimage_coe]
  exact Set.image_subset _ subset_closure
#align quasi_sober_of_open_cover quasiSober_of_open_cover

/-- Any Hausdorff space is a quasi-sober space because any irreducible set is a singleton. -/
instance (priority := 100) T2Space.quasiSober [T2Space α] : QuasiSober α where
  sober h _ := by
    obtain ⟨x, rfl⟩ := isIrreducible_iff_singleton.mp h
    exact ⟨x, closure_singleton⟩
#align t2_space.quasi_sober T2Space.quasiSober

end Sober


import function.bijection data.list.set data.fin
open fin function

namespace fin
protected
lemma le_refl {n} (a : fin n) : a ≤ a := fin.cases_on a (λ a _, nat.le_refl a)
protected
lemma le_trans {n} {a b c : fin n} : a ≤ b → b ≤ c → a ≤ c :=
fin.cases_on a (λ _ _,
fin.cases_on b (λ _ _,
fin.cases_on c (λ _ _,
  assume Hab Hbc,
  nat.le_trans Hab Hbc
)
)
)

protected
lemma le_antisymm {n}{a b : fin n} : a ≤ b → b ≤ a → a = b :=
fin.cases_on a (λ _ _,
fin.cases_on b (λ _ _,
  assume Hab Hba,
  fin.eq_of_veq (nat.le_antisymm Hab Hba)
)
)

instance {n} : decidable_linear_order (fin n) :=
{
  lt := fin.lt,
  le := fin.le,
  le_refl := fin.le_refl,
  le_trans := @fin.le_trans _,
  le_antisymm := @fin.le_antisymm _,
  le_iff_lt_or_eq := λ a b,
    fin.cases_on a (λ i _,
    fin.cases_on b (λ j _,
     iff.intro (assume H, or.elim (nat.lt_or_eq_of_le H) or.inl (assume Heq, or.inr (fin.eq_of_veq Heq)))
       (assume H, nat.le_of_lt_or_eq (or.imp id (begin intro heq, apply (fin.veq_of_eq heq) end) H))
    )
    ),
  lt_irrefl := λ a, fin.cases_on a (λ _ _,
    nat.lt_irrefl _
  ),
  le_total := λ a b, fin.cases_on a (λ _ _, fin.cases_on b (λ _ _, nat.le_total)),
  decidable_lt := fin.decidable_lt,
  decidable_le := fin.decidable_le,
  decidable_eq := fin.decidable_eq _
}
def swap {n} (k : fin (n+1)) : fin (n+1) → fin (n+1) := take i, if i = k then 0 else if i = 0 then k else i

namespace swap
variables {n : ℕ } {k : fin (n+1)}
lemma idem : ∀ i, swap k (swap k i) = i
:= take i, if Hik : i = k then
             if Hkz : k = 0 then by simp [Hik, Hkz, swap] else
                begin
                 simp_using_hs [swap],
                 apply if_neg,
                 intro H,
                 apply Hkz,
                 symmetry,
                 assumption
                end
           else if Hiz : i = 0 then
                begin
                 rw Hiz,
                 simp [swap],
                 apply if_pos,
                 apply if_neg,
                 intro H,
                 apply Hik,
                 rw Hiz,
                 assumption
                end else
                by
                simp [swap];
                cc

lemma has_left_inverse  : has_left_inverse (swap k) := ⟨ swap k, idem ⟩
lemma has_right_inverse  :  has_right_inverse (swap k) := ⟨ swap k, idem ⟩
lemma has_isomorphism : has_bijection(swap k) := ⟨ swap k,  idem , idem ⟩

lemma injective : injective (swap k) := injective_of_has_left_inverse has_left_inverse
lemma surjective : surjective (swap k) := surjective_of_has_right_inverse has_right_inverse

instance : bijection (swap k) := ⟨ swap k, idem , idem ⟩

lemma k_eq_zero : swap k k = 0 := by simp [swap]
lemma zero_eq_k : swap k 0 = k := if H : 0 = k then by simp_using_hs [swap] else by simp_using_hs [swap]
lemma id_of_zero : swap 0 = @id (fin (n+1)) :=
  begin
  apply funext,
  intro i,
  simp_using_hs [swap],
  cases (fin.decidable_eq _ i 0) with H H,
  repeat {simp_using_hs}
  end
end swap

lemma ne_zero_of_succ {n} : ∀ i : fin n, fin.succ i ≠ 0 :=
 begin
  intros i,
  cases i,
  unfold fin.succ,
  intro H,
  apply (nat.succ_ne_zero val),
  apply (fin.veq_of_eq H),
 end
lemma succ.injective {n} : injective (@fin.succ n) :=
begin
 intros fi fj H,
 cases fi with i ilt,
 cases fj with j jlt,
 simp [fin.succ] at H,
 apply fin.eq_of_veq,
 apply nat.succ.inj,
 simp,
 exact (fin.veq_of_eq H)
end

lemma pred.injective {n} {i j : fin (n + 1)} { ine0 : i ≠ 0} { jne0 : j ≠ 0} : fin.pred i ine0 = fin.pred j jne0 → i = j
:=
begin
cases i with ival ilt,
cases j with jval jlt,
simp [fin.pred],
intro H,
apply fin.eq_of_veq,
simp,
apply nat.pred_inj,
{
  -- ival > 0
  apply nat.pos_of_ne_zero,
  exact (fin.vne_of_ne ine0)
},
{
  -- jval > 0
  apply nat.pos_of_ne_zero,
  exact (fin.vne_of_ne jne0)
},
{
  exact (fin.veq_of_eq H)
}
end

/--
 A proof of pigeonhole principle.
-/
theorem not_injective_of_gt {m n} (f : fin m → fin n) : m > n → ¬ injective f :=
begin
  revert m,
  induction n with n iH,
  {
      intros m f H Hinj,
      cases (f ⟨0, H⟩ ) with val is_lt,
      exact (absurd is_lt (nat.not_lt_zero _))
  },
  {
      intros m f Hmn Hinj,
      pose pred_m := nat.pred m,
      assert Hm : m = nat.succ pred_m, {
          symmetry,
          apply nat.succ_pred_eq_of_pos,
          transitivity,
          exact Hmn,
          apply nat.zero_lt_succ
      },
      revert f Hmn,
      rw Hm,
      intros f Hpmn Hinj,
      pose g := swap (f 0) ∘ f ∘ fin.succ,
      assert Hgnz : ∀ i, g i ≠ 0,
      {
        intros i Hgz,
        apply (ne_zero_of_succ i),
        apply Hinj,
        apply (@swap.injective _ (f 0)),
        rw swap.k_eq_zero,
        assumption
      },
      pose h := λ i, fin.pred (g i) (Hgnz i),
      apply (iH h),
        {
          apply nat.le_of_succ_le_succ,
          apply Hpmn,
        },
        {
            intros i₁ i₂ Heq,
            apply succ.injective,
            apply Hinj,
            apply swap.injective,
            apply pred.injective,
            assumption
        }
  }
end

def elems : ∀ n : ℕ, list (fin n)
| 0 := []
| (n+1) := 0 :: list.map fin.succ (elems n)

lemma succ_ne_zero {n} (i : fin n) : fin.succ i ≠ 0 :=
begin
cases i,
simp [fin.succ],
apply fin.ne_of_vne,
rw fin.val_zero,
simp,
apply nat.succ_ne_zero
end

/-
lemma nodup_elems : ∀ n, list.nodup (elems n)
| 0     := list.nodup_nil
| (n+1) := list.nodup_cons (λ h, exists.elim (list.exists_of_mem_map h) (λ i hp, succ_ne_zero _ hp.right))
    (list.nodup_map succ.injective (nodup_elems n))
-/

def mem_elems : ∀ {n} (i : fin n), i ∈ elems n
| 0     ⟨_ , is_lt⟩ := absurd is_lt (nat.not_lt_zero _)
| (n+1) ⟨0 , _⟩ := list.mem_cons_self _ _
| (n+1) ⟨i + 1, is_lt⟩ := list.mem_cons_of_mem _ (list.mem_map fin.succ (mem_elems ⟨i, nat.le_of_succ_le_succ is_lt⟩))

def {u} nth { α : Type u} : Π (l : list α), fin (list.length l) → α
| [] ⟨_, is_lt⟩  := absurd is_lt (nat.not_lt_zero _)
| (x :: xs) ⟨0, _⟩  := x
| (_ :: xs) ⟨n+1, is_lt⟩ := nth xs ⟨n, nat.le_of_succ_le_succ is_lt⟩

lemma {u} mem_nth {α : Type u} : ∀ (l : list α) i, nth l i ∈ l
| [] ⟨_, is_lt⟩  := absurd is_lt (nat.not_lt_zero _)
| (x :: xs) ⟨0, _⟩ := list.mem_cons_self _ _
| (_ :: xs) ⟨i+1, is_lt⟩ := list.mem_cons_of_mem _ $ mem_nth xs ⟨i, nat.le_of_succ_le_succ is_lt⟩

def {u} left_index {α : Type u}[decidable_eq α]{a} : Π {l : list α}, a ∈ l → fin (list.length l)
| []      h := absurd h (list.not_mem_nil _)
| (x::xs) h := if H : a = x then (0 : fin ((list.length xs) + 1))
               else fin.succ $ left_index $ or.resolve_left h H

def {u} nth_left_index_left_inverse {α : Type u} [deq : decidable_eq α] {l : list α} {a} (h : a ∈ l) : nth l (left_index h) = a :=
begin
induction l with x xs iH,
{
  exact (absurd h (list.not_mem_nil _))
},
{
  unfold left_index,
  cases (deq a x) with Hne Heq,
  {
    rw dif_neg,
    assert Hmem : a ∈ xs, apply or.resolve_left, assumption, assumption,
    change nth (x :: xs) (fin.succ (left_index Hmem)) = a,
    assert Lem : ∀ a x (xs : list α)(H : a ∈ xs), nth (x :: xs) (fin.succ (left_index H)) = nth xs (left_index H),
    {
      intros a x xs H,
      generalize (left_index H) i,
      intro i,
      cases i,
      simp [fin.succ, nth],
      refl
    },
    rw Lem,
    apply iH,
    assumption
  },
  {
    rw dif_pos,
    rw Heq,
    refl,
    assumption
  }
}
end

lemma {u} nth_ne_nth_of_nodup_of_lt {α : Type u} {l : list α}  : Π {i j : fin (list.length l)}, list.nodup l → i < j → nth l i ≠ nth l j :=
begin
induction l with x xs iH,
{
  intro i,
  exact (absurd i.is_lt (nat.not_lt_zero _))
},
{
  intros i j Hdis Hlt Heq,
  cases i with i ilt,
  cases j with j jlt,
  assert Hj : j = nat.succ (nat.pred j),
  {
    symmetry,
    apply nat.succ_pred_eq_of_pos,
    apply nat.lt_of_le_of_lt,
    apply nat.zero_le,
    assumption
  },
  revert jlt,
  rw Hj,
  intros jlt Hlt Heq,
  cases i with i,
  {
    simp [nth] at Heq,

    apply (list.not_mem_of_nodup_cons Hdis),
    rw Heq,
    apply mem_nth
  },
  {
    simp [nth] at Heq,
    apply (@iH ⟨i, nat.lt_of_succ_lt_succ ilt⟩ ⟨nat.pred j, nat.lt_of_succ_lt_succ jlt⟩ ),
    apply list.nodup_of_nodup_cons,
    assumption,
    exact (nat.lt_of_succ_lt_succ Hlt),
    assumption
  }
}
end

lemma {u} left_index_mem_nth_left_inverse_of_nodup {α : Type u}[decidable_eq α]{l : list α} : list.nodup l → ∀ i, left_index (mem_nth l i) = i :=
begin
intros Hdis i,
induction Hdis with x xs Hx dxs iH,
{
  exact (absurd i.is_lt (nat.not_lt_zero _))
},
{
  cases i with i ilt,
  cases i with i,
  {
    change left_index (list.mem_cons_self x xs) = ⟨0, _⟩,
    simp [left_index],
    rw dif_pos,
    refl,
    refl
  },
  {
    simp [left_index, mem_nth],
    rw dif_neg,
    assert Lem : ∀ {n}(i : fin n), (fin.succ i).val = nat.succ i.val,
    {
      intros n i,
      cases i,
      simp [fin.succ]
    },
    apply fin.eq_of_veq,
    rw Lem,
    simp,
    apply (congr_arg nat.succ),
    pose j : fin (list.length xs) := ⟨i, nat.lt_of_succ_lt_succ ilt⟩,
    change (left_index (mem_nth xs j)).val = j.val,
    apply fin.veq_of_eq,
    apply iH,
    simp [nth],
    intro H,
    apply Hx,
    rw -H,
    apply mem_nth
  }
}
end
lemma {u} injective_nth_of_nodup {α : Type u}{l : list α} : list.nodup l → injective (nth l) :=
  assume Hdis, take i j, assume H,
      if Heq : i = j then Heq
      else if Hlt : i < j then absurd H (nth_ne_nth_of_nodup_of_lt Hdis Hlt)
      else have j < i, from or.resolve_left (lt_or_gt_of_ne Heq) Hlt,
           absurd (eq.symm H) (nth_ne_nth_of_nodup_of_lt Hdis this)

lemma length_le_of_nodup_fin {n} {l : list (fin n)} : list.nodup l → list.length l ≤ n :=
begin
 intro Hdis,
 induction l with x xs iH,
 {
   exact (nat.zero_le _)
 },
 {
    apply le_of_not_gt,
    unfold list.length,
    intro Hgt,
    pose f : fin (list.length xs + 1) → fin n := nth (x::xs),
    apply not_injective_of_gt f Hgt,
    intros i j Hf,
    cases (fin.decidable_eq _ i j) with Hne Heq,
      {
        assert Ho : i < j ∨ i > j,
        {
          cases i with i ilt,
          cases j with j jlt,
          change (i < j ∨ i > j),
          apply lt_or_gt_of_ne,
          apply (fin.vne_of_ne Hne)
        },
       cases Ho with Hlt Hgt,
       {
          exact (absurd Hf (nth_ne_nth_of_nodup_of_lt Hdis Hlt))
       },
       {
         exact (absurd (eq.symm Hf) (nth_ne_nth_of_nodup_of_lt Hdis Hgt))
       }

      },
      {
        exact Heq
      }
 }
end
end fin


import examples.automata

namespace Automata

    variables {Sigma : Type}       -- The alphabet
              {D : Type}            -- Output
    open word

    structure Automaton    :=
            (State : Type)                 -- Set of States
            (δ : State → Sigma → State)    -- δ: S × Σ → S
            (γ : State → D)                -- Output of a state

    /-
    Given a morphism τ between two Automates A and B
    determines if τ is a homomorphism
    -/

    def is_homomorphism_Automaton
        {A B : @Automaton Sigma D} (τ : A.State → B.State) : Prop :=
            ∀ a : A.State ,                     -- ∀ states (a) in A
                A.γ a  = B.γ (τ a) ∧            -- a ∈ T_A iff τ(a) ∈ T_B
            ∀ e : Sigma ,                       -- and ∀ e ∈ Σ
                τ (A.δ a e) = (B.δ (τ a) e)     -- τ(δ_A(a , e)) = δ_B(τ(a) , e)

    def deltaStar {A : @Automaton Sigma D} (s : A.State): word Sigma → A.State
        | ε           :=  s
        | (e•v)       :=  A.δ (deltaStar v) e

    def state_output
        {A : Automaton}
        (s : A.State)
        (w : @word Sigma) : D :=
        A.γ (deltaStar s w)

    inductive T_tree : Type
        | node : D → (Sigma → T_tree) → T_tree

    notation  d ` - ` φ  := T_tree.node d φ

    def delta : @T_tree Sigma D → Sigma → @T_tree Sigma D
        | (d - φ) e := φ e

    def gamma : @T_tree Sigma D → D
        | (d - φ) := d

    def Tree_Automaton : Automaton :=
    {
        State       := @T_tree Sigma D,
        δ           := delta ,
        γ           := gamma
    }

    def Terminal_Automaton : Automaton :=
    {
        State       := word Sigma → D ,
        δ           := λ τ e , λ w , τ (e • w)  ,
        γ           := λ τ , τ word.ε
    }

    def φ (A : @Automaton Sigma D) :
          A.State → (@Terminal_Automaton Sigma D).State
        | a word.ε      := A.γ a
        | a (e • w)     := φ (A.δ a e) w

    theorem Terminal_is_Automaton (A : @Automaton Sigma D) :
            is_homomorphism_Automaton (φ A) :=
            assume a : A.State ,
            and.intro
                begin
                    apply rfl,
                end
                begin
                    intro e,
                    apply rfl
                end

end Automata