import game.world4.level3 -- hide
namespace mynat -- hide

/-

# Power World

## Level 4: `one_pow`
-/

/- Lemma
For all naturals $m$, $1 ^ m = 1$.
-/
lemma one_pow (m : mynat) : (1 : mynat) ^ m = 1 :=
begin [nat_num_game]
  induction m with t ht,
    rw pow_zero,
    refl,
  rw pow_succ,
  rw ht,
  rw mul_one,
  refl,

end

end mynat -- hide


import   data.set.function  set_theory.cardinal
open  set  function

universes u
variable α : Type u

theorem Cantor0 (s :set α): ¬ (∃ f, maps_to f s (powerset s) ∧ surj_on f s (powerset s) ) ∧
   (∃ f:α → set α, inj_on f s)
   := sorry

theorem Cantor: ¬ (∃ f:α → set α, surjective f ) ∧ (∃ f:α → set α, injective f)
:=
sorry

theorem Cantor_cardinal: cardinal.mk(α) < cardinal.mk(set(α )):=
sorry


import lambda_calculus.utlc.basic
import lambda_calculus.utlc.reduction
import lambda_calculus.utlc.beta.church_rosser
import lambda_calculus.utlc.beta.basic
import lambda_calculus.utlc.beta.normal
import lambda_calculus.distance

namespace lambda_calculus
namespace utlc
namespace β

def distance_le (n: ℕ) (a b: utlc) := distance_le has_β_reduction.step n a b

variables {a b c: utlc}
variables {n m nm: ℕ}

theorem distance_le_of_reduction: a ↠β b → ∃ n, distance_le n a b :=
begin
  intro h,
  induction h with _ _ _ hab,
  { exact ⟨0, distance_le_refl _⟩ },
  cases h_ih with n h_ih,
  exact ⟨n+1, distance_le_trans h_ih (distance_le_single hab)⟩
end

theorem distance_le_of_equiv: a ≡β b → ∃ n, distance_le n a b :=
begin
  intro h,
  rcases h with ⟨x, hax, hbx⟩,
  cases distance_le_of_reduction hax with n hax,
  cases distance_le_of_reduction hbx with m hbx,
  exact ⟨n+m, distance_le_trans hax (distance_le_symm hbx)⟩
end

theorem equiv_of_distance_le: distance_le n a b → a ≡β b :=
begin
  induction n generalizing a b,
  { intro p,
    rw [distance_le, distance_le_zero] at p,
    rw [p] },
  intro p,
  rcases distance_le_head p with ⟨x, hax, hxb⟩,
  apply equiv_trans _ (n_ih hxb),
  rw [distance_le_one] at hax,
  obtain h|h|h := hax,
  rw [h],
  refine ⟨x, relation.refl_trans_gen.single h, by refl⟩,
  refine ⟨a, by refl, relation.refl_trans_gen.single h⟩
end

theorem distance_le_of_normal_iteration (n: ℕ): normal_iteration n a = b → distance_le n a b :=
begin
  induction n generalizing a b,
  { simp [normal_iteration, distance_le, distance_le_zero] },
  simp [normal_iteration],
  rw [nat.succ_eq_add_one, nat.add_comm],
  intro p,
  apply distance_le_trans _ (n_ih p),
  rw distance_le_one,
  cases strategic_reduction_step_eq_or_reduction_step a _,
  exact or.inl h,
  exact or.inr (or.inl h)
end

theorem lambda_distance_le_lambda: distance_le n a b → distance_le n (Λ a) (Λ b) :=
begin
  apply distance_le_cong,
  simp,
end

theorem dot_distance_le_dot_left: distance_le n a b → distance_le n (a·c) (b·c) :=
begin
  simp [show ∀ x, x·c = (λ y, y·c) x, by simp],
  apply distance_le_cong,
  intros x y,
  simp,
  intro p,
  apply dot_step_dot_left p,
end

theorem dot_distance_le_dot_right: distance_le n a b → distance_le n (c·a) (c·b) :=
begin
  simp [show ∀ x, c·x = (λ y, c·y) x, by simp],
  apply distance_le_cong,
  intros x y,
  simp,
  intro p,
  apply dot_step_dot_right p,
end

end β
end utlc
end lambda_calculus


/-
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 field_theory.normal
import field_theory.primitive_element
import field_theory.fixed
import ring_theory.power_basis

/-!
# Galois Extensions

In this file we define Galois extensions as extensions which are both separable and normal.

## Main definitions

- `is_galois F E` where `E` is an extension of `F`
- `fixed_field H` where `H : subgroup (E ≃ₐ[F] E)`
- `fixing_subgroup K` where `K : intermediate_field F E`
- `galois_correspondence` where `E/F` is finite dimensional and Galois

## Main results

- `fixing_subgroup_of_fixed_field` : If `E/F` is finite dimensional (but not necessarily Galois)
  then `fixing_subgroup (fixed_field H) = H`
- `fixed_field_of_fixing_subgroup`: If `E/F` is finite dimensional and Galois
  then `fixed_field (fixing_subgroup K) = K`
Together, these two result prove the Galois correspondence

- `is_galois.tfae` : Equivalent characterizations of a Galois extension of finite degree
-/

noncomputable theory
open_locale classical

open finite_dimensional alg_equiv

section

variables (F : Type*) [field F] (E : Type*) [field E] [algebra F E]

