/-
Copyright (c) 2020 Thomas Browning, Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Patrick Lutz
-/

import group_theory.perm.cycle_type
import analysis.complex.polynomial
import field_theory.galois

/-!
# Galois Groups of Polynomials

In this file, we introduce the Galois group of a polynomial `p` over a field `F`,
defined as the automorphism group of its splitting field. We also provide
some results about some extension `E` above `p.splitting_field`, and some specific
results about the Galois groups of ℚ-polynomials with specific numbers of non-real roots.

## Main definitions

- `polynomial.gal p`: the Galois group of a polynomial p.
- `polynomial.gal.restrict p E`: the restriction homomorphism `(E ≃ₐ[F] E) → gal p`.
- `polynomial.gal.gal_action p E`: the action of `gal p` on the roots of `p` in `E`.

## Main results

- `polynomial.gal.restrict_smul`: `restrict p E` is compatible with `gal_action p E`.
- `polynomial.gal.gal_action_hom_injective`: `gal p` acting on the roots of `p` in `E` is faithful.
- `polynomial.gal.restrict_prod_injective`: `gal (p * q)` embeds as a subgroup of `gal p × gal q`.
- `polynomial.gal.card_of_separable`: For a separable polynomial, its Galois group has cardinality
equal to the dimension of its splitting field over `F`.
- `polynomial.gal.gal_action_hom_bijective_of_prime_degree`:
An irreducible polynomial of prime degree with two non-real roots has full Galois group.

## Other results
- `polynomial.gal.card_complex_roots_eq_card_real_add_card_not_gal_inv`: The number of complex roots
equals the number of real roots plus the number of roots not fixed by complex conjugation
(i.e. with some imaginary component).

-/

noncomputable theory
open_locale classical

open finite_dimensional

namespace polynomial

variables {F : Type*} [field F] (p q : polynomial F) (E : Type*) [field E] [algebra F E]

/-- The Galois group of a polynomial. -/
@[derive [group, fintype]]
def gal := p.splitting_field ≃ₐ[F] p.splitting_field

namespace gal

instance : has_coe_to_fun p.gal (λ _, p.splitting_field → p.splitting_field) :=
alg_equiv.has_coe_to_fun

@[ext] lemma ext {σ τ : p.gal} (h : ∀ x ∈ p.root_set p.splitting_field, σ x = τ x) : σ = τ :=
begin
  refine alg_equiv.ext (λ x, (alg_hom.mem_equalizer σ.to_alg_hom τ.to_alg_hom x).mp
      ((set_like.ext_iff.mp _ x).mpr algebra.mem_top)),
  rwa [eq_top_iff, ←splitting_field.adjoin_roots, algebra.adjoin_le_iff],
end

/-- If `p` splits in `F` then the `p.gal` is trivial. -/
def unique_gal_of_splits (h : p.splits (ring_hom.id F)) : unique p.gal :=
{ default := 1,
  uniq := λ f, alg_equiv.ext (λ x, by { obtain ⟨y, rfl⟩ := algebra.mem_bot.mp
    ((set_like.ext_iff.mp ((is_splitting_field.splits_iff _ p).mp h) x).mp algebra.mem_top),
    rw [alg_equiv.commutes, alg_equiv.commutes] }) }

instance [h : fact (p.splits (ring_hom.id F))] : unique p.gal :=
unique_gal_of_splits _ (h.1)

instance unique_gal_zero : unique (0 : polynomial F).gal :=
unique_gal_of_splits _ (splits_zero _)

instance unique_gal_one : unique (1 : polynomial F).gal :=
unique_gal_of_splits _ (splits_one _)

instance unique_gal_C (x : F) : unique (C x).gal :=
unique_gal_of_splits _ (splits_C _ _)

instance unique_gal_X : unique (X : polynomial F).gal :=
unique_gal_of_splits _ (splits_X _)

instance unique_gal_X_sub_C (x : F) : unique (X - C x).gal :=
unique_gal_of_splits _ (splits_X_sub_C _)

instance unique_gal_X_pow (n : ℕ) : unique (X ^ n : polynomial F).gal :=
unique_gal_of_splits _ (splits_X_pow _ _)

instance [h : fact (p.splits (algebra_map F E))] : algebra p.splitting_field E :=
(is_splitting_field.lift p.splitting_field p h.1).to_ring_hom.to_algebra

instance [h : fact (p.splits (algebra_map F E))] : is_scalar_tower F p.splitting_field E :=
is_scalar_tower.of_algebra_map_eq
  (λ x, ((is_splitting_field.lift p.splitting_field p h.1).commutes x).symm)

-- The `algebra p.splitting_field E` instance above behaves badly when
-- `E := p.splitting_field`, since it may result in a unification problem
-- `is_splitting_field.lift.to_ring_hom.to_algebra =?= algebra.id`,
-- which takes an extremely long time to resolve, causing timeouts.
-- Since we don't really care about this definition, marking it as irreducible
-- causes that unification to error out early.
attribute [irreducible] gal.algebra

/-- Restrict from a superfield automorphism into a member of `gal p`. -/
def restrict [fact (p.splits (algebra_map F E))] : (E ≃ₐ[F] E) →* p.gal :=
alg_equiv.restrict_normal_hom p.splitting_field

lemma restrict_surjective [fact (p.splits (algebra_map F E))] [normal F E] :
  function.surjective (restrict p E) :=
alg_equiv.restrict_normal_hom_surjective E

section roots_action

/-- The function taking `roots p p.splitting_field` to `roots p E`. This is actually a bijection,
see `polynomial.gal.map_roots_bijective`. -/
def map_roots [fact (p.splits (algebra_map F E))] :
  root_set p p.splitting_field → root_set p E :=
