/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import ring_theory.adjoin_root
import ring_theory.algebra_tower
import ring_theory.algebraic
import ring_theory.polynomial
import field_theory.minpoly
import linear_algebra.finite_dimensional
import tactic.field_simp
import algebra.polynomial.big_operators

/-!
# Splitting fields

This file introduces the notion of a splitting field of a polynomial and provides an embedding from
a splitting field to any field that splits the polynomial. A polynomial `f : polynomial K` splits
over a field extension `L` of `K` if it is zero or all of its irreducible factors over `L` have
degree `1`. A field extension of `K` of a polynomial `f : polynomial K` is called a splitting field
if it is the smallest field extension of `K` such that `f` splits.

## Main definitions

* `polynomial.splits i f`: A predicate on a field homomorphism `i : K → L` and a polynomial `f`
  saying that `f` is zero or all of its irreducible factors over `L` have degree `1`.
* `polynomial.splitting_field f`: A fixed splitting field of the polynomial `f`.
* `polynomial.is_splitting_field`: A predicate on a field to be a splitting field of a polynomial
  `f`.

## Main statements

* `polynomial.C_leading_coeff_mul_prod_multiset_X_sub_C`: If a polynomial has as many roots as its
  degree, it can be written as the product of its leading coefficient with `∏ (X - a)` where `a`
  ranges through its roots.
* `lift_of_splits`: If `K` and `L` are field extensions of a field `F` and for some finite subset
  `S` of `K`, the minimal polynomial of every `x ∈ K` splits as a polynomial with coefficients in
  `L`, then `algebra.adjoin F S` embeds into `L`.
* `polynomial.is_splitting_field.lift`: An embedding of a splitting field of the polynomial `f` into
  another field such that `f` splits.
* `polynomial.is_splitting_field.alg_equiv`: Every splitting field of a polynomial `f` is isomorpic
  to `splitting_field f` and thus, being a splitting field is unique up to isomorphism.

-/

noncomputable theory
open_locale classical big_operators

universes u v w

variables {F : Type u} {K : Type v} {L : Type w}

namespace polynomial

variables [field K] [field L] [field F]
open polynomial

section splits

variables (i : K →+* L)

/-- A polynomial `splits` iff it is zero or all of its irreducible factors have `degree` 1. -/
def splits (f : polynomial K) : Prop :=
f = 0 ∨ ∀ {g : polynomial L}, irreducible g → g ∣ f.map i → degree g = 1

@[simp] lemma splits_zero : splits i (0 : polynomial K) := or.inl rfl

@[simp] lemma splits_C (a : K) : splits i (C a) :=
if ha : a = 0 then ha.symm ▸ (@C_0 K _).symm ▸ splits_zero i
else
have hia : i a ≠ 0, from mt ((is_add_group_hom.injective_iff i).1
  i.injective _) ha,
or.inr $ λ g hg ⟨p, hp⟩, absurd hg.1 (not_not.2 (is_unit_iff_degree_eq_zero.2 $
  by have := congr_arg degree hp;
    simp [degree_C hia, @eq_comm (with_bot ℕ) 0,
      nat.with_bot.add_eq_zero_iff] at this; clear _fun_match; tauto))

lemma splits_of_degree_eq_one {f : polynomial K} (hf : degree f = 1) : splits i f :=
or.inr $ λ g hg ⟨p, hp⟩,
  by have := congr_arg degree hp;
  simp [nat.with_bot.add_eq_one_iff, hf, @eq_comm (with_bot ℕ) 1,
    mt is_unit_iff_degree_eq_zero.2 hg.1] at this;
  clear _fun_match; tauto

lemma splits_of_degree_le_one {f : polynomial K} (hf : degree f ≤ 1) : splits i f :=
begin
  cases h : degree f with n,
  { rw [degree_eq_bot.1 h]; exact splits_zero i },
  { cases n with n,
    { rw [eq_C_of_degree_le_zero (trans_rel_right (≤) h (le_refl _))];
      exact splits_C _ _ },
    { have hn : n = 0,
      { rw h at hf,
        cases n, { refl }, { exact absurd hf dec_trivial } },
      exact splits_of_degree_eq_one _ (by rw [h, hn]; refl) } }
end

lemma splits_of_nat_degree_le_one {f : polynomial K} (hf : nat_degree f ≤ 1) : splits i f :=
splits_of_degree_le_one i (degree_le_of_nat_degree_le hf)

lemma splits_of_nat_degree_eq_one {f : polynomial K} (hf : nat_degree f = 1) : splits i f :=
splits_of_nat_degree_le_one i (le_of_eq hf)

lemma splits_mul {f g : polynomial K} (hf : splits i f) (hg : splits i g) : splits i (f * g) :=
if h : f * g = 0 then by simp [h]
else or.inr $ λ p hp hpf, ((principal_ideal_ring.irreducible_iff_prime.1 hp).2.2 _ _
    (show p ∣ map i f * map i g, by convert hpf; rw polynomial.map_mul)).elim
  (hf.resolve_left (λ hf, by simpa [hf] using h) hp)
  (hg.resolve_left (λ hg, by simpa [hg] using h) hp)

lemma splits_of_splits_mul {f g : polynomial K} (hfg : f * g ≠ 0) (h : splits i (f * g)) :
  splits i f ∧ splits i g :=
⟨or.inr $ λ g hgi hg, or.resolve_left h hfg hgi
   (by rw map_mul; exact dvd.trans hg (dvd_mul_right _ _)),
 or.inr $ λ g hgi hg, or.resolve_left h hfg hgi
   (by rw map_mul; exact dvd.trans hg (dvd_mul_left _ _))⟩

lemma splits_of_splits_of_dvd {f g : polynomial K} (hf0 : f ≠ 0) (hf : splits i f) (hgf : g ∣ f) :
  splits i g :=
by { obtain ⟨f, rfl⟩ := hgf, exact (splits_of_splits_mul i hf0 hf).1 }

lemma splits_of_splits_gcd_left {f g : polynomial K} (hf0 : f ≠ 0) (hf : splits i f) :
  splits i (euclidean_domain.gcd f g) :=
polynomial.splits_of_splits_of_dvd i hf0 hf (euclidean_domain.gcd_dvd_left f g)

lemma splits_of_splits_gcd_right {f g : polynomial K} (hg0 : g ≠ 0) (hg : splits i g) :
  splits i (euclidean_domain.gcd f g) :=
polynomial.splits_of_splits_of_dvd i hg0 hg (euclidean_domain.gcd_dvd_right f g)

lemma splits_map_iff (j : L →+* F) {f : polynomial K} :
  splits j (f.map i) ↔ splits (j.comp i) f :=
by simp [splits, polynomial.map_map]

theorem splits_one : splits i 1 :=
splits_C i 1

theorem splits_of_is_unit {u : polynomial K} (hu : is_unit u) : u.splits i :=
splits_of_splits_of_dvd i one_ne_zero (splits_one _) $ is_unit_iff_dvd_one.1 hu

theorem splits_X_sub_C {x : K} : (X - C x).splits i :=
splits_of_degree_eq_one _ $ degree_X_sub_C x

theorem splits_X : X.splits i :=
splits_of_degree_eq_one _ $ degree_X

theorem splits_id_iff_splits {f : polynomial K} :
  (f.map i).splits (ring_hom.id L) ↔ f.splits i :=
by rw [splits_map_iff, ring_hom.id_comp]

theorem splits_mul_iff {f g : polynomial K} (hf : f ≠ 0) (hg : g ≠ 0) :
  (f * g).splits i ↔ f.splits i ∧ g.splits i :=
⟨splits_of_splits_mul i (mul_ne_zero hf hg), λ ⟨hfs, hgs⟩, splits_mul i hfs hgs⟩

theorem splits_prod {ι : Type u} {s : ι → polynomial K} {t : finset ι} :
  (∀ j ∈ t, (s j).splits i) → (∏ x in t, s x).splits i :=
begin
  refine finset.induction_on t (λ _, splits_one i) (λ a t hat ih ht, _),
  rw finset.forall_mem_insert at ht, rw finset.prod_insert hat,
  exact splits_mul i ht.1 (ih ht.2)
end

lemma splits_pow {f : polynomial K} (hf : f.splits i) (n : ℕ) : (f ^ n).splits i :=
begin
  rw [←finset.card_range n, ←finset.prod_const],
  exact splits_prod i (λ j hj, hf),
end

lemma splits_X_pow (n : ℕ) : (X ^ n).splits i := splits_pow i (splits_X i) n

theorem splits_prod_iff {ι : Type u} {s : ι → polynomial K} {t : finset ι} :
  (∀ j ∈ t, s j ≠ 0) → ((∏ x in t, s x).splits i ↔ ∀ j ∈ t, (s j).splits i) :=
begin
  refine finset.induction_on t (λ _, ⟨λ _ _ h, h.elim, λ _, splits_one i⟩) (λ a t hat ih ht, _),
  rw finset.forall_mem_insert at ht ⊢,
  rw [finset.prod_insert hat, splits_mul_iff i ht.1 (finset.prod_ne_zero_iff.2 ht.2), ih ht.2]
end

lemma degree_eq_one_of_irreducible_of_splits {p : polynomial L}
  (h_nz : p ≠ 0) (hp : irreducible p) (hp_splits : splits (ring_hom.id L) p) :
  p.degree = 1 :=
begin
  rcases hp_splits,
  { contradiction },
  { apply hp_splits hp, simp }
end

lemma exists_root_of_splits {f : polynomial K} (hs : splits i f) (hf0 : degree f ≠ 0) :
  ∃ x, eval₂ i x f = 0 :=
if hf0 : f = 0 then ⟨37, by simp [hf0]⟩
else
  let ⟨g, hg⟩ := wf_dvd_monoid.exists_irreducible_factor
    (show ¬ is_unit (f.map i), from mt is_unit_iff_degree_eq_zero.1 (by rwa degree_map))
    (map_ne_zero hf0) in
  let ⟨x, hx⟩ := exists_root_of_degree_eq_one (hs.resolve_left hf0 hg.1 hg.2) in
  let ⟨i, hi⟩ := hg.2 in
  ⟨x, by rw [← eval_map, hi, eval_mul, show _ = _, from hx, zero_mul]⟩

lemma exists_multiset_of_splits {f : polynomial K} : splits i f →
  ∃ (s : multiset L), f.map i = C (i f.leading_coeff) *
  (s.map (λ a : L, (X : polynomial L) - C a)).prod :=
suffices splits (ring_hom.id _) (f.map i) → ∃ s : multiset L, f.map i =
  (C (f.map i).leading_coeff) * (s.map (λ a : L, (X : polynomial L) - C a)).prod,