/-- A field extension E/F is galois if it is both separable and normal -/
class is_galois : Prop :=
(separable' : is_separable F E)
(normal' : normal F E)

variables {F E}

theorem is_galois_iff : is_galois F E ↔ is_separable F E ∧ normal F E :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

protected theorem is_galois.is_separable (h : is_galois F E) : is_separable F E := h.1
protected theorem is_galois.normal (h : is_galois F E) : normal F E := h.2

@[priority 100] -- see Note [lower instance priority]
instance is_galois.normal'' [h : is_galois F E] : normal F E := h.2

variables (F E)

namespace is_galois

instance self : is_galois F F :=
⟨is_separable_self F, normal_self F⟩

@[priority 100] -- see Note [lower instance priority]
instance to_is_separable [h : is_galois F E] : is_separable F E := h.1

@[priority 100] -- see Note [lower instance priority]
instance to_normal [h : is_galois F E] : normal F E := h.2

variables (F) {E}

lemma integral [is_galois F E] (x : E) : is_integral F x := normal.is_integral' x

lemma separable [h : is_galois F E] (x : E) : (minpoly F x).separable := h.is_separable.separable x

lemma splits [is_galois F E] (x : E) : (minpoly F x).splits (algebra_map F E) := normal.splits' x

variables (F E)

instance of_fixed_field (G : Type*) [group G] [fintype G] [mul_semiring_action G E] :
  is_galois (mul_action.fixed_points G E) E :=
⟨fixed_points.separable G E, fixed_points.normal G E⟩

lemma intermediate_field.adjoin_simple.card_aut_eq_finrank
  [finite_dimensional F E] {α : E} (hα : is_integral F α)
  (h_sep : (minpoly F α).separable)
  (h_splits : (minpoly F α).splits (algebra_map F F⟮α⟯)) :
  fintype.card (F⟮α⟯ ≃ₐ[F] F⟮α⟯) = finrank F F⟮α⟯ :=
begin
  letI : fintype (F⟮α⟯ →ₐ[F] F⟮α⟯) := intermediate_field.fintype_of_alg_hom_adjoin_integral F hα,
  rw intermediate_field.adjoin.finrank hα,
  rw ← intermediate_field.card_alg_hom_adjoin_integral F hα h_sep h_splits,
  exact fintype.card_congr (alg_equiv_equiv_alg_hom F F⟮α⟯)
end

lemma card_aut_eq_finrank [finite_dimensional F E] [h : is_galois F E] :
  fintype.card (E ≃ₐ[F] E) = finrank F E :=
begin
  cases field.exists_primitive_element h.1 with α hα,
  let iso : F⟮α⟯ ≃ₐ[F] E := {
    to_fun := λ e, e.val,
    inv_fun := λ e, ⟨e, by { rw hα, exact intermediate_field.mem_top }⟩,
    left_inv := λ _, by { ext, refl },
    right_inv := λ _, rfl,
    map_mul' := λ _ _, rfl,
    map_add' := λ _ _, rfl,
    commutes' := λ _, rfl },
  have H : is_integral F α := is_galois.integral F α,
  have h_sep : (minpoly F α).separable := is_galois.separable F α,
  have h_splits : (minpoly F α).splits (algebra_map F E) := is_galois.splits F α,
  replace h_splits : polynomial.splits (algebra_map F F⟮α⟯) (minpoly F α),
  { convert polynomial.splits_comp_of_splits
    (algebra_map F E) iso.symm.to_alg_hom.to_ring_hom h_splits },
  rw ← linear_equiv.finrank_eq iso.to_linear_equiv,
  rw ← intermediate_field.adjoin_simple.card_aut_eq_finrank F E H h_sep h_splits,
  apply fintype.card_congr,
  apply equiv.mk (λ ϕ, iso.trans (trans ϕ iso.symm)) (λ ϕ, iso.symm.trans (trans ϕ iso)),
  { intro ϕ, ext1, simp only [trans_apply, apply_symm_apply] },
  { intro ϕ, ext1, simp only [trans_apply, symm_apply_apply] },
end

end is_galois

end

section is_galois_tower

variables (F K E : Type*) [field F] [field K] [field E] {E' : Type*} [field E'] [algebra F E']
variables [algebra F K] [algebra F E] [algebra K E] [is_scalar_tower F K E]

lemma is_galois.tower_top_of_is_galois [is_galois F E] : is_galois K E :=
⟨is_separable_tower_top_of_is_separable F K E, normal.tower_top_of_normal F K E⟩

variables {F E}

@[priority 100] -- see Note [lower instance priority]
instance is_galois.tower_top_intermediate_field (K : intermediate_field F E) [h : is_galois F E] :
  is_galois K E := is_galois.tower_top_of_is_galois F K E

lemma is_galois_iff_is_galois_bot : is_galois (⊥ : intermediate_field F E) E ↔ is_galois F E :=
begin
  split,
  { introI h,
    exact is_galois.tower_top_of_is_galois (⊥ : intermediate_field F E) F E },
  { introI h, apply_instance },
end

lemma is_galois.of_alg_equiv [h : is_galois F E] (f : E ≃ₐ[F] E') : is_galois F E' :=
⟨is_separable.of_alg_hom F E f.symm, normal.of_alg_equiv f⟩

lemma alg_equiv.transfer_galois (f : E ≃ₐ[F] E') : is_galois F E ↔ is_galois F E' :=
⟨λ h, by exactI is_galois.of_alg_equiv f, λ h, by exactI is_galois.of_alg_equiv f.symm⟩

lemma is_galois_iff_is_galois_top : is_galois F (⊤ : intermediate_field F E) ↔ is_galois F E :=
(intermediate_field.top_equiv).transfer_galois

instance is_galois_bot : is_galois F (⊥ : intermediate_field F E) :=
(intermediate_field.bot_equiv F E).transfer_galois.mpr (is_galois.self F)

end is_galois_tower

section galois_correspondence

variables {F : Type*} [field F] {E : Type*} [field E] [algebra F E]
variables (H : subgroup (E ≃ₐ[F] E)) (K : intermediate_field F E)

namespace intermediate_field

instance subgroup_action : faithful_mul_semiring_action H E :=
{ smul := λ h x, h x,
  smul_zero := λ _, map_zero _,
  smul_add := λ _, map_add _,
  one_smul := λ _, rfl,
  smul_one := λ _, map_one _,
  mul_smul := λ _ _ _, rfl,
  smul_mul := λ _, map_mul _,
  eq_of_smul_eq_smul' := λ x y z, subtype.ext (alg_equiv.ext z) }

/-- The intermediate_field fixed by a subgroup -/
def fixed_field : intermediate_field F E :=
{ carrier := mul_action.fixed_points H E,
  zero_mem' := λ g, smul_zero g,
  add_mem' := λ a b hx hy g, by rw [smul_add g a b, hx, hy],
  neg_mem' := λ a hx g, by rw [smul_neg g a, hx],
  one_mem' := λ g, smul_one g,
  mul_mem' := λ a b hx hy g, by rw [smul_mul' g a b, hx, hy],
  inv_mem' := λ a hx g, by rw [smul_inv _ g a, hx],
  algebra_map_mem' := λ a g, commutes g a }

lemma finrank_fixed_field_eq_card [finite_dimensional F E] :
  finrank (fixed_field H) E = fintype.card H :=
fixed_points.finrank_eq_card H E

/-- The subgroup fixing an intermediate_field -/
def fixing_subgroup : subgroup (E ≃ₐ[F] E) :=
{ carrier := λ ϕ, ∀ x : K, ϕ x = x,
  one_mem' := λ _, rfl,
  mul_mem' := λ _ _ hx hy _, (congr_arg _ (hy _)).trans (hx _),
  inv_mem' := λ _ hx _, (equiv.symm_apply_eq (to_equiv _)).mpr (hx _).symm }

lemma le_iff_le : K ≤ fixed_field H ↔ H ≤ fixing_subgroup K :=
⟨λ h g hg x, h (subtype.mem x) ⟨g, hg⟩, λ h x hx g, h (subtype.mem g) ⟨x, hx⟩⟩

/-- The fixing_subgroup of `K : intermediate_field F E` is isomorphic to `E ≃ₐ[K] E` -/
def fixing_subgroup_equiv : fixing_subgroup K ≃* (E ≃ₐ[K] E) :=
{ to_fun := λ ϕ, of_bijective (alg_hom.mk ϕ (map_one ϕ) (map_mul ϕ)
    (map_zero ϕ) (map_add ϕ) (ϕ.mem)) (bijective ϕ),
  inv_fun := λ ϕ, ⟨of_bijective (alg_hom.mk ϕ (ϕ.map_one) (ϕ.map_mul)
    (ϕ.map_zero) (ϕ.map_add) (λ r, ϕ.commutes (algebra_map F K r)))
      (ϕ.bijective), ϕ.commutes⟩,
  left_inv := λ _, by { ext, refl },
  right_inv := λ _, by { ext, refl },
  map_mul' := λ _ _, by { ext, refl } }

theorem fixing_subgroup_fixed_field [finite_dimensional F E] :
  fixing_subgroup (fixed_field H) = H :=
begin
  have H_le : H ≤ (fixing_subgroup (fixed_field H)) := (le_iff_le _ _).mp (le_refl _),
  suffices : fintype.card H = fintype.card (fixing_subgroup (fixed_field H)),
  { exact set_like.coe_injective
      (set.eq_of_inclusion_surjective ((fintype.bijective_iff_injective_and_card
        (set.inclusion H_le)).mpr ⟨set.inclusion_injective H_le, this⟩).2).symm },
  apply fintype.card_congr,
  refine (fixed_points.to_alg_hom_equiv H E).trans _,
  refine (alg_equiv_equiv_alg_hom (fixed_field H) E).symm.trans _,
  exact (fixing_subgroup_equiv (fixed_field H)).to_equiv.symm
end

instance fixed_field.algebra : algebra K (fixed_field (fixing_subgroup K)) :=
{ smul := λ x y, ⟨x*y, λ ϕ, by rw [smul_mul', (show ϕ • ↑x = ↑x, by exact subtype.mem ϕ x),
    (show ϕ • ↑y = ↑y, by exact subtype.mem y ϕ)]⟩,
  to_fun := λ x, ⟨x, λ ϕ, subtype.mem ϕ x⟩,
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  map_one' := rfl,
  map_mul' := λ _ _, rfl,
  commutes' := λ _ _, mul_comm _ _,
  smul_def' := λ _ _, rfl }

instance fixed_field.is_scalar_tower : is_scalar_tower K (fixed_field (fixing_subgroup K)) E :=
⟨λ _ _ _, mul_assoc _ _ _⟩

end intermediate_field

namespace is_galois
theorem fixed_field_fixing_subgroup [finite_dimensional F E] [h : is_galois F E] :
  intermediate_field.fixed_field (intermediate_field.fixing_subgroup K) = K :=
begin
  have K_le : K ≤ intermediate_field.fixed_field (intermediate_field.fixing_subgroup K) :=
    (intermediate_field.le_iff_le _ _).mpr (le_refl _),
  suffices : finrank K E =
    finrank (intermediate_field.fixed_field (intermediate_field.fixing_subgroup K)) E,
  { exact (intermediate_field.eq_of_le_of_finrank_eq' K_le this).symm },
  rw [intermediate_field.finrank_fixed_field_eq_card,
    fintype.card_congr (intermediate_field.fixing_subgroup_equiv K).to_equiv],
  exact (card_aut_eq_finrank K E).symm,
end

lemma card_fixing_subgroup_eq_finrank [finite_dimensional F E] [is_galois F E] :
  fintype.card (intermediate_field.fixing_subgroup K) = finrank K E :=
by conv { to_rhs, rw [←fixed_field_fixing_subgroup K,
  intermediate_field.finrank_fixed_field_eq_card] }

/-- The Galois correspondence from intermediate fields to subgroups -/
def intermediate_field_equiv_subgroup [finite_dimensional F E] [is_galois F E] :
  intermediate_field F E ≃o order_dual (subgroup (E ≃ₐ[F] E)) :=
{ to_fun := intermediate_field.fixing_subgroup,
  inv_fun := intermediate_field.fixed_field,
  left_inv := λ K, fixed_field_fixing_subgroup K,
  right_inv := λ H, intermediate_field.fixing_subgroup_fixed_field H,
  map_rel_iff' := λ K L, by { rw [←fixed_field_fixing_subgroup L, intermediate_field.le_iff_le,
                                  fixed_field_fixing_subgroup L, ←order_dual.dual_le], refl } }

/-- The Galois correspondence as a galois_insertion -/
def galois_insertion_intermediate_field_subgroup [finite_dimensional F E] :
  galois_insertion (order_dual.to_dual ∘
      (intermediate_field.fixing_subgroup : intermediate_field F E → subgroup (E ≃ₐ[F] E)))
    ((intermediate_field.fixed_field : subgroup (E ≃ₐ[F] E) → intermediate_field F E) ∘
      order_dual.to_dual) :=
{ choice := λ K _, intermediate_field.fixing_subgroup K,
  gc := λ K H, (intermediate_field.le_iff_le H K).symm,
  le_l_u := λ H, le_of_eq (intermediate_field.fixing_subgroup_fixed_field H).symm,
  choice_eq := λ K _, rfl }

/-- The Galois correspondence as a galois_coinsertion -/
def galois_coinsertion_intermediate_field_subgroup [finite_dimensional F E] [is_galois F E] :
  galois_coinsertion (order_dual.to_dual ∘
      (intermediate_field.fixing_subgroup : intermediate_field F E → subgroup (E ≃ₐ[F] E)))
    ((intermediate_field.fixed_field : subgroup (E ≃ₐ[F] E) → intermediate_field F E) ∘
      order_dual.to_dual) :=
{ choice := λ H _, intermediate_field.fixed_field H,
  gc := λ K H, (intermediate_field.le_iff_le H K).symm,
  u_l_le := λ K, le_of_eq (fixed_field_fixing_subgroup K),
  choice_eq := λ H _, rfl }

end is_galois

end galois_correspondence

section galois_equivalent_definitions

variables (F : Type*) [field F] (E : Type*) [field E] [algebra F E]

namespace is_galois

lemma is_separable_splitting_field [finite_dimensional F E] [h : is_galois F E] :
  ∃ p : polynomial F, p.separable ∧ p.is_splitting_field F E :=
begin
  cases field.exists_primitive_element h.1 with α h1,
  use [minpoly F α, separable F α, is_galois.splits F α],
  rw [eq_top_iff, ←intermediate_field.top_to_subalgebra, ←h1],
  rw intermediate_field.adjoin_simple_to_subalgebra_of_integral F α (integral F α),
  apply algebra.adjoin_mono,
  rw [set.singleton_subset_iff, finset.mem_coe, multiset.mem_to_finset, polynomial.mem_roots],
  { dsimp only [polynomial.is_root],
    rw [polynomial.eval_map, ←polynomial.aeval_def],
    exact minpoly.aeval _ _ },
  { exact polynomial.map_ne_zero (minpoly.ne_zero (integral F α)) }
end

lemma of_fixed_field_eq_bot [finite_dimensional F E]
  (h : intermediate_field.fixed_field (⊤ : subgroup (E ≃ₐ[F] E)) = ⊥) : is_galois F E :=
begin
  rw [←is_galois_iff_is_galois_bot, ←h],
  exact is_galois.of_fixed_field E (⊤ : subgroup (E ≃ₐ[F] E)),
end

lemma of_card_aut_eq_finrank [finite_dimensional F E]
  (h : fintype.card (E ≃ₐ[F] E) = finrank F E) : is_galois F E :=
begin
  apply of_fixed_field_eq_bot,
  have p : 0 < finrank (intermediate_field.fixed_field (⊤ : subgroup (E ≃ₐ[F] E))) E := finrank_pos,
  rw [←intermediate_field.finrank_eq_one_iff, ←mul_left_inj' (ne_of_lt p).symm, finrank_mul_finrank,
      ←h, one_mul, intermediate_field.finrank_fixed_field_eq_card],
  apply fintype.card_congr,
  exact { to_fun := λ g, ⟨g, subgroup.mem_top g⟩, inv_fun := coe,
          left_inv := λ g, rfl, right_inv := λ _, by { ext, refl } },
end

variables {F} {E} {p : polynomial F}

lemma of_separable_splitting_field_aux [hFE : finite_dimensional F E]
  [sp : p.is_splitting_field F E] (hp : p.separable) (K : intermediate_field F E) {x : E}
  (hx : x ∈ (p.map (algebra_map F E)).roots) :
  fintype.card ((↑K⟮x⟯ : intermediate_field F E) →ₐ[F] E) =
    fintype.card (K →ₐ[F] E) * finrank K K⟮x⟯ :=
begin
  have h : is_integral K x := is_integral_of_is_scalar_tower x (is_integral_of_noetherian hFE x),
  have h1 : p ≠ 0 := λ hp, by rwa [hp, polynomial.map_zero, polynomial.roots_zero] at hx,
  have h2 : (minpoly K x) ∣ p.map (algebra_map F K),
  { apply minpoly.dvd,
    rw [polynomial.aeval_def, polynomial.eval₂_map, ←polynomial.eval_map],
    exact (polynomial.mem_roots (polynomial.map_ne_zero h1)).mp hx },
  let key_equiv : ((↑K⟮x⟯ : intermediate_field F E) →ₐ[F] E) ≃ Σ (f : K →ₐ[F] E),
    @alg_hom K K⟮x⟯ E _ _ _ _ (ring_hom.to_algebra f) :=
  equiv.trans (alg_equiv.arrow_congr (intermediate_field.lift2_alg_equiv K⟮x⟯) (alg_equiv.refl))
    alg_hom_equiv_sigma,
  haveI : Π (f : K →ₐ[F] E), fintype (@alg_hom K K⟮x⟯ E _ _ _ _ (ring_hom.to_algebra f)) := λ f, by
  { apply fintype.of_injective (sigma.mk f) (λ _ _ H, eq_of_heq ((sigma.mk.inj H).2)),
    exact fintype.of_equiv _ key_equiv },
  rw [fintype.card_congr key_equiv, fintype.card_sigma, intermediate_field.adjoin.finrank h],
  apply finset.sum_const_nat,
  intros f hf,
  rw ← @intermediate_field.card_alg_hom_adjoin_integral K _ E _ _ x E _ (ring_hom.to_algebra f) h,
  { apply fintype.card_congr, refl },
  { exact polynomial.separable.of_dvd ((polynomial.separable_map (algebra_map F K)).mpr hp) h2 },
  { refine polynomial.splits_of_splits_of_dvd _ (polynomial.map_ne_zero h1) _ h2,
    rw [polynomial.splits_map_iff, ←is_scalar_tower.algebra_map_eq],
    exact sp.splits },
end

lemma of_separable_splitting_field [sp : p.is_splitting_field F E] (hp : p.separable) :
  is_galois F E :=
begin
  haveI hFE : finite_dimensional F E := polynomial.is_splitting_field.finite_dimensional E p,
  let s := (p.map (algebra_map F E)).roots.to_finset,
  have adjoin_root : intermediate_field.adjoin F ↑s = ⊤,
  { apply intermediate_field.to_subalgebra_injective,
    rw [intermediate_field.top_to_subalgebra, ←top_le_iff, ←sp.adjoin_roots],
    apply intermediate_field.algebra_adjoin_le_adjoin, },
  let P : intermediate_field F E → Prop := λ K, fintype.card (K →ₐ[F] E) = finrank F K,
  suffices : P (intermediate_field.adjoin F ↑s),
  { rw adjoin_root at this,
    apply of_card_aut_eq_finrank,
    rw ← eq.trans this (linear_equiv.finrank_eq intermediate_field.top_equiv.to_linear_equiv),
    exact fintype.card_congr (equiv.trans (alg_equiv_equiv_alg_hom F E)
      (alg_equiv.arrow_congr intermediate_field.top_equiv.symm alg_equiv.refl)) },
  apply intermediate_field.induction_on_adjoin_finset s P,
  { have key := intermediate_field.card_alg_hom_adjoin_integral F
      (show is_integral F (0 : E), by exact is_integral_zero),
    rw [minpoly.zero, polynomial.nat_degree_X] at key,
    specialize key polynomial.separable_X (polynomial.splits_X (algebra_map F E)),
    rw [←@subalgebra.finrank_bot F E _ _ _, ←intermediate_field.bot_to_subalgebra] at key,
    refine eq.trans _ key,
    apply fintype.card_congr,
    rw intermediate_field.adjoin_zero },
  intros K x hx hK,
  simp only [P] at *,
  rw [of_separable_splitting_field_aux hp K (multiset.mem_to_finset.mp hx),
    hK, finrank_mul_finrank],
  exact (linear_equiv.finrank_eq (intermediate_field.lift2_alg_equiv K⟮x⟯).to_linear_equiv).symm,
end

/--Equivalent characterizations of a Galois extension of finite degree-/
theorem tfae [finite_dimensional F E] :
  tfae [is_galois F E,
    intermediate_field.fixed_field (⊤ : subgroup (E ≃ₐ[F] E)) = ⊥,
    fintype.card (E ≃ₐ[F] E) = finrank F E,
    ∃ p : polynomial F, p.separable ∧ p.is_splitting_field F E] :=
begin
  tfae_have : 1 → 2,
  { exact λ h, order_iso.map_bot (@intermediate_field_equiv_subgroup F _ E _ _ _ h).symm },
  tfae_have : 1 → 3,
  { introI _, exact card_aut_eq_finrank F E },
  tfae_have : 1 → 4,
  { introI _, exact is_separable_splitting_field F E },
  tfae_have : 2 → 1,
  { exact of_fixed_field_eq_bot F E },
  tfae_have : 3 → 1,
  { exact of_card_aut_eq_finrank F E },
  tfae_have : 4 → 1,
  { rintros ⟨h, hp1, _⟩, exactI of_separable_splitting_field hp1 },
  tfae_finish,
end

end is_galois

end galois_equivalent_definitions


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

import ring_theory.eisenstein_criterion
import ring_theory.integrally_closed
import ring_theory.norm
import ring_theory.polynomial.cyclotomic.basic

/-!
# Eisenstein polynomials
Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]` is
*Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
`f.coeff 0 ∉ 𝓟 ^ 2`. In this file we gather miscellaneous results about Eisenstein polynomials.

## Main definitions
* `polynomial.is_eisenstein_at f 𝓟`: the property of being Eisenstein at `𝓟`.

## Main results
* `polynomial.is_eisenstein_at.irreducible`: if a primitive `f` satisfies `f.is_eisenstein_at 𝓟`,
  where `𝓟.is_prime`, then `f` is irreducible.
* `mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at`: let `K` be the field of fraction
  of an integrally closed domain `R` and let `L` be a separable extension of `K`, generated by an
  integral power basis `B` such that the minimal polynomial of `B.gen` is Eisenstein at `p`. Given
  `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`, then `z ∈ adjoin R {B.gen}`.
  Together with `algebra.discr_mul_is_integral_mem_adjoin` this result often allows to compute the
  ring of integers of `L`.

## Implementation details
We also define a notion `is_weakly_eisenstein_at` requiring only that
`∀ n < f.nat_degree → f.coeff n ∈ 𝓟`. This makes certain results slightly more general and it is
useful since it is sometimes better behaved (for example it is stable under `polynomial.map`).

-/

universes u v w z

variables {R : Type u}

open ideal algebra finset

open_locale big_operators polynomial

namespace polynomial

/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
is *weakly Eisenstein at `𝓟`* if `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟`. -/
@[mk_iff] structure is_weakly_eisenstein_at [comm_semiring R] (f : R[X]) (𝓟 : ideal R) :
  Prop := (mem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟)

/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
is *Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
`f.coeff 0 ∉ 𝓟 ^ 2`. -/
@[mk_iff] structure is_eisenstein_at [comm_semiring R] (f : R[X]) (𝓟 : ideal R) : Prop :=
(leading : f.leading_coeff ∉ 𝓟)
(mem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟)
(not_mem : f.coeff 0 ∉ 𝓟 ^ 2)

namespace is_weakly_eisenstein_at

section comm_semiring

variables [comm_semiring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_weakly_eisenstein_at 𝓟)

include hf

lemma map {A : Type v} [comm_ring A] (φ : R →+* A) : (f.map φ).is_weakly_eisenstein_at (𝓟.map φ) :=
begin
  refine (is_weakly_eisenstein_at_iff _ _).2 (λ n hn, _),
  rw [coeff_map],
  exact mem_map_of_mem _ (hf.mem (lt_of_lt_of_le hn (nat_degree_map_le _ _)))
end

end comm_semiring

section comm_ring

variables [comm_ring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_weakly_eisenstein_at 𝓟)
variables {S : Type v} [comm_ring S] [algebra R S]

section principal

variable {p : R}

local notation `P` := submodule.span R {p}

lemma exists_mem_adjoin_mul_eq_pow_nat_degree {x : S} (hx : aeval x f = 0)
  (hmo : f.monic) (hf : f.is_weakly_eisenstein_at P) : ∃ y ∈ adjoin R ({x} : set S),
  (algebra_map R S) p * y = x ^ (f.map (algebra_map R S)).nat_degree :=
begin
  rw [aeval_def, polynomial.eval₂_eq_eval_map, eval_eq_sum_range, range_add_one,
    sum_insert not_mem_range_self, sum_range, (hmo.map
    (algebra_map R S)).coeff_nat_degree, one_mul] at hx,
  replace hx := eq_neg_of_add_eq_zero hx,
  have : ∀ n < f.nat_degree, p ∣ f.coeff n,
  { intros n hn,
    refine mem_span_singleton.1 (by simpa using hf.mem hn) },
  choose! φ hφ using this,
  conv_rhs at hx { congr, congr, skip, funext,
    rw [fin.coe_eq_val, coeff_map, hφ i.1 (lt_of_lt_of_le i.2 (nat_degree_map_le _ _)),
      ring_hom.map_mul, mul_assoc] },
  rw [hx, ← mul_sum, neg_eq_neg_one_mul, ← mul_assoc (-1 : S), mul_comm (-1 : S), mul_assoc],
  refine ⟨-1 * ∑ (i : fin (f.map (algebra_map R S)).nat_degree),
    (algebra_map R S) (φ i.1) * x ^ i.1, _, rfl⟩,
  exact subalgebra.mul_mem _ (subalgebra.neg_mem _ (subalgebra.one_mem _))
    (subalgebra.sum_mem _ (λ i hi, subalgebra.mul_mem _ (subalgebra.algebra_map_mem _ _)
    (subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton x)) _)))
end

lemma exists_mem_adjoin_mul_eq_pow_nat_degree_le {x : S} (hx : aeval x f = 0)
  (hmo : f.monic) (hf : f.is_weakly_eisenstein_at P) :
  ∀ i, (f.map (algebra_map R S)).nat_degree ≤ i →
  ∃ y ∈ adjoin R ({x} : set S), (algebra_map R S) p * y = x ^ i :=
begin
  intros i hi,
  obtain ⟨k, hk⟩ := le_iff_exists_add.1 hi,
  rw [hk, pow_add],
  obtain ⟨y, hy, H⟩ := exists_mem_adjoin_mul_eq_pow_nat_degree hx hmo hf,
  refine ⟨y * x ^ k, _, _⟩,
  { exact subalgebra.mul_mem _ hy (subalgebra.pow_mem _  (subset_adjoin (set.mem_singleton x)) _) },
  { rw [← mul_assoc _ y, H] }
end

end principal

include hf

lemma pow_nat_degree_le_of_root_of_monic_mem {x : R} (hroot : is_root f x) (hmo : f.monic) :
  ∀ i, f.nat_degree ≤ i → x ^ i ∈ 𝓟 :=
begin
  intros i hi,
  obtain ⟨k, hk⟩ := le_iff_exists_add.1 hi,
  rw [hk, pow_add],
  suffices : x ^ f.nat_degree ∈ 𝓟,
  { exact mul_mem_right (x ^ k) 𝓟 this },
  rw [is_root.def, eval_eq_sum_range, finset.range_add_one, finset.sum_insert
    finset.not_mem_range_self, finset.sum_range, hmo.coeff_nat_degree, one_mul] at hroot,
  rw [eq_neg_of_add_eq_zero hroot, neg_mem_iff],
  refine submodule.sum_mem _ (λ i hi,  mul_mem_right _ _ (hf.mem (fin.is_lt i)))
end

lemma pow_nat_degree_le_of_aeval_zero_of_monic_mem_map {x : S} (hx : aeval x f = 0)
  (hmo : f.monic) :
  ∀ i, (f.map (algebra_map R S)).nat_degree ≤ i → x ^ i ∈ 𝓟.map (algebra_map R S) :=
begin
  suffices : x ^ (f.map (algebra_map R S)).nat_degree ∈ 𝓟.map (algebra_map R S),
  { intros i hi,
    obtain ⟨k, hk⟩ := le_iff_exists_add.1 hi,
    rw [hk, pow_add],
    refine mul_mem_right _ _ this },
  rw [aeval_def, eval₂_eq_eval_map, ← is_root.def] at hx,
  refine pow_nat_degree_le_of_root_of_monic_mem (hf.map _) hx (hmo.map _) _ rfl.le
end

end comm_ring

end is_weakly_eisenstein_at

namespace is_eisenstein_at

section comm_semiring

variables [comm_semiring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_eisenstein_at 𝓟)

lemma _root_.polynomial.monic.leading_coeff_not_mem (hf : f.monic) (h : 𝓟 ≠ ⊤) :
  ¬f.leading_coeff ∈ 𝓟 :=
hf.leading_coeff.symm ▸ (ideal.ne_top_iff_one _).1 h

lemma _root_.polynomial.monic.is_eisenstein_at_of_mem_of_not_mem (hf : f.monic) (h : 𝓟 ≠ ⊤)
  (hmem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟) (hnot_mem : f.coeff 0 ∉ 𝓟 ^ 2) :
  f.is_eisenstein_at 𝓟 :=
{ leading := hf.leading_coeff_not_mem h,
  mem := λ n hn, hmem hn,
  not_mem := hnot_mem }

include hf

lemma is_weakly_eisenstein_at : is_weakly_eisenstein_at f 𝓟 := ⟨hf.mem⟩

lemma coeff_mem {n : ℕ} (hn : n ≠ f.nat_degree) : f.coeff n ∈ 𝓟 :=
begin
  cases ne_iff_lt_or_gt.1 hn,
  { exact hf.mem h },
  { rw [coeff_eq_zero_of_nat_degree_lt h],
    exact ideal.zero_mem _}
end

end comm_semiring

section is_domain

variables [comm_ring R] [is_domain R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_eisenstein_at 𝓟)

/-- If a primitive `f` satisfies `f.is_eisenstein_at 𝓟`, where `𝓟.is_prime`, then `f` is
irreducible. -/
lemma irreducible (hprime : 𝓟.is_prime) (hu : f.is_primitive)
  (hfd0 : 0 < f.nat_degree) : irreducible f :=
irreducible_of_eisenstein_criterion hprime hf.leading (λ n hn, hf.mem (coe_lt_degree.1 hn))
  (nat_degree_pos_iff_degree_pos.1 hfd0) hf.not_mem hu

end is_domain

end is_eisenstein_at

end polynomial

section cyclotomic

variables (p : ℕ)

local notation `𝓟` := submodule.span ℤ {p}

open polynomial

lemma cyclotomic_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] :
  ((cyclotomic p ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
begin
  refine monic.is_eisenstein_at_of_mem_of_not_mem _
    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
    nat.prime_iff_prime_int.1 hp.out) (λ i hi, _) _,
  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
    refine ((cyclotomic.monic p ℤ).comp (monic_X_add_C 1) (λ h, _)),
    rw [nat_degree_X_add_C] at h,
    exact zero_ne_one h.symm },
  { rw [cyclotomic_eq_geom_sum hp.out, geom_sum_X_comp_X_add_one_eq_sum, ← lcoeff_apply,
      linear_map.map_sum],
    conv { congr, congr, skip, funext,
      rw [lcoeff_apply, ← C_eq_nat_cast, ← monomial_eq_C_mul_X, coeff_monomial] },
    rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C, mul_one,
      nat_degree_cyclotomic, nat.totient_prime hp.out] at hi,
    simp only [lt_of_lt_of_le hi (nat.sub_le _ _), int.nat_cast_eq_coe_nat, sum_ite_eq', mem_range,
      if_true, ideal.submodule_span_eq, ideal.mem_span_singleton],
    exact int.coe_nat_dvd.2
      (nat.prime.dvd_choose_self (nat.succ_pos i) (lt_tsub_iff_right.1 hi) hp.out) },
  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_eq_geom_sum hp.out, eval_add, eval_X,
      eval_one, zero_add, eval_geom_sum, one_geom_sum, int.nat_cast_eq_coe_nat,
      ideal.submodule_span_eq, ideal.span_singleton_pow, ideal.mem_span_singleton],
    intro h,
    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
    rw [← mul_assoc, mul_one, mul_assoc] at hk,
    nth_rewrite 0 [← nat.mul_one p] at hk,
    rw [nat.mul_right_inj hp.out.pos] at hk,
    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
end

lemma cyclotomic_prime_pow_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] (n : ℕ) :
  ((cyclotomic (p ^ (n + 1)) ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
begin
  refine monic.is_eisenstein_at_of_mem_of_not_mem _
    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
    nat.prime_iff_prime_int.1 hp.out) _ _,
  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
    refine ((cyclotomic.monic _ ℤ).comp (monic_X_add_C 1) (λ h, _)),
    rw [nat_degree_X_add_C] at h,
    exact zero_ne_one h.symm },
  { induction n with n hn,
    { intros i hi,
      rw [zero_add, pow_one] at hi ⊢,
      exact (cyclotomic_comp_X_add_one_is_eisenstein_at p).mem hi },
    { intros i hi,
      rw [ideal.submodule_span_eq, ideal.mem_span_singleton, ← zmod.int_coe_zmod_eq_zero_iff_dvd,
        ← int.coe_cast_ring_hom, ← coeff_map, map_comp, map_cyclotomic, polynomial.map_add, map_X,
        polynomial.map_one, pow_add, pow_one, cyclotomic_mul_prime_dvd_eq_pow, pow_comp,
        ← zmod.expand_card, coeff_expand hp.out.pos],
      { simp only [ite_eq_right_iff],
        rintro ⟨k, hk⟩,
        rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C,
          mul_one, nat_degree_cyclotomic, nat.totient_prime_pow hp.out (nat.succ_pos _),
          nat.succ_sub_one] at hn hi,
        rw [hk, pow_succ, mul_assoc] at hi,
        rw [hk, mul_comm, nat.mul_div_cancel _ hp.out.pos],
        replace hn := hn (lt_of_mul_lt_mul_left' hi),
        rw [ideal.submodule_span_eq, ideal.mem_span_singleton,
          ← zmod.int_coe_zmod_eq_zero_iff_dvd, ← int.coe_cast_ring_hom, ← coeff_map] at hn,
        simpa [map_comp] using hn },
      { exact ⟨p ^ n, by rw [pow_succ]⟩ } } },
  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime_pow_eq_geom_sum hp.out, eval_add,
      eval_X, eval_one, zero_add, geom_sum_def, eval_finset_sum],
    simp only [eval_pow, eval_X, one_pow, sum_const, card_range, nat.smul_one_eq_coe,
      int.nat_cast_eq_coe_nat, submodule_span_eq, ideal.submodule_span_eq,
      ideal.span_singleton_pow, ideal.mem_span_singleton],
    intro h,
    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
    rw [← mul_assoc, mul_one, mul_assoc] at hk,
    nth_rewrite 0 [← nat.mul_one p] at hk,
    rw [nat.mul_right_inj hp.out.pos] at hk,
    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
end

end cyclotomic

section is_integral

variables {K : Type v} {L : Type z} {p : R} [comm_ring R] [field K] [field L]
variables [algebra K L] [algebra R L] [algebra R K] [is_scalar_tower R K L] [is_separable K L]
variables [is_domain R] [normalized_gcd_monoid R] [is_fraction_ring R K] [is_integrally_closed R]

local notation `𝓟` := submodule.span R {p}

open is_integrally_closed power_basis nat polynomial is_scalar_tower

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `Q : polynomial R` is such that
`aeval B.gen Q = p • z`, then `p ∣ Q.coeff 0`. -/
lemma dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
  (hp : prime p) (hBint : is_integral R B.gen) {z : L} {Q : polynomial R}
  (hQ : aeval B.gen Q = p • z) (hzint : is_integral R z)
  (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) : p ∣ Q.coeff 0 :=
begin
  -- First define some abbreviations.
  letI := B.finite_dimensional,
  let P := minpoly R B.gen,
  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
  have finrank_K_L : finite_dimensional.finrank K L = B.dim := B.finrank,
  have deg_K_P : (minpoly K B.gen).nat_degree = B.dim := B.nat_degree_minpoly,
  have deg_R_P : P.nat_degree = B.dim,
  { rw [← deg_K_P, minpoly.gcd_domain_eq_field_fractions K hBint,
        (minpoly.monic hBint).nat_degree_map (algebra_map R K)] },
  choose! f hf using hei.is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
    (minpoly.aeval R B.gen) (minpoly.monic hBint),
  simp only [(minpoly.monic hBint).nat_degree_map, deg_R_P] at hf,

  -- The Eisenstein condition shows that `p` divides `Q.coeff 0`
  -- if `p^n.succ` divides the following multiple of `Q.coeff 0^n.succ`:
  suffices : p ^ n.succ ∣
    (Q.coeff 0 ^ n.succ * ((-1) ^ (n.succ * n) * (minpoly R B.gen).coeff 0 ^ n)),
  { have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
      hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
    refine prime.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd hp ((_ : _ ^ n.succ ∣ _)) hndiv,
    convert (is_unit.dvd_mul_right ⟨(-1) ^ (n.succ * n), rfl⟩).mpr this using 1,
    push_cast,
    ring_nf, simp [pow_right_comm _ _ 2] },

  -- We claim the quotient of `Q^n * _` by `p^n` is the following `r`:
  have aux : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0, B.dim ≤ i + n,
  { intros i hi,
    simp only [mem_range, mem_erase] at hi,
    rw [hn],
    exact le_add_pred_of_pos _ hi.1 },
  have hintsum : is_integral R (z * B.gen ^ n -
    ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0, Q.coeff x • f (x + n)),
  { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
      (is_integral.sum _ (λ i hi, (is_integral_smul _ _))),
    exact adjoin_le_integral_closure hBint (hf _ (aux i hi)).1 },
  obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
  use r,

  -- Do the computation in `K` so we can work in terms of `z` instead of `r`.
  apply is_fraction_ring.injective R K,
  simp only [_root_.map_mul, _root_.map_pow, _root_.map_neg, _root_.map_one],
  -- Both sides are actually norms:
  calc _ = norm K (Q.coeff 0 • B.gen ^ n) : _
  ... = norm K (p • (z * B.gen ^ n) - ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
          p • Q.coeff x • f (x + n))
    : congr_arg (norm K) (eq_sub_of_add_eq _)
  ... = _ : _,
  { simp only [algebra.smul_def, algebra_map_apply R K L, norm_algebra_map, _root_.map_mul,
      _root_.map_pow, finrank_K_L, power_basis.norm_gen_eq_coeff_zero_minpoly,
      minpoly.gcd_domain_eq_field_fractions K hBint, coeff_map, ← hn],
    ring_exp },
  swap, { simp_rw [← smul_sum, ← smul_sub, algebra.smul_def p, algebra_map_apply R K L,
      _root_.map_mul, norm_algebra_map, finrank_K_L, hr, ← hn] },

  calc _ = (Q.coeff 0 • 1 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
              Q.coeff x • B.gen ^ x) * B.gen ^ n : _
  ... = (Q.coeff 0 • B.gen ^ 0 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
              Q.coeff x • B.gen ^ x) * B.gen ^ n : by rw pow_zero
  ... = (aeval B.gen Q) * B.gen ^ n : _
  ... = _ : by rw [hQ, algebra.smul_mul_assoc],
  { have : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0,
      Q.coeff i • (B.gen ^ i * B.gen ^ n) =
      p • Q.coeff i • f (i + n),
    { intros i hi,
      rw [←pow_add, ←(hf _ (aux i hi)).2, ←algebra.smul_def, smul_smul, mul_comm _ p, smul_smul] },
    simp only [add_mul, smul_mul_assoc, one_mul, sum_mul, sum_congr rfl this] },
  { rw [aeval_eq_sum_range,
        finset.add_sum_erase (range (Q.nat_degree + 1)) (λ i, Q.coeff i • B.gen ^ i)],
    simp },
end

lemma mem_adjoin_of_dvd_coeff_of_dvd_aeval {A B : Type*} [comm_semiring A] [comm_ring B]
  [algebra A B] [no_zero_smul_divisors A B] {Q : polynomial A} {p : A} {x z : B} (hp : p ≠ 0)
  (hQ : ∀ i ∈ range (Q.nat_degree + 1), p ∣ Q.coeff i) (hz : aeval x Q = p • z) :
  z ∈ adjoin A ({x} : set B) :=
begin
  choose! f hf using hQ,
  rw [aeval_eq_sum_range, sum_range] at hz,
  conv_lhs at hz { congr, skip, funext,
    rw [hf i (mem_range.2 (fin.is_lt i)), ← smul_smul] },
  rw [← smul_sum] at hz,
  rw [← smul_right_injective _ hp hz],
  exact subalgebra.sum_mem _ (λ _ _, subalgebra.smul_mem _
    (subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton _)) _) _)
end

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p • z ∈ adjoin R {B.gen}`, then
`z ∈ adjoin R {B.gen}`. -/
lemma mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
  (hp : prime p) (hBint : is_integral R B.gen) {z : L} (hzint : is_integral R z)
  (hz : p • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
  z ∈ adjoin R ({B.gen} : set L) :=
begin
  -- First define some abbreviations.
  have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
    hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
  letI := finite_dimensional B,
  set P := minpoly R B.gen with hP,
  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
  haveI : no_zero_smul_divisors R L := no_zero_smul_divisors.trans R K L,
  let P₁ := P.map (algebra_map R L),

  -- There is a polynomial `Q` such that `p • z = aeval B.gen Q`. We can assume that
  -- `Q.degree < P.degree` and `Q ≠ 0`.
  rw [adjoin_singleton_eq_range_aeval] at hz,
  obtain ⟨Q₁, hQ⟩ := hz,
  set Q := Q₁ %ₘ P with hQ₁,
  replace hQ : aeval B.gen Q = p • z,
  { rw [← mod_by_monic_add_div Q₁ (minpoly.monic hBint)] at hQ,
    simpa using hQ },
  by_cases hQzero : Q = 0,
  { simp only [hQzero, algebra.smul_def, zero_eq_mul, aeval_zero] at hQ,
    cases hQ with H H₁,
    { have : function.injective (algebra_map R L),
      { rw [algebra_map_eq R K L],
        exact (algebra_map K L).injective.comp (is_fraction_ring.injective R K) },      exfalso,
      exact hp.ne_zero ((ring_hom.injective_iff _).1 this _ H) },
    { rw [H₁],
      exact subalgebra.zero_mem _ } },

  -- It is enough to prove that all coefficients of `Q` are divisible by `p`, by induction.
  -- The base case is `dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at`.
  refine mem_adjoin_of_dvd_coeff_of_dvd_aeval hp.ne_zero (λ i, _) hQ,
  refine nat.case_strong_induction_on i _ (λ j hind, _),
  { intro H,
    exact dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at
      hp hBint hQ hzint hei },
  { intro hj,
    refine hp.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd _ hndiv,
    exact n,

    -- Two technical results we will need about `P.nat_degree` and `Q.nat_degree`.
    have H := degree_mod_by_monic_lt Q₁ (minpoly.monic hBint),
    rw [← hQ₁, ← hP] at H,
    replace H:= nat.lt_iff_add_one_le.1 (lt_of_lt_of_le (lt_of_le_of_lt
      (nat.lt_iff_add_one_le.1 (nat.lt_of_succ_lt_succ (mem_range.1 hj))) (lt_succ_self _))
      (nat.lt_iff_add_one_le.1 (((nat_degree_lt_nat_degree_iff hQzero).2 H)))),
    rw [add_assoc] at H,
    have Hj : Q.nat_degree + 1 = j + 1 + (Q.nat_degree - j),
    { rw [← add_comm 1, ← add_comm 1, add_assoc, add_right_inj, ← nat.add_sub_assoc
        (nat.lt_of_succ_lt_succ (mem_range.1 hj)).le, add_comm, nat.add_sub_cancel] },

    -- By induction hypothesis we can find `g : ℕ → R` such that
    -- `k ∈ range (j + 1) → Q.coeff k • B.gen ^ k = (algebra_map R L) p * g k • B.gen ^ k`-
    choose! g hg using hind,
    replace hg : ∀ k ∈ range (j + 1), Q.coeff k • B.gen ^ k =
      (algebra_map R L p) * (g k • B.gen ^ k),
    { intros k hk,
      rw [hg k (mem_range_succ_iff.1 hk) (mem_range_succ_iff.2 (le_trans (mem_range_succ_iff.1 hk)
        (succ_le_iff.1 (mem_range_succ_iff.1 hj)).le)), algebra.smul_def, algebra.smul_def,
        ring_hom.map_mul, mul_assoc] },

    -- Since `minpoly R B.gen` is Eiseinstein, we can find `f : ℕ → L` such that
    -- `(map (algebra_map R L) (minpoly R B.gen)).nat_degree ≤ i` implies `f i ∈ adjoin R {B.gen}`
    -- and `(algebra_map R L) p * f i = B.gen ^ i`. We will also need `hf₁`, a reformulation of this
    -- property.
    choose! f hf using (is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
    (minpoly.aeval R B.gen) (minpoly.monic hBint) hei.is_weakly_eisenstein_at),
    have hf₁ : ∀ k ∈ (range (Q.nat_degree - j)).erase 0,
      Q.coeff (j + 1 + k) • B.gen ^ (j + 1 + k) * B.gen ^ (P.nat_degree - (j + 2)) =
      (algebra_map R L) p * Q.coeff (j + 1 + k) • f (k + P.nat_degree - 1),
    { intros k hk,
      rw [smul_mul_assoc, ← pow_add, ← nat.add_sub_assoc H, ← add_assoc j 1 1,
        add_comm (j + 1) 1, add_assoc (j + 1), add_comm _ (k + P.nat_degree),
        nat.add_sub_add_right, ← (hf (k + P.nat_degree - 1) _).2, mul_smul_comm],
      rw [(minpoly.monic hBint).nat_degree_map, add_comm, nat.add_sub_assoc,
        le_add_iff_nonneg_right],
      { exact nat.zero_le _ },
      { refine one_le_iff_ne_zero.2 (λ h, _),
        rw [h] at hk,
        simpa using hk },
      { apply_instance } },

  -- The Eisenstein condition shows that `p` divides `Q.coeff j`
  -- if `p^n.succ` divides the following multiple of `Q.coeff (succ j)^n.succ`:
   suffices : p ^ n.succ ∣
    Q.coeff (succ j) ^ n.succ * (minpoly R B.gen).coeff 0 ^ (succ j + (P.nat_degree - (j + 2))),
  { convert this,
    rw [nat.succ_eq_add_one, add_assoc, ← nat.add_sub_assoc H, ← add_assoc, add_comm (j + 1),
      nat.add_sub_add_left, ← nat.add_sub_assoc, nat.add_sub_add_left, hP,
      ← (minpoly.monic hBint).nat_degree_map  (algebra_map R K),
      ← minpoly.gcd_domain_eq_field_fractions K hBint, nat_degree_minpoly, hn, nat.sub_one,
      nat.pred_succ],
    linarith },

  -- Using `hQ : aeval B.gen Q = p • z`, we write `p • z` as a sum of terms of degree less than
  -- `j+1`, that are multiples of `p` by induction, and terms of degree at least `j+1`.
  rw [aeval_eq_sum_range, Hj, range_add, sum_union (disjoint_range_add_left_embedding _ _),
      sum_congr rfl hg, add_comm] at hQ,
  -- We multiply this equality by `B.gen ^ (P.nat_degree-(j+2))`, so we can use `hf₁` on the terms
  -- we didn't know were multiples of `p`, and we take the norm on both sides.
  replace hQ := congr_arg (λ x, x * B.gen ^ (P.nat_degree - (j + 2))) hQ,
  simp_rw [sum_map, add_left_embedding_apply, add_mul, sum_mul, mul_assoc] at hQ,
  rw [← insert_erase (mem_range.2 (tsub_pos_iff_lt.2 $ nat.lt_of_succ_lt_succ $ mem_range.1 hj)),
      sum_insert (not_mem_erase 0 _), add_zero, sum_congr rfl hf₁, ← mul_sum, ← mul_sum,
      add_assoc, ← mul_add, smul_mul_assoc, ← pow_add, algebra.smul_def] at hQ,
  replace hQ := congr_arg (norm K) (eq_sub_of_add_eq hQ),

  -- We obtain an equality of elements of `K`, but everything is integral, so we can move to `R`
  -- and simplify `hQ`.
  have hintsum : is_integral R (z * B.gen ^ (P.nat_degree - (j + 2)) -
      (∑ (x : ℕ) in (range (Q.nat_degree - j)).erase 0, Q.coeff (j + 1 + x) •
        f (x + P.nat_degree - 1) +
      ∑ (x : ℕ) in range (j + 1), g x • B.gen ^ x * B.gen ^ (P.nat_degree - (j + 2)))),
    { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
        (is_integral_add (is_integral.sum _ (λ k hk, is_integral_smul _ _))
        (is_integral.sum _ (λ k hk, is_integral_mul (is_integral_smul _ (is_integral.pow hBint _))
        ((is_integral.pow hBint _))))),
      refine adjoin_le_integral_closure hBint (hf _ _).1,
      rw [(minpoly.monic hBint).nat_degree_map (algebra_map R L)],
      rw [add_comm, nat.add_sub_assoc, le_add_iff_nonneg_right],
      { exact zero_le _ },
      { refine one_le_iff_ne_zero.2 (λ h, _),
        rw [h] at hk,
        simpa using hk } },
    obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
    rw [algebra.smul_def, mul_assoc, ← mul_sub, _root_.map_mul, algebra_map_apply R K L, map_pow,
      norm_algebra_map, _root_.map_mul, algebra_map_apply R K L, norm_algebra_map, finrank B, ← hr,
      power_basis.norm_gen_eq_coeff_zero_minpoly, minpoly.gcd_domain_eq_field_fractions K hBint,
      coeff_map, show (-1 : K) = algebra_map R K (-1), by simp, ← map_pow, ← map_pow,
      ← _root_.map_mul, ← map_pow, ← _root_.map_mul, ← map_pow, ← _root_.map_mul] at hQ,

    -- We can now finish the proof.
    have hppdiv : p ^ B.dim ∣ p ^ B.dim * r := dvd_mul_of_dvd_left dvd_rfl _,
    rwa [← is_fraction_ring.injective R K hQ, mul_comm, ← units.coe_neg_one, mul_pow,
      ← units.coe_pow, ← units.coe_pow, mul_assoc, is_unit.dvd_mul_left _ _ _ ⟨_, rfl⟩, mul_comm,
      ← nat.succ_eq_add_one, hn] at hppdiv }
end

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`,
then `z ∈ adjoin R {B.gen}`. Together with `algebra.discr_mul_is_integral_mem_adjoin` this result
often allows to compute the ring of integers of `L`. -/
lemma mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
  (hp : prime p) (hBint : is_integral R B.gen) {n : ℕ} {z : L} (hzint : is_integral R z)
  (hz : p ^ n • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
  z ∈ adjoin R ({B.gen} : set L) :=
begin
  induction n with n hn,
  { simpa using hz },
  { rw [pow_succ, mul_smul] at hz,
    exact hn (mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at
      hp hBint (is_integral_smul _ hzint) hz hei) }
end

end is_integral


/-
Copyright (c) 2020 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.finite
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Infinitude of intervals

Bounded intervals in dense orders are infinite, as are unbounded intervals
in orders that are unbounded on the appropriate side.
-/

namespace set

theorem Ioo.infinite {α : Type u_1} [preorder α] [densely_ordered α] {a : α} {b : α} (h : a < b) :
    infinite (Ioo a b) :=
  sorry

theorem Ico.infinite {α : Type u_1} [preorder α] [densely_ordered α] {a : α} {b : α} (h : a < b) :
    infinite (Ico a b) :=
  infinite_mono Ioo_subset_Ico_self (Ioo.infinite h)

theorem Ioc.infinite {α : Type u_1} [preorder α] [densely_ordered α] {a : α} {b : α} (h : a < b) :
    infinite (Ioc a b) :=
  infinite_mono Ioo_subset_Ioc_self (Ioo.infinite h)

theorem Icc.infinite {α : Type u_1} [preorder α] [densely_ordered α] {a : α} {b : α} (h : a < b) :
    infinite (Icc a b) :=
  infinite_mono Ioo_subset_Icc_self (Ioo.infinite h)

theorem Iio.infinite {α : Type u_1} [preorder α] [no_bot_order α] {b : α} : infinite (Iio b) :=
  sorry

theorem Iic.infinite {α : Type u_1} [preorder α] [no_bot_order α] {b : α} : infinite (Iic b) :=
  infinite_mono Iio_subset_Iic_self Iio.infinite

theorem Ioi.infinite {α : Type u_1} [preorder α] [no_top_order α] {a : α} : infinite (Ioi a) :=
  Iio.infinite

theorem Ici.infinite {α : Type u_1} [preorder α] [no_top_order α] {a : α} : infinite (Ici a) :=
  infinite_mono Ioi_subset_Ici_self Ioi.infinite

end Mathlib


import Mathlib.Data.List.Basic
import Mathlib.Data.String.Defs

namespace String

lemma congr_append : ∀ (a b : String), a ++ b = String.mk (a.data ++ b.data)
| ⟨a⟩, ⟨b⟩ => rfl

@[simp] lemma length_append : ∀ (as bs : String), (as ++ bs).length = as.length + bs.length
| ⟨as⟩, ⟨bs⟩ => by
  rw [congr_append]
  simp only [String.length]
  exact List.length_append as bs

@[simp] lemma length_repeat' (c : Char) (n : ℕ) : (repeat' c n).length = n :=
by simp only [String.length, String.repeat', List.length_repeat']

lemma length_eq_list_length (l : List Char) : (String.mk l).length = l.length :=
by simp only [String.length]

/-- The length of the String returned by `String.leftpad n a c` is equal
  to the larger of `n` and `s.length` -/
@[simp] lemma leftpad_length (n : ℕ) (c : Char) : ∀ (s : String), (leftpad n c s).length = max n s.length
| ⟨s⟩ => by simp only [leftpad, String.length, List.leftpad_length]

lemma leftpad_prefix (n : ℕ) (c : Char) : ∀ s, isPrefix (repeat' c (n - length s)) (leftpad n c s)
| ⟨l⟩ => by simp only [isPrefix, repeat', leftpad, String.length, List.leftpad_prefix]

lemma leftpad_suffix (n : ℕ) (c : Char) : ∀ s, isSuffix s (leftpad n c s)
| ⟨l⟩ => by simp only [isSuffix, repeat', leftpad, String.length, List.leftpad_suffix]

end String


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

! This file was ported from Lean 3 source module algebra.quadratic_discriminant
! leanprover-community/mathlib commit e085d1df33274f4b32f611f483aae678ba0b42df
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.CharP.Invertible
import Mathlib.Order.Filter.AtTopBot
import Mathlib.Tactic.FieldSimp
import Mathlib.Tactic.LinearCombination

/-!
# Quadratic discriminants and roots of a quadratic

This file defines the discriminant of a quadratic and gives the solution to a quadratic equation.

## Main definition

- `discrim a b c`: the discriminant of a quadratic `a * x * x + b * x + c` is `b * b - 4 * a * c`.

## Main statements

- `quadratic_eq_zero_iff`: roots of a quadratic can be written as
  `(-b + s) / (2 * a)` or `(-b - s) / (2 * a)`, where `s` is a square root of the discriminant.
- `quadratic_ne_zero_of_discrim_ne_sq`: if the discriminant has no square root,
  then the corresponding quadratic has no root.
- `discrim_le_zero`: if a quadratic is always non-negative, then its discriminant is non-positive.
- `discrim_le_zero_of_nonpos`, `discrim_lt_zero`, `discrim_lt_zero_of_neg`: versions of this
  statement with other inequalities.

## Tags

polynomial, quadratic, discriminant, root
-/

open Filter

section Ring

variable {R : Type _}

/-- Discriminant of a quadratic -/
def discrim [Ring R] (a b c : R) : R :=
  b ^ 2 - 4 * a * c
#align discrim discrim

@[simp] lemma discrim_neg [Ring R] (a b c : R) : discrim (-a) (-b) (-c) = discrim a b c := by
  simp [discrim]
#align discrim_neg discrim_neg

variable [CommRing R] {a b c : R}

lemma discrim_eq_sq_of_quadratic_eq_zero {x : R} (h : a * x * x + b * x + c = 0) :
    discrim a b c = (2 * a * x + b) ^ 2 := by
  rw [discrim]
  linear_combination -4 * a * h
#align discrim_eq_sq_of_quadratic_eq_zero discrim_eq_sq_of_quadratic_eq_zero

/-- A quadratic has roots if and only if its discriminant equals some square.
-/
theorem quadratic_eq_zero_iff_discrim_eq_sq [NeZero (2 : R)] [NoZeroDivisors R]
    (ha : a ≠ 0) (x : R) :
    a * x * x + b * x + c = 0 ↔ discrim a b c = (2 * a * x + b) ^ 2 := by
  refine ⟨discrim_eq_sq_of_quadratic_eq_zero, fun h ↦ ?_⟩
  rw [discrim] at h
  have ha : 2 * 2 * a ≠ 0 := mul_ne_zero (mul_ne_zero (NeZero.ne _) (NeZero.ne _)) ha
  apply mul_left_cancel₀ ha
  linear_combination -h
#align quadratic_eq_zero_iff_discrim_eq_sq quadratic_eq_zero_iff_discrim_eq_sq

/-- A quadratic has no root if its discriminant has no square root. -/
theorem quadratic_ne_zero_of_discrim_ne_sq (h : ∀ s : R, discrim a b c ≠ s^2) (x : R) :
    a * x * x + b * x + c ≠ 0 :=
  mt discrim_eq_sq_of_quadratic_eq_zero (h _)
#align quadratic_ne_zero_of_discrim_ne_sq quadratic_ne_zero_of_discrim_ne_sq

end Ring

section Field

variable {K : Type _} [Field K] [NeZero (2 : K)] {a b c x : K}

/-- Roots of a quadratic equation. -/
theorem quadratic_eq_zero_iff (ha : a ≠ 0) {s : K} (h : discrim a b c = s * s) (x : K) :
    a * x * x + b * x + c = 0 ↔ x = (-b + s) / (2 * a) ∨ x = (-b - s) / (2 * a) := by
  rw [quadratic_eq_zero_iff_discrim_eq_sq ha, h, sq, mul_self_eq_mul_self_iff]
  field_simp
  apply or_congr
  · constructor <;> intro h' <;> linear_combination -h'
  · constructor <;> intro h' <;> linear_combination h'
#align quadratic_eq_zero_iff quadratic_eq_zero_iff

/-- A quadratic has roots if its discriminant has square roots -/
theorem exists_quadratic_eq_zero (ha : a ≠ 0) (h : ∃ s, discrim a b c = s * s) :
    ∃ x, a * x * x + b * x + c = 0 := by
  rcases h with ⟨s, hs⟩
  use (-b + s) / (2 * a)
  rw [quadratic_eq_zero_iff ha hs]
  simp
#align exists_quadratic_eq_zero exists_quadratic_eq_zero

/-- Root of a quadratic when its discriminant equals zero -/
theorem quadratic_eq_zero_iff_of_discrim_eq_zero (ha : a ≠ 0) (h : discrim a b c = 0) (x : K) :
    a * x * x + b * x + c = 0 ↔ x = -b / (2 * a) := by
  have : discrim a b c = 0 * 0 := by rw [h, MulZeroClass.mul_zero]
  rw [quadratic_eq_zero_iff ha this, add_zero, sub_zero, or_self_iff]
#align quadratic_eq_zero_iff_of_discrim_eq_zero quadratic_eq_zero_iff_of_discrim_eq_zero

end Field

section LinearOrderedField

variable {K : Type _} [LinearOrderedField K] {a b c : K}

/-- If a polynomial of degree 2 is always nonnegative, then its discriminant is nonpositive -/
theorem discrim_le_zero (h : ∀ x : K, 0 ≤ a * x * x + b * x + c) : discrim a b c ≤ 0 := by
  rw [discrim, sq]
  obtain ha | rfl | ha : a < 0 ∨ a = 0 ∨ 0 < a := lt_trichotomy a 0
  -- if a < 0
  · have : Tendsto (fun x => (a * x + b) * x + c) atTop atBot :=
      tendsto_atBot_add_const_right _ c
        ((tendsto_atBot_add_const_right _ b (tendsto_id.neg_const_mul_atTop ha)).atBot_mul_atTop
          tendsto_id)
    rcases(this.eventually (eventually_lt_atBot 0)).exists with ⟨x, hx⟩
    exact False.elim ((h x).not_lt <| by rwa [← add_mul])
  -- if a = 0
  · rcases eq_or_ne b 0 with (rfl | hb)
    · simp
    · have := h ((-c - 1) / b)
      rw [mul_div_cancel' _ hb] at this
      linarith
  -- if a > 0
  · have ha' : 0 ≤ 4 * a := mul_nonneg zero_le_four ha.le
    convert neg_nonpos.2 (mul_nonneg ha' (h (-b / (2 * a)))) using 1
    field_simp [ha.ne']
    ring
#align discrim_le_zero discrim_le_zero

lemma discrim_le_zero_of_nonpos (h : ∀ x : K, a * x * x + b * x + c ≤ 0) : discrim a b c ≤ 0 :=
  discrim_neg a b c ▸ discrim_le_zero <| by simpa only [neg_mul, ← neg_add, neg_nonneg]
#align discrim_le_zero_of_nonpos discrim_le_zero_of_nonpos

/-- If a polynomial of degree 2 is always positive, then its discriminant is negative,
at least when the coefficient of the quadratic term is nonzero.
-/
theorem discrim_lt_zero (ha : a ≠ 0) (h : ∀ x : K, 0 < a * x * x + b * x + c) :
    discrim a b c < 0 := by
  have : ∀ x : K, 0 ≤ a * x * x + b * x + c := fun x => le_of_lt (h x)
  refine lt_of_le_of_ne (discrim_le_zero this) fun h' ↦ ?_
  have := h (-b / (2 * a))
  have : a * (-b / (2 * a)) * (-b / (2 * a)) + b * (-b / (2 * a)) + c = 0 := by
    rw [quadratic_eq_zero_iff_of_discrim_eq_zero ha h' (-b / (2 * a))]
  linarith
#align discrim_lt_zero discrim_lt_zero

lemma discrim_lt_zero_of_neg (ha : a ≠ 0) (h : ∀ x : K, a * x * x + b * x + c < 0) :
    discrim a b c < 0 :=
  discrim_neg a b c ▸ discrim_lt_zero (neg_ne_zero.2 ha) <| by
    simpa only [neg_mul, ← neg_add, neg_pos]
#align discrim_lt_zero_of_neg discrim_lt_zero_of_neg

end LinearOrderedField


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.equiv.basic
import algebra.field
import algebra.module
import algebra.algebra.basic
import algebra.group.type_tags
import ring_theory.ideal.basic

/-!
# Transfer algebraic structures across `equiv`s

In this file we prove theorems of the following form: if `β` has a
group structure and `α ≃ β` then `α` has a group structure, and
similarly for monoids, semigroups, rings, integral domains, fields and
so on.

Note that most of these constructions can also be obtained using the `transport` tactic.

## Tags

equiv, group, ring, field, module, algebra
-/

universes u v
variables {α : Type u} {β : Type v}

namespace equiv

section instances

variables (e : α ≃ β)

/-- Transfer `has_one` across an `equiv` -/
@[to_additive "Transfer `has_zero` across an `equiv`"]
protected def has_one [has_one β] : has_one α := ⟨e.symm 1⟩
@[to_additive]
lemma one_def [has_one β] : @has_one.one _ (equiv.has_one e) = e.symm 1 := rfl

/-- Transfer `has_mul` across an `equiv` -/
@[to_additive "Transfer `has_add` across an `equiv`"]
protected def has_mul [has_mul β] : has_mul α := ⟨λ x y, e.symm (e x * e y)⟩
@[to_additive]
lemma mul_def [has_mul β] (x y : α) :
  @has_mul.mul _ (equiv.has_mul e) x y = e.symm (e x * e y) := rfl

/-- Transfer `has_div` across an `equiv` -/
@[to_additive "Transfer `has_sub` across an `equiv`"]
protected def has_div [has_div β] : has_div α := ⟨λ x y, e.symm (e x / e y)⟩
@[to_additive]
lemma div_def [has_div β] (x y : α) :
@has_div.div _ (equiv.has_div e) x y = e.symm (e x / e y) := rfl

/-- Transfer `has_inv` across an `equiv` -/
@[to_additive "Transfer `has_neg` across an `equiv`"]
protected def has_inv [has_inv β] : has_inv α := ⟨λ x, e.symm (e x)⁻¹⟩
@[to_additive]
lemma inv_def [has_inv β] (x : α) : @has_inv.inv _ (equiv.has_inv e) x = e.symm (e x)⁻¹ := rfl

/-- Transfer `has_scalar` across an `equiv` -/
protected def has_scalar {R : Type*} [has_scalar R β] : has_scalar R α  :=
⟨λ r x, e.symm (r • (e x))⟩
lemma smul_def {R : Type*} [has_scalar R β] (r : R) (x : α) :
  @has_scalar.smul _ _ (equiv.has_scalar e) r x = e.symm (r • (e x)) := rfl

/--
An equivalence `e : α ≃ β` gives a multiplicative equivalence `α ≃* β`
where the multiplicative structure on `α` is
the one obtained by transporting a multiplicative structure on `β` back along `e`.
-/
@[to_additive
"An equivalence `e : α ≃ β` gives a additive equivalence `α ≃+ β`
where the additive structure on `α` is
the one obtained by transporting an additive structure on `β` back along `e`."]
def mul_equiv (e : α ≃ β) [has_mul β] :
  by { letI := equiv.has_mul e, exact α ≃* β } :=
begin
  introsI,
  exact
  { map_mul' := λ x y, by { apply e.symm.injective, simp, refl, },
    ..e }
end

@[simp, to_additive] lemma mul_equiv_apply (e : α ≃ β) [has_mul β] (a : α) :
  (mul_equiv e) a = e a := rfl

@[to_additive] lemma mul_equiv_symm_apply (e : α ≃ β) [has_mul β] (b : β) :
  by { letI := equiv.has_mul e, exact (mul_equiv e).symm b = e.symm b } :=
begin
  intros, refl,
end

/--
An equivalence `e : α ≃ β` gives a ring equivalence `α ≃+* β`
where the ring structure on `α` is
the one obtained by transporting a ring structure on `β` back along `e`.
-/
def ring_equiv (e : α ≃ β) [has_add β] [has_mul β] :
  by { letI := equiv.has_add e, letI := equiv.has_mul e, exact α ≃+* β } :=
begin
  introsI,
  exact
  { map_add' := λ x y, by { apply e.symm.injective, simp, refl, },
    map_mul' := λ x y, by { apply e.symm.injective, simp, refl, },
    ..e }
end

@[simp] lemma ring_equiv_apply (e : α ≃ β) [has_add β] [has_mul β] (a : α) :
  (ring_equiv e) a = e a := rfl

lemma ring_equiv_symm_apply (e : α ≃ β) [has_add β] [has_mul β] (b : β) :
  by { letI := equiv.has_add e, letI := equiv.has_mul e, exact (ring_equiv e).symm b = e.symm b } :=
begin
  intros, refl,
end

/-- Transfer `semigroup` across an `equiv` -/
@[to_additive "Transfer `add_semigroup` across an `equiv`"]
protected def semigroup [semigroup β] : semigroup α :=
let mul := e.has_mul in
by resetI; apply e.injective.semigroup _; intros; exact e.apply_symm_apply _

/-- Transfer `semigroup_with_zero` across an `equiv` -/
protected def semigroup_with_zero [semigroup_with_zero β] : semigroup_with_zero α :=
let mul := e.has_mul, zero := e.has_zero in
by resetI; apply e.injective.semigroup_with_zero _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_semigroup` across an `equiv` -/
@[to_additive "Transfer `add_comm_semigroup` across an `equiv`"]
protected def comm_semigroup [comm_semigroup β] : comm_semigroup α :=
let mul := e.has_mul in
by resetI; apply e.injective.comm_semigroup _; intros; exact e.apply_symm_apply _

/-- Transfer `mul_zero_class` across an `equiv` -/
protected def mul_zero_class [mul_zero_class β] : mul_zero_class α :=
let zero := e.has_zero, mul := e.has_mul in
by resetI; apply e.injective.mul_zero_class _; intros; exact e.apply_symm_apply _

/-- Transfer `mul_one_class` across an `equiv` -/
@[to_additive "Transfer `add_zero_class` across an `equiv`"]
protected def mul_one_class [mul_one_class β] : mul_one_class α :=
let one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.mul_one_class _; intros; exact e.apply_symm_apply _

/-- Transfer `mul_zero_one_class` across an `equiv` -/
protected def mul_zero_one_class [mul_zero_one_class β] : mul_zero_one_class α :=
let zero := e.has_zero, one := e.has_one,mul := e.has_mul in
by resetI; apply e.injective.mul_zero_one_class _; intros; exact e.apply_symm_apply _

/-- Transfer `monoid` across an `equiv` -/
@[to_additive "Transfer `add_monoid` across an `equiv`"]
protected def monoid [monoid β] : monoid α :=
let one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.monoid _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_monoid` across an `equiv` -/
@[to_additive "Transfer `add_comm_monoid` across an `equiv`"]
protected def comm_monoid [comm_monoid β] : comm_monoid α :=
let one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.comm_monoid _; intros; exact e.apply_symm_apply _

/-- Transfer `group` across an `equiv` -/
@[to_additive "Transfer `add_group` across an `equiv`"]
protected def group [group β] : group α :=
let one := e.has_one, mul := e.has_mul, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.group _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_group` across an `equiv` -/
@[to_additive "Transfer `add_comm_group` across an `equiv`"]
protected def comm_group [comm_group β] : comm_group α :=
let one := e.has_one, mul := e.has_mul, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.comm_group _; intros; exact e.apply_symm_apply _

/-- Transfer `semiring` across an `equiv` -/
protected def semiring [semiring β] : semiring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.semiring _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_semiring` across an `equiv` -/
protected def comm_semiring [comm_semiring β] : comm_semiring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.comm_semiring _; intros; exact e.apply_symm_apply _

/-- Transfer `ring` across an `equiv` -/
protected def ring [ring β] : ring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub in
by resetI; apply e.injective.ring _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_ring` across an `equiv` -/
protected def comm_ring [comm_ring β] : comm_ring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub in
by resetI; apply e.injective.comm_ring _; intros; exact e.apply_symm_apply _

/-- Transfer `nonzero` across an `equiv` -/
protected theorem nontrivial [nontrivial β] : nontrivial α :=
e.surjective.nontrivial

/-- Transfer `domain` across an `equiv` -/
protected def domain [domain β] : domain α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub in
by resetI; apply e.injective.domain _; intros; exact e.apply_symm_apply _

/-- Transfer `integral_domain` across an `equiv` -/
protected def integral_domain [integral_domain β] : integral_domain α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub in
by resetI; apply e.injective.integral_domain _; intros; exact e.apply_symm_apply _

/-- Transfer `division_ring` across an `equiv` -/
protected def division_ring [division_ring β] : division_ring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.division_ring _; intros; exact e.apply_symm_apply _

/-- Transfer `field` across an `equiv` -/
protected def field [field β] : field α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.field _; intros; exact e.apply_symm_apply _

section R
variables (R : Type*)
include R

section
variables [monoid R]

/-- Transfer `mul_action` across an `equiv` -/
protected def mul_action (e : α ≃ β) [mul_action R β] : mul_action R α :=
{ one_smul := by simp [smul_def],
  mul_smul := by simp [smul_def, mul_smul],
  ..equiv.has_scalar e }

/-- Transfer `distrib_mul_action` across an `equiv` -/
protected def distrib_mul_action (e : α ≃ β) [add_comm_monoid β] :
  begin
    letI := equiv.add_comm_monoid e,
    exact Π [distrib_mul_action R β], distrib_mul_action R α
  end :=
begin
  intros,
  letI := equiv.add_comm_monoid e,
  exact (
  { smul_zero := by simp [zero_def, smul_def],
    smul_add := by simp [add_def, smul_def, smul_add],
    ..equiv.mul_action R e } : distrib_mul_action R α)
end

end

section
variables [semiring R]

/-- Transfer `module` across an `equiv` -/
protected def module (e : α ≃ β) [add_comm_monoid β] :
  begin
    letI := equiv.add_comm_monoid e,
    exact Π [module R β], module R α
  end :=
begin
  introsI,
  exact (
  { zero_smul := by simp [zero_def, smul_def],
    add_smul := by simp [add_def, smul_def, add_smul],
    ..equiv.distrib_mul_action R e } : module R α)
end

/--
An equivalence `e : α ≃ β` gives a linear equivalence `α ≃ₗ[R] β`
where the `R`-module structure on `α` is
the one obtained by transporting an `R`-module structure on `β` back along `e`.
-/
def linear_equiv (e : α ≃ β) [add_comm_monoid β] [module R β] :
  begin
    letI := equiv.add_comm_monoid e,
    letI := equiv.module R e,
    exact α ≃ₗ[R] β
  end :=
begin
  introsI,
  exact
  { map_smul' := λ r x, by { apply e.symm.injective, simp, refl, },
    ..equiv.add_equiv e }
end

end

section
variables [comm_semiring R]

/-- Transfer `algebra` across an `equiv` -/
protected def algebra (e : α ≃ β) [semiring β] :
  begin
    letI := equiv.semiring e,
    exact Π [algebra R β], algebra R α
  end :=
begin
  introsI,
  fapply ring_hom.to_algebra',
  { exact ((ring_equiv e).symm : β →+* α).comp (algebra_map R β), },
  { intros r x,
    simp only [function.comp_app, ring_hom.coe_comp],
    have p := ring_equiv_symm_apply e,
    dsimp at p,
    erw p, clear p,
    apply (ring_equiv e).injective,
    simp only [(ring_equiv e).map_mul],
    simp [algebra.commutes], }
end

/--
An equivalence `e : α ≃ β` gives an algebra equivalence `α ≃ₐ[R] β`
where the `R`-algebra structure on `α` is
the one obtained by transporting an `R`-algebra structure on `β` back along `e`.
-/
def alg_equiv (e : α ≃ β) [semiring β] [algebra R β] :
  begin
    letI := equiv.semiring e,
    letI := equiv.algebra R e,
    exact α ≃ₐ[R] β
  end :=
begin
  introsI,
  exact
  { commutes' := λ r, by { apply e.symm.injective, simp, refl, },
    ..equiv.ring_equiv e }
end

end
end R

end instances
end equiv

namespace ring_equiv

protected lemma local_ring {A B : Type*} [comm_ring A] [local_ring A] [comm_ring B] (e : A ≃+* B) :
  local_ring B :=
begin
  haveI := e.symm.to_equiv.nontrivial,
  refine @local_of_surjective A B _ _ _ _ e e.to_equiv.surjective,
end

end ring_equiv


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.measure.haar
import analysis.inner_product_space.pi_L2

/-!
# Additive Haar measure constructed from a basis

Given a basis of a finite-dimensional real vector space, we define the corresponding Lebesgue
measure, which gives measure `1` to the parallelepiped spanned by the basis.

## Main definitions

* `parallelepiped v` is the parallelepiped spanned by a finite family of vectors.
* `basis.parallelepiped` is the parallelepiped associated to a basis, seen as a compact set with
nonempty interior.
* `basis.add_haar` is the Lebesgue measure associated to a basis, giving measure `1` to the
corresponding parallelepiped.

In particular, we declare a `measure_space` instance on any finite-dimensional inner product space,
by using the Lebesgue measure associated to some orthonormal basis (which is in fact independent
of the basis).
-/

open set topological_space measure_theory measure_theory.measure finite_dimensional
open_locale big_operators

noncomputable theory

variables {ι ι' E F : Type*} [fintype ι] [fintype ι']

section add_comm_group

variables [add_comm_group E] [module ℝ E] [add_comm_group F] [module ℝ F]

/-- The closed parallelepiped spanned by a finite family of vectors. -/
def parallelepiped (v : ι → E) : set E :=
(λ (t : ι → ℝ), ∑ i, t i • v i) '' (Icc 0 1)

lemma mem_parallelepiped_iff (v : ι → E) (x : E) :
  x ∈ parallelepiped v ↔ ∃ (t : ι → ℝ) (ht : t ∈ Icc (0 : ι → ℝ) 1), x = ∑ i, t i • v i :=
by simp [parallelepiped, eq_comm]

lemma image_parallelepiped (f : E →ₗ[ℝ] F) (v : ι → E) :
  f '' (parallelepiped v) = parallelepiped (f ∘ v) :=
begin
  simp only [parallelepiped, ← image_comp],
  congr' 1 with t,
  simp only [function.comp_app, linear_map.map_sum, linear_map.map_smulₛₗ, ring_hom.id_apply],
end

/-- Reindexing a family of vectors does not change their parallelepiped. -/
@[simp] lemma parallelepiped_comp_equiv (v : ι → E) (e : ι' ≃ ι) :
  parallelepiped (v ∘ e) = parallelepiped v :=
begin
  simp only [parallelepiped],
  let K : (ι' → ℝ) ≃ (ι → ℝ) := equiv.Pi_congr_left' (λ (a : ι'), ℝ) e,
  have : Icc (0 : (ι → ℝ)) 1 = K '' (Icc (0 : (ι' → ℝ)) 1),
  { rw ← equiv.preimage_eq_iff_eq_image,
    ext x,
    simp only [mem_preimage, mem_Icc, pi.le_def, pi.zero_apply, equiv.Pi_congr_left'_apply,
      pi.one_apply],
    refine ⟨λ h, ⟨λ i, _, λ i, _⟩, λ h, ⟨λ i, h.1 (e.symm i), λ i, h.2 (e.symm i)⟩⟩,
    { simpa only [equiv.symm_apply_apply] using h.1 (e i) },
    { simpa only [equiv.symm_apply_apply] using h.2 (e i) } },
  rw [this, ← image_comp],
  congr' 1 with x,
  simpa only [orthonormal_basis.coe_reindex, function.comp_app, equiv.symm_apply_apply,
    equiv.Pi_congr_left'_apply, equiv.apply_symm_apply]
      using (e.symm.sum_comp (λ (i : ι'), x i • v (e i))).symm,
end

/- The parallelepiped associated to an orthonormal basis of `ℝ` is either `[0, 1]` or `[-1, 0]`. -/
lemma parallelepiped_orthonormal_basis_one_dim (b : orthonormal_basis ι ℝ ℝ) :
  parallelepiped b = Icc 0 1 ∨ parallelepiped b = Icc (-1) 0 :=
begin
  have e : ι ≃ fin 1,
  { apply fintype.equiv_fin_of_card_eq,
    simp only [← finrank_eq_card_basis b.to_basis, finrank_self] },
  have B : parallelepiped (b.reindex e) = parallelepiped b,
  { convert parallelepiped_comp_equiv b e.symm,
    ext i,
    simp only [orthonormal_basis.coe_reindex] },
  rw ← B,
  let F : ℝ → (fin 1 → ℝ) := λ t, (λ i, t),
  have A : Icc (0 : fin 1 → ℝ) 1 = F '' (Icc (0 : ℝ) 1),
  { apply subset.antisymm,
    { assume x hx,
      refine ⟨x 0, ⟨hx.1 0, hx.2 0⟩, _⟩,
      ext j,
      simp only [subsingleton.elim j 0] },
    { rintros x ⟨y, hy, rfl⟩,
      exact ⟨λ j, hy.1, λ j, hy.2⟩ } },
  rcases orthonormal_basis_one_dim (b.reindex e) with H|H,
  { left,
    simp only [H, parallelepiped, algebra.id.smul_eq_mul, mul_one, A,
      finset.sum_singleton, ←image_comp, image_id', finset.univ_unique], },
  { right,
    simp only [H, parallelepiped, algebra.id.smul_eq_mul, mul_one],
    rw A,
    simp only [←image_comp, mul_neg, mul_one, finset.sum_singleton, image_neg, preimage_neg_Icc,
      neg_zero, finset.univ_unique] },
end

end add_comm_group

section normed_space

variables [normed_add_comm_group E] [normed_space ℝ E]

/-- The parallelepiped spanned by a basis, as a compact set with nonempty interior. -/
def basis.parallelepiped (b : basis ι ℝ E) : positive_compacts E :=
{ carrier := parallelepiped b,
  is_compact' := is_compact_Icc.image (continuous_finset_sum finset.univ
    (λ (i : ι) (H : i ∈ finset.univ), (continuous_apply i).smul continuous_const)),
  interior_nonempty' :=
    begin
      suffices H : set.nonempty (interior (b.equiv_funL.symm.to_homeomorph '' (Icc 0 1))),
      { dsimp only [parallelepiped],
        convert H,
        ext t,
        exact (b.equiv_fun_symm_apply t).symm },
      have A : set.nonempty (interior (Icc (0 : ι → ℝ) 1)),
      { rw [← pi_univ_Icc, interior_pi_set (@finite_univ ι _)],
        simp only [univ_pi_nonempty_iff, pi.zero_apply, pi.one_apply, interior_Icc, nonempty_Ioo,
          zero_lt_one, implies_true_iff] },
      rwa [← homeomorph.image_interior, nonempty_image_iff],
    end }

variables [measurable_space E] [borel_space E]

/-- The Lebesgue measure associated to a basis, giving measure `1` to the parallelepiped spanned
by the basis. -/
@[irreducible] def basis.add_haar (b : basis ι ℝ E) : measure E :=
measure.add_haar_measure b.parallelepiped

instance is_add_haar_measure_basis_add_haar (b : basis ι ℝ E) :
  is_add_haar_measure b.add_haar :=
by { rw basis.add_haar, exact measure.is_add_haar_measure_add_haar_measure _ }

lemma basis.add_haar_self (b : basis ι ℝ E) : b.add_haar (parallelepiped b) = 1 :=
by { rw [basis.add_haar], exact add_haar_measure_self }

end normed_space

/-- A finite dimensional inner product space has a canonical measure, the Lebesgue measure giving
volume `1` to the parallelepiped spanned by any orthonormal basis. We define the measure using
some arbitrary choice of orthonormal basis. The fact that it works with any orthonormal basis
is proved in `orthonormal_basis.volume_parallelepiped`. -/
@[priority 100] instance measure_space_of_inner_product_space
  [normed_add_comm_group E] [inner_product_space ℝ E] [finite_dimensional ℝ E]
  [measurable_space E] [borel_space E] :
  measure_space E :=
{ volume := (std_orthonormal_basis ℝ E).to_basis.add_haar }

/- This instance should not be necessary, but Lean has difficulties to find it in product
situations if we do not declare it explicitly. -/
instance real.measure_space : measure_space ℝ := by apply_instance


import ..fglib
import ..basic
import .vector
import .square_matrix
import .invertible_matrix

namespace FG

/- Useful lemmas -/

namespace miscs

open square_matrix
open invertible_matrix

variables {n : ℕ} (A : square_matrix n)

def vector_annihilates_right : Prop :=
  ∃(μ : vec n), μ ≠ 0 ∧ A • μ = 0

def vector_annihilates_left : Prop :=
  vector_annihilates_right A.transpose

def vector_annihilates : Prop :=
  vector_annihilates_right A ∨ vector_annihilates_left A

lemma vector_annihilates_det_eq_zero_iff :
  vector_annihilates A ↔ A.det = 0 :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { rcases h with ⟨μ, hμ, h⟩,
      by_contradiction h₁,
      have h₂ := det_ne_zero_invertible A h₁,
      let AA : invertible_matrix n := ⟨A, h₂⟩,
      have h₃ := calc μ = 1 • μ
          : by rw one_smul
        ... = (AA⁻¹ * AA).val • μ
          : by rw mul_left_inv; simp
        ... = ((AA⁻¹).val * A) • μ
          : by simp
        ... = (AA⁻¹).val • (A • μ)
          : by rw mul_smul
        ... = 0
          : by rw [h, smul_zero],
      exact hμ h₃ },
    { rcases h with ⟨μ, hμ, h⟩,
      by_contradiction h₁,
      have h₁ : A.transpose.det ≠ 0 := by rw transpose_det; exact h₁,
      have h₂ := det_ne_zero_invertible A.transpose h₁,
      let AA : invertible_matrix n := ⟨A.transpose, h₂⟩,
      have h₃ := calc μ = 1 • μ
          : by rw one_smul
        ... = (AA⁻¹ * AA).val • μ
          : by rw mul_left_inv; simp
        ... = ((AA⁻¹).val * A.transpose) • μ
          : by simp
        ... = (AA⁻¹).val • (A.transpose • μ)
          : by rw mul_smul
        ... = 0
          : by rw [h, smul_zero],
      exact hμ h₃ }},
  { intro h,
    sorry }
end

/- `A` is either annihilated by a vector on the left or on the right,
  otherwise it muse be an invertible matrix  -/
lemma vector_annihilates_or_ivertible :
  vector_annihilates A ∨ is_invertible A :=
begin
  rw vector_annihilates_det_eq_zero_iff,
  rw ←det_ne_zero_iff,
  apply classical.em
end

end miscs

end FG