λ x, ⟨is_scalar_tower.to_alg_hom F p.splitting_field E x, begin
  have key := subtype.mem x,
  by_cases p = 0,
  { simp only [h, root_set_zero] at key,
    exact false.rec _ key },
  { rw [mem_root_set h, aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩

lemma map_roots_bijective [h : fact (p.splits (algebra_map F E))] :
  function.bijective (map_roots p E) :=
begin
  split,
  { exact λ _ _ h, subtype.ext (ring_hom.injective _ (subtype.ext_iff.mp h)) },
  { intro y,
    -- this is just an equality of two different ways to write the roots of `p` as an `E`-polynomial
    have key := roots_map
      (is_scalar_tower.to_alg_hom F p.splitting_field E : p.splitting_field →+* E)
      ((splits_id_iff_splits _).mpr (is_splitting_field.splits p.splitting_field p)),
    rw [map_map, alg_hom.comp_algebra_map] at key,
    have hy := subtype.mem y,
    simp only [root_set, finset.mem_coe, multiset.mem_to_finset, key, multiset.mem_map] at hy,
    rcases hy with ⟨x, hx1, hx2⟩,
    exact ⟨⟨x, multiset.mem_to_finset.mpr hx1⟩, subtype.ext hx2⟩ }
end

/-- The bijection between `root_set p p.splitting_field` and `root_set p E`. -/
def roots_equiv_roots [fact (p.splits (algebra_map F E))] :
  (root_set p p.splitting_field) ≃ (root_set p E) :=
equiv.of_bijective (map_roots p E) (map_roots_bijective p E)

instance gal_action_aux : mul_action p.gal (root_set p p.splitting_field) :=
{ smul := λ ϕ x, ⟨ϕ x, begin
    have key := subtype.mem x,
    --simp only [root_set, finset.mem_coe, multiset.mem_to_finset] at *,
    by_cases p = 0,
    { simp only [h, root_set_zero] at key,
      exact false.rec _ key },
    { rw mem_root_set h,
      change aeval (ϕ.to_alg_hom x) p = 0,
      rw [aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩,
  one_smul := λ _, by { ext, refl },
  mul_smul := λ _ _ _, by { ext, refl } }

/-- The action of `gal p` on the roots of `p` in `E`. -/
instance gal_action [fact (p.splits (algebra_map F E))] : mul_action p.gal (root_set p E) :=
{ smul := λ ϕ x, roots_equiv_roots p E (ϕ • ((roots_equiv_roots p E).symm x)),
  one_smul := λ _, by simp only [equiv.apply_symm_apply, one_smul],
  mul_smul := λ _ _ _, by simp only [equiv.apply_symm_apply, equiv.symm_apply_apply, mul_smul] }

variables {p E}

/-- `polynomial.gal.restrict p E` is compatible with `polynomial.gal.gal_action p E`. -/
@[simp] lemma restrict_smul [fact (p.splits (algebra_map F E))]
  (ϕ : E ≃ₐ[F] E) (x : root_set p E) : ↑((restrict p E ϕ) • x) = ϕ x :=
begin
  let ψ := alg_equiv.of_injective_field (is_scalar_tower.to_alg_hom F p.splitting_field E),
  change ↑(ψ (ψ.symm _)) = ϕ x,
  rw alg_equiv.apply_symm_apply ψ,
  change ϕ (roots_equiv_roots p E ((roots_equiv_roots p E).symm x)) = ϕ x,
  rw equiv.apply_symm_apply (roots_equiv_roots p E),
end

variables (p E)

/-- `polynomial.gal.gal_action` as a permutation representation -/
def gal_action_hom [fact (p.splits (algebra_map F E))] : p.gal →* equiv.perm (root_set p E) :=
{ to_fun := λ ϕ, equiv.mk (λ x, ϕ • x) (λ x, ϕ⁻¹ • x)
  (λ x, inv_smul_smul ϕ x) (λ x, smul_inv_smul ϕ x),
  map_one' := by { ext1 x, exact mul_action.one_smul x },
  map_mul' := λ x y, by { ext1 z, exact mul_action.mul_smul x y z } }

lemma gal_action_hom_restrict [fact (p.splits (algebra_map F E))]
  (ϕ : E ≃ₐ[F] E) (x : root_set p E) : ↑(gal_action_hom p E (restrict p E ϕ) x) = ϕ x :=
restrict_smul ϕ x

/-- `gal p` embeds as a subgroup of permutations of the roots of `p` in `E`. -/
lemma gal_action_hom_injective [fact (p.splits (algebra_map F E))] :
  function.injective (gal_action_hom p E) :=
begin
  rw monoid_hom.injective_iff,
  intros ϕ hϕ,
  ext x hx,
  have key := equiv.perm.ext_iff.mp hϕ (roots_equiv_roots p E ⟨x, hx⟩),
  change roots_equiv_roots p E (ϕ • (roots_equiv_roots p E).symm
    (roots_equiv_roots p E ⟨x, hx⟩)) = roots_equiv_roots p E ⟨x, hx⟩ at key,
  rw equiv.symm_apply_apply at key,
  exact subtype.ext_iff.mp (equiv.injective (roots_equiv_roots p E) key),
end

end roots_action

variables {p q}

/-- `polynomial.gal.restrict`, when both fields are splitting fields of polynomials. -/
def restrict_dvd (hpq : p ∣ q) : q.gal →* p.gal :=
if hq : q = 0 then 1 else @restrict F _ p _ _ _
  ⟨splits_of_splits_of_dvd (algebra_map F q.splitting_field) hq (splitting_field.splits q) hpq⟩

lemma restrict_dvd_surjective (hpq : p ∣ q) (hq : q ≠ 0) :
  function.surjective (restrict_dvd hpq) :=
by simp only [restrict_dvd, dif_neg hq, restrict_surjective]

variables (p q)

/-- The Galois group of a product maps into the product of the Galois groups.  -/
def restrict_prod : (p * q).gal →* p.gal × q.gal :=
monoid_hom.prod (restrict_dvd (dvd_mul_right p q)) (restrict_dvd (dvd_mul_left q p))

/-- `polynomial.gal.restrict_prod` is actually a subgroup embedding. -/
lemma restrict_prod_injective : function.injective (restrict_prod p q) :=
begin
  by_cases hpq : (p * q) = 0,
  { haveI : unique (p * q).gal, { rw hpq, apply_instance },
    exact λ f g h, eq.trans (unique.eq_default f) (unique.eq_default g).symm },
  intros f g hfg,
  dsimp only [restrict_prod, restrict_dvd] at hfg,
  simp only [dif_neg hpq, monoid_hom.prod_apply, prod.mk.inj_iff] at hfg,
  ext x hx,
  rw [root_set, map_mul, polynomial.roots_mul] at hx,
  cases multiset.mem_add.mp (multiset.mem_to_finset.mp hx) with h h,
  { haveI : fact (p.splits (algebra_map F (p * q).splitting_field)) :=
      ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_right p q)⟩,
    have key : x = algebra_map (p.splitting_field) (p * q).splitting_field
      ((roots_equiv_roots p _).inv_fun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
      subtype.ext_iff.mp (equiv.apply_symm_apply (roots_equiv_roots p _) ⟨x, _⟩).symm,
    rw [key, ←alg_equiv.restrict_normal_commutes, ←alg_equiv.restrict_normal_commutes],
    exact congr_arg _ (alg_equiv.ext_iff.mp hfg.1 _) },
  { haveI : fact (q.splits (algebra_map F (p * q).splitting_field)) :=
      ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_left q p)⟩,
    have key : x = algebra_map (q.splitting_field) (p * q).splitting_field
      ((roots_equiv_roots q _).inv_fun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
      subtype.ext_iff.mp (equiv.apply_symm_apply (roots_equiv_roots q _) ⟨x, _⟩).symm,
    rw [key, ←alg_equiv.restrict_normal_commutes, ←alg_equiv.restrict_normal_commutes],
    exact congr_arg _ (alg_equiv.ext_iff.mp hfg.2 _) },
  { rwa [ne.def, mul_eq_zero, map_eq_zero, map_eq_zero, ←mul_eq_zero] }
end

/-- `p` splits in the splitting field of `p ∘ q`, for `q` non-constant. -/
lemma splits_in_splitting_field_of_comp (hq : q.nat_degree ≠ 0) :
  p.splits (algebra_map F (p.comp q).splitting_field) :=
begin
  let P : polynomial F → Prop := λ r, r.splits (algebra_map F (r.comp q).splitting_field),
  have key1 : ∀ {r : polynomial F}, irreducible r → P r,
  { intros r hr,
    by_cases hr' : nat_degree r = 0,
    { exact splits_of_nat_degree_le_one _ (le_trans (le_of_eq hr') zero_le_one) },
    obtain ⟨x, hx⟩ := exists_root_of_splits _ (splitting_field.splits (r.comp q))
      (λ h, hr' ((mul_eq_zero.mp (nat_degree_comp.symm.trans
        (nat_degree_eq_of_degree_eq_some h))).resolve_right hq)),
    rw [←aeval_def, aeval_comp] at hx,
    have h_normal : normal F (r.comp q).splitting_field := splitting_field.normal (r.comp q),
    have qx_int := normal.is_integral h_normal (aeval x q),
    exact splits_of_splits_of_dvd _
      (minpoly.ne_zero qx_int)
      (normal.splits h_normal _)
      ((minpoly.irreducible qx_int).dvd_symm hr (minpoly.dvd F _ hx)) },
  have key2 : ∀ {p₁ p₂ : polynomial F}, P p₁ → P p₂ → P (p₁ * p₂),
  { intros p₁ p₂ hp₁ hp₂,
    by_cases h₁ : p₁.comp q = 0,
    { cases comp_eq_zero_iff.mp h₁ with h h,
      { rw [h, zero_mul],
        exact splits_zero _ },
      { exact false.rec _ (hq (by rw [h.2, nat_degree_C])) } },
    by_cases h₂ : p₂.comp q = 0,
    { cases comp_eq_zero_iff.mp h₂ with h h,
      { rw [h, mul_zero],
        exact splits_zero _ },
      { exact false.rec _ (hq (by rw [h.2, nat_degree_C])) } },
    have key := mul_splits_in_splitting_field_of_mul h₁ h₂ hp₁ hp₂,
    rwa ← mul_comp at key },
  exact wf_dvd_monoid.induction_on_irreducible p (splits_zero _)
    (λ _, splits_of_is_unit _) (λ _ _ _ h, key2 (key1 h)),
end

/-- `polynomial.gal.restrict` for the composition of polynomials. -/
def restrict_comp (hq : q.nat_degree ≠ 0) : (p.comp q).gal →* p.gal :=
@restrict F _ p _ _ _ ⟨splits_in_splitting_field_of_comp p q hq⟩

lemma restrict_comp_surjective (hq : q.nat_degree ≠ 0) :
  function.surjective (restrict_comp p q hq) :=
by simp only [restrict_comp, restrict_surjective]

variables {p q}

/-- For a separable polynomial, its Galois group has cardinality
equal to the dimension of its splitting field over `F`. -/
lemma card_of_separable (hp : p.separable) :
  fintype.card p.gal = finrank F p.splitting_field :=
begin
  haveI : is_galois F p.splitting_field := is_galois.of_separable_splitting_field hp,
  exact is_galois.card_aut_eq_finrank F p.splitting_field,
end

lemma prime_degree_dvd_card [char_zero F] (p_irr : irreducible p) (p_deg : p.nat_degree.prime) :
  p.nat_degree ∣ fintype.card p.gal :=
begin
  rw gal.card_of_separable p_irr.separable,
  have hp : p.degree ≠ 0 :=
    λ h, nat.prime.ne_zero p_deg (nat_degree_eq_zero_iff_degree_le_zero.mpr (le_of_eq h)),
  let α : p.splitting_field := root_of_splits (algebra_map F p.splitting_field)
    (splitting_field.splits p) hp,
  have hα : is_integral F α :=
    (is_algebraic_iff_is_integral F).mp (algebra.is_algebraic_of_finite α),
  use finite_dimensional.finrank F⟮α⟯ p.splitting_field,
  suffices : (minpoly F α).nat_degree = p.nat_degree,
  { rw [←finite_dimensional.finrank_mul_finrank F F⟮α⟯ p.splitting_field,
        intermediate_field.adjoin.finrank hα, this] },
  suffices : minpoly F α ∣ p,
  { have key := (minpoly.irreducible hα).dvd_symm p_irr this,
    apply le_antisymm,
    { exact nat_degree_le_of_dvd this p_irr.ne_zero },
    { exact nat_degree_le_of_dvd key (minpoly.ne_zero hα) } },
  apply minpoly.dvd F α,
  rw [aeval_def, map_root_of_splits _ (splitting_field.splits p) hp],
end

section rationals

lemma splits_ℚ_ℂ {p : polynomial ℚ} : fact (p.splits (algebra_map ℚ ℂ)) :=
⟨is_alg_closed.splits_codomain p⟩

local attribute [instance] splits_ℚ_ℂ

/-- The number of complex roots equals the number of real roots plus
    the number of roots not fixed by complex conjugation (i.e. with some imaginary component). -/
lemma card_complex_roots_eq_card_real_add_card_not_gal_inv (p : polynomial ℚ) :
  (p.root_set ℂ).to_finset.card = (p.root_set ℝ).to_finset.card +
  (gal_action_hom p ℂ (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ))).support.card :=
begin
  by_cases hp : p = 0,
  { simp_rw [hp, root_set_zero, set.to_finset_eq_empty_iff.mpr rfl, finset.card_empty, zero_add],
    refine eq.symm (nat.le_zero_iff.mp ((finset.card_le_univ _).trans (le_of_eq _))),
    simp_rw [hp, root_set_zero, fintype.card_eq_zero_iff],
    apply_instance },
  have inj : function.injective (is_scalar_tower.to_alg_hom ℚ ℝ ℂ) := (algebra_map ℝ ℂ).injective,
  rw [←finset.card_image_of_injective _ subtype.coe_injective,
      ←finset.card_image_of_injective _ inj],
  let a : finset ℂ := _,
  let b : finset ℂ := _,
  let c : finset ℂ := _,
  change a.card = b.card + c.card,
  have ha : ∀ z : ℂ, z ∈ a ↔ aeval z p = 0 :=
  λ z, by rw [set.mem_to_finset, mem_root_set hp],
  have hb : ∀ z : ℂ, z ∈ b ↔ aeval z p = 0 ∧ z.im = 0,
  { intro z,
    simp_rw [finset.mem_image, exists_prop, set.mem_to_finset, mem_root_set hp],
    split,
    { rintros ⟨w, hw, rfl⟩,
      exact ⟨by rw [aeval_alg_hom_apply, hw, alg_hom.map_zero], rfl⟩ },
    { rintros ⟨hz1, hz2⟩,
      have key : is_scalar_tower.to_alg_hom ℚ ℝ ℂ z.re = z := by { ext, refl, rw hz2, refl },
      exact ⟨z.re, inj (by rwa [←aeval_alg_hom_apply, key, alg_hom.map_zero]), key⟩ } },
  have hc0 : ∀ w : p.root_set ℂ, gal_action_hom p ℂ
    (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ)) w = w ↔ w.val.im = 0,
  { intro w,
    rw [subtype.ext_iff, gal_action_hom_restrict],
    exact complex.eq_conj_iff_im },
  have hc : ∀ z : ℂ, z ∈ c ↔ aeval z p = 0 ∧ z.im ≠ 0,
  { intro z,
    simp_rw [finset.mem_image, exists_prop],
    split,
    { rintros ⟨w, hw, rfl⟩,
      exact ⟨(mem_root_set hp).mp w.2, mt (hc0 w).mpr (equiv.perm.mem_support.mp hw)⟩ },
    { rintros ⟨hz1, hz2⟩,
      exact ⟨⟨z, (mem_root_set hp).mpr hz1⟩,
        equiv.perm.mem_support.mpr (mt (hc0 _).mp hz2), rfl⟩ } },
  rw ← finset.card_disjoint_union,
  { apply congr_arg finset.card,
    simp_rw [finset.ext_iff, finset.mem_union, ha, hb, hc],
    tauto },
  { intro z,
    rw [finset.inf_eq_inter, finset.mem_inter, hb, hc],
    tauto },
  { apply_instance },
end

/-- An irreducible polynomial of prime degree with two non-real roots has full Galois group. -/
lemma gal_action_hom_bijective_of_prime_degree
  {p : polynomial ℚ} (p_irr : irreducible p) (p_deg : p.nat_degree.prime)
  (p_roots : fintype.card (p.root_set ℂ) = fintype.card (p.root_set ℝ) + 2) :
  function.bijective (gal_action_hom p ℂ) :=
begin
  have h1 : fintype.card (p.root_set ℂ) = p.nat_degree,
  { simp_rw [root_set_def, finset.coe_sort_coe, fintype.card_coe],
    rw [multiset.to_finset_card_of_nodup, ←nat_degree_eq_card_roots],
    { exact is_alg_closed.splits_codomain p },
    { exact nodup_roots ((separable_map (algebra_map ℚ ℂ)).mpr p_irr.separable) } },
  have h2 : fintype.card p.gal = fintype.card (gal_action_hom p ℂ).range :=
  fintype.card_congr (monoid_hom.of_injective (gal_action_hom_injective p ℂ)).to_equiv,
  let conj := restrict p ℂ (complex.conj_ae.restrict_scalars ℚ),
  refine ⟨gal_action_hom_injective p ℂ, λ x, (congr_arg (has_mem.mem x)
    (show (gal_action_hom p ℂ).range = ⊤, from _)).mpr (subgroup.mem_top x)⟩,
  apply equiv.perm.subgroup_eq_top_of_swap_mem,
  { rwa h1 },
  { rw h1,
    convert prime_degree_dvd_card p_irr p_deg using 1,
    convert h2.symm },
  { exact ⟨conj, rfl⟩ },
  { rw ← equiv.perm.card_support_eq_two,
    apply nat.add_left_cancel,
    rw [←p_roots, ←set.to_finset_card (root_set p ℝ), ←set.to_finset_card (root_set p ℂ)],
    exact (card_complex_roots_eq_card_real_add_card_not_gal_inv p).symm },
end

/-- An irreducible polynomial of prime degree with 1-3 non-real roots has full Galois group. -/
lemma gal_action_hom_bijective_of_prime_degree'
  {p : polynomial ℚ} (p_irr : irreducible p) (p_deg : p.nat_degree.prime)
  (p_roots1 : fintype.card (p.root_set ℝ) + 1 ≤ fintype.card (p.root_set ℂ))
  (p_roots2 : fintype.card (p.root_set ℂ) ≤ fintype.card (p.root_set ℝ) + 3) :
  function.bijective (gal_action_hom p ℂ) :=
begin
  apply gal_action_hom_bijective_of_prime_degree p_irr p_deg,
  let n := (gal_action_hom p ℂ (restrict p ℂ
    (complex.conj_ae.restrict_scalars ℚ))).support.card,
  have hn : 2 ∣ n :=
  equiv.perm.two_dvd_card_support (by rw [←monoid_hom.map_pow, ←monoid_hom.map_pow,
    show alg_equiv.restrict_scalars ℚ complex.conj_ae ^ 2 = 1,
    from alg_equiv.ext complex.conj_conj, monoid_hom.map_one, monoid_hom.map_one]),
  have key := card_complex_roots_eq_card_real_add_card_not_gal_inv p,
  simp_rw [set.to_finset_card] at key,
  rw [key, add_le_add_iff_left] at p_roots1 p_roots2,
  rw [key, add_right_inj],
  suffices : ∀ m : ℕ, 2 ∣ m → 1 ≤ m → m ≤ 3 → m = 2,
  { exact this n hn p_roots1 p_roots2 },
  rintros m ⟨k, rfl⟩ h2 h3,
  exact le_antisymm (nat.lt_succ_iff.mp (lt_of_le_of_ne h3 (show 2 * k ≠ 2 * 1 + 1,
    from nat.two_mul_ne_two_mul_add_one))) (nat.succ_le_iff.mpr (lt_of_le_of_ne h2
    (show 2 * 0 + 1 ≠ 2 * k, from nat.two_mul_ne_two_mul_add_one.symm))),
end

end rationals

end gal

end polynomial


-- La identidad es biyectiva
-- =========================

import tactic

open function

variables {X : Type}

-- #print injective
-- #print surjective
-- #print bijective

-- ----------------------------------------------------
-- Ej. 1. Demostrar que la identidad es inyectiva.
-- ----------------------------------------------------

-- 1ª demostración
example : injective (@id X) :=
begin
  intros x₁ x₂ h,
  exact h,
end

-- 2ª demostración
example : injective (@id X) :=
λ x₁ x₂ h, h

-- 3ª demostración
example : injective (@id X) :=
λ x₁ x₂, id

-- 4ª demostración
example : injective (@id X) :=
assume x₁ x₂,
assume h : id x₁ = id x₂,
show x₁ = x₂, from h

-- 5ª demostración
example : injective (@id X) :=
--by library_search
injective_id

-- 6ª demostración
example : injective (@id X) :=
-- by hint
by tauto

-- 7ª demostración
example : injective (@id X) :=
-- by hint
by finish

-- ----------------------------------------------------
-- Ej. 2. Demostrar que la identidad es suprayectiva.
-- ----------------------------------------------------

-- 1ª demostración
example : surjective (@id X) :=
begin
  intro x,
  use x,
  exact rfl,
end

-- 2ª demostración
example : surjective (@id X) :=
begin
  intro x,
  exact ⟨x, rfl⟩,
end

-- 3ª demostración
example : surjective (@id X) :=
λ x, ⟨x, rfl⟩

-- 4ª demostración
example : surjective (@id X) :=
assume y,
show ∃ x, id x = y, from exists.intro y rfl

-- 5ª demostración
example : surjective (@id X) :=
-- by library_search
surjective_id

-- 6ª demostración
example : surjective (@id X) :=
-- by hint
by tauto

-- ----------------------------------------------------
-- Ej. 3. Demostrar que la identidad es biyectiva.
-- ----------------------------------------------------

-- 1ª demostración
example : bijective (@id X) :=
and.intro injective_id surjective_id

-- 2ª demostración
example : bijective (@id X) :=
⟨injective_id, surjective_id⟩

-- 3ª demostración
example : bijective (@id X) :=
-- by library_search
bijective_id


import data.real.basic
import data.set.intervals.basic

/-
(from http://www.mit.edu/~erst/puzzles/)

Q. Can the unit square [0, 1] x [0, 1] be colored with three colors so that any
pair of points with the same color have a distance between them of at most one?

A. No.

-/

def unit_square := set.Icc (0 : ℝ) (1 : ℝ) × set.Icc (0 : ℝ) (1 : ℝ)

def within_distance_one (p1 p2 : unit_square) : Prop :=
(p1.fst.val - p2.fst.val) ^ 2 + (p1.snd.val - p2.snd.val) ^ 2 ≤ 1

lemma composition_preserves_coloring_property
   (f : unit_square → fin 3)
   (g : fin 3 → fin 3)
   (h : ∀ p₁ p₂ : unit_square, g (f p₁) = g (f p₂) → within_distance_one p₁ p₂) :
   ∀ p₁ p₂ : unit_square, f p₁ = f p₂ → within_distance_one p₁ p₂ :=
begin
  intros p1 p2 hfp,
  exact h p1 p2 (congr_arg g hfp),
end

theorem square_three_coloring
  (f : unit_square → fin 3)
  (h : ∀ p₁ p₂ : unit_square, f p₁ = f p₂ → within_distance_one p₁ p₂)
  : false :=
begin
  -- It suffices to consider just the boundary of the square...
  sorry
end


import data.fintype.basic
import data.set
import data.finset
import tactic

noncomputable theory
localized "attribute [instance, priority 100000] classical.prop_decidable
  noncomputable theory" in classical
open_locale classical
open finset

universes u
variables {γ : Type u}

def size (X : finset γ) := (coe X.card : ℤ)
def type_size (γ : Type u) [fintype γ] := (coe (fintype.card γ) : ℤ)

lemma size_empty : size (∅:finset γ) = 0 :=
begin
    unfold size, simp,
end
lemma size_le_of_subset {s t: finset γ} (h : s ⊆ t) : size(s) ≤ size(t) :=
begin
    unfold size, simp, exact card_le_of_subset h
end
lemma size_sdiff {s t : finset γ} (h : s ⊆ t) : size (t \ s) = size t - size s :=
begin
    sorry,
end
lemma size_modular (s t : finset γ) : size s + size t = size (s ∪ t) + size (s ∩ t) :=
begin
    sorry,
end
@[simp] lemma size_map {α β} (f : α ↪ β) {s : finset α} : size (s.map f) = size s :=
begin
    simp,
end
lemma size_compl [decidable_eq γ] [fintype γ] (s : finset γ) :
  size(sᶜ) = type_size γ - size s :=
begin
    sorry
end


-- topological spaces from first princples!

-- Turns out there's quite a lot to it, but it's all straightforward

-- I'll start on the hour. I'll do a brief review of last week
-- (the below file,
-- https://github.com/ImperialCollegeLondon/Example-Lean-Projects/blob/master/src/topology/twitch.lean
-- and then I'll start on the proof that the continuous image of compact is compact.

import tactic

-- remember : in Lean, `set X` means the type of subsets of X
-- or, the type of "sets of elements of X"

open set

/-- The definition of a topological space -/
class topological_space (X : Type) :=
 -- some subsets of X are called "open sets"
(is_open : set X → Prop)
 -- X itself is open
(is_open_univ : is_open univ)
 -- intersection of two open sets is open
(is_open_inter : ∀ U V : set X, is_open U → is_open V → is_open (U ∩ V))
-- arbitrary union of open sets is open
(is_open_sUnion : ∀ (𝒞 : set (set X)), (∀ U ∈ 𝒞, is_open U) → is_open (⋃₀ 𝒞))

-- what is an "arbitrary union of open sets"?
-- I've set it up as a set of open sets
-- but you might have an "indexed family of open sets"
-- ie some type ι, and for all  i ∈ ι an open set U_i
-- and you want ⋃ U_i open

namespace topological_space

-- let X be a topological space

variables {X : Type} [topological_space X]

-- let's do indexed unions

lemma is_open_Union {ι : Type} {f : ι → set X} (hf : ∀ i : ι, is_open (f i)) :
  is_open (⋃ i, f i) :=
begin
  apply is_open_sUnion,
  intros U hU,
  cases hU with i hi,
  dsimp at hi,
  rw ←hi,
  apply hf,
end

-- empty set is open
lemma is_open_empty : is_open (∅ : set X) :=
begin
  let 𝒞 : set (set X) := ∅,
  have h𝒞 : ∀ U ∈ 𝒞, is_open U,
  { rintro U ⟨⟩,
  },
  convert is_open_sUnion 𝒞 h𝒞,
  rw sUnion_empty,
end

-- finite intersection of open sets is open
-- proof by induction on size of finite set
lemma is_open_sInter {𝒞 : set (set X)} (h𝒞 : finite 𝒞) :
  (∀ U ∈ 𝒞, is_open U) → is_open ⋂₀ 𝒞 :=
begin
  apply finite.induction_on h𝒞,
  { -- base case,
    intros,
    convert is_open_univ,
    rw sInter_empty },
  { -- inductive step
    -- going to use is_open_inter
    intro U,
    intro 𝒞,
    intro hU𝒞,
    intro h𝒞,
    intro h𝒞2,
    -- h says "assume both U and every element of 𝒞 is open"
    -- insert U 𝒞 means {U} ∪ 𝒞
    intro h,
    rw sInter_insert,
    apply is_open_inter,
    { apply h,
      simp },
    { apply h𝒞2,
      intros U hU,
      apply h,
      simp [hU] }},
end

-- a variant of finite intersection of opens is open
lemma is_open_bInter {I : Type} {F : set I} (hf : finite F)
  (U : I → set X) (hU : ∀ (i : I), is_open (U i)) :
  is_open (⋂ i ∈ F, U i) :=
begin
  rw bInter_eq_Inter,
  show is_open (⋂₀ set.range (λ x : F, U x)),
  apply is_open_sInter,
  { rw ←image_univ,
    apply finite.image,
    haveI := classical.choice hf,
    apply finite_univ },
  finish,
end

def is_closed (C : set X) : Prop := is_open Cᶜ

@[simp] lemma is_closed_iff (C : set X) : is_closed C ↔ is_open Cᶜ := iff.rfl

-- clearly could spend all day proving facts about closed sets now

lemma is_closed_empty : is_closed (∅ : set X) :=
begin
  simp [is_open_univ],
end

end topological_space

-- next : continuous functions

open topological_space

variables {X : Type} [topological_space X]
  {Y : Type} [topological_space Y]

/-- a function X → Y between topological spaces is continuous if the
  preimage of every open set is open -/
def continuous (f : X → Y) : Prop :=
∀ U, is_open U → is_open (f⁻¹' U)

theorem continuous_id : continuous (id : X → X) :=
begin
  intro U,
  intro hU,
  -- interesting question
  -- clearly id⁻¹' U = U
  -- But this is true *by definition*?
  -- another interesting question
  -- clearly id'' U = U (pushforward)
  -- but is this true *by definition*?
  -- THESE QUESTIONS ARE NOT MATHEMATICAL QUESTIONS
  -- They depend not on the specification, but on the *implementation*
--   have h1 : U = id '' U,
--   { --refl, -- fails!
--     -- not true by definition
--     ext x,
--     split,
--       intro h,
--       unfold set.image,
--       use x, -- this is why it's not true by definition
--       split, assumption, refl,
--       rintro ⟨y, hy1, rfl⟩,
--       exact hy1,
--   },
--   have h2 : U = id⁻¹' U, -- true by definition
--     refl,
  exact hU,
end

variables {Z : Type} [topological_space Z]

theorem continuous.comp {f : X → Y} {g : Y → Z} (hf : continuous f)
  (hg : continuous g) : continuous (g ∘ f) :=
begin
  intro U,
  intro hU,
  change is_open ((g ∘ f)⁻¹' U),
  change is_open (f⁻¹' (g⁻¹' U)),
  -- proving it backwards
  apply hf,
  apply hg,
  exact hU
end

-- term mode proof (same proof!)
theorem continuous.comp' {f : X → Y} {g : Y → Z} (hf : continuous f)
  (hg : continuous g) : continuous (g ∘ f) :=
λ U hU, hf (g⁻¹' U) (hg _ hU)

/-- a subset C of a top space X is compact if every open cover has a finite subcover -/
def compact (C : set X) : Prop :=
  ∀ (ι : Type) (U : ι → set X) (hi : ∀ i : ι, is_open (U i)) (hC : C ⊆ ⋃i, U i),
  ∃ F : set ι, finite F ∧ C ⊆ ⋃ i ∈ F, U i

-- this definition seems to me to be easier to work with

def hausdorff (X : Type) [topological_space X] : Prop :=
∀ x y : X, x ≠ y → ∃ U V : set X, is_open U ∧ is_open V ∧ x ∈ U ∧ y ∈ V ∧ U ∩ V = ∅

-- Theorem: continuous image of a compact set is compact
theorem compact_map {f : X → Y} (hf : continuous f) {C : set X} (hC : compact C) :
  compact (f '' C) :=
begin
  -- suffices to prove that if f(C) is covered by open sets, it has a
  -- finite subcover
  intros I U hU hUC,
  -- hUC : f(C) ⊆ ⋃_{i ∈ I} Uᵢ
  -- So say we've covered f(C) by open sets
  -- Then C has a cover by open sets, namely Vᵢ := f⁻¹(Uᵢ),
  let V : I → set X := λ i, f⁻¹' (U i),
  -- Let's check that all the Vᵢ are open
  have hV : ∀ i : I, is_open (V i),
  { intro i,
    apply hf,
    apply hU },
  -- Let's check that the Vᵢ cover C
  have hVC : C ⊆ ⋃ i, V i,
  { -- say x ∈ C,
    intro x,
    intro hx,
    -- then f(x) ∈ ⋃_i Uᵢ
    have hx2 : f x ∈ ⋃ i, U i,
      apply hUC,
      use [x, hx],
    -- f(x) ∈ ⋃_i Uᵢ, so ∃ i s.t. f(x) ∈ Uᵢ
    rw mem_Union at hx2 ⊢,
    cases hx2 with i hi,
    use i,
    exact hi },
  -- but C is compact
  specialize hC I V hV hVC,
  -- so there exists a finite subcover of Vᵢ,
  rcases hC with ⟨F, hF, hFC⟩,
  -- I claim that corresponding Uᵢ will work
  use [F, hF],
  -- Let's check they cover f(C),
  rintros _ ⟨x, hx1, rfl⟩,
  specialize hFC hx1,
  rw mem_bUnion_iff at hFC ⊢,
  exact hFC,
  -- They do, so the cover of f(C) had a finite subcover :D
end

-- To prove that a compact subspace of a Hausdorff space is closed,
-- we need the fact that a "locally open" set is open!

-- So let's prove that first

lemma open_iff_locally_open (V : set X) :
  is_open V ↔ ∀ x : X, x ∈ V → ∃ U : set X, x ∈ U ∧ is_open U ∧ U ⊆ V :=
⟨λ hV x hx, ⟨V, hx, hV, subset.refl _⟩, λ h, begin
  let 𝒞 : set (set X) := {U : set X | is_open U ∧ U ⊆ V},
    -- 𝒞 doesn't just contain the neighbourhoods of x for each x ∈ V
    -- 𝒞 contains more sets, e.g. the empty set!
    -- Clearly every set in 𝒞 is open, so their union is open
    convert is_open_sUnion 𝒞 _,
    swap,
    { intros U H, cases H, assumption},
    -- It suffices to prove that V is the union of the elements of 𝒞
    { ext x,
      split,
      -- let's prove inclusions in both directions
      { intro hx,
        rcases h x hx with ⟨U, hU1, hU2, hU3⟩,
        rw mem_sUnion,
        use U,
        use hU2,
        exact hU3,
        exact hU1 },
      { -- easy way
        intro hx,
        rw mem_sUnion at hx,
        rcases hx with ⟨U, hUC, hxU⟩,
        cases hUC with h1 h2,
        apply h2 hxU }}
end⟩
-- #exit
-- begin
--   split,
--   { -- This way is easy. Say V is open.
--     intro hV,
--     -- say x ∈ V
--     intros x hx,
--     -- Want an open neighbourhood of x contained in V
--     -- let's just use V :-)
--     use V,
--     use hx,
--     use hV }, -- last goal V ⊆ V closed automatically by `refl`,
--   { intro h,
--     -- Reid Barton trick!
--     let 𝒞 : set (set X) := {U : set X | is_open U ∧ U ⊆ V},
--     -- 𝒞 doesn't just contain the neighbourhoods of x for each x ∈ V
--     -- 𝒞 contains more sets, e.g. the empty set!
--     -- Clearly every set in 𝒞 is open, so their union is open
--     convert is_open_sUnion 𝒞 _,
--     swap,
--     { tidy },
--     -- It suffices to prove that V is the union of the elements of 𝒞
--     { ext x,
--       split,
--       -- let's prove inclusions in both directions
--       { intro hx,
--         rcases h x hx with ⟨U, hU1, hU2, hU3⟩,
--         rw mem_sUnion,
--         use U,
--         use hU2,
--         exact hU3,
--         exact hU1 },
--       { -- easy way
--         intro hx,
--         rw mem_sUnion at hx,
--         rcases hx with ⟨U, hUC, hxU⟩,
--         cases hUC with h1 h2,
--         apply h2 hxU }}}
-- end

-- stream starts at 10am UK time (UTC+2)

-- Goal today

theorem is_closed_of_compact (hX : hausdorff X) {C : set X} (hC : compact C) : is_closed C :=
begin
  unfold is_closed,
  -- let's start with the maths proof
  -- We're going to prove that Cᶜ is open by showing it's locally open
  -- Let x ∈ Cᶜ i.e. x : X and x ∉ C
  -- If we can find an open subset U ⊆ Cᶜ with x ∈ U then we're done
  -- by the previous lemma
  rw open_iff_locally_open,
  intros x hx,
  rw mem_compl_iff at hx,
  -- Where do we find such U?
  -- Now is where we use compactness.
  -- We're going to cover C by a bunch of open sets
  -- Where do we get the open sets?
  -- We get them from Hausdorffness
  -- Let's regard x as fixed.
  -- Say y ∈ C (y is moving)
  -- Then x ≠ y because x ∉ C
  -- so by Hausdorff there exists opens U=U(y) and V=V(y)
  -- disjoint, with x ∈ V and y ∈ U
  -- In particular x ∉ U = U(y)
  -- The union of the U(y) covers C because y ∈ C was arbitrary and y ∈ U(y)
  -- So there's a finite subcover, U(y₁), U(y₂)...U(yₙ) of C
  -- Now take the intersection of the corresponding V(y)'s
  -- this is an open nhd of x
  -- and it's disjoint from the union of the U(y)'s so it's disjoint from C
  -- This V works!

  -- "issue" with the maths proof -- uses the axiom of choice!
  -- Grateful to Reid Barton and Andrej Bauer who independently showed
  -- me a "AC removal principle" -- which makes proofs look (a) a bit slicker
  -- and (b) a bit harder to remember (possibly).

  -- AC removal principle says "DON'T CHOOSE! USE ALL THE CHOICES!"

  -- in our actual proof we'll define a slightly different cover

  -- I is the set of pairs (V,U) of open subsets of X, with
  -- x ∈ V, and U ∩ V empty
  let I := {VU : set X × set X //
    x ∈ VU.1 ∧ is_open VU.1 ∧ is_open VU.2 ∧ VU.1 ∩ VU.2 = ∅},
  -- We want to consider all the U's coming from pairs (V,U) in I
  let U : I → set X := λ VUH, VUH.1.2, -- send (V,U) to U
  -- My claim is that as i ranges through I, the U(i) are an open cover
  -- Let's first prove they're all open
  have hU1 : ∀ i : I, is_open (U i),
  { rintro ⟨⟨V, U⟩, _, _, h, _⟩,
    exact h },
  -- now let's prove they cover C
  have hU2 : C ⊆ ⋃ i, U i,
  { intros y hy,
    /-
    def hausdorff (X : Type) [topological_space X] : Prop :=
    ∀ x y : X, x ≠ y → ∃ U V : set X, is_open U ∧ is_open V ∧ x ∈ U ∧ y ∈ V ∧ U ∩ V = ∅
    -/
    have hxy : x ≠ y,
    { rintro rfl,
      contradiction },
    -- now use that X is Hausdorff
    rcases hX x y hxy with ⟨V, U, hV, hU, hxV, hyU, hUV⟩,
    rw mem_Union,
    -- now let's give the term of type I
    use ⟨(V, U), ⟨hxV, hV, hU, hUV⟩⟩,
    exact hyU },
  /-
  def compact (C : set X) : Prop :=
  ∀ (ι : Type) (U : ι → set X) (hi : ∀ i : ι, is_open (U i)) (hC : C ⊆ ⋃i, U i),
  ∃ F : set ι, finite F ∧ C ⊆ ⋃ i ∈ F, U i
  -/
  specialize hC I U hU1 hU2,
  rcases hC with ⟨F, hF, hFC⟩,
  -- now we have our finite subcover
  -- now let's create the open nhd of x
  let W := ⋂ i ∈ F, (i : I).1.1,
  use W,
  refine ⟨_, _, _⟩,
  { show x ∈ ⋂ (i : I) (H : i ∈ F), i.val.fst,
    rw mem_bInter_iff,
    rintro ⟨⟨V, U⟩, hxV, hV, hU, hUV⟩,
    intro hi,
    use hxV },
  { -- we're missing a lemma here
    -- need a different kind of "finite intersection of opens is open"
    show is_open (⋂ (i : I) (H : i ∈ F), i.val.fst),
    apply is_open_bInter hF,
    rintro ⟨⟨V, U⟩, hxV, hV, hU, hUV⟩,
    exact hV,
  },
  { rw subset_compl_comm,
    rw compl_Inter,
    refine set.subset.trans hFC _,
    apply Union_subset_Union,
    intro i,
    rw compl_Inter,
    apply Union_subset_Union,
    rintro hi,
    rcases i with ⟨⟨V, U⟩, hxV, hV, hU, hUV⟩,
    show U ⊆ Vᶜ,
    rw subset_compl_iff_disjoint,
    rw inter_comm,
    exact hUV },
end


-- new import
import algebra.punit_instances

-- That import is a bunch of structure on the type `unit`.
-- This type just has one term, called punit.star, although
-- we prefer to use the notation ()

example : unit := ()

-- **IMPORTANT NOTE**: I propose we change the definition
-- of G_module, based on comments at
-- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/more.20type.20class.20inference.20issues/near/167024793
class G_module (G : Type*) [group G] (M : Type*) [add_comm_group M]
  extends has_scalar G M :=
(id : ∀ m : M, (1 : G) • m = m)
(mul : ∀ g h : G, ∀ m : M, g • (h • m) = (g * h) • m)
(linear : ∀ g : G, ∀ m n : M, g • (m + n) = g • m + g • n)

-- So now we want to make unit a G-module.
-- By the definition of G_module, we first need to make
-- sure that unit is an add_comm_group, and that there is a scalar
-- multiplication of G on unit.

-- Put in a more computer science way, we need to make
-- sure that Lean's type class inference system can
-- find terms of type `add_comm_group unit` and `has_scalar G unit`.

-- The import algebra.punit_instances gives the add_comm_group instance.
example : add_comm_group unit := by apply_instance

-- But nobody wrote has_scalar G unit, so we have to write it ourselves.

-- has_scalar is a class, so the definition should be an instance.
instance (G : Type*) [group G] : has_scalar G unit :=
{ smul := λ g u, u }

-- using instances means that typeclass inference will work for us.

example (G : Type*) [group G] : has_scalar G unit := by apply_instance

-- That works. The `apply_instance` tactic shows us that "[]" will work
-- if we need a term of type `has_scalar G unit`.

-- Now the structure of a G-module on unit:
instance (G : Type*) [group G] : G_module G unit :=
by refine { id := λ _, rfl,
  mul := λ _ _ _, rfl,
  linear := λ _ _ _, rfl}; apply_instance

-- Anca -- this now means that `unit` has the structure of a G_module.
-- You could factor this file out into a file called something
-- like unit_G_module.lean and just import it when you need it.
-- You should be able to now prove things like unit -> A -> B is exact
-- iff A -> B is injective. Before you do that, you'll need results
-- such as that the map from unit to A sending () to 0 is an add_group_hom,
-- and I guess the crucial thing you'll need is that a group hom A -> B is
-- injective if and only if its kernel is {0}. This is in mathlib;
-- it's called inj_iff_trivial_ker. You should learn how to use the
-- search tool (the magnifying glass in the column on the left) to
-- find where it is.


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

! This file was ported from Lean 3 source module computability.regular_expressions
! leanprover-community/mathlib commit a239cd3e7ac2c7cde36c913808f9d40c411344f6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Rcases
import Mathbin.Computability.Language

/-!
# Regular Expressions

This file contains the formal definition for regular expressions and basic lemmas. Note these are
regular expressions in terms of formal language theory. Note this is different to regex's used in
computer science such as the POSIX standard.

## TODO

* Show that this regular expressions and DFA/NFA's are equivalent.
* `attribute [pattern] has_mul.mul` has been added into this file, it could be moved.
-/

open List Set

open Computability

universe u

variable {α β γ : Type _} [dec : DecidableEq α]

/-- This is the definition of regular expressions. The names used here is to mirror the definition
of a Kleene algebra (https://en.wikipedia.org/wiki/Kleene_algebra).
* `0` (`zero`) matches nothing
* `1` (`epsilon`) matches only the empty string
* `char a` matches only the string 'a'
* `star P` matches any finite concatenation of strings which match `P`
* `P + Q` (`plus P Q`) matches anything which match `P` or `Q`
* `P * Q` (`comp P Q`) matches `x ++ y` if `x` matches `P` and `y` matches `Q`
-/
inductive RegularExpression (α : Type u) : Type u
  | zero : RegularExpression
  | epsilon : RegularExpression
  | Char : α → RegularExpression
  | plus : RegularExpression → RegularExpression → RegularExpression
  | comp : RegularExpression → RegularExpression → RegularExpression
  | star : RegularExpression → RegularExpression
#align regular_expression RegularExpression

namespace RegularExpression

variable {a b : α}

instance : Inhabited (RegularExpression α) :=
  ⟨zero⟩

instance : Add (RegularExpression α) :=
  ⟨plus⟩

instance : Mul (RegularExpression α) :=
  ⟨comp⟩

instance : One (RegularExpression α) :=
  ⟨epsilon⟩

instance : Zero (RegularExpression α) :=
  ⟨zero⟩

instance : Pow (RegularExpression α) ℕ :=
  ⟨fun n r => npowRec r n⟩

attribute [match_pattern] Mul.mul

@[simp]
theorem zero_def : (zero : RegularExpression α) = 0 :=
  rfl
#align regular_expression.zero_def RegularExpression.zero_def

@[simp]
theorem one_def : (epsilon : RegularExpression α) = 1 :=
  rfl
#align regular_expression.one_def RegularExpression.one_def

@[simp]
theorem plus_def (P Q : RegularExpression α) : plus P Q = P + Q :=
  rfl
#align regular_expression.plus_def RegularExpression.plus_def

@[simp]
theorem comp_def (P Q : RegularExpression α) : comp P Q = P * Q :=
  rfl
#align regular_expression.comp_def RegularExpression.comp_def

/-- `matches P` provides a language which contains all strings that `P` matches -/
@[simp]
def matches : RegularExpression α → Language α
  | 0 => 0
  | 1 => 1
  | Char a => {[a]}
  | P + Q => P.matches + Q.matches
  | P * Q => P.matches * Q.matches
  | star P => P.matches∗
#align regular_expression.matches RegularExpression.matches

@[simp]
theorem matches_zero : (0 : RegularExpression α).matches = 0 :=
  rfl
#align regular_expression.matches_zero RegularExpression.matches_zero

@[simp]
theorem matches_epsilon : (1 : RegularExpression α).matches = 1 :=
  rfl
#align regular_expression.matches_epsilon RegularExpression.matches_epsilon

@[simp]
theorem matches_char (a : α) : (char a).matches = {[a]} :=
  rfl
#align regular_expression.matches_char RegularExpression.matches_char

@[simp]
theorem matches_add (P Q : RegularExpression α) : (P + Q).matches = P.matches + Q.matches :=
  rfl
#align regular_expression.matches_add RegularExpression.matches_add

@[simp]
theorem matches_mul (P Q : RegularExpression α) : (P * Q).matches = P.matches * Q.matches :=
  rfl
#align regular_expression.matches_mul RegularExpression.matches_mul

@[simp]
theorem matches_pow (P : RegularExpression α) : ∀ n : ℕ, (P ^ n).matches = P.matches ^ n
  | 0 => matches_epsilon
  | n + 1 => (matches_mul _ _).trans <| Eq.trans (congr_arg _ (matches_pow n)) (pow_succ _ _).symm
#align regular_expression.matches_pow RegularExpression.matches_pow

@[simp]
theorem matches_star (P : RegularExpression α) : P.unit.matches = P.matches∗ :=
  rfl
#align regular_expression.matches_star RegularExpression.matches_star

/-- `match_epsilon P` is true if and only if `P` matches the empty string -/
def matchEpsilon : RegularExpression α → Bool
  | 0 => false
  | 1 => true
  | Char _ => false
  | P + Q => P.matchEpsilon || Q.matchEpsilon
  | P * Q => P.matchEpsilon && Q.matchEpsilon
  | star P => true
#align regular_expression.match_epsilon RegularExpression.matchEpsilon

include dec

/-- `P.deriv a` matches `x` if `P` matches `a :: x`, the Brzozowski derivative of `P` with respect
  to `a` -/
def deriv : RegularExpression α → α → RegularExpression α
  | 0, _ => 0
  | 1, _ => 0
  | Char a₁, a₂ => if a₁ = a₂ then 1 else 0
  | P + Q, a => deriv P a + deriv Q a
  | P * Q, a => if P.matchEpsilon then deriv P a * Q + deriv Q a else deriv P a * Q
  | star P, a => deriv P a * star P
#align regular_expression.deriv RegularExpression.deriv

@[simp]
theorem deriv_zero (a : α) : deriv 0 a = 0 :=
  rfl
#align regular_expression.deriv_zero RegularExpression.deriv_zero

@[simp]
theorem deriv_one (a : α) : deriv 1 a = 0 :=
  rfl
#align regular_expression.deriv_one RegularExpression.deriv_one

@[simp]
theorem deriv_char_self (a : α) : deriv (char a) a = 1 :=
  if_pos rfl
#align regular_expression.deriv_char_self RegularExpression.deriv_char_self

@[simp]
theorem deriv_char_of_ne (h : a ≠ b) : deriv (char a) b = 0 :=
  if_neg h
#align regular_expression.deriv_char_of_ne RegularExpression.deriv_char_of_ne

@[simp]
theorem deriv_add (P Q : RegularExpression α) (a : α) : deriv (P + Q) a = deriv P a + deriv Q a :=
  rfl
#align regular_expression.deriv_add RegularExpression.deriv_add

@[simp]
theorem deriv_star (P : RegularExpression α) (a : α) : deriv P.unit a = deriv P a * star P :=
  rfl
#align regular_expression.deriv_star RegularExpression.deriv_star

/-- `P.rmatch x` is true if and only if `P` matches `x`. This is a computable definition equivalent
  to `matches`. -/
def rmatch : RegularExpression α → List α → Bool
  | P, [] => matchEpsilon P
  | P, a :: as => rmatch (P.deriv a) as
#align regular_expression.rmatch RegularExpression.rmatch

@[simp]
theorem zero_rmatch (x : List α) : rmatch 0 x = false := by
  induction x <;> simp [rmatch, match_epsilon, *]
#align regular_expression.zero_rmatch RegularExpression.zero_rmatch

theorem one_rmatch_iff (x : List α) : rmatch 1 x ↔ x = [] := by
  induction x <;> simp [rmatch, match_epsilon, *]
#align regular_expression.one_rmatch_iff RegularExpression.one_rmatch_iff

theorem char_rmatch_iff (a : α) (x : List α) : rmatch (char a) x ↔ x = [a] :=
  by
  cases' x with _ x
  decide
  cases x
  rw [rmatch, deriv]
  split_ifs <;> tauto
  rw [rmatch, deriv]
  split_ifs
  rw [one_rmatch_iff]
  tauto
  rw [zero_rmatch]
  tauto
#align regular_expression.char_rmatch_iff RegularExpression.char_rmatch_iff

theorem add_rmatch_iff (P Q : RegularExpression α) (x : List α) :
    (P + Q).rmatch x ↔ P.rmatch x ∨ Q.rmatch x :=
  by
  induction' x with _ _ ih generalizing P Q
  · simp only [rmatch, match_epsilon, Bool.or_coe_iff]
  · repeat' rw [rmatch]
    rw [deriv]
    exact ih _ _
#align regular_expression.add_rmatch_iff RegularExpression.add_rmatch_iff

theorem mul_rmatch_iff (P Q : RegularExpression α) (x : List α) :
    (P * Q).rmatch x ↔ ∃ t u : List α, x = t ++ u ∧ P.rmatch t ∧ Q.rmatch u :=
  by
  induction' x with a x ih generalizing P Q
  · rw [rmatch, match_epsilon]
    constructor
    · intro h
      refine' ⟨[], [], rfl, _⟩
      rw [rmatch, rmatch]
      rwa [Bool.and_coe_iff] at h
    · rintro ⟨t, u, h₁, h₂⟩
      cases' List.append_eq_nil.1 h₁.symm with ht hu
      subst ht
      subst hu
      repeat' rw [rmatch] at h₂
      simp [h₂]
  · rw [rmatch, deriv]
    split_ifs with hepsilon
    · rw [add_rmatch_iff, ih]
      constructor
      · rintro (⟨t, u, _⟩ | h)
        · exact ⟨a :: t, u, by tauto⟩
        · exact ⟨[], a :: x, rfl, hepsilon, h⟩
      · rintro ⟨t, u, h, hP, hQ⟩
        cases' t with b t
        · right
          rw [List.nil_append] at h
          rw [← h] at hQ
          exact hQ
        · left
          simp only [List.cons_append] at h
          refine' ⟨t, u, h.2, _, hQ⟩
          rw [rmatch] at hP
          convert hP
          exact h.1
    · rw [ih]
      constructor <;> rintro ⟨t, u, h, hP, hQ⟩
      · exact ⟨a :: t, u, by tauto⟩
      · cases' t with b t
        · contradiction
        · simp only [List.cons_append] at h
          refine' ⟨t, u, h.2, _, hQ⟩
          rw [rmatch] at hP
          convert hP
          exact h.1
#align regular_expression.mul_rmatch_iff RegularExpression.mul_rmatch_iff

theorem star_rmatch_iff (P : RegularExpression α) :
    ∀ x : List α, (star P).rmatch x ↔ ∃ S : List (List α), x = S.join ∧ ∀ t ∈ S, t ≠ [] ∧ P.rmatch t
  | x =>
    by
    have A : ∀ m n : ℕ, n < m + n + 1 := by
      intro m n
      convert add_lt_add_of_le_of_lt (add_le_add (zero_le m) (le_refl n)) zero_lt_one
      simp
    have IH := fun t (h : List.length t < List.length x) => star_rmatch_iff t
    clear star_rmatch_iff
    constructor
    · cases' x with a x
      · intro
        fconstructor
        exact []
        tauto
      · rw [rmatch, deriv, mul_rmatch_iff]
        rintro ⟨t, u, hs, ht, hu⟩
        have hwf : u.length < (List.cons a x).length :=
          by
          rw [hs, List.length_cons, List.length_append]
          apply A
        rw [IH _ hwf] at hu
        rcases hu with ⟨S', hsum, helem⟩
        use (a :: t) :: S'
        constructor
        · simp [hs, hsum]
        · intro t' ht'
          cases' ht' with ht' ht'
          · rw [ht']
            exact ⟨by decide, ht⟩
          · exact helem _ ht'
    · rintro ⟨S, hsum, helem⟩
      cases' x with a x
      · decide
      · rw [rmatch, deriv, mul_rmatch_iff]
        cases' S with t' U
        · exact ⟨[], [], by tauto⟩
        · cases' t' with b t
          · simp only [forall_eq_or_imp, List.mem_cons] at helem
            simp only [eq_self_iff_true, not_true, Ne.def, false_and_iff] at helem
            cases helem
          simp only [List.join, List.cons_append] at hsum
          refine' ⟨t, U.join, hsum.2, _, _⟩
          · specialize helem (b :: t) (by simp)
            rw [rmatch] at helem
            convert helem.2
            exact hsum.1
          · have hwf : U.join.length < (List.cons a x).length :=
              by
              rw [hsum.1, hsum.2]
              simp only [List.length_append, List.length_join, List.length]
              apply A
            rw [IH _ hwf]
            refine' ⟨U, rfl, fun t h => helem t _⟩
            right
            assumption termination_by'
  ⟨fun L₁ L₂ : List _ => L₁.length < L₂.length, InvImage.wf _ Nat.lt_wfRel⟩
#align regular_expression.star_rmatch_iff RegularExpression.star_rmatch_iff

@[simp]
theorem rmatch_iff_matches (P : RegularExpression α) : ∀ x : List α, P.rmatch x ↔ x ∈ P.matches :=
  by
  intro x
  induction P generalizing x
  all_goals
    try rw [zero_def]
    try rw [one_def]
    try rw [plus_def]
    try rw [comp_def]
    rw [matches]
  case zero =>
    rw [zero_rmatch]
    tauto
  case epsilon =>
    rw [one_rmatch_iff]
    rfl
  case char =>
    rw [char_rmatch_iff]
    rfl
  case plus _ _ ih₁ ih₂ =>
    rw [add_rmatch_iff, ih₁, ih₂]
    rfl
  case
    comp P Q ih₁ ih₂ =>
    simp only [mul_rmatch_iff, comp_def, Language.mul_def, exists_and_left, Set.mem_image2,
      Set.image_prod]
    constructor
    · rintro ⟨x, y, hsum, hmatch₁, hmatch₂⟩
      rw [ih₁] at hmatch₁
      rw [ih₂] at hmatch₂
      exact ⟨x, hmatch₁, y, hmatch₂, hsum.symm⟩
    · rintro ⟨x, hmatch₁, y, hmatch₂, hsum⟩
      rw [← ih₁] at hmatch₁
      rw [← ih₂] at hmatch₂
      exact ⟨x, y, hsum.symm, hmatch₁, hmatch₂⟩
  case star _ ih =>
    rw [star_rmatch_iff, Language.kstar_def_nonempty]
    constructor
    all_goals
      rintro ⟨S, hx, hS⟩
      refine' ⟨S, hx, _⟩
      intro y
      specialize hS y
    · rw [← ih y]
      tauto
    · rw [ih y]
      tauto
#align regular_expression.rmatch_iff_matches RegularExpression.rmatch_iff_matches

instance (P : RegularExpression α) : DecidablePred P.matches :=
  by
  intro x
  change Decidable (x ∈ P.matches)
  rw [← rmatch_iff_matches]
  exact Eq.decidable _ _

omit dec

/-- Map the alphabet of a regular expression. -/
@[simp]
def map (f : α → β) : RegularExpression α → RegularExpression β
  | 0 => 0
  | 1 => 1
  | Char a => char (f a)
  | R + S => map R + map S
  | R * S => map R * map S
  | star R => star (map R)
#align regular_expression.map RegularExpression.map

@[simp]
protected theorem map_pow (f : α → β) (P : RegularExpression α) :
    ∀ n : ℕ, map f (P ^ n) = map f P ^ n
  | 0 => rfl
  | n + 1 => (congr_arg ((· * ·) (map f P)) (map_pow n) : _)
#align regular_expression.map_pow RegularExpression.map_pow

@[simp]
theorem map_id : ∀ P : RegularExpression α, P.map id = P
  | 0 => rfl
  | 1 => rfl
  | Char a => rfl
  | R + S => by simp_rw [map, map_id]
  | R * S => by simp_rw [map, map_id]
  | star R => by simp_rw [map, map_id]
#align regular_expression.map_id RegularExpression.map_id

@[simp]
theorem map_map (g : β → γ) (f : α → β) : ∀ P : RegularExpression α, (P.map f).map g = P.map (g ∘ f)
  | 0 => rfl
  | 1 => rfl
  | Char a => rfl
  | R + S => by simp_rw [map, map_map]
  | R * S => by simp_rw [map, map_map]
  | star R => by simp_rw [map, map_map]
#align regular_expression.map_map RegularExpression.map_map

/-- The language of the map is the map of the language. -/
@[simp]
theorem matches_map (f : α → β) :
    ∀ P : RegularExpression α, (P.map f).matches = Language.map f P.matches
  | 0 => (map_zero _).symm
  | 1 => (map_one _).symm
  | Char a => by
    rw [eq_comm]
    exact image_singleton
  | R + S => by simp only [matches_map, map, matches_add, map_add]
  | R * S => by simp only [matches_map, map, matches_mul, map_mul]
  | star R => by
    simp_rw [map, matches, matches_map]
    rw [Language.kstar_eq_supᵢ_pow, Language.kstar_eq_supᵢ_pow]
    simp_rw [← map_pow]
    exact image_Union.symm
#align regular_expression.matches_map RegularExpression.matches_map

end RegularExpression


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.reverse
import algebra.associated
import algebra.regular.smul

/-!
# Theory of monic polynomials

We give several tools for proving that polynomials are monic, e.g.
`monic_mul`, `monic_map`.
-/

noncomputable theory

open finset
open_locale big_operators classical

namespace polynomial
universes u v y
variables {R : Type u} {S : Type v} {a b : R} {m n : ℕ} {ι : Type y}

section semiring
variables [semiring R] {p q r : polynomial R}

lemma monic.as_sum {p : polynomial R} (hp : p.monic) :
  p = X^(p.nat_degree) + (∑ i in range p.nat_degree, C (p.coeff i) * X^i) :=
begin
  conv_lhs { rw [p.as_sum_range_C_mul_X_pow, sum_range_succ_comm] },
  suffices : C (p.coeff p.nat_degree) = 1,
  { rw [this, one_mul] },
  exact congr_arg C hp
end

lemma ne_zero_of_monic_of_zero_ne_one (hp : monic p) (h : (0 : R) ≠ 1) :
  p ≠ 0 := mt (congr_arg leading_coeff) $ by rw [monic.def.1 hp, leading_coeff_zero]; cc

lemma ne_zero_of_ne_zero_of_monic (hp : p ≠ 0) (hq : monic q) : q ≠ 0 :=
begin
  intro h, rw [h, monic.def, leading_coeff_zero] at hq,
  rw [← mul_one p, ← C_1, ← hq, C_0, mul_zero] at hp,
  exact hp rfl
end

lemma monic_map [semiring S] (f : R →+* S) (hp : monic p) : monic (p.map f) :=
if h : (0 : S) = 1 then
  by haveI := subsingleton_of_zero_eq_one h;
  exact subsingleton.elim _ _
else
have f (leading_coeff p) ≠ 0,
  by rwa [show _ = _, from hp, f.map_one, ne.def, eq_comm],
by
begin
  rw [monic, leading_coeff, coeff_map],
  suffices : p.coeff (map f p).nat_degree = 1, simp [this],
  suffices : (map f p).nat_degree = p.nat_degree, rw this, exact hp,
  rwa nat_degree_eq_of_degree_eq (degree_map_eq_of_leading_coeff_ne_zero f _)
end

lemma monic_C_mul_of_mul_leading_coeff_eq_one [nontrivial R] {b : R}
  (hp : b * p.leading_coeff = 1) : monic (C b * p) :=
by rw [monic, leading_coeff_mul' _]; simp [leading_coeff_C b, hp]

lemma monic_mul_C_of_leading_coeff_mul_eq_one [nontrivial R] {b : R}
  (hp : p.leading_coeff * b = 1) : monic (p * C b) :=
by rw [monic, leading_coeff_mul' _]; simp [leading_coeff_C b, hp]

theorem monic_of_degree_le (n : ℕ) (H1 : degree p ≤ n) (H2 : coeff p n = 1) : monic p :=
decidable.by_cases
  (assume H : degree p < n, eq_of_zero_eq_one
    (H2 ▸ (coeff_eq_zero_of_degree_lt H).symm) _ _)
  (assume H : ¬degree p < n,
    by rwa [monic, leading_coeff, nat_degree, (lt_or_eq_of_le H1).resolve_left H])

theorem monic_X_pow_add {n : ℕ} (H : degree p ≤ n) : monic (X ^ (n+1) + p) :=
have H1 : degree p < n+1, from lt_of_le_of_lt H (with_bot.coe_lt_coe.2 (nat.lt_succ_self n)),
monic_of_degree_le (n+1)
  (le_trans (degree_add_le _ _) (max_le (degree_X_pow_le _) (le_of_lt H1)))
  (by rw [coeff_add, coeff_X_pow, if_pos rfl, coeff_eq_zero_of_degree_lt H1, add_zero])

theorem monic_X_add_C (x : R) : monic (X + C x) :=
pow_one (X : polynomial R) ▸ monic_X_pow_add degree_C_le

lemma monic_mul (hp : monic p) (hq : monic q) : monic (p * q) :=
if h0 : (0 : R) = 1 then by haveI := subsingleton_of_zero_eq_one h0;
  exact subsingleton.elim _ _
else
  have leading_coeff p * leading_coeff q ≠ 0, by simp [monic.def.1 hp, monic.def.1 hq, ne.symm h0],
  by rw [monic.def, leading_coeff_mul' this, monic.def.1 hp, monic.def.1 hq, one_mul]

lemma monic_pow (hp : monic p) : ∀ (n : ℕ), monic (p ^ n)
| 0     := monic_one
| (n+1) := by { rw pow_succ, exact monic_mul hp (monic_pow n) }

lemma monic_add_of_left {p q : polynomial R} (hp : monic p) (hpq : degree q < degree p) :
  monic (p + q) :=
by rwa [monic, add_comm, leading_coeff_add_of_degree_lt hpq]

lemma monic_add_of_right {p q : polynomial R} (hq : monic q) (hpq : degree p < degree q) :
  monic (p + q) :=
by rwa [monic, leading_coeff_add_of_degree_lt hpq]

namespace monic

@[simp]
lemma nat_degree_eq_zero_iff_eq_one {p : polynomial R} (hp : p.monic) :
  p.nat_degree = 0 ↔ p = 1 :=
begin
  split; intro h,
  swap, { rw h, exact nat_degree_one },
  have : p = C (p.coeff 0),
  { rw ← polynomial.degree_le_zero_iff,
    rwa polynomial.nat_degree_eq_zero_iff_degree_le_zero at h },
  rw this, convert C_1, rw ← h, apply hp,
end

@[simp]
lemma degree_le_zero_iff_eq_one {p : polynomial R} (hp : p.monic) :
  p.degree ≤ 0 ↔ p = 1 :=
by rw [←hp.nat_degree_eq_zero_iff_eq_one, nat_degree_eq_zero_iff_degree_le_zero]

lemma nat_degree_mul {p q : polynomial R} (hp : p.monic) (hq : q.monic) :
  (p * q).nat_degree = p.nat_degree + q.nat_degree :=
begin
  nontriviality R,
  apply nat_degree_mul',
  simp [hp.leading_coeff, hq.leading_coeff]
end

lemma degree_mul_comm {p : polynomial R} (hp : p.monic) (q : polynomial R) :
  (p * q).degree = (q * p).degree :=
begin
  by_cases h : q = 0,
  { simp [h] },
  rw [degree_mul', hp.degree_mul],
  { exact add_comm _ _ },
  { rwa [hp.leading_coeff, one_mul, leading_coeff_ne_zero] }
end

lemma nat_degree_mul' {p q : polynomial R} (hp : p.monic) (hq : q ≠ 0) :
  (p * q).nat_degree = p.nat_degree + q.nat_degree :=
begin
  rw [nat_degree_mul', add_comm],
  simpa [hp.leading_coeff, leading_coeff_ne_zero]
end

lemma nat_degree_mul_comm {p : polynomial R} (hp : p.monic) (q : polynomial R) :
  (p * q).nat_degree = (q * p).nat_degree :=
begin
  by_cases h : q = 0,
  { simp [h] },
  rw [hp.nat_degree_mul' h, polynomial.nat_degree_mul', add_comm],
  simpa [hp.leading_coeff, leading_coeff_ne_zero]
end

lemma next_coeff_mul {p q : polynomial R} (hp : monic p) (hq : monic q) :
  next_coeff (p * q) = next_coeff p + next_coeff q :=
begin
  nontriviality,
  simp only [← coeff_one_reverse],
  rw reverse_mul;
    simp [coeff_mul, nat.antidiagonal, hp.leading_coeff, hq.leading_coeff, add_comm]
end

lemma eq_one_of_map_eq_one {S : Type*} [semiring S] [nontrivial S]
  (f : R →+* S) (hp : p.monic) (map_eq : p.map f = 1) : p = 1 :=
begin
  nontriviality R,
  have hdeg : p.degree = 0,
  { rw [← degree_map_eq_of_leading_coeff_ne_zero f _, map_eq, degree_one],
    { rw [hp.leading_coeff, f.map_one],
      exact one_ne_zero } },
  have hndeg : p.nat_degree = 0 :=
    with_bot.coe_eq_coe.mp ((degree_eq_nat_degree hp.ne_zero).symm.trans hdeg),
  convert eq_C_of_degree_eq_zero hdeg,
  rw [← hndeg, ← polynomial.leading_coeff, hp.leading_coeff, C.map_one]
end

end monic

end semiring

section comm_semiring
variables [comm_semiring R] {p : polynomial R}

lemma monic_multiset_prod_of_monic (t : multiset ι) (f : ι → polynomial R)
  (ht : ∀ i ∈ t, monic (f i)) :
  monic (t.map f).prod :=
begin
  revert ht,
  refine t.induction_on _ _, { simp },
  intros a t ih ht,
  rw [multiset.map_cons, multiset.prod_cons],
  exact monic_mul
    (ht _ (multiset.mem_cons_self _ _))
    (ih (λ _ hi, ht _ (multiset.mem_cons_of_mem hi)))
end

lemma monic_prod_of_monic (s : finset ι) (f : ι → polynomial R) (hs : ∀ i ∈ s, monic (f i)) :
  monic (∏ i in s, f i) :=
monic_multiset_prod_of_monic s.1 f hs

lemma is_unit_C {x : R} : is_unit (C x) ↔ is_unit x :=
begin
  rw [is_unit_iff_dvd_one, is_unit_iff_dvd_one],
  split,
  { rintros ⟨g, hg⟩,
    replace hg := congr_arg (eval 0) hg,
    rw [eval_one, eval_mul, eval_C] at hg,
    exact ⟨g.eval 0, hg⟩ },
  { rintros ⟨y, hy⟩,
    exact ⟨C y, by rw [← C_mul, ← hy, C_1]⟩ }
end

lemma eq_one_of_is_unit_of_monic (hm : monic p) (hpu : is_unit p) : p = 1 :=
have degree p ≤ 0,
  from calc degree p ≤ degree (1 : polynomial R) :
    let ⟨u, hu⟩ := is_unit_iff_dvd_one.1 hpu in
    if hu0 : u = 0
    then begin
        rw [hu0, mul_zero] at hu,
        rw [← mul_one p, hu, mul_zero],
        simp
      end
    else have p.leading_coeff * u.leading_coeff ≠ 0,
        by rw [hm.leading_coeff, one_mul, ne.def, leading_coeff_eq_zero];
          exact hu0,
      by rw [hu, degree_mul' this];
        exact le_add_of_nonneg_right (degree_nonneg_iff_ne_zero.2 hu0)
  ... ≤ 0 : degree_one_le,
by rw [eq_C_of_degree_le_zero this, ← nat_degree_eq_zero_iff_degree_le_zero.2 this,
    ← leading_coeff, hm.leading_coeff, C_1]

lemma monic.next_coeff_multiset_prod (t : multiset ι) (f : ι → polynomial R)
  (h : ∀ i ∈ t, monic (f i)) :
  next_coeff (t.map f).prod = (t.map (λ i, next_coeff (f i))).sum :=
begin
  revert h,
  refine multiset.induction_on t _ (λ a t ih ht, _),
  { simp only [multiset.not_mem_zero, forall_prop_of_true, forall_prop_of_false, multiset.map_zero,
               multiset.prod_zero, multiset.sum_zero, not_false_iff, forall_true_iff],
    rw ← C_1, rw next_coeff_C_eq_zero },
  { rw [multiset.map_cons, multiset.prod_cons, multiset.map_cons, multiset.sum_cons,
        monic.next_coeff_mul, ih],
    exacts [λ i hi, ht i (multiset.mem_cons_of_mem hi), ht a (multiset.mem_cons_self _ _),
            monic_multiset_prod_of_monic _ _ (λ b bs, ht _ (multiset.mem_cons_of_mem bs))] }
end

lemma monic.next_coeff_prod (s : finset ι) (f : ι → polynomial R) (h : ∀ i ∈ s, monic (f i)) :
  next_coeff (∏ i in s, f i) = ∑ i in s, next_coeff (f i) :=
monic.next_coeff_multiset_prod s.1 f h

end comm_semiring

section ring
variables [ring R] {p : polynomial R}

theorem monic_X_sub_C (x : R) : monic (X - C x) :=
by simpa only [sub_eq_add_neg, C_neg] using monic_X_add_C (-x)

theorem monic_X_pow_sub {n : ℕ} (H : degree p ≤ n) : monic (X ^ (n+1) - p) :=
by simpa [sub_eq_add_neg] using monic_X_pow_add (show degree (-p) ≤ n, by rwa ←degree_neg p at H)

/-- `X ^ n - a` is monic. -/
lemma monic_X_pow_sub_C {R : Type u} [ring R] (a : R) {n : ℕ} (h : n ≠ 0) : (X ^ n - C a).monic :=
begin
  obtain ⟨k, hk⟩ := nat.exists_eq_succ_of_ne_zero h,
  convert monic_X_pow_sub _,
  exact le_trans degree_C_le nat.with_bot.coe_nonneg,
end

lemma not_is_unit_X_pow_sub_one (R : Type*) [comm_ring R] [nontrivial R] (n : ℕ) :
  ¬ is_unit (X ^ n - 1 : polynomial R) :=
begin
  intro h,
  rcases eq_or_ne n 0 with rfl | hn,
  { simpa using h },
  apply hn,
  rwa [← @nat_degree_X_pow_sub_C _ _ _ n (1 : R),
      eq_one_of_is_unit_of_monic (monic_X_pow_sub_C (1 : R) hn),
      nat_degree_one]
end

lemma monic_sub_of_left {p q : polynomial R} (hp : monic p) (hpq : degree q < degree p) :
  monic (p - q) :=
by { rw sub_eq_add_neg, apply monic_add_of_left hp, rwa degree_neg }

lemma monic_sub_of_right {p q : polynomial R}
  (hq : q.leading_coeff = -1) (hpq : degree p < degree q) : monic (p - q) :=
have (-q).coeff (-q).nat_degree = 1 :=
by rw [nat_degree_neg, coeff_neg, show q.coeff q.nat_degree = -1, from hq, neg_neg],
by { rw sub_eq_add_neg, apply monic_add_of_right this, rwa degree_neg }

section injective
open function
variables [semiring S] {f : R →+* S} (hf : injective f)
include hf

lemma degree_map_eq_of_injective (p : polynomial R) : degree (p.map f) = degree p :=
if h : p = 0 then by simp [h]
else degree_map_eq_of_leading_coeff_ne_zero _
  (by rw [← f.map_zero]; exact mt hf.eq_iff.1
    (mt leading_coeff_eq_zero.1 h))

lemma degree_map' (p : polynomial R) :
  degree (p.map f) = degree p :=
p.degree_map_eq_of_injective hf

lemma nat_degree_map' (p : polynomial R) :
  nat_degree (p.map f) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_map' hf p)

lemma leading_coeff_map' (p : polynomial R) :
  leading_coeff (p.map f) = f (leading_coeff p) :=
begin
  unfold leading_coeff,
  rw [coeff_map, nat_degree_map' hf p],
end

lemma next_coeff_map (p : polynomial R) :
  (p.map f).next_coeff = f p.next_coeff :=
begin
  unfold next_coeff,
  rw nat_degree_map' hf,
  split_ifs; simp
end

lemma leading_coeff_of_injective (p : polynomial R) :
  leading_coeff (p.map f) = f (leading_coeff p) :=
begin
  delta leading_coeff,
  rw [coeff_map f, nat_degree_map' hf p]
end

lemma monic_of_injective {p : polynomial R} (hp : (p.map f).monic) : p.monic :=
begin
  apply hf,
  rw [← leading_coeff_of_injective hf, hp.leading_coeff, f.map_one]
end

end injective
end ring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : polynomial R}

@[simp] lemma not_monic_zero : ¬monic (0 : polynomial R) :=
by simpa only [monic, leading_coeff_zero] using (zero_ne_one : (0 : R) ≠ 1)

lemma ne_zero_of_monic (h : monic p) : p ≠ 0 :=
λ h₁, @not_monic_zero R _ _ (h₁ ▸ h)

end nonzero_semiring

section not_zero_divisor

-- TODO: using gh-8537, rephrase lemmas that involve commutation around `*` using the op-ring

variables [semiring R] {p : polynomial R}

lemma monic.mul_left_ne_zero (hp : monic p) {q : polynomial R} (hq : q ≠ 0) :
  q * p ≠ 0 :=
begin
  by_cases h : p = 1,
  { simpa [h] },
  rw [ne.def, ←degree_eq_bot, hp.degree_mul, with_bot.add_eq_bot, not_or_distrib, degree_eq_bot],
  refine ⟨hq, _⟩,
  rw [←hp.degree_le_zero_iff_eq_one, not_le] at h,
  refine (lt_trans _ h).ne',
  simp
end

lemma monic.mul_right_ne_zero (hp : monic p) {q : polynomial R} (hq : q ≠ 0) :
  p * q ≠ 0 :=
begin
  by_cases h : p = 1,
  { simpa [h] },
  rw [ne.def, ←degree_eq_bot, hp.degree_mul_comm, hp.degree_mul, with_bot.add_eq_bot,
      not_or_distrib, degree_eq_bot],
  refine ⟨hq, _⟩,
  rw [←hp.degree_le_zero_iff_eq_one, not_le] at h,
  refine (lt_trans _ h).ne',
  simp
end

lemma monic.mul_nat_degree_lt_iff (h : monic p) {q : polynomial R} :
  (p * q).nat_degree < p.nat_degree ↔ p ≠ 1 ∧ q = 0 :=
begin
  by_cases hq : q = 0,
  { suffices : 0 < p.nat_degree ↔ p.nat_degree ≠ 0,
    { simpa [hq, ←h.nat_degree_eq_zero_iff_eq_one] },
    exact ⟨λ h, h.ne', λ h, lt_of_le_of_ne (nat.zero_le _) h.symm ⟩ },
  { simp [h.nat_degree_mul', hq] }
end

lemma monic.mul_right_eq_zero_iff (h : monic p) {q : polynomial R} :
  p * q = 0 ↔ q = 0 :=
begin
  by_cases hq : q = 0;
  simp [h.mul_right_ne_zero, hq]
end

lemma monic.mul_left_eq_zero_iff (h : monic p) {q : polynomial R} :
  q * p = 0 ↔ q = 0 :=
begin
  by_cases hq : q = 0;
  simp [h.mul_left_ne_zero, hq]
end

lemma monic.is_regular {R : Type*} [ring R] {p : polynomial R} (hp : monic p) : is_regular p :=
begin
  split,
  { intros q r h,
    rw [←sub_eq_zero, ←hp.mul_right_eq_zero_iff, mul_sub, h, sub_self] },
  { intros q r h,
    simp only at h,
    rw [←sub_eq_zero, ←hp.mul_left_eq_zero_iff, sub_mul, h, sub_self] }
end

lemma degree_smul_of_smul_regular {S : Type*} [monoid S] [distrib_mul_action S R]
  {k : S} (p : polynomial R) (h : is_smul_regular R k) :
  (k • p).degree = p.degree :=
begin
  refine le_antisymm _ _,
  { rw degree_le_iff_coeff_zero,
    intros m hm,
    rw degree_lt_iff_coeff_zero at hm,
    simp [hm m le_rfl] },
  { rw degree_le_iff_coeff_zero,
    intros m hm,
    rw degree_lt_iff_coeff_zero at hm,
    refine h _,
    simpa using hm m le_rfl },
end

lemma nat_degree_smul_of_smul_regular {S : Type*} [monoid S] [distrib_mul_action S R]
  {k : S} (p : polynomial R) (h : is_smul_regular R k) :
  (k • p).nat_degree = p.nat_degree :=
begin
  by_cases hp : p = 0,
  { simp [hp] },
  rw [←with_bot.coe_eq_coe, ←degree_eq_nat_degree hp, ←degree_eq_nat_degree,
      degree_smul_of_smul_regular p h],
  contrapose! hp,
  rw ←smul_zero k at hp,
  exact h.polynomial hp
end

lemma leading_coeff_smul_of_smul_regular {S : Type*} [monoid S] [distrib_mul_action S R]
  {k : S} (p : polynomial R) (h : is_smul_regular R k) :
  (k • p).leading_coeff = k • p.leading_coeff :=
by rw [leading_coeff, leading_coeff, coeff_smul, nat_degree_smul_of_smul_regular p h]

lemma monic_of_is_unit_leading_coeff_inv_smul (h : is_unit p.leading_coeff) :
  monic (h.unit⁻¹ • p) :=
begin
  rw [monic.def, leading_coeff_smul_of_smul_regular _ (is_smul_regular_of_group _), units.smul_def],
  obtain ⟨k, hk⟩ := h,
  simp only [←hk, smul_eq_mul, ←units.coe_mul, units.coe_eq_one, inv_mul_eq_iff_eq_mul],
  simp [units.ext_iff, is_unit.unit_spec]
end

lemma is_unit_leading_coeff_mul_right_eq_zero_iff (h : is_unit p.leading_coeff) {q : polynomial R} :
  p * q = 0 ↔ q = 0 :=
begin
  split,
  { intro hp,
    rw ←smul_eq_zero_iff_eq (h.unit)⁻¹ at hp,
    have : (h.unit)⁻¹ • (p * q) = ((h.unit)⁻¹ • p) * q,
    { ext,
      simp only [units.smul_def, coeff_smul, coeff_mul, smul_eq_mul, mul_sum],
      refine sum_congr rfl (λ x hx, _),
      rw ←mul_assoc },
    rwa [this, monic.mul_right_eq_zero_iff] at hp,
    exact monic_of_is_unit_leading_coeff_inv_smul _ },
  { rintro rfl,
    simp }
end

end not_zero_divisor

end polynomial


/-
Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp

! This file was ported from Lean 3 source module linear_algebra.matrix.spectrum
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Spectrum
import Mathbin.LinearAlgebra.Matrix.Hermitian

/-! # Spectral theory of hermitian matrices

This file proves the spectral theorem for matrices. The proof of the spectral theorem is based on
the spectral theorem for linear maps (`diagonalization_basis_apply_self_apply`).

## Tags

spectral theorem, diagonalization theorem

-/

namespace Matrix

variable {𝕜 : Type _} [IsROrC 𝕜] [DecidableEq 𝕜] {n : Type _} [Fintype n] [DecidableEq n]

variable {A : Matrix n n 𝕜}

open Matrix

open BigOperators

namespace IsHermitian

variable (hA : A.IsHermitian)

/-- The eigenvalues of a hermitian matrix, indexed by `fin (fintype.card n)` where `n` is the index
type of the matrix. -/
noncomputable def eigenvalues₀ : Fin (Fintype.card n) → ℝ :=
  (isHermitian_iff_isSymmetric.1 hA).Eigenvalues finrank_euclideanSpace
#align matrix.is_hermitian.eigenvalues₀ Matrix.IsHermitian.eigenvalues₀

/-- The eigenvalues of a hermitian matrix, reusing the index `n` of the matrix entries. -/
noncomputable def eigenvalues : n → ℝ := fun i =>
  hA.eigenvalues₀ <| (Fintype.equivOfCardEq (Fintype.card_fin _)).symm i
#align matrix.is_hermitian.eigenvalues Matrix.IsHermitian.eigenvalues

/-- A choice of an orthonormal basis of eigenvectors of a hermitian matrix. -/
noncomputable def eigenvectorBasis : OrthonormalBasis n 𝕜 (EuclideanSpace 𝕜 n) :=
  ((isHermitian_iff_isSymmetric.1 hA).eigenvectorBasis finrank_euclideanSpace).reindex
    (Fintype.equivOfCardEq (Fintype.card_fin _))
#align matrix.is_hermitian.eigenvector_basis Matrix.IsHermitian.eigenvectorBasis

/-- A matrix whose columns are an orthonormal basis of eigenvectors of a hermitian matrix. -/
noncomputable def eigenvectorMatrix : Matrix n n 𝕜 :=
  (PiLp.basisFun _ 𝕜 n).toMatrix (eigenvectorBasis hA).toBasis
#align matrix.is_hermitian.eigenvector_matrix Matrix.IsHermitian.eigenvectorMatrix

/-- The inverse of `eigenvector_matrix` -/
noncomputable def eigenvectorMatrixInv : Matrix n n 𝕜 :=
  (eigenvectorBasis hA).toBasis.toMatrix (PiLp.basisFun _ 𝕜 n)
#align matrix.is_hermitian.eigenvector_matrix_inv Matrix.IsHermitian.eigenvectorMatrixInv

theorem eigenvectorMatrix_mul_inv : hA.eigenvectorMatrix ⬝ hA.eigenvectorMatrixInv = 1 := by
  apply Basis.toMatrix_mul_toMatrix_flip
#align matrix.is_hermitian.eigenvector_matrix_mul_inv Matrix.IsHermitian.eigenvectorMatrix_mul_inv

noncomputable instance : Invertible hA.eigenvectorMatrixInv :=
  invertibleOfLeftInverse _ _ hA.eigenvectorMatrix_mul_inv

noncomputable instance : Invertible hA.eigenvectorMatrix :=
  invertibleOfRightInverse _ _ hA.eigenvectorMatrix_mul_inv

theorem eigenvectorMatrix_apply (i j : n) : hA.eigenvectorMatrix i j = hA.eigenvectorBasis j i := by
  simp_rw [eigenvector_matrix, Basis.toMatrix_apply, OrthonormalBasis.coe_toBasis,
    PiLp.basisFun_repr]
#align matrix.is_hermitian.eigenvector_matrix_apply Matrix.IsHermitian.eigenvectorMatrix_apply

theorem eigenvectorMatrixInv_apply (i j : n) :
    hA.eigenvectorMatrixInv i j = star (hA.eigenvectorBasis i j) := by
  rw [eigenvector_matrix_inv, Basis.toMatrix_apply, OrthonormalBasis.coe_toBasis_repr_apply,
    OrthonormalBasis.repr_apply_apply, PiLp.basisFun_apply, PiLp.equiv_symm_single,
    EuclideanSpace.inner_single_right, one_mul, IsROrC.star_def]
#align matrix.is_hermitian.eigenvector_matrix_inv_apply Matrix.IsHermitian.eigenvectorMatrixInv_apply

theorem conjTranspose_eigenvectorMatrixInv : hA.eigenvectorMatrixInvᴴ = hA.eigenvectorMatrix :=
  by
  ext (i j)
  rw [conj_transpose_apply, eigenvector_matrix_inv_apply, eigenvector_matrix_apply, star_star]
#align matrix.is_hermitian.conj_transpose_eigenvector_matrix_inv Matrix.IsHermitian.conjTranspose_eigenvectorMatrixInv

theorem conjTranspose_eigenvectorMatrix : hA.eigenvectorMatrixᴴ = hA.eigenvectorMatrixInv := by
  rw [← conj_transpose_eigenvector_matrix_inv, conj_transpose_conj_transpose]
#align matrix.is_hermitian.conj_transpose_eigenvector_matrix Matrix.IsHermitian.conjTranspose_eigenvectorMatrix

/-- *Diagonalization theorem*, *spectral theorem* for matrices; A hermitian matrix can be
diagonalized by a change of basis.

For the spectral theorem on linear maps, see `diagonalization_basis_apply_self_apply`. -/
theorem spectral_theorem :
    hA.eigenvectorMatrixInv ⬝ A = diagonal (coe ∘ hA.Eigenvalues) ⬝ hA.eigenvectorMatrixInv :=
  by
  rw [eigenvector_matrix_inv, PiLp.basis_toMatrix_basisFun_mul]
  ext (i j)
  have := is_hermitian_iff_is_symmetric.1 hA
  convert this.diagonalization_basis_apply_self_apply finrank_euclideanSpace
      (EuclideanSpace.single j 1) ((Fintype.equivOfCardEq (Fintype.card_fin _)).symm i) using
    1
  · dsimp only [EuclideanSpace.single, to_euclidean_lin_pi_Lp_equiv_symm, to_lin'_apply,
      Matrix.of_apply, is_hermitian.eigenvector_basis]
    simp_rw [mul_vec_single, mul_one, OrthonormalBasis.coe_toBasis_repr_apply,
      OrthonormalBasis.repr_reindex]
    rfl
  · simp only [diagonal_mul, (· ∘ ·), eigenvalues]
    rw [eigenvector_basis, Basis.toMatrix_apply, OrthonormalBasis.coe_toBasis_repr_apply,
      OrthonormalBasis.repr_reindex, eigenvalues₀, PiLp.basisFun_apply, PiLp.equiv_symm_single]
#align matrix.is_hermitian.spectral_theorem Matrix.IsHermitian.spectral_theorem

theorem eigenvalues_eq (i : n) :
    hA.Eigenvalues i =
      IsROrC.re (star (hA.eigenvectorMatrixᵀ i) ⬝ᵥ A.mulVec (hA.eigenvectorMatrixᵀ i)) :=
  by
  have := hA.spectral_theorem
  rw [← Matrix.mul_inv_eq_iff_eq_mul_of_invertible] at this
  have := congr_arg IsROrC.re (congr_fun (congr_fun this i) i)
  rw [diagonal_apply_eq, IsROrC.of_real_re, inv_eq_left_inv hA.eigenvector_matrix_mul_inv, ←
    conj_transpose_eigenvector_matrix, mul_mul_apply] at this
  exact this.symm
#align matrix.is_hermitian.eigenvalues_eq Matrix.IsHermitian.eigenvalues_eq

/-- The determinant of a hermitian matrix is the product of its eigenvalues. -/
theorem det_eq_prod_eigenvalues : det A = ∏ i, hA.Eigenvalues i :=
  by
  apply mul_left_cancel₀ (det_ne_zero_of_left_inverse (eigenvector_matrix_mul_inv hA))
  rw [← det_mul, spectral_theorem, det_mul, mul_comm, det_diagonal]
#align matrix.is_hermitian.det_eq_prod_eigenvalues Matrix.IsHermitian.det_eq_prod_eigenvalues

end IsHermitian

end Matrix


/-
Copyright (c) 2020 Yury Kudryashov, Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Anne Baanen

! This file was ported from Lean 3 source module algebra.big_operators.fin
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.BigOperators
import Mathlib.Data.Fintype.Fin
import Mathlib.Data.List.FinRange
import Mathlib.Logic.Equiv.Fin

/-!
# Big operators and `Fin`

Some results about products and sums over the type `Fin`.

The most important results are the induction formulas `Fin.prod_univ_castSucc`
and `Fin.prod_univ_succ`, and the formula `Fin.prod_const` for the product of a
constant function. These results have variants for sums instead of products.

-/

open BigOperators

open Finset

variable {α : Type _} {β : Type _}

namespace Finset

@[to_additive]
theorem prod_range [CommMonoid β] {n : ℕ} (f : ℕ → β) :
    (∏ i in Finset.range n, f i) = ∏ i : Fin n, f i :=
  prod_bij' (fun k w => ⟨k, mem_range.mp w⟩) (fun _ _ => mem_univ _)
    (fun _ _ => congr_arg _ (Fin.val_mk _).symm) (fun a _ => a) (fun a _ => mem_range.mpr a.prop)
    (fun _ _ => Fin.val_mk _) fun _ _ => Fin.eta _ _
#align finset.prod_range Finset.prod_range
#align finset.sum_range Finset.sum_range

end Finset

namespace Fin

@[to_additive]
theorem prod_univ_def [CommMonoid β] {n : ℕ} (f : Fin n → β) :
    (∏ i, f i) = ((List.finRange n).map f).prod := by simp [univ_def]
#align fin.prod_univ_def Fin.prod_univ_def
#align fin.sum_univ_def Fin.sum_univ_def

@[to_additive]
theorem prod_ofFn [CommMonoid β] {n : ℕ} (f : Fin n → β) : (List.ofFn f).prod = ∏ i, f i := by
  rw [List.ofFn_eq_map, prod_univ_def]
#align fin.prod_of_fn Fin.prod_ofFn
#align fin.sum_of_fn Fin.sum_ofFn

/-- A product of a function `f : Fin 0 → β` is `1` because `Fin 0` is empty -/
@[to_additive "A sum of a function `f : Fin 0 → β` is `0` because `Fin 0` is empty"]
theorem prod_univ_zero [CommMonoid β] (f : Fin 0 → β) : (∏ i, f i) = 1 :=
  rfl
#align fin.prod_univ_zero Fin.prod_univ_zero
#align fin.sum_univ_zero Fin.sum_univ_zero

/-- A product of a function `f : Fin (n + 1) → β` over all `Fin (n + 1)`
is the product of `f x`, for some `x : Fin (n + 1)` times the remaining product -/
@[to_additive "A sum of a function `f : Fin (n + 1) → β` over all `Fin (n + 1)` is the sum of
`f x`, for some `x : Fin (n + 1)` plus the remaining product"]
theorem prod_univ_succAbove [CommMonoid β] {n : ℕ} (f : Fin (n + 1) → β) (x : Fin (n + 1)) :
    (∏ i, f i) = f x * ∏ i : Fin n, f (x.succAbove i) := by
  rw [univ_succAbove, prod_cons, Finset.prod_map]
#align fin.prod_univ_succ_above Fin.prod_univ_succAbove
#align fin.sum_univ_succ_above Fin.sum_univ_succAbove

/-- A product of a function `f : Fin (n + 1) → β` over all `Fin (n + 1)`
is the product of `f 0` plus the remaining product -/
@[to_additive "A sum of a function `f : Fin (n + 1) → β` over all `Fin (n + 1)` is the sum of
`f 0` plus the remaining product"]
theorem prod_univ_succ [CommMonoid β] {n : ℕ} (f : Fin (n + 1) → β) :
    (∏ i, f i) = f 0 * ∏ i : Fin n, f i.succ :=
  prod_univ_succAbove f 0
#align fin.prod_univ_succ Fin.prod_univ_succ
#align fin.sum_univ_succ Fin.sum_univ_succ

/-- A product of a function `f : Fin (n + 1) → β` over all `Fin (n + 1)`
is the product of `f (Fin.last n)` plus the remaining product -/
@[to_additive "A sum of a function `f : Fin (n + 1) → β` over all `Fin (n + 1)` is the sum of
`f (Fin.last n)` plus the remaining sum"]
theorem prod_univ_castSucc [CommMonoid β] {n : ℕ} (f : Fin (n + 1) → β) :
    (∏ i, f i) = (∏ i : Fin n, f (Fin.castSucc i)) * f (last n) := by
  simpa [mul_comm] using prod_univ_succAbove f (last n)
#align fin.prod_univ_cast_succ Fin.prod_univ_castSucc
#align fin.sum_univ_cast_succ Fin.sum_univ_castSucc

@[to_additive]
theorem prod_cons [CommMonoid β] {n : ℕ} (x : β) (f : Fin n → β) :
    (∏ i : Fin n.succ, (cons x f : Fin n.succ → β) i) = x * ∏ i : Fin n, f i := by
  simp_rw [prod_univ_succ, cons_zero, cons_succ]
#align fin.prod_cons Fin.prod_cons
#align fin.sum_cons Fin.sum_cons

@[to_additive sum_univ_one]
theorem prod_univ_one [CommMonoid β] (f : Fin 1 → β) : (∏ i, f i) = f 0 := by simp
#align fin.prod_univ_one Fin.prod_univ_one
#align fin.sum_univ_one Fin.sum_univ_one

@[to_additive (attr := simp)]
theorem prod_univ_two [CommMonoid β] (f : Fin 2 → β) : (∏ i, f i) = f 0 * f 1 := by
  simp [prod_univ_succ]
#align fin.prod_univ_two Fin.prod_univ_two
#align fin.sum_univ_two Fin.sum_univ_two

@[to_additive]

@[to_additive]
theorem prod_univ_four [CommMonoid β] (f : Fin 4 → β) : (∏ i, f i) = f 0 * f 1 * f 2 * f 3 := by
  rw [prod_univ_castSucc, prod_univ_three]
  rfl
#align fin.prod_univ_four Fin.prod_univ_four
#align fin.sum_univ_four Fin.sum_univ_four

@[to_additive]
theorem prod_univ_five [CommMonoid β] (f : Fin 5 → β) :
    (∏ i, f i) = f 0 * f 1 * f 2 * f 3 * f 4 := by
  rw [prod_univ_castSucc, prod_univ_four]
  rfl
#align fin.prod_univ_five Fin.prod_univ_five
#align fin.sum_univ_five Fin.sum_univ_five

@[to_additive]
theorem prod_univ_six [CommMonoid β] (f : Fin 6 → β) :
    (∏ i, f i) = f 0 * f 1 * f 2 * f 3 * f 4 * f 5 := by
  rw [prod_univ_castSucc, prod_univ_five]
  rfl
#align fin.prod_univ_six Fin.prod_univ_six
#align fin.sum_univ_six Fin.sum_univ_six

@[to_additive]
theorem prod_univ_seven [CommMonoid β] (f : Fin 7 → β) :
    (∏ i, f i) = f 0 * f 1 * f 2 * f 3 * f 4 * f 5 * f 6 := by
  rw [prod_univ_castSucc, prod_univ_six]
  rfl
#align fin.prod_univ_seven Fin.prod_univ_seven
#align fin.sum_univ_seven Fin.sum_univ_seven

@[to_additive]
theorem prod_univ_eight [CommMonoid β] (f : Fin 8 → β) :
    (∏ i, f i) = f 0 * f 1 * f 2 * f 3 * f 4 * f 5 * f 6 * f 7 := by
  rw [prod_univ_castSucc, prod_univ_seven]
  rfl
#align fin.prod_univ_eight Fin.prod_univ_eight
#align fin.sum_univ_eight Fin.sum_univ_eight

theorem sum_pow_mul_eq_add_pow {n : ℕ} {R : Type _} [CommSemiring R] (a b : R) :
    (∑ s : Finset (Fin n), a ^ s.card * b ^ (n - s.card)) = (a + b) ^ n := by
  simpa using Fintype.sum_pow_mul_eq_add_pow (Fin n) a b
#align fin.sum_pow_mul_eq_add_pow Fin.sum_pow_mul_eq_add_pow

theorem prod_const [CommMonoid α] (n : ℕ) (x : α) : (∏ _i : Fin n, x) = x ^ n := by simp
#align fin.prod_const Fin.prod_const

theorem sum_const [AddCommMonoid α] (n : ℕ) (x : α) : (∑ _i : Fin n, x) = n • x := by simp
#align fin.sum_const Fin.sum_const

@[to_additive]
theorem prod_Ioi_zero {M : Type _} [CommMonoid M] {n : ℕ} {v : Fin n.succ → M} :
    (∏ i in Ioi 0, v i) = ∏ j : Fin n, v j.succ := by
  rw [Ioi_zero_eq_map, Finset.prod_map, val_succEmbedding]
#align fin.prod_Ioi_zero Fin.prod_Ioi_zero
#align fin.sum_Ioi_zero Fin.sum_Ioi_zero

@[to_additive]
theorem prod_Ioi_succ {M : Type _} [CommMonoid M] {n : ℕ} (i : Fin n) (v : Fin n.succ → M) :
    (∏ j in Ioi i.succ, v j) = ∏ j in Ioi i, v j.succ := by
  rw [Ioi_succ, Finset.prod_map, val_succEmbedding]
#align fin.prod_Ioi_succ Fin.prod_Ioi_succ
#align fin.sum_Ioi_succ Fin.sum_Ioi_succ

@[to_additive]
theorem prod_congr' {M : Type _} [CommMonoid M] {a b : ℕ} (f : Fin b → M) (h : a = b) :
    (∏ i : Fin a, f (cast h i)) = ∏ i : Fin b, f i := by
  subst h
  congr
#align fin.prod_congr' Fin.prod_congr'
#align fin.sum_congr' Fin.sum_congr'

@[to_additive]
theorem prod_univ_add {M : Type _} [CommMonoid M] {a b : ℕ} (f : Fin (a + b) → M) :
    (∏ i : Fin (a + b), f i) = (∏ i : Fin a, f (castAdd b i)) * ∏ i : Fin b, f (natAdd a i) := by
  rw [Fintype.prod_equiv finSumFinEquiv.symm f fun i => f (finSumFinEquiv.toFun i)]
  · apply Fintype.prod_sum_type
  · intro x
    simp only [Equiv.toFun_as_coe, Equiv.apply_symm_apply]
#align fin.prod_univ_add Fin.prod_univ_add
#align fin.sum_univ_add Fin.sum_univ_add

@[to_additive]
theorem prod_trunc {M : Type _} [CommMonoid M] {a b : ℕ} (f : Fin (a + b) → M)
    (hf : ∀ j : Fin b, f (natAdd a j) = 1) :
    (∏ i : Fin (a + b), f i) = ∏ i : Fin a, f (castLe (Nat.le.intro rfl) i) := by
  rw [prod_univ_add, Fintype.prod_eq_one _ hf, mul_one]
  rfl
#align fin.prod_trunc Fin.prod_trunc
#align fin.sum_trunc Fin.sum_trunc

section PartialProd

variable [Monoid α] {n : ℕ}

/-- For `f = (a₁, ..., aₙ)` in `αⁿ`, `partialProd f` is `(1, a₁, a₁a₂, ..., a₁...aₙ)` in `αⁿ⁺¹`. -/
@[to_additive "For `f = (a₁, ..., aₙ)` in `αⁿ`, `partialSum f` is\n
`(0, a₁, a₁ + a₂, ..., a₁ + ... + aₙ)` in `αⁿ⁺¹`."]
def partialProd (f : Fin n → α) (i : Fin (n + 1)) : α :=
  ((List.ofFn f).take i).prod
#align fin.partial_prod Fin.partialProd
#align fin.partial_sum Fin.partialSum

@[to_additive (attr := simp)]
theorem partialProd_zero (f : Fin n → α) : partialProd f 0 = 1 := by simp [partialProd]
#align fin.partial_prod_zero Fin.partialProd_zero
#align fin.partial_sum_zero Fin.partialSum_zero

@[to_additive]
theorem partialProd_succ (f : Fin n → α) (j : Fin n) :
    partialProd f j.succ = partialProd f (Fin.castSucc j) * f j := by
  simp [partialProd, List.take_succ, List.ofFnNthVal, dif_pos j.is_lt, ← Option.coe_def]
#align fin.partial_prod_succ Fin.partialProd_succ
#align fin.partial_sum_succ Fin.partialSum_succ

@[to_additive]
theorem partialProd_succ' (f : Fin (n + 1) → α) (j : Fin (n + 1)) :
    partialProd f j.succ = f 0 * partialProd (Fin.tail f) j := by
  simp [partialProd]
  rfl
#align fin.partial_prod_succ' Fin.partialProd_succ'
#align fin.partial_sum_succ' Fin.partialSum_succ'

@[to_additive]
theorem partialProd_left_inv {G : Type _} [Group G] (f : Fin (n + 1) → G) :
    (f 0 • partialProd fun i : Fin n => (f i)⁻¹ * f i.succ) = f :=
  funext fun x => Fin.inductionOn x (by simp) fun x hx => by
    simp only [coe_eq_castSucc, Pi.smul_apply, smul_eq_mul] at hx⊢
    rw [partialProd_succ, ← mul_assoc, hx, mul_inv_cancel_left]
#align fin.partial_prod_left_inv Fin.partialProd_left_inv
#align fin.partial_sum_left_neg Fin.partialSum_left_neg

-- Porting note:
-- 1) Changed `i` in statement to `(Fin.castLt i (Nat.lt_succ_of_lt i.2))` because of
--    coercion issues. Might need to be fixed later.
-- 2) The current proof is really bad! It should be redone once `assoc_rw` is
--    implemented and `rw` knows that `i.succ = i + 1`.
-- 3) The original Mathport output was:
--   cases' i with i hn
--   induction' i with i hi generalizing hn
--   · simp [← Fin.succ_mk, partialProd_succ]
--   · specialize hi (lt_trans (Nat.lt_succ_self i) hn)
--     simp only [mul_inv_rev, Fin.coe_eq_castSucc, Fin.succ_mk, Fin.castSucc_mk, smul_eq_mul,
--       Pi.smul_apply] at hi ⊢
--     rw [← Fin.succ_mk _ _ (lt_trans (Nat.lt_succ_self _) hn), ← Fin.succ_mk]
--     simp only [partialProd_succ, mul_inv_rev, Fin.castSucc_mk]
--     assoc_rw [hi, inv_mul_cancel_left]
@[to_additive]
theorem partialProd_right_inv {G : Type _} [Group G] (g : G) (f : Fin n → G) (i : Fin n) :
    ((g • partialProd f) (Fin.castLt i (Nat.lt_succ_of_lt i.2)))⁻¹ *
    (g • partialProd f) i.succ = f i := by
  rcases i with ⟨i, hn⟩
  induction i with
  | zero =>
    simp
    change partialProd f (succ ⟨0, hn⟩) = f ⟨0, hn⟩
    rw [partialProd_succ]
    simp
  | succ i hi =>
    specialize hi (lt_trans (Nat.lt_succ_self i) hn)
    simp at hi ⊢
    change (partialProd f (succ ⟨i, Nat.lt_of_succ_lt hn⟩))⁻¹ * g⁻¹ * (g *
      partialProd f (succ ⟨i + 1, hn⟩)) = f ⟨Nat.succ i, hn⟩
    rw [partialProd_succ, partialProd_succ, Fin.castSucc_mk, Fin.castSucc_mk, mul_inv_rev]
    simp_rw [← mul_assoc] at hi ⊢
    suffices h : (f ⟨i, Nat.lt_of_succ_lt hn⟩)⁻¹ *
        ((partialProd f ⟨i, Nat.lt_succ_of_lt (Nat.lt_of_succ_lt hn)⟩)⁻¹ * g⁻¹ *
        (g * partialProd f ⟨i + 1, Nat.succ_lt_succ (Nat.lt_of_succ_lt hn)⟩)) *
        f ⟨Nat.succ i, hn⟩ = f ⟨Nat.succ i, hn⟩
    · simp_rw[←mul_assoc] at h
      assumption
    · rw [mul_left_eq_self, inv_mul_eq_one, ←hi, ← mul_assoc]
#align fin.partial_prod_right_inv Fin.partialProd_right_inv
#align fin.partial_sum_right_neg Fin.partialSum_right_neg

end PartialProd

end Fin

namespace List

section CommMonoid

variable [CommMonoid α]

@[to_additive]
theorem prod_take_ofFn {n : ℕ} (f : Fin n → α) (i : ℕ) :
    ((ofFn f).take i).prod = ∏ j in Finset.univ.filter fun j : Fin n => j.val < i, f j := by
  induction i with
  | zero =>
    simp
  | succ i IH =>
    by_cases h : i < n
    · have : i < length (ofFn f) := by rwa [length_ofFn f]
      rw [prod_take_succ _ _ this]
      have A : ((Finset.univ : Finset (Fin n)).filter fun j => j.val < i + 1) =
          ((Finset.univ : Finset (Fin n)).filter fun j => j.val < i) ∪ {(⟨i, h⟩ : Fin n)} := by
        ext ⟨_, _⟩
        simp [Nat.lt_succ_iff_lt_or_eq]
      have B : _root_.Disjoint (Finset.filter (fun j : Fin n => j.val < i) Finset.univ)
          (singleton (⟨i, h⟩ : Fin n)) := by simp
      rw [A, Finset.prod_union B, IH]
      simp
    · have A : (ofFn f).take i = (ofFn f).take i.succ := by
        rw [← length_ofFn f] at h
        have : length (ofFn f) ≤ i := not_lt.mp h
        rw [take_all_of_le this, take_all_of_le (le_trans this (Nat.le_succ _))]
      have B : ∀ j : Fin n, ((j : ℕ) < i.succ) = ((j : ℕ) < i) := by
        intro j
        have : (j : ℕ) < i := lt_of_lt_of_le j.2 (not_lt.mp h)
        simp [this, lt_trans this (Nat.lt_succ_self _)]
      simp [← A, B, IH]
#align list.prod_take_of_fn List.prod_take_ofFn
#align list.sum_take_of_fn List.sum_take_ofFn

@[to_additive]
theorem prod_ofFn {n : ℕ} {f : Fin n → α} : (ofFn f).prod = ∏ i, f i := by
  convert prod_take_ofFn f n
  · rw [take_all_of_le (le_of_eq (length_ofFn f))]
  · simp
#align list.prod_of_fn List.prod_ofFn
#align list.sum_of_fn List.sum_ofFn

end CommMonoid

-- Porting note: Statement had deprecated `L.nthLe i i.is_lt` instead of `L.get i`.
@[to_additive]
theorem alternatingProd_eq_finset_prod {G : Type _} [CommGroup G] :
    ∀ (L : List G), alternatingProd L = ∏ i : Fin L.length, L.get i ^ (-1 : ℤ) ^ (i : ℕ)
  | [] => by
    rw [alternatingProd, Finset.prod_eq_one]
    rintro ⟨i, ⟨⟩⟩
  | g::[] => by
    show g = ∏ i : Fin 1, [g].get i ^ (-1 : ℤ) ^ (i : ℕ)
    rw [Fin.prod_univ_succ]; simp
  | g::h::L =>
    calc g * h⁻¹ * L.alternatingProd
      = g * h⁻¹ * ∏ i : Fin L.length, L.get i ^ (-1 : ℤ) ^ (i : ℕ) :=
        congr_arg _ (alternatingProd_eq_finset_prod _)
    _ = ∏ i : Fin (L.length + 2), List.get (g::h::L) i ^ (-1 : ℤ) ^ (i : ℕ) := by
        { rw [Fin.prod_univ_succ, Fin.prod_univ_succ, mul_assoc]
          simp [Nat.succ_eq_add_one, pow_add]}
#align list.alternating_prod_eq_finset_prod List.alternatingProd_eq_finset_prod
#align list.alternating_sum_eq_finset_sum List.alternatingSum_eq_finset_sum

end List


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

import ..todo
import topology.subset_properties
import topology.separation
import topology.metric_space.basic

/-!
A formal roadmap for basic properties of paracompact spaces.

It contains the statements that compact spaces and metric spaces are paracompact,
and that paracompact t2 spaces are normal, as well as partially formalised proofs.

Any contributor should feel welcome to contribute complete proofs. When this happens,
we should also consider preserving the current file as an exemplar of a formal roadmap.
-/

open set filter

universe u

namespace roadmap

class paracompact_space (X : Type u) [topological_space X] : Prop :=
(locally_finite_refinement :
  ∀ {α : Type u} (u : α → set X) (uo : ∀ a, is_open (u a)) (uc : Union u = univ),
  ∃ {β : Type u} (v : β → set X) (vo : ∀ b, is_open (v b)) (vc : Union v = univ),
  locally_finite v ∧ ∀ b, ∃ a, v b ⊆ u a)

/-- Any open cover of a paracompact space has a locally finite *precise* refinement, that is,
 one indexed on the same type with each open set contained in the corresponding original one. -/
lemma paracompact_space.precise_refinement {X : Type u} [topological_space X] [paracompact_space X]
  {α : Type u} (u : α → set X) (uo : ∀ a, is_open (u a)) (uc : Union u = univ) :
  ∃ v : α → set X, (∀ a, is_open (v a)) ∧ Union v = univ ∧ locally_finite v ∧ (∀ a, v a ⊆ u a) :=
begin
  obtain ⟨β, w, wo, wc, lfw, wr⟩ := paracompact_space.locally_finite_refinement u uo uc,
  choose f hf using wr,
  refine ⟨λ a, ⋃₀ {s | ∃ b, f b = a ∧ s = w b}, λ a, _, _, _, λ a, _⟩,
  { apply is_open_sUnion _,
    rintros t ⟨b, rfl, rfl⟩,
    apply wo },
  { todo },
  { todo },
  { apply sUnion_subset,
    rintros t ⟨b, rfl, rfl⟩,
    apply hf }
end

lemma paracompact_of_compact {X : Type u} [topological_space X] [compact_space X] :
  paracompact_space X :=
begin
  refine ⟨λ α u uo uc, _⟩,
  obtain ⟨s, _, sf, sc⟩ :=
    compact_univ.elim_finite_subcover_image (λ a _, uo a) (by rwa [univ_subset_iff, bUnion_univ]),
  refine ⟨s, λ b, u b.val, λ b, uo b.val, _, _, λ b, ⟨b.val, subset.refl _⟩⟩,
  { todo },
  { intro x,
    refine ⟨univ, univ_mem_sets, _⟩,
    todo },
end

lemma normal_of_paracompact_t2 {X : Type u} [topological_space X] [t2_space X]
  [paracompact_space X] : normal_space X :=
todo
/-
Similar to the proof of `generalized_tube_lemma`, but different enough not to merge them.
Lemma: if `s : set X` is closed and can be separated from any point by open sets,
then `s` can also be separated from any closed set by open sets. Apply twice.

See
* Bourbaki, General Topology, Chapter IX, §4.4
* https://ncatlab.org/nlab/show/paracompact+Hausdorff+spaces+are+normal
-/

lemma paracompact_of_metric {X : Type u} [metric_space X] : paracompact_space X :=
todo
/-
See Mary Ellen Rudin, A new proof that metric spaces are paracompact.
https://www.ams.org/journals/proc/1969-020-02/S0002-9939-1969-0236876-3/S0002-9939-1969-0236876-3.pdf
-/
end roadmap


/-
Copyright (c) 2021 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens, Thomas Browning
-/

import data.nat.choose.basic
import data.nat.choose.sum

/-!
# Central binomial coefficients

This file proves properties of the central binomial coefficients (that is, `nat.choose (2 * n) n`).

## Main definition and results

* `nat.central_binom`: the central binomial coefficient, `(2 * n).choose n`.
* `nat.succ_mul_central_binom_succ`: the inductive relationship between successive central binomial
  coefficients.
* `nat.four_pow_lt_mul_central_binom`: an exponential lower bound on the central binomial
  coefficient.
* `succ_dvd_central_binom`: The result that `n+1 ∣ n.central_binom`, ensuring that the explicit
  definition of the Catalan numbers is integer-valued.
-/

namespace nat

/--
The central binomial coefficient, `nat.choose (2 * n) n`.
-/
def central_binom (n : ℕ) := (2 * n).choose n

lemma central_binom_eq_two_mul_choose (n : ℕ) : central_binom n = (2 * n).choose n := rfl

lemma central_binom_pos (n : ℕ) : 0 < central_binom n :=
choose_pos (nat.le_mul_of_pos_left zero_lt_two)

lemma central_binom_ne_zero (n : ℕ) : central_binom n ≠ 0 :=
(central_binom_pos n).ne'

@[simp] lemma central_binom_zero : central_binom 0 = 1 :=
choose_zero_right _

/--
The central binomial coefficient is the largest binomial coefficient.
-/
lemma choose_le_central_binom (r n : ℕ) : choose (2 * n) r ≤ central_binom n :=
calc (2 * n).choose r ≤ (2 * n).choose (2 * n / 2) : choose_le_middle r (2 * n)
... = (2 * n).choose n : by rw nat.mul_div_cancel_left n zero_lt_two

lemma two_le_central_binom (n : ℕ) (n_pos : 0 < n) : 2 ≤ central_binom n :=
calc 2 ≤ 2 * n : le_mul_of_pos_right n_pos
... = (2 * n).choose 1 : (choose_one_right (2 * n)).symm
... ≤ central_binom n : choose_le_central_binom 1 n

/--
An inductive property of the central binomial coefficient.
-/
lemma succ_mul_central_binom_succ (n : ℕ) :
  (n + 1) * central_binom (n + 1) = 2 * (2 * n + 1) * central_binom n :=
calc (n + 1) * (2 * (n + 1)).choose (n + 1) = (2 * n + 2).choose (n + 1) * (n + 1) : mul_comm _ _
... = (2 * n + 1).choose n * (2 * n + 2) : by rw [choose_succ_right_eq, choose_mul_succ_eq]
... = 2 * ((2 * n + 1).choose n * (n + 1)) : by ring
... = 2 * ((2 * n + 1).choose n * ((2 * n + 1) - n)) :
  by rw [two_mul n, add_assoc, nat.add_sub_cancel_left]
... = 2 * ((2 * n).choose n * (2 * n + 1)) : by rw choose_mul_succ_eq
... = (2 * (2 * n + 1)) * (2 * n).choose n : by rw [mul_assoc, mul_comm (2 * n + 1)]

/--
An exponential lower bound on the central binomial coefficient.
This bound is of interest because it appears in
[Tochiori's refinement of Erdős's proof of Bertrand's postulate](tochiori_bertrand).
-/
lemma four_pow_lt_mul_central_binom (n : ℕ) (n_big : 4 ≤ n) : 4 ^ n < n * central_binom n :=
begin
  induction n using nat.strong_induction_on with n IH,
  rcases lt_trichotomy n 4 with (hn|rfl|hn),
  { clear IH, dec_trivial! },
  { norm_num [central_binom, choose] },
  obtain ⟨n, rfl⟩ : ∃ m, n = m + 1 := nat.exists_eq_succ_of_ne_zero (zero_lt_four.trans hn).ne',
  calc 4 ^ (n + 1) < 4 * (n * central_binom n) :
      (mul_lt_mul_left zero_lt_four).mpr (IH n n.lt_succ_self (nat.le_of_lt_succ hn))
  ... ≤ 2 * (2 * n + 1) * central_binom n : by { rw ← mul_assoc, linarith }
  ... = (n + 1) * central_binom (n + 1) : (succ_mul_central_binom_succ n).symm,
end

/--
An exponential lower bound on the central binomial coefficient.
This bound is weaker than `four_pow_n_lt_n_mul_central_binom`, but it is of historical interest
because it appears in Erdős's proof of Bertrand's postulate.
-/
lemma four_pow_le_two_mul_self_mul_central_binom : ∀ (n : ℕ) (n_pos : 0 < n),
  4 ^ n ≤ (2 * n) * central_binom n
| 0 pr := (nat.not_lt_zero _ pr).elim
| 1 pr := by norm_num [central_binom, choose]
| 2 pr := by norm_num [central_binom, choose]
| 3 pr := by norm_num [central_binom, choose]
| n@(m + 4) _ :=
calc 4 ^ n ≤ n * central_binom n : (four_pow_lt_mul_central_binom _ le_add_self).le
... ≤ 2 * n * central_binom n    : by { rw [mul_assoc], refine le_mul_of_pos_left zero_lt_two }

lemma two_dvd_central_binom_succ (n : ℕ) : 2 ∣ central_binom (n + 1) :=
begin
  use (n+1+n).choose n,
  rw [central_binom_eq_two_mul_choose, two_mul, ← add_assoc, choose_succ_succ, choose_symm_add,
      ← two_mul],
end

lemma two_dvd_central_binom_of_one_le {n : ℕ} (h : 0 < n) : 2 ∣ central_binom n :=
begin
  rw ← nat.succ_pred_eq_of_pos h,
  exact two_dvd_central_binom_succ n.pred,
end

/-- A crucial lemma to ensure that Catalan numbers can be defined via their explicit formula
  `catalan n = n.central_binom / (n + 1)`. -/
lemma succ_dvd_central_binom (n : ℕ) : (n + 1) ∣ n.central_binom :=
begin
  have h_s : (n+1).coprime (2*n+1),
  { rw [two_mul,add_assoc, coprime_add_self_right, coprime_self_add_left],
    exact coprime_one_left n },
  apply h_s.dvd_of_dvd_mul_left,
  apply dvd_of_mul_dvd_mul_left zero_lt_two,
  rw [← mul_assoc, ← succ_mul_central_binom_succ, mul_comm],
  exact mul_dvd_mul_left _ (two_dvd_central_binom_succ n),
end

end nat