by rwa [splits_map_iff, leading_coeff_map i] at this,
wf_dvd_monoid.induction_on_irreducible (f.map i)
  (λ _, ⟨{37}, by simp [i.map_zero]⟩)
  (λ u hu _, ⟨0,
    by conv_lhs { rw eq_C_of_degree_eq_zero (is_unit_iff_degree_eq_zero.1 hu) };
      simp [leading_coeff, nat_degree_eq_of_degree_eq_some (is_unit_iff_degree_eq_zero.1 hu)]⟩)
  (λ f p hf0 hp ih hfs,
    have hpf0 : p * f ≠ 0, from mul_ne_zero hp.ne_zero hf0,
    let ⟨s, hs⟩ := ih (splits_of_splits_mul _ hpf0 hfs).2 in
    ⟨-(p * norm_unit p).coeff 0 ::ₘ s,
      have hp1 : degree p = 1, from hfs.resolve_left hpf0 hp (by simp),
      begin
        rw [multiset.map_cons, multiset.prod_cons, leading_coeff_mul, C_mul, mul_assoc,
          mul_left_comm (C f.leading_coeff), ← hs, ← mul_assoc, mul_left_inj' hf0],
        conv_lhs {rw eq_X_add_C_of_degree_eq_one hp1},
        simp only [mul_add, coe_norm_unit_of_ne_zero hp.ne_zero, mul_comm p, coeff_neg,
          C_neg, sub_eq_add_neg, neg_neg, coeff_C_mul, (mul_assoc _ _ _).symm, C_mul.symm,
          mul_inv_cancel (show p.leading_coeff ≠ 0, from mt leading_coeff_eq_zero.1
            hp.ne_zero), one_mul],
      end⟩)

/-- Pick a root of a polynomial that splits. -/
def root_of_splits {f : polynomial K} (hf : f.splits i) (hfd : f.degree ≠ 0) : L :=
classical.some $ exists_root_of_splits i hf hfd

theorem map_root_of_splits {f : polynomial K} (hf : f.splits i) (hfd) :
  f.eval₂ i (root_of_splits i hf hfd) = 0 :=
classical.some_spec $ exists_root_of_splits i hf hfd

theorem roots_map {f : polynomial K} (hf : f.splits $ ring_hom.id K) :
  (f.map i).roots = (f.roots).map i :=
if hf0 : f = 0 then by rw [hf0, map_zero, roots_zero, roots_zero, multiset.map_zero] else
have hmf0 : f.map i ≠ 0 := map_ne_zero hf0,
let ⟨m, hm⟩ := exists_multiset_of_splits _ hf in
have h1 : (0 : polynomial K) ∉ m.map (λ r, X - C r),
  from zero_nmem_multiset_map_X_sub_C _ _,
have h2 : (0 : polynomial L) ∉ m.map (λ r, X - C (i r)),
  from zero_nmem_multiset_map_X_sub_C _ _,
begin
  rw map_id at hm, rw hm at hf0 hmf0 ⊢, rw map_mul at hmf0 ⊢,
  rw [roots_mul hf0, roots_mul hmf0, map_C, roots_C, zero_add, roots_C, zero_add,
      map_multiset_prod, multiset.map_map], simp_rw [(∘), map_sub, map_X, map_C],
  rw [roots_multiset_prod _ h2, multiset.bind_map,
      roots_multiset_prod _ h1, multiset.bind_map],
  simp_rw roots_X_sub_C,
  rw [multiset.bind_cons, multiset.bind_zero, add_zero,
      multiset.bind_cons, multiset.bind_zero, add_zero, multiset.map_id']
end

lemma eq_prod_roots_of_splits {p : polynomial K} {i : K →+* L}
  (hsplit : splits i p) :
  p.map i = C (i p.leading_coeff) * ((p.map i).roots.map (λ a, X - C a)).prod :=
begin
  by_cases p_eq_zero : p = 0,
  { rw [p_eq_zero, map_zero, leading_coeff_zero, i.map_zero, C.map_zero, zero_mul] },

  obtain ⟨s, hs⟩ := exists_multiset_of_splits i hsplit,
  have map_ne_zero : p.map i ≠ 0 := map_ne_zero (p_eq_zero),
  have prod_ne_zero : C (i p.leading_coeff) * (multiset.map (λ a, X - C a) s).prod ≠ 0 :=
    by rwa hs at map_ne_zero,

  have zero_nmem : (0 : polynomial L) ∉ s.map (λ a, X - C a),
    from zero_nmem_multiset_map_X_sub_C _ _,
  have map_bind_roots_eq : (s.map (λ a, X - C a)).bind (λ a, a.roots) = s,
  { refine multiset.induction_on s (by rw [multiset.map_zero, multiset.zero_bind]) _,
    intros a s ih,
    rw [multiset.map_cons, multiset.cons_bind, ih, roots_X_sub_C,
        multiset.cons_add, zero_add] },

  rw [hs, roots_mul prod_ne_zero, roots_C, zero_add,
      roots_multiset_prod _ zero_nmem,
      map_bind_roots_eq]
end

lemma eq_prod_roots_of_splits_id {p : polynomial K}
  (hsplit : splits (ring_hom.id K) p) :
  p = C (p.leading_coeff) * (p.roots.map (λ a, X - C a)).prod :=
by simpa using eq_prod_roots_of_splits hsplit

lemma eq_prod_roots_of_monic_of_splits_id {p : polynomial K}
  (m : monic p) (hsplit : splits (ring_hom.id K) p) :
  p = (p.roots.map (λ a, X - C a)).prod :=
begin
  convert eq_prod_roots_of_splits_id hsplit,
  simp [m],
end

lemma eq_X_sub_C_of_splits_of_single_root {x : K} {h : polynomial K} (h_splits : splits i h)
  (h_roots : (h.map i).roots = {i x}) : h = (C (leading_coeff h)) * (X - C x) :=
begin
  apply polynomial.map_injective _ i.injective,
  rw [eq_prod_roots_of_splits h_splits, h_roots],
  simp,
end

lemma nat_degree_eq_card_roots {p : polynomial K} {i : K →+* L}
  (hsplit : splits i p) : p.nat_degree = (p.map i).roots.card :=
begin
  by_cases p_eq_zero : p = 0,
  { rw [p_eq_zero, nat_degree_zero, map_zero, roots_zero, multiset.card_zero] },
  have map_ne_zero : p.map i ≠ 0 := map_ne_zero (p_eq_zero),
  rw eq_prod_roots_of_splits hsplit at map_ne_zero,

  conv_lhs { rw [← nat_degree_map i, eq_prod_roots_of_splits hsplit] },
  have : (0 : polynomial L) ∉ (map i p).roots.map (λ a, X - C a),
    from zero_nmem_multiset_map_X_sub_C _ _,
  simp [nat_degree_mul (left_ne_zero_of_mul map_ne_zero) (right_ne_zero_of_mul map_ne_zero),
        nat_degree_multiset_prod _ this]
end

lemma degree_eq_card_roots {p : polynomial K} {i : K →+* L} (p_ne_zero : p ≠ 0)
  (hsplit : splits i p) : p.degree = (p.map i).roots.card :=
by rw [degree_eq_nat_degree p_ne_zero, nat_degree_eq_card_roots hsplit]

section UFD

local attribute [instance, priority 10] principal_ideal_ring.to_unique_factorization_monoid
local infix ` ~ᵤ ` : 50 := associated

open unique_factorization_monoid associates

lemma splits_of_exists_multiset {f : polynomial K} {s : multiset L}
  (hs : f.map i = C (i f.leading_coeff) * (s.map (λ a : L, (X : polynomial L) - C a)).prod) :
  splits i f :=
if hf0 : f = 0 then or.inl hf0
else
  or.inr $ λ p hp hdp,
    have ht : multiset.rel associated
      (factors (f.map i)) (s.map (λ a : L, (X : polynomial L) - C a)) :=
    factors_unique
      (λ p hp, irreducible_of_factor _ hp)
      (λ p' m, begin
          obtain ⟨a,m,rfl⟩ := multiset.mem_map.1 m,
          exact irreducible_of_degree_eq_one (degree_X_sub_C _),
        end)
      (associated.symm $ calc _ ~ᵤ f.map i :
        ⟨(units.map' C : units L →* units (polynomial L)) (units.mk0 (f.map i).leading_coeff
            (mt leading_coeff_eq_zero.1 (map_ne_zero hf0))),
          by conv_rhs {rw [hs, ← leading_coeff_map i, mul_comm]}; refl⟩
        ... ~ᵤ _ : associated.symm (unique_factorization_monoid.factors_prod (by simpa using hf0))),
  let ⟨q, hq, hpq⟩ := exists_mem_factors_of_dvd (by simpa) hp hdp in
  let ⟨q', hq', hqq'⟩ := multiset.exists_mem_of_rel_of_mem ht hq in
  let ⟨a, ha⟩ := multiset.mem_map.1 hq' in
  by rw [← degree_X_sub_C a, ha.2];
    exact degree_eq_degree_of_associated (hpq.trans hqq')

lemma splits_of_splits_id {f : polynomial K} : splits (ring_hom.id _) f → splits i f :=
unique_factorization_monoid.induction_on_prime f (λ _, splits_zero _)
  (λ _ hu _, splits_of_degree_le_one _
    ((is_unit_iff_degree_eq_zero.1 hu).symm ▸ dec_trivial))
  (λ a p ha0 hp ih hfi, splits_mul _
    (splits_of_degree_eq_one _
      ((splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).1.resolve_left
        hp.1 (irreducible_of_prime hp) (by rw map_id)))
    (ih (splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).2))

end UFD

lemma splits_iff_exists_multiset {f : polynomial K} : splits i f ↔
  ∃ (s : multiset L), f.map i = C (i f.leading_coeff) *
  (s.map (λ a : L, (X : polynomial L) - C a)).prod :=
⟨exists_multiset_of_splits i, λ ⟨s, hs⟩, splits_of_exists_multiset i hs⟩

lemma splits_comp_of_splits (j : L →+* F) {f : polynomial K}
  (h : splits i f) : splits (j.comp i) f :=
begin
  change i with ((ring_hom.id _).comp i) at h,
  rw [← splits_map_iff],
  rw [← splits_map_iff i] at h,
  exact splits_of_splits_id _ h
end

/-- A monic polynomial `p` that has as many roots as its degree
can be written `p = ∏(X - a)`, for `a` in `p.roots`. -/
lemma prod_multiset_X_sub_C_of_monic_of_roots_card_eq {p : polynomial K}
  (hmonic : p.monic) (hroots : p.roots.card = p.nat_degree) :
  (multiset.map (λ (a : K), X - C a) p.roots).prod = p :=
begin
  have hprodmonic : (multiset.map (λ (a : K), X - C a) p.roots).prod.monic,
  { simp only [prod_multiset_root_eq_finset_root (ne_zero_of_monic hmonic),
      monic_prod_of_monic, monic_X_sub_C, monic_pow, forall_true_iff] },
  have hdegree : (multiset.map (λ (a : K), X - C a) p.roots).prod.nat_degree = p.nat_degree,
  { rw [← hroots, nat_degree_multiset_prod _ (zero_nmem_multiset_map_X_sub_C _ (λ a : K, a))],
    simp only [eq_self_iff_true, mul_one, nat.cast_id, nsmul_eq_mul, multiset.sum_repeat,
      multiset.map_const,nat_degree_X_sub_C, function.comp, multiset.map_map] },
  obtain ⟨q, hq⟩ := prod_multiset_X_sub_C_dvd p,
  have qzero : q ≠ 0,
  { rintro rfl, apply hmonic.ne_zero, simpa only [mul_zero] using hq },
  have degp :
    p.nat_degree = (multiset.map (λ (a : K), X - C a) p.roots).prod.nat_degree + q.nat_degree,
  { nth_rewrite 0 [hq],
    simp only [nat_degree_mul (ne_zero_of_monic hprodmonic) qzero] },
  have degq : q.nat_degree = 0,
  { rw hdegree at degp,
    exact (add_right_inj p.nat_degree).mp (tactic.ring_exp.add_pf_sum_z degp rfl).symm },
  obtain ⟨u, hu⟩ := is_unit_iff_degree_eq_zero.2 ((degree_eq_iff_nat_degree_eq qzero).2 degq),
  have hassoc : associated (multiset.map (λ (a : K), X - C a) p.roots).prod p,
  { rw associated, use u, rw [hu, ← hq] },
  exact eq_of_monic_of_associated hprodmonic hmonic hassoc
end

/-- A polynomial `p` that has as many roots as its degree
can be written `p = p.leading_coeff * ∏(X - a)`, for `a` in `p.roots`. -/
lemma C_leading_coeff_mul_prod_multiset_X_sub_C {p : polynomial K}
  (hroots : p.roots.card = p.nat_degree) :
  (C p.leading_coeff) * (multiset.map (λ (a : K), X - C a) p.roots).prod = p :=
begin
  by_cases hzero : p = 0,
  { rw [hzero, leading_coeff_zero, ring_hom.map_zero, zero_mul], },
  { have hcoeff : p.leading_coeff ≠ 0,
    { intro h, exact hzero (leading_coeff_eq_zero.1 h) },
    have hrootsnorm : (normalize p).roots.card = (normalize p).nat_degree,
    { rw [roots_normalize, normalize_apply, nat_degree_mul hzero (units.ne_zero _), hroots,
          coe_norm_unit, nat_degree_C, add_zero], },
    have hprod := prod_multiset_X_sub_C_of_monic_of_roots_card_eq (monic_normalize hzero)
                    hrootsnorm,
    rw [roots_normalize, normalize_apply, coe_norm_unit_of_ne_zero hzero] at hprod,
    calc (C p.leading_coeff) * (multiset.map (λ (a : K), X - C a) p.roots).prod
        = p * C ((p.leading_coeff)⁻¹ * p.leading_coeff) :
        by rw [hprod, mul_comm, mul_assoc, ← C_mul]
    ... = p * C 1 : by field_simp
    ... = p : by simp only [mul_one, ring_hom.map_one], },
end

/-- A polynomial splits if and only if it has as many roots as its degree. -/
lemma splits_iff_card_roots {p : polynomial K} :
  splits (ring_hom.id K) p ↔ p.roots.card = p.nat_degree :=
begin
  split,
  { intro H, rw [nat_degree_eq_card_roots H, map_id] },
  { intro hroots,
    apply (splits_iff_exists_multiset (ring_hom.id K)).2,
    use p.roots,
    simp only [ring_hom.id_apply, map_id],
    exact (C_leading_coeff_mul_prod_multiset_X_sub_C hroots).symm },
end

end splits

end polynomial

section embeddings

variables (F) [field F]

/-- If `p` is the minimal polynomial of `a` over `F` then `F[a] ≃ₐ[F] F[x]/(p)` -/
def alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly
  {R : Type*} [comm_ring R] [algebra F R] (x : R) :
  algebra.adjoin F ({x} : set R) ≃ₐ[F] adjoin_root (minpoly F x) :=
alg_equiv.symm $ alg_equiv.of_bijective
  (alg_hom.cod_restrict
    (adjoin_root.lift_hom _ x $ minpoly.aeval F x) _
    (λ p, adjoin_root.induction_on _ p $ λ p,
      (algebra.adjoin_singleton_eq_range F x).symm ▸ (polynomial.aeval _).mem_range.mpr ⟨p, rfl⟩))
  ⟨(alg_hom.injective_cod_restrict _ _ _).2 $ (alg_hom.injective_iff _).2 $ λ p,
    adjoin_root.induction_on _ p $ λ p hp, ideal.quotient.eq_zero_iff_mem.2 $
    ideal.mem_span_singleton.2 $ minpoly.dvd F x hp,
  λ y,
    let ⟨p, hp⟩ := (set_like.ext_iff.1 (algebra.adjoin_singleton_eq_range F x) (y : R)).1 y.2 in
    ⟨adjoin_root.mk _ p, subtype.eq hp⟩⟩

open finset

/-- If a `subalgebra` is finite_dimensional as a submodule then it is `finite_dimensional`. -/
lemma finite_dimensional.of_subalgebra_to_submodule
  {K V : Type*} [field K] [ring V] [algebra K V] {s : subalgebra K V}
  (h : finite_dimensional K s.to_submodule) : finite_dimensional K s := h

/-- If `K` and `L` are field extensions of `F` and we have `s : finset K` such that
the minimal polynomial of each `x ∈ s` splits in `L` then `algebra.adjoin F s` embeds in `L`. -/
theorem lift_of_splits {F K L : Type*} [field F] [field K] [field L]
  [algebra F K] [algebra F L] (s : finset K) :
  (∀ x ∈ s, is_integral F x ∧ polynomial.splits (algebra_map F L) (minpoly F x)) →
  nonempty (algebra.adjoin F (↑s : set K) →ₐ[F] L) :=
begin
  refine finset.induction_on s (λ H, _) (λ a s has ih H, _),
  { rw [coe_empty, algebra.adjoin_empty],
    exact ⟨(algebra.of_id F L).comp (algebra.bot_equiv F K)⟩ },
  rw forall_mem_insert at H, rcases H with ⟨⟨H1, H2⟩, H3⟩, cases ih H3 with f,
  choose H3 H4 using H3,
  rw [coe_insert, set.insert_eq, set.union_comm, algebra.adjoin_union],
  letI := (f : algebra.adjoin F (↑s : set K) →+* L).to_algebra,
  haveI : finite_dimensional F (algebra.adjoin F (↑s : set K)) := (
    (submodule.fg_iff_finite_dimensional _).1
      (fg_adjoin_of_finite (set.finite_mem_finset s) H3)).of_subalgebra_to_submodule,
  letI := field_of_finite_dimensional F (algebra.adjoin F (↑s : set K)),
  have H5 : is_integral (algebra.adjoin F (↑s : set K)) a := is_integral_of_is_scalar_tower a H1,
  have H6 : (minpoly (algebra.adjoin F (↑s : set K)) a).splits
    (algebra_map (algebra.adjoin F (↑s : set K)) L),
  { refine polynomial.splits_of_splits_of_dvd _
      (polynomial.map_ne_zero $ minpoly.ne_zero H1 :
        polynomial.map (algebra_map _ _) _ ≠ 0)
      ((polynomial.splits_map_iff _ _).2 _)
      (minpoly.dvd _ _ _),
    { rw ← is_scalar_tower.algebra_map_eq, exact H2 },
    { rw [← is_scalar_tower.aeval_apply, minpoly.aeval] } },
  obtain ⟨y, hy⟩ := polynomial.exists_root_of_splits _ H6 (ne_of_lt (minpoly.degree_pos H5)).symm,
  refine ⟨subalgebra.of_under _ _ _⟩,
  refine (adjoin_root.lift_hom (minpoly (algebra.adjoin F (↑s : set K)) a) y hy).comp _,
  exact alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly (algebra.adjoin F (↑s : set K)) a
end

end embeddings

namespace polynomial

variables [field K] [field L] [field F]
open polynomial

section splitting_field

/-- Non-computably choose an irreducible factor from a polynomial. -/
def factor (f : polynomial K) : polynomial K :=
if H : ∃ g, irreducible g ∧ g ∣ f then classical.some H else X

instance irreducible_factor (f : polynomial K) : irreducible (factor f) :=
begin
  rw factor, split_ifs with H, { exact (classical.some_spec H).1 }, { exact irreducible_X }
end

theorem factor_dvd_of_not_is_unit {f : polynomial K} (hf1 : ¬is_unit f) : factor f ∣ f :=
begin
  by_cases hf2 : f = 0, { rw hf2, exact dvd_zero _ },
  rw [factor, dif_pos (wf_dvd_monoid.exists_irreducible_factor hf1 hf2)],
  exact (classical.some_spec $ wf_dvd_monoid.exists_irreducible_factor hf1 hf2).2
end

theorem factor_dvd_of_degree_ne_zero {f : polynomial K} (hf : f.degree ≠ 0) : factor f ∣ f :=
factor_dvd_of_not_is_unit (mt degree_eq_zero_of_is_unit hf)

theorem factor_dvd_of_nat_degree_ne_zero {f : polynomial K} (hf : f.nat_degree ≠ 0) :
  factor f ∣ f :=
factor_dvd_of_degree_ne_zero (mt nat_degree_eq_of_degree_eq_some hf)

/-- Divide a polynomial f by X - C r where r is a root of f in a bigger field extension. -/
def remove_factor (f : polynomial K) : polynomial (adjoin_root $ factor f) :=
map (adjoin_root.of f.factor) f /ₘ (X - C (adjoin_root.root f.factor))

theorem X_sub_C_mul_remove_factor (f : polynomial K) (hf : f.nat_degree ≠ 0) :
  (X - C (adjoin_root.root f.factor)) * f.remove_factor = map (adjoin_root.of f.factor) f :=
let ⟨g, hg⟩ := factor_dvd_of_nat_degree_ne_zero hf in
mul_div_by_monic_eq_iff_is_root.2 $ by rw [is_root.def, eval_map, hg, eval₂_mul, ← hg,
    adjoin_root.eval₂_root, zero_mul]

theorem nat_degree_remove_factor (f : polynomial K) :
  f.remove_factor.nat_degree = f.nat_degree - 1 :=
by rw [remove_factor, nat_degree_div_by_monic _ (monic_X_sub_C _), nat_degree_map,
       nat_degree_X_sub_C]

theorem nat_degree_remove_factor' {f : polynomial K} {n : ℕ} (hfn : f.nat_degree = n+1) :
  f.remove_factor.nat_degree = n :=
by rw [nat_degree_remove_factor, hfn, n.add_sub_cancel]

/-- Auxiliary construction to a splitting field of a polynomial. Uses induction on the degree. -/
def splitting_field_aux (n : ℕ) : Π {K : Type u} [field K], by exactI Π (f : polynomial K),
  f.nat_degree = n → Type u :=
nat.rec_on n (λ K _ _ _, K) $ λ n ih K _ f hf, by exactI
ih f.remove_factor (nat_degree_remove_factor' hf)

namespace splitting_field_aux

theorem succ (n : ℕ) (f : polynomial K) (hfn : f.nat_degree = n + 1) :
  splitting_field_aux (n+1) f hfn =
    splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn) := rfl

instance field (n : ℕ) : Π {K : Type u} [field K], by exactI
  Π {f : polynomial K} (hfn : f.nat_degree = n), field (splitting_field_aux n f hfn) :=
nat.rec_on n (λ K _ _ _, ‹field K›) $ λ n ih K _ f hf, ih _

instance inhabited {n : ℕ} {f : polynomial K} (hfn : f.nat_degree = n) :
  inhabited (splitting_field_aux n f hfn) := ⟨37⟩

instance algebra (n : ℕ) : Π {K : Type u} [field K], by exactI
  Π {f : polynomial K} (hfn : f.nat_degree = n), algebra K (splitting_field_aux n f hfn) :=
nat.rec_on n (λ K _ _ _, by exactI algebra.id K) $ λ n ih K _ f hfn,
by exactI @@algebra.comap.algebra _ _ _ _ _ _ _ (ih _)

instance algebra' {n : ℕ} {f : polynomial K} (hfn : f.nat_degree = n + 1) :
  algebra (adjoin_root f.factor) (splitting_field_aux _ _ hfn) :=
splitting_field_aux.algebra n _

instance algebra'' {n : ℕ} {f : polynomial K} (hfn : f.nat_degree = n + 1) :
  algebra K (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)) :=
splitting_field_aux.algebra (n+1) hfn

instance algebra''' {n : ℕ} {f : polynomial K} (hfn : f.nat_degree = n + 1) :
  algebra (adjoin_root f.factor)
    (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)) :=
splitting_field_aux.algebra n _

instance scalar_tower {n : ℕ} {f : polynomial K} (hfn : f.nat_degree = n + 1) :
  is_scalar_tower K (adjoin_root f.factor) (splitting_field_aux _ _ hfn) :=
is_scalar_tower.of_algebra_map_eq $ λ x, rfl

instance scalar_tower' {n : ℕ} {f : polynomial K} (hfn : f.nat_degree = n + 1) :
  is_scalar_tower K (adjoin_root f.factor)
    (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)) :=
is_scalar_tower.of_algebra_map_eq $ λ x, rfl

theorem algebra_map_succ (n : ℕ) (f : polynomial K) (hfn : f.nat_degree = n + 1) :
  by exact algebra_map K (splitting_field_aux _ _ hfn) =
    (algebra_map (adjoin_root f.factor)
        (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn))).comp
      (adjoin_root.of f.factor) :=
rfl

protected theorem splits (n : ℕ) : ∀ {K : Type u} [field K], by exactI
  ∀ (f : polynomial K) (hfn : f.nat_degree = n),
    splits (algebra_map K $ splitting_field_aux n f hfn) f :=
nat.rec_on n (λ K _ _ hf, by exactI splits_of_degree_le_one _
  (le_trans degree_le_nat_degree $ hf.symm ▸ with_bot.coe_le_coe.2 zero_le_one)) $ λ n ih K _ f hf,
by { resetI, rw [← splits_id_iff_splits, algebra_map_succ, ← map_map, splits_id_iff_splits,
    ← X_sub_C_mul_remove_factor f (λ h, by { rw h at hf, cases hf })],
exact splits_mul _ (splits_X_sub_C _) (ih _ _) }

theorem exists_lift (n : ℕ) : ∀ {K : Type u} [field K], by exactI
  ∀ (f : polynomial K) (hfn : f.nat_degree = n) {L : Type*} [field L], by exactI
    ∀ (j : K →+* L) (hf : splits j f), ∃ k : splitting_field_aux n f hfn →+* L,
      k.comp (algebra_map _ _) = j :=
nat.rec_on n (λ K _ _ _ L _ j _, by exactI ⟨j, j.comp_id⟩) $ λ n ih K _ f hf L _ j hj, by exactI
have hndf : f.nat_degree ≠ 0, by { intro h, rw h at hf, cases hf },
have hfn0 : f ≠ 0, by { intro h, rw h at hndf, exact hndf rfl },
let ⟨r, hr⟩ := exists_root_of_splits _ (splits_of_splits_of_dvd j hfn0 hj
  (factor_dvd_of_nat_degree_ne_zero hndf))
  (mt is_unit_iff_degree_eq_zero.2 f.irreducible_factor.1) in
have hmf0 : map (adjoin_root.of f.factor) f ≠ 0, from map_ne_zero hfn0,
have hsf : splits (adjoin_root.lift j r hr) f.remove_factor,
by { rw ← X_sub_C_mul_remove_factor _ hndf at hmf0, refine (splits_of_splits_mul _ hmf0 _).2,
  rwa [X_sub_C_mul_remove_factor _ hndf, ← splits_id_iff_splits, map_map, adjoin_root.lift_comp_of,
      splits_id_iff_splits] },
let ⟨k, hk⟩ := ih f.remove_factor (nat_degree_remove_factor' hf) (adjoin_root.lift j r hr) hsf in
⟨k, by rw [algebra_map_succ, ← ring_hom.comp_assoc, hk, adjoin_root.lift_comp_of]⟩

theorem adjoin_roots (n : ℕ) : ∀ {K : Type u} [field K], by exactI
  ∀ (f : polynomial K) (hfn : f.nat_degree = n),
    algebra.adjoin K (↑(f.map $ algebra_map K $ splitting_field_aux n f hfn).roots.to_finset :
      set (splitting_field_aux n f hfn)) = ⊤ :=
nat.rec_on n (λ K _ f hf, by exactI algebra.eq_top_iff.2 (λ x, subalgebra.range_le _ ⟨x, rfl⟩)) $
λ n ih K _ f hfn, by exactI
have hndf : f.nat_degree ≠ 0, by { intro h, rw h at hfn, cases hfn },
have hfn0 : f ≠ 0, by { intro h, rw h at hndf, exact hndf rfl },
have hmf0 : map (algebra_map K (splitting_field_aux n.succ f hfn)) f ≠ 0 := map_ne_zero hfn0,
by { rw [algebra_map_succ, ← map_map, ← X_sub_C_mul_remove_factor _ hndf, map_mul] at hmf0 ⊢,
rw [roots_mul hmf0, map_sub, map_X, map_C, roots_X_sub_C, multiset.to_finset_add, finset.coe_union,
    multiset.to_finset_cons, multiset.to_finset_zero, insert_emptyc_eq, finset.coe_singleton,
    algebra.adjoin_union, ← set.image_singleton, algebra.adjoin_algebra_map K (adjoin_root f.factor)
      (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)),
    adjoin_root.adjoin_root_eq_top, algebra.map_top,
    is_scalar_tower.range_under_adjoin K (adjoin_root f.factor)
      (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)),
    ih, subalgebra.res_top] }

end splitting_field_aux

/-- A splitting field of a polynomial. -/
def splitting_field (f : polynomial K) :=
splitting_field_aux _ f rfl

namespace splitting_field

variables (f : polynomial K)

instance : field (splitting_field f) :=
splitting_field_aux.field _ _

instance inhabited : inhabited (splitting_field f) := ⟨37⟩

instance : algebra K (splitting_field f) :=
splitting_field_aux.algebra _ _

protected theorem splits : splits (algebra_map K (splitting_field f)) f :=
splitting_field_aux.splits _ _ _

variables [algebra K L] (hb : splits (algebra_map K L) f)

/-- Embeds the splitting field into any other field that splits the polynomial. -/
def lift : splitting_field f →ₐ[K] L :=
{ commutes' := λ r, by { have := classical.some_spec (splitting_field_aux.exists_lift _ _ _ _ hb),
    exact ring_hom.ext_iff.1 this r },
  .. classical.some (splitting_field_aux.exists_lift _ _ _ _ hb) }

theorem adjoin_roots : algebra.adjoin K
    (↑(f.map (algebra_map K $ splitting_field f)).roots.to_finset : set (splitting_field f)) = ⊤ :=
splitting_field_aux.adjoin_roots _ _ _

theorem adjoin_root_set : algebra.adjoin K (f.root_set f.splitting_field) = ⊤ :=
adjoin_roots f

end splitting_field

variables (K L) [algebra K L]
/-- Typeclass characterising splitting fields. -/
class is_splitting_field (f : polynomial K) : Prop :=
(splits [] : splits (algebra_map K L) f)
(adjoin_roots [] : algebra.adjoin K (↑(f.map (algebra_map K L)).roots.to_finset : set L) = ⊤)

namespace is_splitting_field

variables {K}
instance splitting_field (f : polynomial K) : is_splitting_field K (splitting_field f) f :=
⟨splitting_field.splits f, splitting_field.adjoin_roots f⟩

section scalar_tower

variables {K L F} [algebra F K] [algebra F L] [is_scalar_tower F K L]

variables {K}
instance map (f : polynomial F) [is_splitting_field F L f] :
  is_splitting_field K L (f.map $ algebra_map F K) :=
⟨by { rw [splits_map_iff, ← is_scalar_tower.algebra_map_eq], exact splits L f },
 subalgebra.res_inj F $ by { rw [map_map, ← is_scalar_tower.algebra_map_eq, subalgebra.res_top,
    eq_top_iff, ← adjoin_roots L f, algebra.adjoin_le_iff],
  exact λ x hx, @algebra.subset_adjoin K _ _ _ _ _ _ hx }⟩

variables {K} (L)
theorem splits_iff (f : polynomial K) [is_splitting_field K L f] :
  polynomial.splits (ring_hom.id K) f ↔ (⊤ : subalgebra K L) = ⊥ :=
⟨λ h, eq_bot_iff.2 $ adjoin_roots L f ▸ (roots_map (algebra_map K L) h).symm ▸
  algebra.adjoin_le_iff.2 (λ y hy,
    let ⟨x, hxs, hxy⟩ := finset.mem_image.1 (by rwa multiset.to_finset_map at hy) in
    hxy ▸ set_like.mem_coe.2 $ subalgebra.algebra_map_mem _ _),
 λ h, @ring_equiv.to_ring_hom_refl K _ ▸
  ring_equiv.trans_symm (ring_equiv.of_bijective _ $ algebra.bijective_algebra_map_iff.2 h) ▸
  by { rw ring_equiv.to_ring_hom_trans, exact splits_comp_of_splits _ _ (splits L f) }⟩

theorem mul (f g : polynomial F) (hf : f ≠ 0) (hg : g ≠ 0) [is_splitting_field F K f]
  [is_splitting_field K L (g.map $ algebra_map F K)] :
  is_splitting_field F L (f * g) :=
⟨(is_scalar_tower.algebra_map_eq F K L).symm ▸ splits_mul _
  (splits_comp_of_splits _ _ (splits K f))
  ((splits_map_iff _ _).1 (splits L $ g.map $ algebra_map F K)),
 by rw [map_mul, roots_mul (mul_ne_zero (map_ne_zero hf : f.map (algebra_map F L) ≠ 0)
        (map_ne_zero hg)), multiset.to_finset_add, finset.coe_union, algebra.adjoin_union,
      is_scalar_tower.algebra_map_eq F K L, ← map_map,
      roots_map (algebra_map K L) ((splits_id_iff_splits $ algebra_map F K).2 $ splits K f),
      multiset.to_finset_map, finset.coe_image, algebra.adjoin_algebra_map, adjoin_roots,
      algebra.map_top, is_scalar_tower.range_under_adjoin, ← map_map, adjoin_roots,
      subalgebra.res_top]⟩

end scalar_tower

/-- Splitting field of `f` embeds into any field that splits `f`. -/
def lift [algebra K F] (f : polynomial K) [is_splitting_field K L f]
  (hf : polynomial.splits (algebra_map K F) f) : L →ₐ[K] F :=
if hf0 : f = 0 then (algebra.of_id K F).comp $
  (algebra.bot_equiv K L : (⊥ : subalgebra K L) →ₐ[K] K).comp $
  by { rw ← (splits_iff L f).1 (show f.splits (ring_hom.id K), from hf0.symm ▸ splits_zero _),
  exact algebra.to_top } else
alg_hom.comp (by { rw ← adjoin_roots L f, exact classical.choice (lift_of_splits _ $ λ y hy,
    have aeval y f = 0, from (eval₂_eq_eval_map _).trans $
      (mem_roots $ by exact map_ne_zero hf0).1 (multiset.mem_to_finset.mp hy),
    ⟨(is_algebraic_iff_is_integral _).1 ⟨f, hf0, this⟩,
      splits_of_splits_of_dvd _ hf0 hf $ minpoly.dvd _ _ this⟩) })
  algebra.to_top

theorem finite_dimensional (f : polynomial K) [is_splitting_field K L f] : finite_dimensional K L :=
finite_dimensional.iff_fg.2 $ @algebra.top_to_submodule K L _ _ _ ▸ adjoin_roots L f ▸
  fg_adjoin_of_finite (set.finite_mem_finset _) (λ y hy,
  if hf : f = 0
  then by { rw [hf, map_zero, roots_zero] at hy, cases hy }
  else (is_algebraic_iff_is_integral _).1 ⟨f, hf, (eval₂_eq_eval_map _).trans $
    (mem_roots $ by exact map_ne_zero hf).1 (multiset.mem_to_finset.mp hy)⟩)

instance (f : polynomial K) : _root_.finite_dimensional K f.splitting_field :=
finite_dimensional f.splitting_field f

/-- Any splitting field is isomorphic to `splitting_field f`. -/
def alg_equiv (f : polynomial K) [is_splitting_field K L f] : L ≃ₐ[K] splitting_field f :=
begin
  refine alg_equiv.of_bijective (lift L f $ splits (splitting_field f) f)
    ⟨ring_hom.injective (lift L f $ splits (splitting_field f) f).to_ring_hom, _⟩,
  haveI := finite_dimensional (splitting_field f) f,
  haveI := finite_dimensional L f,
  have : finite_dimensional.finrank K L = finite_dimensional.finrank K (splitting_field f) :=
  le_antisymm
    (linear_map.finrank_le_finrank_of_injective
      (show function.injective (lift L f $ splits (splitting_field f) f).to_linear_map, from
        ring_hom.injective (lift L f $ splits (splitting_field f) f : L →+* f.splitting_field)))
    (linear_map.finrank_le_finrank_of_injective
      (show function.injective (lift (splitting_field f) f $ splits L f).to_linear_map, from
        ring_hom.injective (lift (splitting_field f) f $ splits L f : f.splitting_field →+* L))),
  change function.surjective (lift L f $ splits (splitting_field f) f).to_linear_map,
  refine (linear_map.injective_iff_surjective_of_finrank_eq_finrank this).1 _,
  exact ring_hom.injective (lift L f $ splits (splitting_field f) f : L →+* f.splitting_field)
end

end is_splitting_field

end splitting_field

end polynomial


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

Notation for vectors and matrices
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.card
import Mathlib.data.matrix.basic
import Mathlib.tactic.fin_cases
import Mathlib.PostPort

universes u u_1 u_2 u_3

namespace Mathlib

/-!
# Matrix and vector notation

This file defines notation for vectors and matrices. Given `a b c d : α`,
the notation allows us to write `![a, b, c, d] : fin 4 → α`.
Nesting vectors gives a matrix, so `![![a, b], ![c, d]] : matrix (fin 2) (fin 2) α`.
This file includes `simp` lemmas for applying operations in
`data.matrix.basic` to values built out of this notation.

## Main definitions

* `vec_empty` is the empty vector (or `0` by `n` matrix) `![]`
* `vec_cons` prepends an entry to a vector, so `![a, b]` is `vec_cons a (vec_cons b vec_empty)`

## Implementation notes

The `simp` lemmas require that one of the arguments is of the form `vec_cons _ _`.
This ensures `simp` works with entries only when (some) entries are already given.
In other words, this notation will only appear in the output of `simp` if it
already appears in the input.

## Notations

The main new notation is `![a, b]`, which gets expanded to `vec_cons a (vec_cons b vec_empty)`.
-/

namespace matrix

/-- `![]` is the vector with no entries. -/
def vec_empty {α : Type u} : fin 0 → α :=
  fin_zero_elim

/-- `vec_cons h t` prepends an entry `h` to a vector `t`.

The inverse functions are `vec_head` and `vec_tail`.
The notation `![a, b, ...]` expands to `vec_cons a (vec_cons b ...)`.
-/
def vec_cons {α : Type u} {n : ℕ} (h : α) (t : fin n → α) : fin (Nat.succ n) → α :=
  fin.cons h t

/-- `vec_head v` gives the first entry of the vector `v` -/
def vec_head {α : Type u} {n : ℕ} (v : fin (Nat.succ n) → α) : α :=
  v 0

/-- `vec_tail v` gives a vector consisting of all entries of `v` except the first -/
def vec_tail {α : Type u} {n : ℕ} (v : fin (Nat.succ n) → α) : fin n → α :=
  v ∘ fin.succ

theorem empty_eq {α : Type u} (v : fin 0 → α) : v = vec_empty :=
  funext
    fun (i : fin 0) => false.dcases_on (fun (h : i ∈ fintype.elems (fin 0)) => v i = vec_empty i) (fintype.complete i)

@[simp] theorem head_fin_const {α : Type u} {n : ℕ} (a : α) : (vec_head fun (i : fin (n + 1)) => a) = a :=
  rfl

@[simp] theorem cons_val_zero {α : Type u} {m : ℕ} (x : α) (u : fin m → α) : vec_cons x u 0 = x :=
  rfl

theorem cons_val_zero' {α : Type u} {m : ℕ} (h : 0 < Nat.succ m) (x : α) (u : fin m → α) : vec_cons x u { val := 0, property := h } = x :=
  rfl

@[simp] theorem cons_val_succ {α : Type u} {m : ℕ} (x : α) (u : fin m → α) (i : fin m) : vec_cons x u (fin.succ i) = u i := sorry

@[simp] theorem cons_val_succ' {α : Type u} {m : ℕ} {i : ℕ} (h : Nat.succ i < Nat.succ m) (x : α) (u : fin m → α) : vec_cons x u { val := Nat.succ i, property := h } = u { val := i, property := nat.lt_of_succ_lt_succ h } := sorry

@[simp] theorem head_cons {α : Type u} {m : ℕ} (x : α) (u : fin m → α) : vec_head (vec_cons x u) = x :=
  rfl

@[simp] theorem tail_cons {α : Type u} {m : ℕ} (x : α) (u : fin m → α) : vec_tail (vec_cons x u) = u := sorry

@[simp] theorem empty_val' {α : Type u} {n' : Type u_1} (j : n') : (fun (i : fin 0) => vec_empty i j) = vec_empty :=
  empty_eq fun (i : fin 0) => vec_empty i j

@[simp] theorem cons_val' {α : Type u} {m : ℕ} {n' : Type u_2} [fintype n'] (v : n' → α) (B : matrix (fin m) n' α) (i : fin (Nat.succ m)) (j : n') : vec_cons v B i j = vec_cons (v j) (fun (i : fin m) => B i j) i := sorry

@[simp] theorem head_val' {α : Type u} {m : ℕ} {n' : Type u_2} [fintype n'] (B : matrix (fin (Nat.succ m)) n' α) (j : n') : (vec_head fun (i : fin (Nat.succ m)) => B i j) = vec_head B j :=
  rfl

@[simp] theorem tail_val' {α : Type u} {m : ℕ} {n' : Type u_2} [fintype n'] (B : matrix (fin (Nat.succ m)) n' α) (j : n') : (vec_tail fun (i : fin (Nat.succ m)) => B i j) = fun (i : fin m) => vec_tail B i j := sorry

@[simp] theorem cons_head_tail {α : Type u} {m : ℕ} (u : fin (Nat.succ m) → α) : vec_cons (vec_head u) (vec_tail u) = u :=
  fin.cons_self_tail u

@[simp] theorem range_cons {α : Type u} {n : ℕ} (x : α) (u : fin n → α) : set.range (vec_cons x u) = singleton x ∪ set.range u := sorry

@[simp] theorem range_empty {α : Type u} (u : fin 0 → α) : set.range u = ∅ := sorry

/-- `![a, b, ...] 1` is equal to `b`.

  The simplifier needs a special lemma for length `≥ 2`, in addition to
  `cons_val_succ`, because `1 : fin 1 = 0 : fin 1`.
-/
@[simp] theorem cons_val_one {α : Type u} {m : ℕ} (x : α) (u : fin (Nat.succ m) → α) : vec_cons x u 1 = vec_head u :=
  cons_val_succ x u 0

@[simp] theorem cons_val_fin_one {α : Type u} (x : α) (u : fin 0 → α) (i : fin 1) : vec_cons x u i = x := sorry

/-! ### Numeral (`bit0` and `bit1`) indices
The following definitions and `simp` lemmas are to allow any
numeral-indexed element of a vector given with matrix notation to
be extracted by `simp` (even when the numeral is larger than the
number of elements in the vector, which is taken modulo that number
of elements by virtue of the semantics of `bit0` and `bit1` and of
addition on `fin n`).
-/

@[simp] theorem empty_append {α : Type u} {n : ℕ} (v : fin n → α) : fin.append (Eq.symm (zero_add n)) vec_empty v = v := sorry

@[simp] theorem cons_append {α : Type u} {m : ℕ} {n : ℕ} {o : ℕ} (ho : o + 1 = m + 1 + n) (x : α) (u : fin m → α) (v : fin n → α) : fin.append ho (vec_cons x u) v =
  vec_cons x
    (fin.append
      (eq.mp (Eq._oldrec (Eq.refl (o + 1 = m + n + 1)) (propext add_right_cancel_iff))
        (eq.mp (Eq._oldrec (Eq.refl (o + 1 = m + (n + 1))) (Eq.symm (add_assoc m n 1)))
          (eq.mp (Eq._oldrec (Eq.refl (o + 1 = m + (1 + n))) (add_comm 1 n))
            (eq.mp (Eq._oldrec (Eq.refl (o + 1 = m + 1 + n)) (add_assoc m 1 n)) ho))))
      u v) := sorry

/-- `vec_alt0 v` gives a vector with half the length of `v`, with
only alternate elements (even-numbered). -/
def vec_alt0 {α : Type u} {m : ℕ} {n : ℕ} (hm : m = n + n) (v : fin m → α) (k : fin n) : α :=
  v { val := ↑k + ↑k, property := sorry }

/-- `vec_alt1 v` gives a vector with half the length of `v`, with
only alternate elements (odd-numbered). -/
def vec_alt1 {α : Type u} {m : ℕ} {n : ℕ} (hm : m = n + n) (v : fin m → α) (k : fin n) : α :=
  v { val := ↑k + ↑k + 1, property := sorry }

theorem vec_alt0_append {α : Type u} {n : ℕ} (v : fin n → α) : vec_alt0 rfl (fin.append rfl v v) = v ∘ bit0 := sorry

theorem vec_alt1_append {α : Type u} {n : ℕ} (v : fin (n + 1) → α) : vec_alt1 rfl (fin.append rfl v v) = v ∘ bit1 := sorry

@[simp] theorem vec_head_vec_alt0 {α : Type u} {m : ℕ} {n : ℕ} (hm : m + bit0 1 = n + 1 + (n + 1)) (v : fin (m + bit0 1) → α) : vec_head (vec_alt0 hm v) = v 0 :=
  rfl

@[simp] theorem vec_head_vec_alt1 {α : Type u} {m : ℕ} {n : ℕ} (hm : m + bit0 1 = n + 1 + (n + 1)) (v : fin (m + bit0 1) → α) : vec_head (vec_alt1 hm v) = v 1 :=
  rfl

@[simp] theorem cons_vec_bit0_eq_alt0 {α : Type u} {n : ℕ} (x : α) (u : fin n → α) (i : fin (n + 1)) : vec_cons x u (bit0 i) = vec_alt0 rfl (fin.append rfl (vec_cons x u) (vec_cons x u)) i := sorry

@[simp] theorem cons_vec_bit1_eq_alt1 {α : Type u} {n : ℕ} (x : α) (u : fin n → α) (i : fin (n + 1)) : vec_cons x u (bit1 i) = vec_alt1 rfl (fin.append rfl (vec_cons x u) (vec_cons x u)) i := sorry

@[simp] theorem cons_vec_alt0 {α : Type u} {m : ℕ} {n : ℕ} (h : m + 1 + 1 = n + 1 + (n + 1)) (x : α) (y : α) (u : fin m → α) : vec_alt0 h (vec_cons x (vec_cons y u)) =
  vec_cons x
    (vec_alt0
      (eq.mp (Eq._oldrec (Eq.refl (m + 1 = n + n + 1)) (propext add_right_cancel_iff))
        (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + n + 1 + 1)) (propext add_right_cancel_iff))
          (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + (n + 1) + 1)) (Eq.symm (add_assoc n n 1)))
            (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + (n + 1 + 1))) (Eq.symm (add_assoc n (n + 1) 1)))
              (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + (1 + (n + 1)))) (add_comm 1 (n + 1)))
                (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + 1 + (n + 1))) (add_assoc n 1 (n + 1))) h))))))
      u) := sorry

-- Although proved by simp, extracting element 8 of a five-element

-- vector does not work by simp unless this lemma is present.

@[simp] theorem empty_vec_alt0 (α : Type u_1) {h : 0 = 0 + 0} : vec_alt0 h vec_empty = vec_empty :=
  eq.mpr (id (propext (eq_iff_true_of_subsingleton (vec_alt0 h vec_empty) vec_empty))) trivial

@[simp] theorem cons_vec_alt1 {α : Type u} {m : ℕ} {n : ℕ} (h : m + 1 + 1 = n + 1 + (n + 1)) (x : α) (y : α) (u : fin m → α) : vec_alt1 h (vec_cons x (vec_cons y u)) =
  vec_cons y
    (vec_alt1
      (eq.mp (Eq._oldrec (Eq.refl (m + 1 = n + n + 1)) (propext add_right_cancel_iff))
        (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + n + 1 + 1)) (propext add_right_cancel_iff))
          (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + (n + 1) + 1)) (Eq.symm (add_assoc n n 1)))
            (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + (n + 1 + 1))) (Eq.symm (add_assoc n (n + 1) 1)))
              (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + (1 + (n + 1)))) (add_comm 1 (n + 1)))
                (eq.mp (Eq._oldrec (Eq.refl (m + 1 + 1 = n + 1 + (n + 1))) (add_assoc n 1 (n + 1))) h))))))
      u) := sorry

-- Although proved by simp, extracting element 9 of a five-element

-- vector does not work by simp unless this lemma is present.

@[simp] theorem empty_vec_alt1 (α : Type u_1) {h : 0 = 0 + 0} : vec_alt1 h vec_empty = vec_empty :=
  eq.mpr (id (propext (eq_iff_true_of_subsingleton (vec_alt1 h vec_empty) vec_empty))) trivial

@[simp] theorem dot_product_empty {α : Type u} [add_comm_monoid α] [Mul α] (v : fin 0 → α) (w : fin 0 → α) : dot_product v w = 0 :=
  finset.sum_empty

@[simp] theorem cons_dot_product {α : Type u} {n : ℕ} [add_comm_monoid α] [Mul α] (x : α) (v : fin n → α) (w : fin (Nat.succ n) → α) : dot_product (vec_cons x v) w = x * vec_head w + dot_product v (vec_tail w) := sorry

@[simp] theorem dot_product_cons {α : Type u} {n : ℕ} [add_comm_monoid α] [Mul α] (v : fin (Nat.succ n) → α) (x : α) (w : fin n → α) : dot_product v (vec_cons x w) = vec_head v * x + dot_product (vec_tail v) w := sorry

@[simp] theorem col_empty {α : Type u} (v : fin 0 → α) : col v = vec_empty :=
  empty_eq (col v)

@[simp] theorem col_cons {α : Type u} {m : ℕ} (x : α) (u : fin m → α) : col (vec_cons x u) = vec_cons (fun (_x : Unit) => x) (col u) := sorry

@[simp] theorem row_empty {α : Type u} : row vec_empty = fun (_x : Unit) => vec_empty :=
  funext fun (x : Unit) => funext fun (x_1 : fin 0) => Eq.refl (row vec_empty x x_1)

@[simp] theorem row_cons {α : Type u} {m : ℕ} (x : α) (u : fin m → α) : row (vec_cons x u) = fun (_x : Unit) => vec_cons x u :=
  funext fun (x_1 : Unit) => funext fun (x_2 : fin (Nat.succ m)) => Eq.refl (row (vec_cons x u) x_1 x_2)

@[simp] theorem transpose_empty_rows {α : Type u} {m' : Type u_1} [fintype m'] (A : matrix m' (fin 0) α) : transpose A = vec_empty :=
  empty_eq (transpose A)

@[simp] theorem transpose_empty_cols {α : Type u} {m' : Type u_1} [fintype m'] : transpose vec_empty = fun (i : m') => vec_empty :=
  funext fun (i : m') => empty_eq (transpose vec_empty i)

@[simp] theorem cons_transpose {α : Type u} {m : ℕ} {n' : Type u_2} [fintype n'] (v : n' → α) (A : matrix (fin m) n' α) : transpose (vec_cons v A) = fun (i : n') => vec_cons (v i) (transpose A i) := sorry

@[simp] theorem head_transpose {α : Type u} {n : ℕ} {m' : Type u_1} [fintype m'] (A : matrix m' (fin (Nat.succ n)) α) : vec_head (transpose A) = vec_head ∘ A :=
  rfl

@[simp] theorem tail_transpose {α : Type u} {n : ℕ} {m' : Type u_1} [fintype m'] (A : matrix m' (fin (Nat.succ n)) α) : vec_tail (transpose A) = transpose (vec_tail ∘ A) :=
  ext fun (i : fin n) (j : m') => Eq.refl (vec_tail (transpose A) i j)

@[simp] theorem empty_mul {α : Type u} {n' : Type u_2} {o' : Type u_3} [fintype n'] [fintype o'] [semiring α] (A : matrix (fin 0) n' α) (B : matrix n' o' α) : matrix.mul A B = vec_empty :=
  empty_eq (matrix.mul A B)

@[simp] theorem empty_mul_empty {α : Type u} {m' : Type u_1} {o' : Type u_3} [fintype m'] [fintype o'] [semiring α] (A : matrix m' (fin 0) α) (B : matrix (fin 0) o' α) : matrix.mul A B = 0 :=
  rfl

@[simp] theorem mul_empty {α : Type u} {m' : Type u_1} {n' : Type u_2} [fintype m'] [fintype n'] [semiring α] (A : matrix m' n' α) (B : matrix n' (fin 0) α) : matrix.mul A B = fun (_x : m') => vec_empty :=
  funext fun (_x : m') => empty_eq (matrix.mul A B _x)

theorem mul_val_succ {α : Type u} {m : ℕ} {n' : Type u_2} {o' : Type u_3} [fintype n'] [fintype o'] [semiring α] (A : matrix (fin (Nat.succ m)) n' α) (B : matrix n' o' α) (i : fin m) (j : o') : matrix.mul A B (fin.succ i) j = matrix.mul (vec_tail A) B i j :=
  rfl

@[simp] theorem cons_mul {α : Type u} {m : ℕ} {n' : Type u_2} {o' : Type u_3} [fintype n'] [fintype o'] [semiring α] (v : n' → α) (A : matrix (fin m) n' α) (B : matrix n' o' α) : matrix.mul (vec_cons v A) B = vec_cons (vec_mul v B) (matrix.mul A B) := sorry

@[simp] theorem empty_vec_mul {α : Type u} {o' : Type u_3} [fintype o'] [semiring α] (v : fin 0 → α) (B : matrix (fin 0) o' α) : vec_mul v B = 0 :=
  rfl

@[simp] theorem vec_mul_empty {α : Type u} {n' : Type u_2} [fintype n'] [semiring α] (v : n' → α) (B : matrix n' (fin 0) α) : vec_mul v B = vec_empty :=
  empty_eq (vec_mul v B)

@[simp] theorem cons_vec_mul {α : Type u} {n : ℕ} {o' : Type u_3} [fintype o'] [semiring α] (x : α) (v : fin n → α) (B : matrix (fin (Nat.succ n)) o' α) : vec_mul (vec_cons x v) B = x • vec_head B + vec_mul v (vec_tail B) := sorry

@[simp] theorem vec_mul_cons {α : Type u} {n : ℕ} {o' : Type u_3} [fintype o'] [semiring α] (v : fin (Nat.succ n) → α) (w : o' → α) (B : matrix (fin n) o' α) : vec_mul v (vec_cons w B) = vec_head v • w + vec_mul (vec_tail v) B := sorry

@[simp] theorem empty_mul_vec {α : Type u} {n' : Type u_2} [fintype n'] [semiring α] (A : matrix (fin 0) n' α) (v : n' → α) : mul_vec A v = vec_empty :=
  empty_eq (mul_vec A v)

@[simp] theorem mul_vec_empty {α : Type u} {m' : Type u_1} [fintype m'] [semiring α] (A : matrix m' (fin 0) α) (v : fin 0 → α) : mul_vec A v = 0 :=
  rfl

@[simp] theorem cons_mul_vec {α : Type u} {m : ℕ} {n' : Type u_2} [fintype n'] [semiring α] (v : n' → α) (A : fin m → n' → α) (w : n' → α) : mul_vec (vec_cons v A) w = vec_cons (dot_product v w) (mul_vec A w) := sorry

@[simp] theorem mul_vec_cons {n : ℕ} {m' : Type u_1} [fintype m'] {α : Type u_2} [comm_semiring α] (A : m' → fin (Nat.succ n) → α) (x : α) (v : fin n → α) : mul_vec A (vec_cons x v) = x • vec_head ∘ A + mul_vec (vec_tail ∘ A) v := sorry

@[simp] theorem empty_vec_mul_vec {α : Type u} {n' : Type u_2} [fintype n'] [semiring α] (v : fin 0 → α) (w : n' → α) : vec_mul_vec v w = vec_empty :=
  empty_eq (vec_mul_vec v w)

@[simp] theorem vec_mul_vec_empty {α : Type u} {m' : Type u_1} [fintype m'] [semiring α] (v : m' → α) (w : fin 0 → α) : vec_mul_vec v w = fun (_x : m') => vec_empty :=
  funext fun (i : m') => empty_eq (vec_mul_vec v w i)

@[simp] theorem cons_vec_mul_vec {α : Type u} {m : ℕ} {n' : Type u_2} [fintype n'] [semiring α] (x : α) (v : fin m → α) (w : n' → α) : vec_mul_vec (vec_cons x v) w = vec_cons (x • w) (vec_mul_vec v w) := sorry

@[simp] theorem vec_mul_vec_cons {α : Type u} {n : ℕ} {m' : Type u_1} [fintype m'] [semiring α] (v : m' → α) (x : α) (w : fin n → α) : vec_mul_vec v (vec_cons x w) = fun (i : m') => v i • vec_cons x w := sorry

@[simp] theorem smul_empty {α : Type u} [semiring α] (x : α) (v : fin 0 → α) : x • v = vec_empty :=
  empty_eq (x • v)

@[simp] theorem smul_mat_empty {α : Type u} [semiring α] {m' : Type u_1} (x : α) (A : fin 0 → m' → α) : x • A = vec_empty :=
  empty_eq (x • A)

@[simp] theorem smul_cons {α : Type u} {n : ℕ} [semiring α] (x : α) (y : α) (v : fin n → α) : x • vec_cons y v = vec_cons (x * y) (x • v) := sorry

@[simp] theorem smul_mat_cons {α : Type u} {m : ℕ} {n' : Type u_2} [fintype n'] [semiring α] (x : α) (v : n' → α) (A : matrix (fin m) n' α) : x • vec_cons v A = vec_cons (x • v) (x • A) := sorry

@[simp] theorem empty_add_empty {α : Type u} [Add α] (v : fin 0 → α) (w : fin 0 → α) : v + w = vec_empty :=
  empty_eq (v + w)

@[simp] theorem cons_add {α : Type u} {n : ℕ} [Add α] (x : α) (v : fin n → α) (w : fin (Nat.succ n) → α) : vec_cons x v + w = vec_cons (x + vec_head w) (v + vec_tail w) := sorry

@[simp] theorem add_cons {α : Type u} {n : ℕ} [Add α] (v : fin (Nat.succ n) → α) (y : α) (w : fin n → α) : v + vec_cons y w = vec_cons (vec_head v + y) (vec_tail v + w) := sorry

@[simp] theorem head_add {α : Type u} {n : ℕ} [Add α] (a : fin (Nat.succ n) → α) (b : fin (Nat.succ n) → α) : vec_head (a + b) = vec_head a + vec_head b :=
  rfl

@[simp] theorem tail_add {α : Type u} {n : ℕ} [Add α] (a : fin (Nat.succ n) → α) (b : fin (Nat.succ n) → α) : vec_tail (a + b) = vec_tail a + vec_tail b :=
  rfl

@[simp] theorem empty_sub_empty {α : Type u} [Sub α] (v : fin 0 → α) (w : fin 0 → α) : v - w = vec_empty :=
  empty_eq (v - w)

@[simp] theorem cons_sub {α : Type u} {n : ℕ} [Sub α] (x : α) (v : fin n → α) (w : fin (Nat.succ n) → α) : vec_cons x v - w = vec_cons (x - vec_head w) (v - vec_tail w) := sorry

@[simp] theorem sub_cons {α : Type u} {n : ℕ} [Sub α] (v : fin (Nat.succ n) → α) (y : α) (w : fin n → α) : v - vec_cons y w = vec_cons (vec_head v - y) (vec_tail v - w) := sorry

@[simp] theorem head_sub {α : Type u} {n : ℕ} [Sub α] (a : fin (Nat.succ n) → α) (b : fin (Nat.succ n) → α) : vec_head (a - b) = vec_head a - vec_head b :=
  rfl

@[simp] theorem tail_sub {α : Type u} {n : ℕ} [Sub α] (a : fin (Nat.succ n) → α) (b : fin (Nat.succ n) → α) : vec_tail (a - b) = vec_tail a - vec_tail b :=
  rfl

@[simp] theorem zero_empty {α : Type u} [HasZero α] : 0 = vec_empty :=
  empty_eq 0

@[simp] theorem cons_zero_zero {α : Type u} {n : ℕ} [HasZero α] : vec_cons 0 0 = 0 := sorry

@[simp] theorem head_zero {α : Type u} {n : ℕ} [HasZero α] : vec_head 0 = 0 :=
  rfl

@[simp] theorem tail_zero {α : Type u} {n : ℕ} [HasZero α] : vec_tail 0 = 0 :=
  rfl

@[simp] theorem cons_eq_zero_iff {α : Type u} {n : ℕ} [HasZero α] {v : fin n → α} {x : α} : vec_cons x v = 0 ↔ x = 0 ∧ v = 0 := sorry

theorem cons_nonzero_iff {α : Type u} {n : ℕ} [HasZero α] {v : fin n → α} {x : α} : vec_cons x v ≠ 0 ↔ x ≠ 0 ∨ v ≠ 0 :=
  { mp := fun (h : vec_cons x v ≠ 0) => iff.mp not_and_distrib (h ∘ iff.mpr cons_eq_zero_iff),
    mpr := fun (h : x ≠ 0 ∨ v ≠ 0) => mt (iff.mp cons_eq_zero_iff) (iff.mpr not_and_distrib h) }

@[simp] theorem neg_empty {α : Type u} [Neg α] (v : fin 0 → α) : -v = vec_empty :=
  empty_eq (-v)

@[simp] theorem neg_cons {α : Type u} {n : ℕ} [Neg α] (x : α) (v : fin n → α) : -vec_cons x v = vec_cons (-x) (-v) := sorry

@[simp] theorem head_neg {α : Type u} {n : ℕ} [Neg α] (a : fin (Nat.succ n) → α) : vec_head (-a) = -vec_head a :=
  rfl

@[simp] theorem tail_neg {α : Type u} {n : ℕ} [Neg α] (a : fin (Nat.succ n) → α) : vec_tail (-a) = -vec_tail a :=
  rfl

@[simp] theorem minor_empty {α : Type u} {m' : Type u_1} {n' : Type u_2} {o' : Type u_3} [fintype m'] [fintype n'] [fintype o'] (A : matrix m' n' α) (row : fin 0 → m') (col : o' → n') : minor A row col = vec_empty :=
  empty_eq (minor A row col)

@[simp] theorem minor_cons_row {α : Type u} {m : ℕ} {m' : Type u_1} {n' : Type u_2} {o' : Type u_3} [fintype m'] [fintype n'] [fintype o'] (A : matrix m' n' α) (i : m') (row : fin m → m') (col : o' → n') : minor A (vec_cons i row) col = vec_cons (fun (j : o') => A i (col j)) (minor A row col) := sorry


import tactic
import order.complete_lattice
import set_theory.cardinal.finite
import ..aux.ncard
import algebra.big_operators.finprod

noncomputable theory
open_locale classical
open_locale big_operators

/-!
A few helper lemmas for a separate PR
-/

section finset

variables {α : Type*} {X Y : finset α}

lemma finset.exists_mem_sdiff_of_card_lt_card (h : X.card < Y.card) :
  ∃ e, e ∈ Y ∧ e ∉ X :=
begin
  refine by_contra (λ h', h.not_le (finset.card_mono (λ x hx, _))),
  push_neg at h',
  exact h' _ hx,
end

@[simp] lemma finset.card_inter_add_card_sdiff_eq_card (X Y : finset α) :
  (X ∩ Y).card + (X \ Y).card = X.card :=
by {convert @finset.card_sdiff_add_card_eq_card _ _ _ _ _; simp}

lemma finset.card_sdiff_eq_card_sdiff_iff_card_eq_card {X Y : finset α} :
  X.card = Y.card ↔ (X \ Y).card = (Y \ X).card :=
by rw [←finset.card_inter_add_card_sdiff_eq_card X Y, ←finset.card_inter_add_card_sdiff_eq_card Y X,
    finset.inter_comm, add_right_inj]

lemma finset.card_le_card_iff_card_sdiff_le_card_sdiff {X Y : finset α} :
  X.card ≤ Y.card ↔ (X \ Y).card ≤ (Y \ X).card :=
by rw [←finset.card_inter_add_card_sdiff_eq_card X Y, ←finset.card_inter_add_card_sdiff_eq_card Y X,
  finset.inter_comm, add_le_add_iff_left]

lemma finset.card_lt_card_iff_card_sdiff_lt_card_sdiff {X Y : finset α} :
  X.card < Y.card ↔ (X \ Y).card < (Y \ X).card :=
by rw [←finset.card_inter_add_card_sdiff_eq_card X Y, ←finset.card_inter_add_card_sdiff_eq_card Y X,
    finset.inter_comm, add_lt_add_iff_left]

lemma nat.card_eq_to_finset_card [fintype α] (S : set α) :
  nat.card S = S.to_finset.card :=
by simp [nat.card_eq_fintype_card]

end finset

open set

theorem set.finite.exists_minimal_wrt {α β : Type*} [partial_order β] (f : α → β) (s : set α)
  (h : s.finite) :
s.nonempty → (∃ (a : α) (H : a ∈ s), ∀ (a' : α), a' ∈ s → f a' ≤ f a → f a = f a') :=
@set.finite.exists_maximal_wrt α (order_dual β) _ f s h

lemma set.finite.exists_maximal {α : Type*} [finite α] [partial_order α] (P : α → Prop)
(h : ∃ x, P x) :
  ∃ m, P m ∧ ∀ x, P x → m ≤ x → m = x :=
begin
  obtain ⟨m,⟨hm : P m,hm'⟩⟩ := set.finite.exists_maximal_wrt (@id α) (set_of P) (to_finite _) h,
  exact ⟨m, hm, hm'⟩,
end

lemma set.finite.exists_minimal {α : Type*} [finite α] [partial_order α] (P : α → Prop)
(h : ∃ x, P x) : ∃ m, P m ∧ ∀ x, P x → x ≤ m → m = x :=
@set.finite.exists_maximal (order_dual α) _ _ P h

lemma set.finite.exists_minimal_subset {α : Type*} {s : set α} {P : set α → Prop} (hs : s.finite)
(hsP : P s) :
  ∃ t ⊆ s, P t ∧ ∀ t' ⊂ t, ¬ P t' :=
begin
  obtain ⟨t₀,ht₀,ht₀min⟩ := @set.finite.exists_minimal (set s) (@set.finite' _ (hs.to_subtype)) _
    (P ∘ (set.image coe)) ⟨univ, by simpa⟩,
  refine ⟨coe '' t₀, by simp, ht₀, λ t' ht' hPt', ht'.ne _⟩,
  have ht's : t' ⊆ s, from ht'.subset.trans (by simp),
  have ht'' := subtype.coe_image_of_subset ht's,
  simp_rw function.comp_app at ht₀ ht₀min,

  rw [ht₀min {x : ↥s | ↑x ∈ t'} (by rwa ht'') _, ht''],
  convert @preimage_mono _ _ (coe : s → α)   _ _ ht'.subset,
  rw preimage_image_eq _ subtype.coe_injective,
end

lemma set.diff_singleton_ssubset_iff {α : Type*} {e : α} {S : set α} :
  S \ {e} ⊂ S ↔ e ∈ S :=
⟨ λ h, by_contra (λ he, h.ne (by rwa [sdiff_eq_left, disjoint_singleton_right])),
  λ h, ssubset_of_ne_of_subset
    (by rwa [ne.def, sdiff_eq_left, disjoint_singleton_right, not_not_mem]) (diff_subset _ _)⟩

lemma set.diff_singleton_ssubset {α : Type*} {e : α} {S : set α} (heS : e ∈ S) :
  S \ {e} ⊂ S :=
set.diff_singleton_ssubset_iff.mpr heS

lemma insert_diff_singleton_comm {α : Type*} {X : set α} {e f : α} (hef : e ≠ f) :
  insert e (X \ {f}) = (insert e X) \ {f} :=
by rw [←union_singleton, ←union_singleton, union_diff_distrib,
  diff_singleton_eq_self (by simpa using hef.symm : f ∉ {e})]

lemma function.injective.compl_image {α β : Type*} {f : α → β} (hf : f.injective) (X : set α) :
  (f '' X)ᶜ = f '' (Xᶜ) ∪ (range f)ᶜ :=
begin
  apply compl_injective,
  simp_rw [compl_union, compl_compl],
  refine (subset_inter _ (image_subset_range _ _)).antisymm _,
  { rintro x ⟨y, hy, rfl⟩ ⟨z,hz, hzy⟩,
    rw [hf hzy] at hz,
    exact hz hy},
  rintro x ⟨hx, ⟨y, rfl⟩⟩,
  exact ⟨y, by_contra (λ (hy : y ∈ Xᶜ), hx (mem_image_of_mem _ hy)), rfl⟩,
end

lemma singleton_inter_eq_of_mem {α : Type*} {x : α} {s : set α} (hx : x ∈ s) :
  {x} ∩ s = {x} :=
(inter_subset_left _ _).antisymm (subset_inter subset_rfl (singleton_subset_iff.mpr hx))

lemma inter_singleton_eq_of_mem {α : Type*} {x : α} {s : set α} (hx : x ∈ s) :
  s ∩ {x} = {x} :=
(inter_subset_right _ _).antisymm (subset_inter (singleton_subset_iff.mpr hx) subset_rfl)

@[simp] lemma diff_diff_cancel_right {α : Type*} (s t : set α) :
  s \ (t \ s) = s :=
(diff_subset _ _).antisymm (λ x hx, ⟨hx, λ h, h.2 hx⟩)

@[simp] lemma not_mem_diff_singleton {α : Type*} (x : α) (s : set α) :
  x ∉ s \ {x} :=
by simp only [mem_diff, mem_singleton, not_true, and_false, not_false_iff]

section sigma

/- Some lemmas about sets in sigma types -/

variables {ι : Type*} {α : ι → Type*} {x y : set (Σ i, α i)} {f : ∀ i, set (α i)} {i j : ι}

lemma sigma.subset_iff :
  x ⊆ y ↔ ∀ i, (sigma.mk i ⁻¹' x) ⊆ (sigma.mk i ⁻¹' y) :=
⟨λ h i a ha, h ha, λ h ⟨i,a⟩ ha, h i ha⟩

lemma sigma.eq_iff_forall_preimage_mk_eq :
  x = y ↔ ∀ i, (sigma.mk i ⁻¹' x) = (sigma.mk i ⁻¹' y) :=
⟨by {rintro rfl, exact λ _, rfl}, λ h, (sigma.subset_iff.mpr (λ i, (h i).subset)).antisymm
  (sigma.subset_iff.mpr (λ i, (h i).symm.subset))⟩

@[simp] lemma sigma.preimage_mk_Union_image_mk :
  sigma.mk j ⁻¹' (⋃ (i : ι), sigma.mk i '' f i) = f j:=
begin
  rw [preimage_Union, subset_antisymm_iff, Union_subset_iff],
  refine ⟨λ k, _, subset_Union_of_subset j (by rw preimage_image_eq _ sigma_mk_injective)⟩,
  obtain (rfl | hjk) := eq_or_ne j k,
  { rw preimage_image_eq _ sigma_mk_injective},
  rw preimage_image_sigma_mk_of_ne hjk,
  exact empty_subset _,
end

lemma sigma.eq_Union_image_preimage_mk (x : set (Σ i, α i)) :
  x = ⋃ (i : ι), sigma.mk i '' (sigma.mk i ⁻¹' x) :=
by simp [sigma.eq_iff_forall_preimage_mk_eq]

lemma sigma.image_preimage_mk_pairwise_disjoint (x : set (Σ i, α i)) :
  pairwise (disjoint on (λ i, sigma.mk i '' (sigma.mk i ⁻¹' x))) :=
begin
  refine λ i j hij s hs hs' a ha, hij _,
  simp only [bot_eq_empty, le_eq_subset, mem_empty_iff_false] at hs hs' ⊢,
  obtain ⟨t,ht,rfl⟩ := hs ha,
  obtain ⟨t', ht', h'⟩ := hs' ha,
  simp only at h',
  rw h'.1,
end

lemma sigma_equiv_prod_mk {α : Type*} {i : ι} :
  (equiv.sigma_equiv_prod ι α) ∘ (sigma.mk i) = prod.mk i :=
by {ext; simp}

variables [finite ι]

@[simp] lemma finsum_mem_one {α : Type*} (s : set α) :
  ∑ᶠ a ∈ s, 1 = s.ncard :=
begin
  have hsupp := @function.support_const α _ _ _ (nat.one_ne_zero),
  obtain (h | h) := s.finite_or_infinite,
  { have h' := h,
    rw [←inter_univ s, ← hsupp] at h',
    convert finsum_mem_eq_sum _ h',
    rw [←finset.card_eq_sum_ones, ncard_eq_to_finset_card _ h],
    congr',
    rw [hsupp, inter_univ]},
  rw [h.ncard, finsum_mem_eq_zero_of_infinite],
  rwa [hsupp, inter_univ],
end

@[simp] lemma finsum_one (α : Sort*) :
  ∑ᶠ (a : α), 1 = nat.card α :=
by rw [←finsum_mem_univ, finsum_mem_one, ncard_univ]

lemma sigma.ncard_eq_finsum_ncard_image_preimage_mk (x : set (Σ i, α i)) (hx : x.finite) :
  x.ncard = ∑ᶠ i, (sigma.mk i '' (sigma.mk i ⁻¹' x)).ncard :=
begin
  rw [←finsum_mem_one,  sigma.eq_Union_image_preimage_mk x,
    finsum_mem_Union (sigma.image_preimage_mk_pairwise_disjoint x)],
  { simp [←finsum_mem_one]},
  exact λ i, hx.subset (by simp),
end

lemma min_one_ncard_eq_ite {α : Type*} {s : set α} (hs : s.finite):
  min 1 s.ncard = ite (s.nonempty) 1 0 :=
begin
  obtain (rfl | h) := s.eq_empty_or_nonempty, simp,
  rwa [if_pos h, min_eq_left_iff, nat.add_one_le_iff, ncard_pos hs],
end

@[simp] lemma sigma.ncard_preimage_mk (x : set (Σ i, α i)) (i : ι) :
  (sigma.mk i ⁻¹' x).ncard = (x ∩ sigma.fst ⁻¹' {i}).ncard :=
begin
  rw [←range_sigma_mk, ←preimage_inter_range,
    ncard_preimage_of_injective_subset_range sigma_mk_injective],
  apply inter_subset_right,
end

end sigma

section finsum

lemma finsum_mem_le_finsum_mem  {ι N : Type*} [ordered_add_comm_monoid N] {f g : ι → N}
{s : set ι} (hf : (s ∩ function.support f).finite) (hg : (s ∩ function.support g).finite)
(h : ∀ (i : ι), i ∈ s → f i ≤ g i) :
  ∑ᶠ (i ∈ s), f i ≤ ∑ᶠ (i ∈ s), g i :=
begin
  set hs' := hf.union hg,
  rw [← inter_distrib_left] at hs',
  rw [@finsum_mem_eq_sum_of_inter_support_eq _ _ _ f _ hs'.to_finset,
    @finsum_mem_eq_sum_of_inter_support_eq _ _ _ g _ hs'.to_finset],
  { apply finset.sum_le_sum,
    simp only [finite.mem_to_finset, mem_inter_iff, mem_union, function.mem_support, and_imp],
    exact λ i hi h', h i hi},
  { rw [finite.coe_to_finset, inter_assoc, inter_eq_self_of_subset_right (subset_union_right _ _)]},
  rw [finite.coe_to_finset, inter_assoc, inter_eq_self_of_subset_right (subset_union_left _ _)],
end

lemma finsum_le_finsum {ι N : Type*} [ordered_add_comm_monoid N] {f g : ι → N}
(hf : f.support.finite) (hg : g.support.finite) (h : ∀ i, f i ≤ g i) :
  ∑ᶠ i, f i ≤ ∑ᶠ i, g i :=
begin
  rw [←finsum_mem_univ],
  nth_rewrite 1 ←finsum_mem_univ,
  apply finsum_mem_le_finsum_mem;
  simpa,
end

/-- If `f ≤ g` pointwise on `s`, but the sum of `g` is at most the sum of `f`, then `f = g` on `s`-/
lemma eq_of_finsum_mem_ge_finsum_mem_of_forall_le {ι N : Type*} [ordered_cancel_add_comm_monoid N]
{f g : ι → N} {s : set ι} (hf : (s ∩ f.support).finite) (hg : (s ∩ g.support).finite)
(h_le : ∀ i ∈ s, f i ≤ g i) (h_ge : ∑ᶠ i ∈ s, g i ≤ ∑ᶠ i ∈ s, f i) {a : ι} (ha : a ∈ s) :
  f a = g a :=
begin
  refine (h_le a ha).antisymm _,
  set s' := s \ {a} with hs',
  have hs'f : ((s \ {a}) ∩ f.support).finite, from
    hf.subset (inter_subset_inter_left _ (diff_subset _ _)),
  have hs'g : ((s \ {a}) ∩ g.support).finite, from
    hg.subset (inter_subset_inter_left _ (diff_subset _ _)),
  rw [←insert_eq_of_mem ha, ←insert_diff_singleton,
    finsum_mem_insert' _ (not_mem_diff_singleton _ _) hs'f,
    finsum_mem_insert' _ (not_mem_diff_singleton _ _) hs'g] at h_ge,
  exact le_of_add_le_add_right
    ((add_le_add_left (finsum_mem_le_finsum_mem hs'f hs'g (λ i hi, h_le _ hi.1)) (g a)).trans h_ge),
end

lemma eq_of_finsum_ge_finsum_of_forall_le {ι N : Type*} [ordered_cancel_add_comm_monoid N]
{f g : ι → N} (hf : f.support.finite) (hg : g.support.finite) (h_le : ∀ i, f i ≤ g i)
(h_ge : ∑ᶠ i, g i ≤ ∑ᶠ i, f i) (a : ι) :
   f a = g a :=
begin
  rw [←finsum_mem_univ f, ←finsum_mem_univ g] at h_ge,
  exact eq_of_finsum_mem_ge_finsum_mem_of_forall_le (by rwa univ_inter) (by rwa univ_inter)
    (λ i _, h_le i) h_ge (mem_univ a),
end

lemma finsum_le_finsum_of_subset  {ι M : Type*} [canonically_ordered_add_monoid M]  {f : ι → M}
{s t : set ι}  (h : s ⊆ t) (ht : t.finite) :
 ∑ᶠ x ∈ s, f x ≤ ∑ᶠ x ∈ t, f x :=
begin
  rw [←inter_union_diff t s, inter_eq_right_iff_subset.mpr h,
    finsum_mem_union (@disjoint_sdiff_self_right _ s t _) (ht.subset h) (ht.diff _)],
  exact le_add_right rfl.le,
end

lemma finsum_le_finsum_of_subset'  {ι M : Type*} [canonically_ordered_add_monoid M]  {f : ι → M}
{s t : set ι}  (h : s ⊆ t) (ht : (t ∩ f.support).finite) :
 ∑ᶠ x ∈ s, f x ≤ ∑ᶠ x ∈ t, f x :=
begin
  rw ←finsum_mem_inter_support,
  nth_rewrite 1 [←finsum_mem_inter_support],
  apply finsum_le_finsum_of_subset (inter_subset_inter_left _ h) ht,
end

lemma mem_le_finsum {ι M : Type*} [canonically_ordered_add_monoid M]  {f : ι → M} {x : ι}
{t : set ι}  (h : x ∈ t) (ht : t.finite) :
  f x ≤ ∑ᶠ x ∈ t, f x :=
begin
  rw ←@finsum_mem_singleton _ _ _ f x,
  exact finsum_le_finsum_of_subset (singleton_subset_iff.mpr h) ht,
end

lemma mem_le_finsum' {ι M : Type*} [canonically_ordered_add_monoid M]  {f : ι → M} {x : ι}
{t : set ι}  (h : x ∈ t) (ht : (t ∩ f.support).finite) :
  f x ≤ ∑ᶠ x ∈ t, f x :=
begin
  rw ←@finsum_mem_singleton _ _ _ f x,
  exact finsum_le_finsum_of_subset' (singleton_subset_iff.mpr h) ht,
end

lemma ncard_sUnion_le {α : Type*} (s : set (set α)) (hs : s.finite) (hs' : ∀ x ∈ s, set.finite x):
  (⋃₀ s).ncard ≤ ∑ᶠ x ∈ s, ncard x :=
begin
  refine set.finite.induction_on hs (by simp) (λ a t hat ht h, _),
  rw [sUnion_insert, finsum_mem_insert _ hat ht],
  exact (ncard_union_le _ _).trans (add_le_add rfl.le h),
end

lemma ncard_Union_le {ι α : Type*} [finite ι] (s : ι → set α) (h : ∀ i, (s i).finite) :
  (⋃ i, s i).ncard ≤ ∑ᶠ i, (s i).ncard :=
begin
   suffices h' : ∀ (t : set ι), (⋃ i ∈ t, s i).ncard ≤ ∑ᶠ (i ∈ t), (s i).ncard,
   { convert h' univ; simp},
  refine λ t, (to_finite t).induction_on (by simp) _,
  intros a t₀ hat₀ ht₀ IH,
  rw [bUnion_insert, finsum_mem_insert _ hat₀ ht₀],
  exact (ncard_union_le _ _).trans (add_le_add rfl.le IH),
end

@[simp] lemma finsum_mem_boole  {α : Type*} (s : set α) (p : α → Prop) :
  ∑ᶠ x ∈ s, ite (p x) 1 0 = (s ∩ set_of p).ncard :=
begin
  have hsupp : s ∩ set_of p = (s ∩ function.support (λ x, ite (p x) 1 0)), by {ext, simp},
  cases (s ∩ set_of p).finite_or_infinite,
  { have h' : (s ∩ function.support (λ x, ite (p x) 1 0)).finite,  by rwa ←hsupp,
    rw [finsum_mem_eq_sum _ h', ncard_eq_to_finset_card _ h],
    simp only [finset.sum_boole, finset.filter_true_of_mem, finite.mem_to_finset, mem_inter_iff,
      function.mem_support, ne.def, ite_eq_right_iff, nat.one_ne_zero, not_forall, not_false_iff,
      exists_prop, and_true, and_imp, imp_self, implies_true_iff, nat.cast_id],
    convert rfl},
  rw [finsum_mem_eq_zero_of_infinite, h.ncard],
  rwa ←hsupp,
end

@[simp] lemma finsum_boole {α : Type*} (p : α → Prop) :
  ∑ᶠ x, ite (p x) 1 0 = (set_of p).ncard :=
by rw [←finsum_mem_univ, finsum_mem_boole, univ_inter]

lemma ncard_eq_finsum_fiber {α ι : Type*} {s : set α} (hs : s.finite) (f : α → ι) :
  s.ncard = ∑ᶠ (i : ι), (s ∩ f ⁻¹' {i}).ncard :=
begin

  have h' : (function.support (λ i, (s ∩ f ⁻¹' {i}).ncard)).finite,
  { apply (hs.image f).subset,
    rintro i (h : ¬ (_ = 0)),
    rw [(ncard_eq_zero (hs.subset (inter_subset_left _ _))), ←ne.def, ←nonempty_iff_ne_empty] at h,
     obtain ⟨x, hxs, hx⟩ := h,
     exact ⟨x, hxs, by simpa using hx⟩},

  rw [ncard_eq_to_finset_card _ hs,
    @finset.card_eq_sum_card_fiberwise _ _ _ f (hs.to_finset) ((hs.image f).to_finset)],
  { rw [←finsum_mem_univ, ←finsum_mem_inter_support, univ_inter,
     finsum_mem_eq_finite_to_finset_sum _ h', finset.sum_congr],
    { ext,
      simp_rw [finite.mem_to_finset, mem_image, function.mem_support, ne.def,
          ncard_eq_zero (hs.subset (inter_subset_left _ _)), eq_empty_iff_forall_not_mem,
        not_forall, mem_inter_iff, not_not, mem_preimage, mem_singleton_iff]},

    intros x hx,
    rw [ncard_eq_to_finset_card _ (hs.subset (inter_subset_left _ _))] ,
    convert rfl,
    ext,
    simp},
  simp only [finite.mem_to_finset, mem_image],
  exact λ x hx, ⟨x, hx, rfl⟩,
end

end finsum


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn

! This file was ported from Lean 3 source module category_theory.functor.category
! leanprover-community/mathlib commit 8350c34a64b9bc3fc64335df8006bffcadc7baa6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.NatTrans
import Mathlib.CategoryTheory.Iso

/-!
# The category of functors and natural transformations between two fixed categories.

We provide the category instance on `C ⥤ D`, with morphisms the natural transformations.

## Universes

If `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/

namespace CategoryTheory

-- declare the `v`'s first; see note [CategoryTheory universes].
universe v₁ v₂ v₃ u₁ u₂ u₃

open NatTrans Category CategoryTheory.Functor

variable (C : Type u₁) [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D]

attribute [local simp] vcomp_app

variable {C D} {E : Type u₃} [Category.{v₃} E]
variable {F G H I : C ⥤ D}

/-- `Functor.category C D` gives the category structure on functors and natural transformations
between categories `C` and `D`.

Notice that if `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/
instance Functor.category : Category.{max u₁ v₂} (C ⥤ D) where
  Hom F G := NatTrans F G
  id F := NatTrans.id F
  comp α β := vcomp α β
#align category_theory.functor.category CategoryTheory.Functor.category

namespace NatTrans

-- Porting note: the behaviour of `ext` has changed here.
-- We need to provide a copy of the `NatTrans.ext` lemma,
-- written in terms of `F ⟶ G` rather than `NatTrans F G`,
-- or the `ext` will not retrieve it from the cache.
@[ext]
theorem ext' {α β : F ⟶ G} (w : α.app = β.app) : α = β := NatTrans.ext _ _ w

@[simp]
theorem vcomp_eq_comp (α : F ⟶ G) (β : G ⟶ H) : vcomp α β = α ≫ β := rfl
#align category_theory.nat_trans.vcomp_eq_comp CategoryTheory.NatTrans.vcomp_eq_comp

theorem vcomp_app' (α : F ⟶ G) (β : G ⟶ H) (X : C) : (α ≫ β).app X = α.app X ≫ β.app X := rfl
#align category_theory.nat_trans.vcomp_app' CategoryTheory.NatTrans.vcomp_app'

theorem congr_app {α β : F ⟶ G} (h : α = β) (X : C) : α.app X = β.app X := by rw [h]
#align category_theory.nat_trans.congr_app CategoryTheory.NatTrans.congr_app

@[simp]
theorem id_app (F : C ⥤ D) (X : C) : (𝟙 F : F ⟶ F).app X = 𝟙 (F.obj X) := rfl
#align category_theory.nat_trans.id_app CategoryTheory.NatTrans.id_app

@[simp]
theorem comp_app {F G H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) :
    (α ≫ β).app X = α.app X ≫ β.app X := rfl
#align category_theory.nat_trans.comp_app CategoryTheory.NatTrans.comp_app

theorem app_naturality {F G : C ⥤ D ⥤ E} (T : F ⟶ G) (X : C) {Y Z : D} (f : Y ⟶ Z) :
    (F.obj X).map f ≫ (T.app X).app Z = (T.app X).app Y ≫ (G.obj X).map f :=
  (T.app X).naturality f
#align category_theory.nat_trans.app_naturality CategoryTheory.NatTrans.app_naturality

theorem naturality_app {F G : C ⥤ D ⥤ E} (T : F ⟶ G) (Z : D) {X Y : C} (f : X ⟶ Y) :
    (F.map f).app Z ≫ (T.app Y).app Z = (T.app X).app Z ≫ (G.map f).app Z :=
  congr_fun (congr_arg app (T.naturality f)) Z
#align category_theory.nat_trans.naturality_app CategoryTheory.NatTrans.naturality_app

/-- A natural transformation is a monomorphism if each component is. -/
theorem mono_of_mono_app (α : F ⟶ G) [∀ X : C, Mono (α.app X)] : Mono α :=
  ⟨fun g h eq => by
    ext X
    rw [← cancel_mono (α.app X), ← comp_app, eq, comp_app]⟩
#align category_theory.nat_trans.mono_of_mono_app CategoryTheory.NatTrans.mono_of_mono_app

/-- A natural transformation is an epimorphism if each component is. -/
theorem epi_of_epi_app (α : F ⟶ G) [∀ X : C, Epi (α.app X)] : Epi α :=
  ⟨fun g h eq => by
    ext X
    rw [← cancel_epi (α.app X), ← comp_app, eq, comp_app]⟩
#align category_theory.nat_trans.epi_of_epi_app CategoryTheory.NatTrans.epi_of_epi_app

/-- `hcomp α β` is the horizontal composition of natural transformations. -/
@[simps]
def hcomp {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : F ⋙ H ⟶ G ⋙ I where
  app := fun X : C => β.app (F.obj X) ≫ I.map (α.app X)
  naturality X Y f := by
    rw [Functor.comp_map, Functor.comp_map, ← assoc, naturality, assoc, ← map_comp I, naturality,
      map_comp, assoc]
#align category_theory.nat_trans.hcomp CategoryTheory.NatTrans.hcomp
#align category_theory.nat_trans.hcomp_app CategoryTheory.NatTrans.hcomp_app

/-- Notation for horizontal composition of natural transformations. -/
infixl:80 " ◫ " => hcomp

theorem hcomp_id_app {H : D ⥤ E} (α : F ⟶ G) (X : C) : (α ◫ 𝟙 H).app X = H.map (α.app X) := by
  simp
#align category_theory.nat_trans.hcomp_id_app CategoryTheory.NatTrans.hcomp_id_app

theorem id_hcomp_app {H : E ⥤ C} (α : F ⟶ G) (X : E) : (𝟙 H ◫ α).app X = α.app _ := by simp
#align category_theory.nat_trans.id_hcomp_app CategoryTheory.NatTrans.id_hcomp_app

-- Note that we don't yet prove a `hcomp_assoc` lemma here: even stating it is painful, because we
-- need to use associativity of functor composition. (It's true without the explicit associator,
-- because functor composition is definitionally associative,
-- but relying on the definitional equality causes bad problems with elaboration later.)
theorem exchange {I J K : D ⥤ E} (α : F ⟶ G) (β : G ⟶ H) (γ : I ⟶ J) (δ : J ⟶ K) :
    (α ≫ β) ◫ (γ ≫ δ) = (α ◫ γ) ≫ β ◫ δ := by
  aesop_cat
#align category_theory.nat_trans.exchange CategoryTheory.NatTrans.exchange

end NatTrans

open NatTrans

namespace Functor

/-- Flip the arguments of a bifunctor. See also `currying.lean`. -/
@[simps]
protected def flip (F : C ⥤ D ⥤ E) : D ⥤ C ⥤ E where
  obj k :=
    { obj := fun j => (F.obj j).obj k,
      map := fun f => (F.map f).app k, }
  map f := { app := fun j => (F.obj j).map f }
#align category_theory.functor.flip CategoryTheory.Functor.flip
#align category_theory.functor.flip_obj_map CategoryTheory.Functor.flip_obj_map
#align category_theory.functor.flip_obj_obj CategoryTheory.Functor.flip_obj_obj
#align category_theory.functor.flip_map_app CategoryTheory.Functor.flip_map_app

end Functor

@[reassoc (attr := simp)]
theorem map_hom_inv_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) :
    (F.map e.hom).app Z ≫ (F.map e.inv).app Z = 𝟙 _ := by
  simp [← NatTrans.comp_app, ← Functor.map_comp]
#align category_theory.map_hom_inv_app CategoryTheory.map_hom_inv_app
#align category_theory.map_hom_inv_app_assoc CategoryTheory.map_hom_inv_app_assoc

@[reassoc (attr := simp)]
theorem map_inv_hom_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) :
    (F.map e.inv).app Z ≫ (F.map e.hom).app Z = 𝟙 _ := by
  simp [← NatTrans.comp_app, ← Functor.map_comp]
#align category_theory.map_inv_hom_app CategoryTheory.map_inv_hom_app
#align category_theory.map_inv_hom_app_assoc CategoryTheory.map_inv_hom_app_assoc

end CategoryTheory


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

import algebra.module.basic

/-!
# Instances on punit

This file collects facts about algebraic structures on the one-element type, e.g. that it is a
commutative ring.
-/

universes u

namespace punit
variables (x y : punit.{u+1}) (s : set punit.{u+1})

@[to_additive]
instance : comm_group punit :=
by refine_struct
{ mul := λ _ _, star,
  one := star,
  inv := λ _, star,
  div := λ _ _, star,
  npow := λ _ _, star,
  gpow := λ _ _, star,
  .. };
intros; exact subsingleton.elim _ _

instance : comm_ring punit :=
by refine
{ .. punit.comm_group,
  .. punit.add_comm_group,
  .. };
intros; exact subsingleton.elim _ _

instance : complete_boolean_algebra punit :=
by refine
{ le := λ _ _, true,
  le_antisymm := λ _ _ _ _, subsingleton.elim _ _,
  lt := λ _ _, false,
  lt_iff_le_not_le := λ _ _, iff_of_false not_false (λ H, H.2 trivial),
  top := star,
  bot := star,
  sup := λ _ _, star,
  inf := λ _ _, star,
  Sup := λ _, star,
  Inf := λ _, star,
  compl := λ _, star,
  sdiff := λ _ _, star,
  .. };
intros; trivial <|> simp only [eq_iff_true_of_subsingleton]

instance : canonically_ordered_add_monoid punit :=
by refine
{ lt_of_add_lt_add_left := λ _ _ _, id,
  le_iff_exists_add := λ _ _, iff_of_true _ ⟨star, subsingleton.elim _ _⟩,
  .. punit.comm_ring, .. punit.complete_boolean_algebra, .. };
intros; trivial

instance : linear_ordered_cancel_add_comm_monoid punit :=
{ add_left_cancel := λ _ _ _ _, subsingleton.elim _ _,
  le_of_add_le_add_left := λ _ _ _ _, trivial,
  le_total := λ _ _, or.inl trivial,
  decidable_le := λ _ _, decidable.true,
  decidable_eq := punit.decidable_eq,
  decidable_lt := λ _ _, decidable.false,
  .. punit.canonically_ordered_add_monoid }

instance (R : Type u) [semiring R] : module R punit := module.of_core $
by refine
{ smul := λ _ _, star,
  .. punit.comm_ring, .. };
intros; exact subsingleton.elim _ _

@[simp] lemma zero_eq : (0 : punit) = star := rfl
@[simp, to_additive] lemma one_eq : (1 : punit) = star := rfl
@[simp] lemma add_eq : x + y = star := rfl
@[simp, to_additive] lemma mul_eq : x * y = star := rfl
@[simp, to_additive] lemma div_eq : x / y = star := rfl
@[simp] lemma neg_eq : -x = star := rfl
@[simp, to_additive] lemma inv_eq : x⁻¹ = star := rfl
lemma smul_eq : x • y = star := rfl
@[simp] lemma top_eq : (⊤ : punit) = star := rfl
@[simp] lemma bot_eq : (⊥ : punit) = star := rfl
@[simp] lemma sup_eq : x ⊔ y = star := rfl
@[simp] lemma inf_eq : x ⊓ y = star := rfl
@[simp] lemma Sup_eq : Sup s = star := rfl
@[simp] lemma Inf_eq : Inf s = star := rfl
@[simp] protected lemma le : x ≤ y := trivial
@[simp] lemma not_lt : ¬(x < y) := not_false

end punit


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_30 :
  (33818^2 + 33819^2 + 33820^2 + 33821^2 + 33822^2) % 17 = 0 :=
begin
  norm_num,
end


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import measure_theory.measure.measure_space

/-!
# Weak convergence of (finite) measures

This file will define the topology of weak convergence of finite measures and probability measures
on topological spaces. The topology of weak convergence is the coarsest topology w.r.t. which
for every bounded continuous `ℝ≥0`-valued function `f`, the integration of `f` against the
measure is continuous.

TODOs:
* Define the topologies (the current version only defines the types) via
  `weak_dual ℝ≥0 (α →ᵇ ℝ≥0)`.
* Prove that an equivalent definition of the topologies is obtained requiring continuity of
  integration of bounded continuous `ℝ`-valued functions instead.
* Include the portmanteau theorem on characterizations of weak convergence of (Borel) probability
  measures.

## Main definitions

The main definitions are the types `finite_measure α` and `probability_measure α`.

TODO:
* Define the topologies on the above types.

## Main results

None yet.

TODO:
* Portmanteau theorem.

## Notations

No new notation is introduced.

## Implementation notes

The topology of weak convergence of finite Borel measures will be defined using a mapping from
`finite_measure α` to `weak_dual ℝ≥0 (α →ᵇ ℝ≥0)`, inheriting the topology from the latter.

The current implementation of `finite_measure α` and `probability_measure α` is directly as
subtypes of `measure α`, and the coercion to a function is the composition `ennreal.to_nnreal`
and the coercion to function of `measure α`. Another alternative would be to use a bijection
with `vector_measure α ℝ≥0` as an intermediate step. The choice of implementation should not have
drastic downstream effects, so it can be changed later if appropriate.

Potential advantages of using the `nnreal`-valued vector measure alternative:
 * The coercion to function would avoid need to compose with `ennreal.to_nnreal`, the
   `nnreal`-valued API could be more directly available.
Potential drawbacks of the vector measure alternative:
 * The coercion to function would lose monotonicity, as non-measurable sets would be defined to
   have measure 0.
 * No integration theory directly. E.g., the topology definition requires `lintegral` w.r.t.
   a coercion to `measure α` in any case.

## References

* [Billingsley, *Convergence of probability measures*][billingsley1999]

## Tags

weak convergence of measures, finite measure, probability measure

-/

noncomputable theory
open measure_theory
open set
open filter
open_locale topological_space ennreal nnreal

namespace measure_theory

variables {α : Type*} [measurable_space α]

/-- Finite measures are defined as the subtype of measures that have the property of being finite
measures (i.e., their total mass is finite). -/
def finite_measure (α : Type*) [measurable_space α] : Type* :=
{μ : measure α // is_finite_measure μ}

namespace finite_measure

/-- A finite measure can be interpreted as a measure. -/
instance : has_coe (finite_measure α) (measure_theory.measure α) := coe_subtype

instance is_finite_measure (μ : finite_measure α) :
  is_finite_measure (μ : measure α) := μ.prop

instance : has_coe_to_fun (finite_measure α) (λ _, set α → ℝ≥0) :=
⟨λ μ s, (μ s).to_nnreal⟩

lemma coe_fn_eq_to_nnreal_coe_fn_to_measure (ν : finite_measure α) :
  (ν : set α → ℝ≥0) = λ s, ((ν : measure α) s).to_nnreal := rfl

@[simp] lemma ennreal_coe_fn_eq_coe_fn_to_measure (ν : finite_measure α) (s : set α) :
  (ν s : ℝ≥0∞) = (ν : measure α) s := ennreal.coe_to_nnreal (measure_lt_top ↑ν s).ne

@[simp] lemma val_eq_to_measure (ν : finite_measure α) : ν.val = (ν : measure α) := rfl

lemma coe_injective : function.injective (coe : finite_measure α → measure α) :=
subtype.coe_injective

/-- The (total) mass of a finite measure `μ` is `μ univ`, i.e., the cast to `nnreal` of
`(μ : measure α) univ`. -/
def mass (μ : finite_measure α) : ℝ≥0 := μ univ

@[simp] lemma ennreal_mass {μ : finite_measure α} :
  (μ.mass : ℝ≥0∞) = (μ : measure α) univ := ennreal_coe_fn_eq_coe_fn_to_measure μ set.univ

instance has_zero : has_zero (finite_measure α) :=
{ zero := ⟨0, measure_theory.is_finite_measure_zero⟩ }

instance : inhabited (finite_measure α) := ⟨0⟩

instance : has_add (finite_measure α) :=
{ add := λ μ ν, ⟨μ + ν, measure_theory.is_finite_measure_add⟩ }

instance : has_scalar ℝ≥0 (finite_measure α) :=
{ smul := λ (c : ℝ≥0) μ, ⟨c • μ, measure_theory.is_finite_measure_smul_nnreal⟩, }

@[simp, norm_cast] lemma coe_zero : (coe : finite_measure α → measure α) 0 = 0 := rfl

@[simp, norm_cast] lemma coe_add (μ ν : finite_measure α) : ↑(μ + ν) = (↑μ + ↑ν : measure α) := rfl

@[simp, norm_cast] lemma coe_smul (c : ℝ≥0) (μ : finite_measure α) :
  ↑(c • μ) = (c • ↑μ : measure α) := rfl

@[simp, norm_cast] lemma coe_fn_zero :
  (⇑(0 : finite_measure α) : set α → ℝ≥0) = (0 : set α → ℝ≥0) := by { funext, refl, }

@[simp, norm_cast] lemma coe_fn_add (μ ν : finite_measure α) :
  (⇑(μ + ν) : set α → ℝ≥0) = (⇑μ + ⇑ν : set α → ℝ≥0) :=
by { funext, simp [← ennreal.coe_eq_coe], }

@[simp, norm_cast] lemma coe_fn_smul (c : ℝ≥0) (μ : finite_measure α) :
  (⇑(c • μ) : set α → ℝ≥0) = c • (⇑μ : set α → ℝ≥0) :=
by { funext, simp [← ennreal.coe_eq_coe], }

instance : add_comm_monoid (finite_measure α) :=
finite_measure.coe_injective.add_comm_monoid
  (coe : finite_measure α → measure α) finite_measure.coe_zero finite_measure.coe_add

/-- Coercion is an `add_monoid_hom`. -/
@[simps]
def coe_add_monoid_hom : finite_measure α →+ measure α :=
{ to_fun := coe, map_zero' := coe_zero, map_add' := coe_add }

instance {α : Type*} [measurable_space α] : module ℝ≥0 (finite_measure α) :=
function.injective.module _ coe_add_monoid_hom finite_measure.coe_injective coe_smul

end finite_measure

/-- Probability measures are defined as the subtype of measures that have the property of being
probability measures (i.e., their total mass is one). -/
def probability_measure (α : Type*) [measurable_space α] : Type* :=
{μ : measure α // is_probability_measure μ}

namespace probability_measure

instance [inhabited α] : inhabited (probability_measure α) :=
⟨⟨measure.dirac (default α), measure.dirac.is_probability_measure⟩⟩

/-- A probability measure can be interpreted as a measure. -/
instance : has_coe (probability_measure α) (measure_theory.measure α) := coe_subtype

instance : has_coe_to_fun (probability_measure α) (λ _, set α → ℝ≥0) :=
⟨λ μ s, (μ s).to_nnreal⟩

instance (μ : probability_measure α) : is_probability_measure (μ : measure α) := μ.prop

lemma coe_fn_eq_to_nnreal_coe_fn_to_measure (ν : probability_measure α) :
  (ν : set α → ℝ≥0) = λ s, ((ν : measure α) s).to_nnreal := rfl

@[simp] lemma val_eq_to_measure (ν : probability_measure α) : ν.val = (ν : measure α) := rfl

lemma coe_injective : function.injective (coe : probability_measure α → measure α) :=
subtype.coe_injective

@[simp] lemma coe_fn_univ (ν : probability_measure α) : ν univ = 1 :=
congr_arg ennreal.to_nnreal ν.prop.measure_univ

/-- A probability measure can be interpreted as a finite measure. -/
def to_finite_measure (μ : probability_measure α) : finite_measure α := ⟨μ, infer_instance⟩

@[simp] lemma coe_comp_to_finite_measure_eq_coe (ν : probability_measure α) :
  (ν.to_finite_measure : measure α) = (ν : measure α) := rfl

@[simp] lemma coe_fn_comp_to_finite_measure_eq_coe_fn (ν : probability_measure α) :
  (ν.to_finite_measure : set α → ℝ≥0) = (ν : set α → ℝ≥0) := rfl

@[simp] lemma ennreal_coe_fn_eq_coe_fn_to_measure (ν : probability_measure α) (s : set α) :
  (ν s : ℝ≥0∞) = (ν : measure α) s :=
by { rw [← coe_fn_comp_to_finite_measure_eq_coe_fn,
     finite_measure.ennreal_coe_fn_eq_coe_fn_to_measure], refl, }

@[simp] lemma mass_to_finite_measure (μ : probability_measure α) :
  μ.to_finite_measure.mass = 1 := μ.coe_fn_univ

end probability_measure

end measure_theory