#exit

-- the to be Mason-Stother formalization
-- Authors Johannes & Jens

--Defining the gcd
import poly
import unique_factorization_domain
import data.finsupp
import algebraically_closed_field
import poly_over_UFD

noncomputable theory
local infix ^ := monoid.pow
local notation `d[`a`]` := polynomial.derivative a
local notation Σ := finset.sume
local notation Π := finset.prod
local notation `Π₀` := finsupp.prod
local notation `~`a:=polynomial a

open polynomial
open classical
local attribute [instance] prop_decidable

-- TODO: there is some problem with the module instances for module.to_add_comm_group ...
-- force ring.to_add_comm_group to be stronger
attribute [instance] ring.to_add_comm_group

universe u

attribute [instance] field.to_unique_factorization_domain --correct?

variable {β : Type u}
variables [field β]
--variables  [algebraically_closed_field β] -- Should be an instance of algebraically closed.
open finsupp

def c_fac (p : polynomial β) : β := some ( polynomial_fac_finsupp p)

--Looks ugly still
def factors (p : polynomial β) : polynomial β →₀ ℕ :=
classical.some (some_spec $ polynomial_fac_finsupp p)

lemma factors_irred (p : polynomial β) : ∀x ∈ (factors p).support, irreducible x :=
assume x h, ((some_spec $ some_spec $ polynomial_fac_finsupp p).2 x h).1

--(some_spec $ some_spec $ polynomial_fac_finsupp p).2
def factors_monic (p : polynomial β) : ∀x ∈ (factors p).support, monic x :=
λx h, ((some_spec $ some_spec $ polynomial_fac_finsupp p).2 x h).2

lemma h_factors (p : polynomial β) :  p = C (c_fac p) * ((finsupp.prod (factors p) (λ k n, k ^n) ) ) ∧ (∀x∈(factors p).support, irreducible x ∧ monic x)   :=
some_spec (some_spec ( polynomial_fac_finsupp p))

def facs_to_pow_min_one (p : polynomial β →₀ ℕ ) : finset (polynomial β):= p.support.image (λ a, a^(p a - 1))

open classical
section algebraically_closed

--It might be good to remove the attribute to domain of integral domain?
def rad (p : polynomial β) : polynomial β :=
finset.prod (finsupp.support (factors p)) id --The radiacal

lemma rad_ne_zero {p : polynomial β} : rad p ≠ 0 :=
begin
  rw [rad],
  apply prod_ne_zero_of_forall_mem_ne_zero,
  intros x h1,
  have h2 : irreducible x,
  {apply factors_irred p, exact h1},
  exact and.elim_left h2,
end

lemma degree_rad_eq_sum_support_degree {f : polynomial β} :
  degree (rad f) = (finset.sum (finsupp.support (factors f)) degree ) :=
begin
  rw rad,
  have h1 : finset.prod (support (factors f)) id ≠ 0,
  {
    apply prod_ne_zero_of_forall_mem_ne_zero,
    intros x h1,
    have : irreducible x,
    from factors_irred f x h1,
    exact and.elim_left this,
  },
  rw degree_prod_eq_sum_degree_of_prod_ne_zero h1
end

lemma prod_pow_min_on_ne_zero {f : polynomial β} :
  finsupp.prod (to_finsupp_pow_min_one (factors f)) (λ (x : ~β) (y : ℕ), x ^ y) ≠ 0 :=
begin
  rw [finsupp.prod],
  refine prod_ne_zero_of_forall_mem_ne_zero' _ _ _ _,
  {
    intros x h2,
    exact pow_ne_zero _ h2,
  },
  exact _root_.zero_ne_one,
  {
    intros x h2,
    have h3: x ∈ support (factors f),
    from finset.mem_of_subset support_pow_min_one_subset_support h2,
    have h4 : irreducible x,
    from factors_irred f x h3,
    exact and.elim_left h4
  }
end

lemma degree_eq_add_degree_rad_degree_pow_min_one {f : polynomial β} :
  degree (finsupp.prod (factors f) (λ x n, x^n)) =
    degree (finsupp.prod (to_finsupp_pow_min_one (factors f)) (λ (x : ~β) (y : ℕ), x ^ y)) +
    degree (rad f) :=
begin
--!!!!! we need to add 'in' when using conv.
  have h1 : (support (to_finsupp_pow_min_one (factors f))) ⊆ support (factors f),
  {
    from support_pow_min_one_subset_support,
  },
  have h2 : (support (to_finsupp_pow_min_one (factors f))) ∪ (support (factors f) \ (support (to_finsupp_pow_min_one (factors f)))) = support (factors f),
  from finset.union_sdiff_of_subset h1,
  have h3 : ∀x, x ∈ support (factors f) \ support (to_finsupp_pow_min_one (factors f)) ↔ (factors f) x = 1,
  from  mem_sdiff_support_support_pow_min_one_iff_eq_one,
  have h4 : finset.prod (support (to_finsupp_pow_min_one (factors f)))(λ (x : ~β), x ^ (to_finsupp_pow_min_one (factors f)) x * x) =
         finset.prod (support (to_finsupp_pow_min_one (factors f)))
         (λ (x : ~β), x ^ (factors f) x),
  {
    apply finset.prod_congr,
    exact rfl,
    intros x h4,
    rw [mul_comm _ x, ←pow_succ, to_finsupp_pow_min_one, finsupp.map_range_apply],
    have h5 : (factors f) x ≠ 0,
    {
      have h5 : x ∈ support (factors f),
      from finset.mem_of_subset h1 h4,
      rw [finsupp.mem_support_iff] at h5,
      exact h5,
    },
    have h6 : (factors f) x ≥ 1,
    {
      have h6 : 0 < (factors f) x,
      from nat.pos_of_ne_zero h5,
      have h7 : nat.succ 0 ≤ (factors f) x,
      from nat.succ_le_of_lt h6,
      exact h7
    },
    rw [nat.sub_add_cancel h6],
  },
  have h5 :  finset.prod (support (factors f) \ support (to_finsupp_pow_min_one (factors f))) (λ (x : ~β), x) = finset.prod (support (factors f) \ support (to_finsupp_pow_min_one (factors f))) (λ (x : ~β), x ^ (factors f) x) ,
  {
    apply finset.prod_congr,
    exact rfl,
    intro x,
    rw h3 x,
    intro h5,
    rw h5,
    simp only [pow_one x],
  },
  have h6 : Π₀ (to_finsupp_pow_min_one (factors f)) (λ (x : ~β) (y : ℕ), x ^ y) * rad f ≠ 0,
  {
    apply mul_ne_zero,
    exact prod_pow_min_on_ne_zero,
    exact rad_ne_zero
  },
  have h7 : support (to_finsupp_pow_min_one (factors f)) ∩
    (support (factors f) \ support (to_finsupp_pow_min_one (factors f))) = ∅,
  {simp},

  conv
  {
    to_rhs,
    rw [←degree_mul_eq_add_of_mul_ne_zero h6, rad, finsupp.prod, ←h2, finset.prod_union h7, ←mul_assoc, ←finset.prod_mul_distrib],
    simp,
    rw [h4, h5, ←finset.prod_union h7, finset.union_comm _ _, finset.sdiff_union_of_subset h1, ←finsupp.prod],
  }
end

--More general, where does it belong?
lemma ne_zero_of_dvd_ne_zero {γ : Type u}{a b : γ} [comm_semiring γ] (h1 : a ∣ b) (h2 : b ≠ 0) : a ≠ 0 :=
begin
  simp only [has_dvd.dvd] at h1,
  let c := some h1,
  have h3: b = a * c,
  from some_spec h1,
  by_contradiction h4,
  rw not_not at h4,
  rw h4 at h3,
  simp at h3,
  contradiction
end

lemma one_le_of_ne_zero {n : ℕ } (h : n ≠ 0) : 1 ≤ n :=
begin
  let m := some (nat.exists_eq_succ_of_ne_zero h),
  have h1 : n = nat.succ m,
  from some_spec (nat.exists_eq_succ_of_ne_zero h),
  rw [h1, nat.succ_le_succ_iff], --simp * failes here
  exact nat.zero_le _,

end

lemma degree_wron_le {a b : polynomial β} : degree (d[a] * b - a * d[b]) ≤ degree a + degree b - 1 :=
begin
  by_cases h1 : (a = 0),
  {
    simp *,
    exact nat.zero_le _,
  },
  {
    by_cases h2 : (degree a = 0),
    {

      by_cases h3 : (b = 0),
      {
        rw h3,
        simp,
        exact nat.zero_le _,
      },
      {
        simp [*],
        by_cases h4 : (degree b = 0),
        {
          simp *,
          rw [←is_constant_iff_degree_eq_zero] at *,
          have h5 : derivative a = 0,
          from derivative_eq_zero_of_is_constant h2,
          have h6 : derivative b = 0,
          from derivative_eq_zero_of_is_constant h4,
          simp *,
        },
        {
          have h2a : degree a = 0,
          from h2,
          rw [←is_constant_iff_degree_eq_zero] at h2,
          have h5 : derivative a = 0,
          from derivative_eq_zero_of_is_constant h2,
          simp *,
          by_cases h6 : (derivative b = 0),
          {
            simp *,
            exact nat.zero_le _,
          },
          {
            rw [degree_neg],
            apply nat.le_trans degree_mul,
            simp *,
            exact degree_derivative_le,
          }
        },

      }
    },
    {
      by_cases h3 : (b = 0),
      {
        simp *,
        exact nat.zero_le _,
      },
      {
        by_cases h4 : (degree b = 0),
        {
          simp *,
          rw [←is_constant_iff_degree_eq_zero] at h4,
          have h5 : derivative b = 0,
          from derivative_eq_zero_of_is_constant h4,
          simp *,
          apply nat.le_trans degree_mul,
          rw [is_constant_iff_degree_eq_zero] at h4,
          simp *,
          exact degree_derivative_le,
        },
        {
          apply nat.le_trans degree_sub,
          have h5 : degree (d[a] * b) ≤ degree a + degree b - 1,
          {
            apply nat.le_trans degree_mul,
            rw [add_comm _ (degree b), add_comm _ (degree b), nat.add_sub_assoc],
            apply add_le_add_left,
            exact degree_derivative_le,
            exact _root_.one_le_of_ne_zero h2,
          },
          have h6 : (degree (a * d[b])) ≤ degree a + degree b - 1,
          {
            apply nat.le_trans degree_mul,
            rw [nat.add_sub_assoc],
            apply add_le_add_left,
            exact degree_derivative_le,
            exact _root_.one_le_of_ne_zero h4,
          },
          exact max_le h5 h6,
        }
      }
    }
  }
end

lemma Mason_Stothers_lemma (f : polynomial β) :
  degree f ≤ degree (gcd f (derivative f )) + degree (rad f) := --I made degree radical from this one
begin
  by_cases hf : (f = 0),
  {
    rw [hf],
    simp,
    exact nat.zero_le _,
  },
  have h_tmp : ((finsupp.prod (factors f) (λ k n, k ^n) ) ) = (factors f).support.prod (λa, (λ k n, k ^n) a ((factors f) a)),
  simp [finsupp.prod],
  have h_der : derivative ((factors f).support.prod (λa, (λ k n, k ^n) a ((factors f) a)))
  = (factors f).support.sum (λb, derivative ((λa, (λ k n, k ^n) a ((factors f) a)) b) * (finset.erase (factors f).support b).prod (λa, (λ k n, k ^n) a ((factors f) a))),
  simp [derivative_prod],

  have h_der2 : ∀x ∈ (support (factors f)), (x^((factors f) x -1))∣(derivative ((factors f).support.prod (λa, (λ k n, k ^n) a ((factors f) a))) ),--
  {
    intros,
    rw h_der,
    refine dvd_sum _,
    intros y hy,
    by_cases (x = y),
    {
      have : x ^ ((factors f) x - 1) ∣
    d[(λ (a : ~β), (λ (k : ~β) (n : ℕ), k ^ n) a ((factors f) a)) y],
      rw derivative_pow,
      have : (factors f) y ≠  0,
      simp [iff.elim_left (mem_support_iff _) hy],
      simp only [if_neg this],
      refine dvd.intro (↑((factors f) y) * d[y]) _,
      rw [h],
      exact calc
      y ^ ((factors f) y - 1) * (↑((factors f) y) * d[y]) =
      y ^ ((factors f) y - 1) * ↑((factors f) y) * d[y] : by rw mul_assoc
      ... = ↑((factors f) y) * y ^ ((factors f) y - 1) * d[y] : by rw [(mul_comm (y ^ ((factors f) y - 1)) ( ↑((factors f) y)))],
      exact dvd_mul_of_dvd_left this _
    },
    {
      have : x ^ ((factors f) x - 1) ∣ (finset.prod (finset.erase (support (factors f)) y) (λ (a : ~β), a ^ (factors f) a)),
      have : x ∈ (finset.erase (support (factors f)) y),
      exact finset.mem_erase_of_ne_of_mem h H,
      apply dvd_prod_of_dvd_mem,
      exact this,
      exact dvd_pow_sub_one_pow,
      refine dvd_mul_of_dvd_right this _
    }
  },

  have h_fac : f = C (c_fac f) * ((finsupp.prod (factors f) (λ k n, k ^n) ) ),
    from (h_factors f).1,
  have h_dvd_der : ∀x ∈ (support (factors f)), (x^((factors f) x -1))∣ (derivative f),
  {
    intros y hy,
    rw (congr_arg derivative h_fac),
    rw h_tmp,
    rw derivative_C_mul,
    apply dvd_mul_of_dvd_right (h_der2 y hy)
  },
  have h_dvd_f : ∀x ∈ (support (factors f)), (x^((factors f) x -1))∣ f,
  {
    intros y hy,
    conv in (f) {rw h_fac}, --Nice using the conv could be very handy.
    rw h_tmp,
    refine dvd_mul_of_dvd_right _ (C (c_fac f)),
    apply dvd_prod_of_dvd_mem,
    apply hy,
    apply dvd_pow_sub_one_pow
  },
  have h_dvd_gcd_f_der : ∀x ∈ (support (factors f)), (x^((factors f) x -1))∣ (gcd f (derivative f)),
  {
    intros y hy,
    apply gcd_min,
    apply h_dvd_f y,
    apply hy,
    apply h_dvd_der y,
    apply hy
  }, --For the next lemma some notions of UFD need to be made.
  have h_prod_dvd_gcd_f_der :(to_finsupp_pow_min_one (factors f)).prod (λ x y, x ^ y) ∣ gcd f d[f],
  {
    apply facs_to_pow_prod_dvd,
    rw [to_finsupp_pow_min_one],
    dunfold to_finsupp_pow_min_one._proof_1,
    intros x h1,
    have h2 : x ∈ support (factors f),
    {
      have :(support (map_range (λ (n : ℕ), n - has_one.one ℕ) _ (factors f))) ⊆ ( support (factors f)),
      from support_pow_min_one_subset_support,
      exact finset.mem_of_subset this h1
    },
    have h3 : irreducible x,
    from factors_irred f x h2,
    have h4 : x ^ ((map_range (λ (n : ℕ), n - has_one.one ℕ) _ (factors f)) x) ∣ gcd f d[f],
    {
        rw map_range_apply,
        exact h_dvd_gcd_f_der x h2
    },
    have h5 : ∀ (y : ~β),
        y ∈ support (map_range (λ (n : ℕ), n - has_one.one ℕ) _ (factors f)) → x ≠ y → ¬associated x y,
        {
          intros y h5,
          have h6 : y ∈ support (factors f),
          {--duplicate code here
            have :(support (map_range (λ (n : ℕ), n - has_one.one ℕ) _ (factors f))) ⊆ ( support (factors f)),
            from support_pow_min_one_subset_support,
            exact finset.mem_of_subset this h5
          },
          have h7 : monic x,
          from  factors_monic f x h2,
          have h8 : monic y,
          from factors_monic f y h6,
          intro h9,
          rw associated_iff_eq h7 h8,
          exact h9,
        },
        exact ⟨h3 ,h4 ,h5 ⟩,
  },
  {
    have h_gcd : gcd f d[f] ≠ 0,
    {
      rw [ne.def, gcd_eq_zero_iff_eq_zero_and_eq_zero],
      simp [hf]
    },
    have h1 : degree (finsupp.prod (to_finsupp_pow_min_one (factors f)) (λ (x : ~β) (y : ℕ), x ^ y)) ≤ degree (gcd f d[f]),
      from degree_dvd h_prod_dvd_gcd_f_der h_gcd,
    have h2 : degree f = degree (finsupp.prod (to_finsupp_pow_min_one (factors f)) (λ (x : ~β) (y : ℕ), x ^ y)) + (degree (rad f)),
    {
      have h2: (C (c_fac f) * finsupp.prod (factors f) (λ (k : ~β) (n : ℕ), k ^ n) ≠ 0), --Had a lemma for this?
      {
        rw [←h_fac],
        exact hf
      },
      conv
      {
        to_lhs,
        rw [h_fac, degree_mul_eq_add_of_mul_ne_zero h2],
        simp,
        rw [degree_eq_add_degree_rad_degree_pow_min_one],
      }
    },
    rw h2,
    apply add_le_add_right,
    exact h1
  },
end

--We don't use factors below this point.

--needs cleaning

lemma Mason_Stothers_lemma'
(f : polynomial β) : degree f - degree (gcd f (derivative f )) ≤  degree (rad f) :=
begin
  have h1 : degree f - degree (gcd f (derivative f )) ≤ degree (gcd f (derivative f )) + degree (rad f) - degree (gcd f (derivative f )),
  {
    apply nat.sub_le_sub_right,
    apply Mason_Stothers_lemma,
  },
  have h2 : degree (gcd f d[f]) + degree (rad f) - degree (gcd f d[f]) =  degree (rad f),
  {
    rw [add_comm _ (degree (rad f)), nat.add_sub_assoc, nat.sub_self, nat.add_zero],
    exact nat.le_refl _,
  },
  rw h2 at h1,
  exact h1,
end

lemma eq_zero_of_le_pred {n : ℕ} (h : n ≤ nat.pred n) : n = 0 :=
begin
  cases n,
    simp,
    simp at h,
    have h1 : nat.succ n = n,
    from le_antisymm h (nat.le_succ n),
    have h2 : nat.succ n ≠ n,
    from nat.succ_ne_self n,
    contradiction,
end

lemma derivative_eq_zero_of_dvd_derivative_self {a : polynomial β} (h : a ∣ d[a]) : d[a] = 0 :=
begin
  by_contradiction hc,
  have h1 : degree d[a] ≤ degree a - 1,
  from degree_derivative_le,
  have h2 : degree a ≤ degree d[a],
  from degree_dvd h hc,
  have h3 : degree a = 0,
  {
    have h3 : degree a ≤ degree a - 1,
    from le_trans h2 h1,
    exact eq_zero_of_le_pred h3,
  },
  rw ←is_constant_iff_degree_eq_zero at h3,
  have h5 : d[a] = 0,
  from derivative_eq_zero_of_is_constant h3,
  contradiction,
end

--In MS detailed I call this zero wronskian
lemma derivative_eq_zero_and_derivative_eq_zero_of_coprime_of_wron_eq_zero
{a b : polynomial β}
(h1 : coprime a b)
(h2 : d[a] * b - a * d[b] = 0)
: d[a] = 0 ∧  d[b] = 0 :=
begin
  have h3 : d[a] * b = a * d[b],
  {
    exact calc d[a] * b = d[a] * b + (-a * d[b] + a * d[b]) : by simp
    ... = d[a] * b - (a * d[b]) + a * d[b] : by simp [add_assoc]
    ... = 0 + a * d[b] : by rw [h2]
    ... = _ : by simp
  },
  have h4 : a ∣ d[a] * b,
  from dvd.intro _ h3.symm,
  rw mul_comm at h4,
  have h5 : a ∣ d[a],
  exact dvd_of_dvd_mul_of_coprime h4 h1,
  have h6 : d[a] = 0,
  from derivative_eq_zero_of_dvd_derivative_self h5,

  --duplication
  rw mul_comm at h3,
  have h7 : b ∣ a * d[b],
  from dvd.intro _ h3,
  have h8 : b ∣ d[b],
  exact dvd_of_dvd_mul_of_coprime h7 (coprime_comm h1),
  have h9 : d[b] = 0,
  from derivative_eq_zero_of_dvd_derivative_self h8,
  exact ⟨h6, h9⟩,
end

lemma coprime_gcd_derivative_gcd_derivative_of_coprime {a b : polynomial β} (h : coprime a b) : coprime (gcd a d[a]) (gcd b d[b]) :=
sorry

lemma degree_gcd_derivative_le_degree {a : polynomial β}: degree (gcd a d[a]) ≤ degree a :=
begin
  by_cases h : (a = 0),
  {
    simp * at *,
  },
  {
    apply degree_gcd_le_left,
    exact h,
  }
end

lemma degree_gcd_derivative_lt_degree_of_degree_ne_zero {a : polynomial β} (h : degree a ≠ 0) (h_char : characteristic_zero β) : degree (gcd a d[a]) < degree a :=
begin
  have h1 : degree (gcd a d[a]) ≤ degree d[a],
  {
    apply degree_dvd,
    apply gcd_right,
    rw [ne.def, derivative_eq_zero_iff_is_constant, is_constant_iff_degree_eq_zero],
    exact h,
    exact h_char,
  },
  have h2 : ∃ n, degree a = nat.succ n,
  from nat.exists_eq_succ_of_ne_zero h,
  let n := some h2,
  have h3 : degree a = nat.succ n,
  from some_spec h2,
  exact calc degree (gcd a d[a]) ≤ degree d[a] : h1
  ... ≤ degree a - 1 : degree_derivative_le
  ... ≤ nat.succ n - 1 : by rw h3
  ... = n : rfl
  ... < nat.succ n : nat.lt_succ_self _
  ... = degree a : eq.symm h3,

end

--We will need extra conditions here
lemma degree_rad_add {a b c : polynomial β}: degree (rad a) + degree (rad b) + degree (rad c) ≤ degree (rad (a * b * c)) :=
begin
  admit,
end

lemma gt_zero_of_ne_zero {n : ℕ} (h : n ≠ 0) : n > 0 :=
begin
  have h1 : ∃ m : ℕ, n = nat.succ m,
  from nat.exists_eq_succ_of_ne_zero h,
  let m := some h1,
  have h2 : n = nat.succ m,
  from some_spec h1,
  rw h2,
  exact nat.zero_lt_succ _,
end

lemma MS_aux_1a {c : polynomial β} (h3 : ¬degree c = 0)(h_char : characteristic_zero β) : 1 ≤ (degree c - degree (gcd c d[c])) :=
begin
  have h4 : degree c - degree (gcd c d[c]) > 0,
  {
    rw [nat.pos_iff_ne_zero, ne.def, nat.sub_eq_zero_iff_le],
    simp,
    exact degree_gcd_derivative_lt_degree_of_degree_ne_zero h3 h_char,
  },
  exact h4,

end

--should be in poly
lemma MS_aux_1b {a b c : polynomial β} (h_char : characteristic_zero β) (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) (h1 : is_constant b)
(h2 : ¬is_constant a) : ¬ is_constant c :=
begin
  rw [is_constant_iff_degree_eq_zero] at *,
  have h3 : c (degree a) ≠ 0,
  {
    rw ← h_add,
    simp,
    have h3 : b (degree a) = 0,
    {
      apply eq_zero_of_gt_degree,
      rw h1,
      exact gt_zero_of_ne_zero h2,
    },
    rw h3,
    simp,
    have h4 : leading_coeff a = 0 ↔ a = 0,
    from leading_coef_eq_zero_iff_eq_zero,
    rw leading_coeff at h4,
    rw h4,
    by_contradiction h5,
    rw h5 at h2,
    simp at h2,
    exact h2,
  },
  have h4 : degree a ≤ degree c,
  from le_degree h3,
  by_contradiction h5,
  rw h5 at h4,
  have : degree a = 0,
  from nat.eq_zero_of_le_zero h4,
  contradiction,
end

lemma MS_aux_1 {a b c : polynomial β} (h_char : characteristic_zero β) (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
  1 ≤ degree b - degree (gcd b d[b]) + (degree c - degree (gcd c d[c])) :=
begin
  by_cases h1 : (is_constant b),
  {
    by_cases h2 : (is_constant a),
    {
      have h3 : is_constant c,
      from is_constant_add h2 h1 h_add,
      simp * at *,
    },
    {
      have h3 : ¬ is_constant c,
      {
        exact MS_aux_1b h_char h_add h_constant h1 h2,
      },
      rw [is_constant_iff_degree_eq_zero] at h3,
      have h4 : 1 ≤ (degree c - degree (gcd c d[c])),
      from MS_aux_1a h3 h_char,
      apply nat.le_trans h4,
      simp,
      exact nat.zero_le _,
    }
  },
  {
    rw [is_constant_iff_degree_eq_zero] at h1,
    have h2 : 1 ≤ degree b - degree (gcd b d[b]),
    from MS_aux_1a h1 h_char,
    apply nat.le_trans h2,
    simp,
    exact nat.zero_le _,
  }

end

--Strong duplication with MS_aux_1
lemma MS_aux_2 {a b c : polynomial β} (h_char : characteristic_zero β) (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
   1 ≤ degree (rad a) + (degree c - degree (gcd c d[c])) :=
begin
  by_cases h1 : is_constant b,
  {
    by_cases h2 : is_constant a,
    {
      have h3 : is_constant c,
      from is_constant_add h2 h1 h_add,
      simp * at *,
    },
    {
      have h3 : ¬ is_constant c,
      {
        rw [is_constant_iff_degree_eq_zero] at *,
        have h3 : c (degree a) ≠ 0,
        {
          rw ← h_add,
          simp,
          have h3 : b (degree a) = 0,
          {
            apply eq_zero_of_gt_degree,
            rw h1,
            exact gt_zero_of_ne_zero h2,
          },
          rw h3,
          simp,
          have h4 : leading_coeff a = 0 ↔ a = 0,
          from leading_coef_eq_zero_iff_eq_zero,
          rw leading_coeff at h4,
          rw h4,
          by_contradiction h5,
          rw h5 at h2,
          simp at h2,
          exact h2,
        },
        have h4 : degree a ≤ degree c,
        from le_degree h3,
        by_contradiction h5,
        rw h5 at h4,
        have : degree a = 0,
        from nat.eq_zero_of_le_zero h4,
        contradiction,
      },
      rw [is_constant_iff_degree_eq_zero] at h3,
      have h4 : 1 ≤ (degree c - degree (gcd c d[c])),
      from MS_aux_1a h3 h_char,
      apply nat.le_trans h4,
      simp,
      exact nat.zero_le _,
    }
  },
  {
    by_cases h2 : (is_constant a),
    {
      rw add_comm at h_add,
      have h_constant' : ¬(is_constant b ∧ is_constant a ∧ is_constant c),
      {simp [*, and_comm]},
      have h3 : ¬is_constant c,
      from MS_aux_1b h_char h_add h_constant' h2 h1,
      rw [is_constant_iff_degree_eq_zero] at h3,
      have h4 : 1 ≤ (degree c - degree (gcd c d[c])),
      from MS_aux_1a h3 h_char,
      apply nat.le_trans h4,
      simp,
      exact nat.zero_le _,
    },
    {
      admit --admit here

    }
  }
end

--h_deg_c_le_1
lemma rw_aux_1 [field β]
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c))
  (h_deg_add_le : degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]) ≤ degree a + degree b - 1) :
  degree c ≤
    (degree a - degree (gcd a d[a])) +
    (degree b - degree (gcd b d[b])) +
    (degree c - degree (gcd c d[c])) - 1 :=
have 1 ≤ degree a + degree b, from sorry,
have h : ∀p:polynomial β, degree (gcd p d[p]) ≤ degree p, from sorry,
have (degree (gcd a d[a]) : ℤ) + (degree (gcd b d[b]) : ℤ) + (degree (gcd c d[c]) : ℤ) ≤
    (degree a : ℤ) + (degree b : ℤ) - 1,
  by rwa [← int.coe_nat_add, ← int.coe_nat_add, ← int.coe_nat_add, ← int.coe_nat_one,
    ← int.coe_nat_sub this, int.coe_nat_le],
have (degree c : ℤ) ≤
    ((degree a : ℤ) - (degree (gcd a d[a]) : ℤ)) +
    ((degree b : ℤ) - (degree (gcd b d[b]) : ℤ)) +
    ((degree c : ℤ) - (degree (gcd c d[c]) : ℤ)) - 1,
  from calc (degree c : ℤ) ≤
    ((degree c : ℤ) + ((degree a : ℤ) + (degree b : ℤ) - 1)) -
      ((degree (gcd a d[a]) : ℤ) + (degree (gcd b d[b]) : ℤ) + (degree (gcd c d[c]) : ℤ)) :
      le_sub_iff_add_le.mpr $ add_le_add_left this _
    ... = _ : by simp,
have 1 + (degree c : ℤ) ≤
    ((degree a : ℤ) - (degree (gcd a d[a]) : ℤ)) +
    ((degree b : ℤ) - (degree (gcd b d[b]) : ℤ)) +
    ((degree c : ℤ) - (degree (gcd c d[c]) : ℤ)),
  from add_le_of_le_sub_left this,
nat.le_sub_left_of_add_le $
  by rwa [← int.coe_nat_sub (h _), ← int.coe_nat_sub (h _), ← int.coe_nat_sub (h _),
      ← int.coe_nat_add, ← int.coe_nat_add, ← int.coe_nat_one, ← int.coe_nat_add, int.coe_nat_le] at this

/-
lemma Mason_Stothers_lemma
(f : polynomial β) : degree f ≤ degree (gcd f (derivative f )) + degree (rad f) -/
/-
lemma Mason_Stothers_lemma'
(f : polynomial β) : degree f - degree (gcd f (derivative f )) ≤  degree (rad f) :=
 -/
 /-
--We will need extra conditions here
lemma degree_rad_add {a b c : polynomial β}: degree (rad a) + degree (rad b) + degree (rad c) ≤ degree (rad (a * b * c)) :=
begin
  admit,
end-/

lemma nat.add_mono{a b c d : ℕ} (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
begin
  exact calc a + c ≤ a + d : nat.add_le_add_left hcd _
  ... ≤ b + d : nat.add_le_add_right hab _
end

--h_le_rad
lemma rw_aux_2 [field β] --We want to use the Mason Stothers lemmas here
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c))
  (h_rad: rad(a)*rad(b)*rad(c)= rad(a*b*c))
   : degree a - degree (gcd a d[a]) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1 ≤
  degree (rad (a * b * c)) - 1:=
begin
  apply nat.sub_le_sub_right,
  have h_rad:  degree(rad(a))+degree(rad(b))+degree(rad(c)) ≤ degree(rad(a*b*c)),
    from sorry,
  refine nat.le_trans _ h_rad,
  apply nat.add_mono _ (Mason_Stothers_lemma' c),
  apply nat.add_mono (Mason_Stothers_lemma' a) (Mason_Stothers_lemma' b),
end

theorem Mason_Stothers [field β]
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
  degree c ≤ degree ( rad (a*b*c)) - 1 :=

begin
  have h_der_not_all_zero : ¬(d[a] = 0 ∧ d[b] = 0 ∧ d[c] = 0),
  {
    rw [derivative_eq_zero_iff_is_constant, derivative_eq_zero_iff_is_constant, derivative_eq_zero_iff_is_constant],
    exact h_constant,
    exact h_char, -- Should be written down shorter
    exact h_char,
    exact h_char,
  },
  have h_der : d[a] + d[b] = d[c],
  {
    rw [←h_add, derivative_add],
  },
  have h_wron : d[a] * b - a * d[b] = d[a] * c - a * d[c],
  {
    have h1 : d[a] * a + d[a] * b = d[a] * c,
      exact calc d[a] * a + d[a] * b = d[a] * (a + b) : by rw [mul_add]
      ... = _ : by rw h_add,
    have h2 : a * d[a] + a * d[b] = a * d[c],
      exact calc a * d[a] + a * d[b] = a * (d[a] + d[b]) : by rw [mul_add]
      ... = _ : by rw h_der,
    have h3 : d[a] * b - a * d[b] = d[a] * c - a * d[c],
      exact calc d[a] * b - a * d[b] = d[a] * b + (d[a] * a - d[a] * a) - a * d[b] : by simp
      ... = d[a] * b + d[a] * a - d[a] * a - a * d[b] : by simp
      ... = d[a] * c - (d[a] * a +  a * d[b]) : by simp [h1]
      ... = d[a] * c - (a * d[a] +  a * d[b]) : by rw [mul_comm _ a]
      ... = _ : by rw h2,
    exact h3
  },
  have h_dvd_wron_a : gcd a d[a] ∣ d[a] * b - a * d[b],
  {
    have h1 : gcd a d[a] ∣ d[a] * b,
    {
      apply dvd_trans gcd_right,
      apply dvd_mul_of_dvd_left,
      simp
    },
    have h2 : gcd a d[a] ∣ a * d[b],
    {
      apply dvd_trans gcd_left,
      apply dvd_mul_of_dvd_left,
      simp
    },
    exact dvd_sub h1 h2,
  },
  have h_dvd_wron_b : gcd b d[b] ∣ d[a] * b - a * d[b],
  {
    have h1 : gcd b d[b] ∣ d[a] * b,
    {
      apply dvd_trans gcd_left,
      apply dvd_mul_of_dvd_right,
      simp
    },
    have h2 : gcd b d[b] ∣ a * d[b],
    {
      apply dvd_trans gcd_right,
      apply dvd_mul_of_dvd_right,
      simp
    },
    exact dvd_sub h1 h2,
  },

  have h_dvd_wron_c : gcd c d[c] ∣ d[a] * b - a * d[b],
  {
    rw h_wron,
    have h1 : gcd c d[c] ∣ a * d[c],
    {
      apply dvd_trans gcd_right,
      apply dvd_mul_of_dvd_right,
      simp
    },
    have h2 : gcd c d[c] ∣ d[a] * c,
    {
      apply dvd_trans gcd_left,
      apply dvd_mul_of_dvd_right,
      simp
    },
    exact dvd_sub h2 h1,
  },
  have h_gcds_dvd : (gcd a d[a]) * (gcd b d[b]) * (gcd c d[c]) ∣ d[a] * b - a * d[b],
  {
    apply mul_dvd_of_dvd_of_dvd_of_coprime,
    apply coprime_mul_of_coprime_of_coprime_of_coprime,
    exact coprime_gcd_derivative_gcd_derivative_of_coprime (coprime_comm h_coprime_ca),
    exact coprime_gcd_derivative_gcd_derivative_of_coprime h_coprime_bc,
    exact coprime_gcd_derivative_gcd_derivative_of_coprime h_coprime_ca,
    apply mul_dvd_of_dvd_of_dvd_of_coprime,
    exact coprime_gcd_derivative_gcd_derivative_of_coprime h_coprime_ab,
    exact h_dvd_wron_a,
    exact h_dvd_wron_b,
    exact h_dvd_wron_c
  },
  have h_wron_ne_zero : d[a] * b - a * d[b] ≠ 0,
  {
    by_contradiction h1,
    rw not_not at h1,
    have h_a_b : d[a] = 0 ∧ d[b] = 0,
    from derivative_eq_zero_and_derivative_eq_zero_of_coprime_of_wron_eq_zero h_coprime_ab h1,
    have h2 : d[a] * c - a * d[c] = 0,
    {rw [←h_wron, h1]},
    have h_a_c : d[a] = 0 ∧ d[c] = 0,
    from derivative_eq_zero_and_derivative_eq_zero_of_coprime_of_wron_eq_zero (coprime_comm h_coprime_ca) h2,
    have h3 : (d[a] = 0 ∧ d[b] = 0 ∧ d[c] = 0),
    exact ⟨and.elim_left h_a_b, and.elim_right h_a_b, and.elim_right h_a_c⟩,
    contradiction
  },
  have h_deg_add : degree (gcd a d[a] * gcd b d[b] * gcd c d[c]) = degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]),
  {
    have h1 : gcd a d[a] * gcd b d[b] * gcd c d[c] ≠ 0,
    from ne_zero_of_dvd_ne_zero h_gcds_dvd h_wron_ne_zero,
    have h2 : degree (gcd a d[a] * gcd b d[b] * gcd c d[c]) = degree (gcd a d[a] * gcd b d[b]) + degree (gcd c d[c]),
    from degree_mul_eq_add_of_mul_ne_zero h1,
    have h3 : gcd a d[a] * gcd b d[b] ≠ 0,
    from ne_zero_of_mul_ne_zero_right h1,
    have h4 : degree (gcd a d[a] * gcd b d[b]) = degree (gcd a d[a]) + degree (gcd b d[b]),
    from degree_mul_eq_add_of_mul_ne_zero h3,
    rw [h2, h4]
  },
  have h_deg_add_le : degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]) ≤ degree a + degree b - 1,
  {
    rw [←h_deg_add],
    have h1 : degree (gcd a d[a] * gcd b d[b] * gcd c d[c]) ≤ degree (d[a] * b - a * d[b]),
    from degree_dvd h_gcds_dvd h_wron_ne_zero,
    exact nat.le_trans h1 (degree_wron_le),
  },--needs cleaning
  have h_deg_c_le_1 : degree c ≤ (degree a - degree (gcd a d[a])) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1,
  {
    have h1 : degree c + (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c])) ≤ degree c + (degree a + degree b - 1),
    from nat.add_le_add_left h_deg_add_le _,
    have h2 : degree c + (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c])) - (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]))
    ≤ degree c + (degree a + degree b - 1) - (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c])),
    from nat.sub_le_sub_right h1 _,
    have h3 : degree c + (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c])) - (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c])) = degree c,
    {--twice h3?

      have h3 : degree c + (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c])) =
      degree c + (degree (gcd c d[c])) + (degree (gcd b d[b]) + degree (gcd a d[a]) ),
      {
        simp [add_assoc, add_comm],
      },
      rw [h3],
      --rw [add_comm (degree (gcd b d[b])) (degree (gcd c d[c]))],
      --rw [←add_assoc, add_comm (degree (gcd a d[a])) _],
      rw [←nat.sub_sub, ←nat.sub_sub], --should use tactic comb here
      have h4 : degree c + degree (gcd c d[c]) + (degree (gcd b d[b]) + degree (gcd a d[a])) =
      degree c + degree (gcd c d[c]) + degree (gcd b d[b]) + degree (gcd a d[a]),
      {
        simp [add_comm],
      },
      rw h4,
      rw [nat.add_sub_assoc, nat.sub_self _, nat.add_zero ], --tactic comb
      rw [nat.add_sub_assoc, nat.sub_self _, nat.add_zero],
      rw [nat.add_sub_assoc, nat.sub_self _, nat.add_zero],
      exact nat.le_refl _,
      exact nat.le_refl _,
      exact nat.le_refl _,
    },
    rw h3 at h2,
    have h4 : degree c + (degree a + degree b - 1) - (degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]))
    = degree a - degree (gcd a d[a]) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1,
    {
      have h4 : degree c + (degree a + degree b - 1) = degree c + degree b + degree a - 1,
      {
       rw [add_comm (degree a) _, ← nat.add_sub_assoc, add_assoc],
       apply _root_.one_le_of_ne_zero,
       have h4 : degree b + degree a ≠ 0, --cleaning
       {
         rw [is_constant_iff_degree_eq_zero, is_constant_iff_degree_eq_zero, is_constant_iff_degree_eq_zero] at h_constant,
         rw [not_and_distrib, not_and_distrib] at h_constant,
         cases h_constant,
         {
           by_contradiction h4,
           simp at h4,
           rw [add_eq_zero_iff_eq_zero_of_nonneg] at h4,
           exact h_constant (and.elim_left h4),
           exact nat.zero_le _,
           exact nat.zero_le _,
         },
         {
           cases h_constant,
           {
            by_contradiction h4,
            simp at h4,
            rw [add_eq_zero_iff_eq_zero_of_nonneg] at h4,
            exact h_constant (and.elim_right h4),
            exact nat.zero_le _,
            exact nat.zero_le _,
           },
           {
             by_contradiction h4,
             simp at h4,
             have h5 : degree c ≤ max (degree a) (degree b),
             {
               rw ←h_add,
               exact degree_add,
             },
             rw [add_eq_zero_iff_eq_zero_of_nonneg] at h4,
             rw [and.elim_left h4, and.elim_right h4] at h5,
             simp at h5,
             have h6 : degree c = 0,
             from nat.eq_zero_of_le_zero h5,
             contradiction,
             exact nat.zero_le _,
             exact nat.zero_le _,
           }
         }
       },
       exact h4,
      },
      rw [h4, nat.sub_sub _ 1 _, add_comm 1 _, ←nat.sub_sub _ _ 1],
      rw [←nat.sub_sub, ←nat.sub_sub],
      rw [nat.add_sub_assoc],
      rw [add_assoc, add_comm (degree b) _, ← add_assoc, add_comm (degree c) _, nat.add_sub_assoc],
      rw [add_assoc, add_comm (degree c) _, ←add_assoc, nat.add_sub_assoc],
      exact degree_gcd_derivative_le_degree,
      exact degree_gcd_derivative_le_degree,
      exact degree_gcd_derivative_le_degree,

    },
    rw h4 at h2,
    exact h2,
  },
  have h_le_rad : degree a - degree (gcd a d[a]) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1 ≤
  degree (rad (a * b * c)) - 1,
  {
    have h1 : degree a - degree (gcd a d[a]) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1 ≤
    degree (rad a ) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1,
    {
      have h1a : degree a - degree (gcd a d[a]) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1 =
      degree a - degree (gcd a d[a]) + ((degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1),
      {
        rw [add_assoc, nat.add_sub_assoc],
        exact MS_aux_1 h_char h_add h_constant,
      },
      have h1b : degree (rad a) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1 =
      degree (rad a) + ((degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1),
      {
        rw [add_assoc, nat.add_sub_assoc],
        exact MS_aux_1 h_char h_add h_constant,
      },
      rw [h1a, h1b],
      apply @nat.add_le_add_right (degree a - degree (gcd a d[a])) (degree (rad a)),
      exact Mason_Stothers_lemma' _,
    },
    apply nat.le_trans h1,
    rw add_comm (degree (rad a)) _,
    have h2 : degree b - degree (gcd b d[b]) + degree (rad a) + (degree c - degree (gcd c d[c])) - 1 ≤
    degree (rad b) + degree (rad a) + (degree c - degree (gcd c d[c])) - 1,
    {
      have h2a : degree b - degree (gcd b d[b]) + degree (rad a) + (degree c - degree (gcd c d[c])) - 1 = degree b - degree (gcd b d[b]) + (degree (rad a) + (degree c - degree (gcd c d[c])) - 1),
      {
        rw [add_assoc, nat.add_sub_assoc],
        exact MS_aux_2 h_char h_add h_constant,
      },
      have h2b : degree (rad b) + degree (rad a) + (degree c - degree (gcd c d[c])) - 1 =
      degree (rad b) + (degree (rad a) + (degree c - degree (gcd c d[c])) - 1),
      {
        rw [add_assoc, nat.add_sub_assoc],
        exact MS_aux_2 h_char h_add h_constant,
      },
      rw [h2a, h2b],
      apply nat.add_le_add_right,
      exact Mason_Stothers_lemma' _,
    },
    apply nat.le_trans h2,
    rw [add_assoc, add_comm (degree (rad a)) _, ← add_assoc, add_comm (degree (rad b)) _],
    have h3 : degree c - degree (gcd c d[c]) + degree (rad b) + degree (rad a) - 1 ≤
    degree (rad c) + degree (rad b) + degree (rad a) - 1,
    {
      have h3a : degree c - degree (gcd c d[c]) + degree (rad b) + degree (rad a) - 1 = degree c - degree (gcd c d[c]) + (degree (rad b) + degree (rad a) - 1),
      {
        rw [add_assoc, nat.add_sub_assoc],
        admit, -- admit here
      },
      have h3b : degree (rad c) + degree (rad b) + degree (rad a) - 1  =
      degree (rad c) + (degree (rad b) + degree (rad a) - 1),
      {
        rw [add_assoc, nat.add_sub_assoc],
        admit, -- admit here
      },
      rw [h3a, h3b],
      apply nat.add_le_add_right,
      exact Mason_Stothers_lemma' _,
    },
    apply nat.le_trans h3,
    rw [add_comm (degree (rad c)) _, add_assoc, add_comm (degree (rad c)) _, ← add_assoc, add_comm (degree (rad b)) _],
    apply nat.sub_le_sub_right,
    exact degree_rad_add,
  },
  exact nat.le_trans h_deg_c_le_1 h_le_rad,
end

end algebraically_closed


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca, Johan Commelin, Scott Morrison

! This file was ported from Lean 3 source module analysis.normed.group.SemiNormedGroup.kernels
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Group.SemiNormedGroup
import Mathbin.Analysis.Normed.Group.Quotient
import Mathbin.CategoryTheory.Limits.Shapes.Kernels

/-!
# Kernels and cokernels in SemiNormedGroup₁ and SemiNormedGroup

We show that `SemiNormedGroup₁` has cokernels
(for which of course the `cokernel.π f` maps are norm non-increasing),
as well as the easier result that `SemiNormedGroup` has cokernels. We also show that
`SemiNormedGroup` has kernels.

So far, I don't see a way to state nicely what we really want:
`SemiNormedGroup` has cokernels, and `cokernel.π f` is norm non-increasing.
The problem is that the limits API doesn't promise you any particular model of the cokernel,
and in `SemiNormedGroup` one can always take a cokernel and rescale its norm
(and hence making `cokernel.π f` arbitrarily large in norm), obtaining another categorical cokernel.

-/

open CategoryTheory CategoryTheory.Limits

universe u

namespace SemiNormedGroup₁

noncomputable section

/-- Auxiliary definition for `has_cokernels SemiNormedGroup₁`. -/
def cokernelCocone {X Y : SemiNormedGroup₁.{u}} (f : X ⟶ Y) : Cofork f 0 :=
  Cofork.ofπ
    (@SemiNormedGroup₁.mkHom _ (SemiNormedGroup.of (Y ⧸ NormedAddGroupHom.range f.1))
      f.1.range.normedMk (NormedAddGroupHom.isQuotientQuotient _).norm_le)
    (by
      ext
      simp only [comp_apply, limits.zero_comp, NormedAddGroupHom.zero_apply,
        SemiNormedGroup₁.mkHom_apply, SemiNormedGroup₁.zero_apply, ← NormedAddGroupHom.mem_ker,
        f.1.range.ker_normedMk, f.1.mem_range]
      use x
      rfl)
#align SemiNormedGroup₁.cokernel_cocone SemiNormedGroup₁.cokernelCocone

/-- Auxiliary definition for `has_cokernels SemiNormedGroup₁`. -/
def cokernelLift {X Y : SemiNormedGroup₁.{u}} (f : X ⟶ Y) (s : CokernelCofork f) :
    (cokernelCocone f).pt ⟶ s.pt := by
  fconstructor
  -- The lift itself:
  · apply NormedAddGroupHom.lift _ s.π.1
    rintro _ ⟨b, rfl⟩
    change (f ≫ s.π) b = 0
    simp
  -- The lift has norm at most one:
  exact NormedAddGroupHom.lift_normNoninc _ _ _ s.π.2
#align SemiNormedGroup₁.cokernel_lift SemiNormedGroup₁.cokernelLift

instance : HasCokernels SemiNormedGroup₁.{u}
    where HasColimit X Y f :=
    HasColimit.mk
      { Cocone := cokernelCocone f
        IsColimit :=
          isColimitAux _ (cokernelLift f)
            (fun s => by
              ext
              apply NormedAddGroupHom.lift_mk f.1.range
              rintro _ ⟨b, rfl⟩
              change (f ≫ s.π) b = 0
              simp)
            fun s m w =>
            Subtype.eq
              (NormedAddGroupHom.lift_unique f.1.range _ _ _ (congr_arg Subtype.val w : _)) }

-- Sanity check
example : HasCokernels SemiNormedGroup₁ := by infer_instance

end SemiNormedGroup₁

namespace SemiNormedGroup

section EqualizersAndKernels

/-- The equalizer cone for a parallel pair of morphisms of seminormed groups. -/
def fork {V W : SemiNormedGroup.{u}} (f g : V ⟶ W) : Fork f g :=
  @Fork.ofι _ _ _ _ _ _ (of (f - g).ker) (NormedAddGroupHom.incl (f - g).ker) <|
    by
    ext v
    have : v.1 ∈ (f - g).ker := v.2
    simpa only [NormedAddGroupHom.incl_apply, Pi.zero_apply, coe_comp, NormedAddGroupHom.coe_zero,
      Subtype.val_eq_coe, NormedAddGroupHom.mem_ker, NormedAddGroupHom.coe_sub, Pi.sub_apply,
      sub_eq_zero] using this
#align SemiNormedGroup.fork SemiNormedGroup.fork

instance hasLimit_parallelPair {V W : SemiNormedGroup.{u}} (f g : V ⟶ W) :
    HasLimit (parallelPair f g)
    where exists_limit :=
    Nonempty.intro
      { Cone := fork f g
        IsLimit :=
          Fork.IsLimit.mk _
            (fun c =>
              NormedAddGroupHom.ker.lift (Fork.ι c) _ <|
                show NormedAddGroupHom.compHom (f - g) c.ι = 0
                  by
                  rw [AddMonoidHom.map_sub, AddMonoidHom.sub_apply, sub_eq_zero]
                  exact c.condition)
            (fun c => NormedAddGroupHom.ker.incl_comp_lift _ _ _) fun c g h =>
            by
            ext x
            dsimp
            rw [← h]
            rfl }
#align SemiNormedGroup.has_limit_parallel_pair SemiNormedGroup.hasLimit_parallelPair

instance : Limits.HasEqualizers.{u, u + 1} SemiNormedGroup :=
  @hasEqualizers_of_hasLimit_parallelPair SemiNormedGroup _ fun V W f g =>
    SemiNormedGroup.hasLimit_parallelPair f g

end EqualizersAndKernels

section Cokernel

-- PROJECT: can we reuse the work to construct cokernels in `SemiNormedGroup₁` here?
-- I don't see a way to do this that is less work than just repeating the relevant parts.
/-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/
def cokernelCocone {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : Cofork f 0 :=
  @Cofork.ofπ _ _ _ _ _ _ (SemiNormedGroup.of (Y ⧸ NormedAddGroupHom.range f)) f.range.normedMk
    (by
      ext
      simp only [comp_apply, limits.zero_comp, NormedAddGroupHom.zero_apply, ←
        NormedAddGroupHom.mem_ker, f.range.ker_normed_mk, f.mem_range, exists_apply_eq_apply])
#align SemiNormedGroup.cokernel_cocone SemiNormedGroup.cokernelCocone

/-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/
def cokernelLift {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) (s : CokernelCofork f) :
    (cokernelCocone f).pt ⟶ s.pt :=
  NormedAddGroupHom.lift _ s.π
    (by
      rintro _ ⟨b, rfl⟩
      change (f ≫ s.π) b = 0
      simp)
#align SemiNormedGroup.cokernel_lift SemiNormedGroup.cokernelLift

/-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/
def isColimitCokernelCocone {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
    IsColimit (cokernelCocone f) :=
  isColimitAux _ (cokernelLift f)
    (fun s => by
      ext
      apply NormedAddGroupHom.lift_mk f.range
      rintro _ ⟨b, rfl⟩
      change (f ≫ s.π) b = 0
      simp)
    fun s m w => NormedAddGroupHom.lift_unique f.range _ _ _ w
#align SemiNormedGroup.is_colimit_cokernel_cocone SemiNormedGroup.isColimitCokernelCocone

instance : HasCokernels SemiNormedGroup.{u}
    where HasColimit X Y f :=
    HasColimit.mk
      { Cocone := cokernelCocone f
        IsColimit := isColimitCokernelCocone f }

-- Sanity check
example : HasCokernels SemiNormedGroup := by infer_instance

section ExplicitCokernel

/-- An explicit choice of cokernel, which has good properties with respect to the norm. -/
def explicitCokernel {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : SemiNormedGroup.{u} :=
  (cokernelCocone f).pt
#align SemiNormedGroup.explicit_cokernel SemiNormedGroup.explicitCokernel

/-- Descend to the explicit cokernel. -/
def explicitCokernelDesc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z} (w : f ≫ g = 0) :
    explicitCokernel f ⟶ Z :=
  (isColimitCokernelCocone f).desc (Cofork.ofπ g (by simp [w]))
#align SemiNormedGroup.explicit_cokernel_desc SemiNormedGroup.explicitCokernelDesc

/-- The projection from `Y` to the explicit cokernel of `X ⟶ Y`. -/
def explicitCokernelπ {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : Y ⟶ explicitCokernel f :=
  (cokernelCocone f).ι.app WalkingParallelPair.one
#align SemiNormedGroup.explicit_cokernel_π SemiNormedGroup.explicitCokernelπ

theorem explicitCokernelπ_surjective {X Y : SemiNormedGroup.{u}} {f : X ⟶ Y} :
    Function.Surjective (explicitCokernelπ f) :=
  surjective_quot_mk _
#align SemiNormedGroup.explicit_cokernel_π_surjective SemiNormedGroup.explicitCokernelπ_surjective

@[simp, reassoc.1]
theorem comp_explicitCokernelπ {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
    f ≫ explicitCokernelπ f = 0 :=
  by
  convert(cokernel_cocone f).w walking_parallel_pair_hom.left
  simp
#align SemiNormedGroup.comp_explicit_cokernel_π SemiNormedGroup.comp_explicitCokernelπ

@[simp]
theorem explicitCokernelπ_apply_dom_eq_zero {X Y : SemiNormedGroup.{u}} {f : X ⟶ Y} (x : X) :
    (explicitCokernelπ f) (f x) = 0 :=
  show (f ≫ explicitCokernelπ f) x = 0
    by
    rw [comp_explicit_cokernel_π]
    rfl
#align SemiNormedGroup.explicit_cokernel_π_apply_dom_eq_zero SemiNormedGroup.explicitCokernelπ_apply_dom_eq_zero

@[simp, reassoc.1]
theorem explicitCokernelπ_desc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    (w : f ≫ g = 0) : explicitCokernelπ f ≫ explicitCokernelDesc w = g :=
  (isColimitCokernelCocone f).fac _ _
#align SemiNormedGroup.explicit_cokernel_π_desc SemiNormedGroup.explicitCokernelπ_desc

@[simp]
theorem explicitCokernelπ_desc_apply {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    {cond : f ≫ g = 0} (x : Y) : explicitCokernelDesc cond (explicitCokernelπ f x) = g x :=
  show (explicitCokernelπ f ≫ explicitCokernelDesc cond) x = g x by rw [explicit_cokernel_π_desc]
#align SemiNormedGroup.explicit_cokernel_π_desc_apply SemiNormedGroup.explicitCokernelπ_desc_apply

theorem explicitCokernelDesc_unique {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    (w : f ≫ g = 0) (e : explicitCokernel f ⟶ Z) (he : explicitCokernelπ f ≫ e = g) :
    e = explicitCokernelDesc w :=
  by
  apply (is_colimit_cokernel_cocone f).uniq (cofork.of_π g (by simp [w]))
  rintro (_ | _)
  · convert w.symm
    simp
  · exact he
#align SemiNormedGroup.explicit_cokernel_desc_unique SemiNormedGroup.explicitCokernelDesc_unique

theorem explicitCokernelDesc_comp_eq_desc {X Y Z W : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    {h : Z ⟶ W} {cond : f ≫ g = 0} :
    explicitCokernelDesc cond ≫ h =
      explicitCokernelDesc
        (show f ≫ g ≫ h = 0 by rw [← CategoryTheory.Category.assoc, cond, limits.zero_comp]) :=
  by
  refine' explicit_cokernel_desc_unique _ _ _
  rw [← CategoryTheory.Category.assoc, explicit_cokernel_π_desc]
#align SemiNormedGroup.explicit_cokernel_desc_comp_eq_desc SemiNormedGroup.explicitCokernelDesc_comp_eq_desc

@[simp]
theorem explicitCokernelDesc_zero {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} :
    explicitCokernelDesc (show f ≫ (0 : Y ⟶ Z) = 0 from CategoryTheory.Limits.comp_zero) = 0 :=
  Eq.symm <| explicitCokernelDesc_unique _ _ CategoryTheory.Limits.comp_zero
#align SemiNormedGroup.explicit_cokernel_desc_zero SemiNormedGroup.explicitCokernelDesc_zero

@[ext]
theorem explicitCokernel_hom_ext {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y}
    (e₁ e₂ : explicitCokernel f ⟶ Z) (h : explicitCokernelπ f ≫ e₁ = explicitCokernelπ f ≫ e₂) :
    e₁ = e₂ := by
  let g : Y ⟶ Z := explicit_cokernel_π f ≫ e₂
  have w : f ≫ g = 0 := by simp
  have : e₂ = explicit_cokernel_desc w :=
    by
    apply explicit_cokernel_desc_unique
    rfl
  rw [this]
  apply explicit_cokernel_desc_unique
  exact h
#align SemiNormedGroup.explicit_cokernel_hom_ext SemiNormedGroup.explicitCokernel_hom_ext

instance explicitCokernelπ.epi {X Y : SemiNormedGroup.{u}} {f : X ⟶ Y} :
    Epi (explicitCokernelπ f) := by
  constructor
  intro Z g h H
  ext x
  obtain ⟨x, hx⟩ := explicit_cokernel_π_surjective (explicit_cokernel_π f x)
  change (explicit_cokernel_π f ≫ g) _ = _
  rw [H]
#align SemiNormedGroup.explicit_cokernel_π.epi SemiNormedGroup.explicitCokernelπ.epi

theorem isQuotientExplicitCokernelπ {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
    NormedAddGroupHom.IsQuotient (explicitCokernelπ f) :=
  NormedAddGroupHom.isQuotientQuotient _
#align SemiNormedGroup.is_quotient_explicit_cokernel_π SemiNormedGroup.isQuotientExplicitCokernelπ

theorem normNoninc_explicitCokernelπ {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
    (explicitCokernelπ f).NormNoninc :=
  (isQuotientExplicitCokernelπ f).norm_le
#align SemiNormedGroup.norm_noninc_explicit_cokernel_π SemiNormedGroup.normNoninc_explicitCokernelπ

open NNReal

theorem explicitCokernelDesc_norm_le_of_norm_le {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y}
    {g : Y ⟶ Z} (w : f ≫ g = 0) (c : ℝ≥0) (h : ‖g‖ ≤ c) : ‖explicitCokernelDesc w‖ ≤ c :=
  NormedAddGroupHom.lift_norm_le _ _ _ h
#align SemiNormedGroup.explicit_cokernel_desc_norm_le_of_norm_le SemiNormedGroup.explicitCokernelDesc_norm_le_of_norm_le

theorem explicitCokernelDesc_normNoninc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    {cond : f ≫ g = 0} (hg : g.NormNoninc) : (explicitCokernelDesc cond).NormNoninc :=
  by
  refine' NormedAddGroupHom.NormNoninc.normNoninc_iff_norm_le_one.2 _
  rw [← NNReal.coe_one]
  exact
    explicit_cokernel_desc_norm_le_of_norm_le cond 1
      (NormedAddGroupHom.NormNoninc.normNoninc_iff_norm_le_one.1 hg)
#align SemiNormedGroup.explicit_cokernel_desc_norm_noninc SemiNormedGroup.explicitCokernelDesc_normNoninc

theorem explicitCokernelDesc_comp_eq_zero {X Y Z W : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    {h : Z ⟶ W} (cond : f ≫ g = 0) (cond2 : g ≫ h = 0) : explicitCokernelDesc cond ≫ h = 0 :=
  by
  rw [← cancel_epi (explicit_cokernel_π f), ← category.assoc, explicit_cokernel_π_desc]
  simp [cond2]
#align SemiNormedGroup.explicit_cokernel_desc_comp_eq_zero SemiNormedGroup.explicitCokernelDesc_comp_eq_zero

theorem explicitCokernelDesc_norm_le {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    (w : f ≫ g = 0) : ‖explicitCokernelDesc w‖ ≤ ‖g‖ :=
  explicitCokernelDesc_norm_le_of_norm_le w ‖g‖₊ le_rfl
#align SemiNormedGroup.explicit_cokernel_desc_norm_le SemiNormedGroup.explicitCokernelDesc_norm_le

/-- The explicit cokernel is isomorphic to the usual cokernel. -/
def explicitCokernelIso {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : explicitCokernel f ≅ cokernel f :=
  (isColimitCokernelCocone f).coconePointUniqueUpToIso (colimit.isColimit _)
#align SemiNormedGroup.explicit_cokernel_iso SemiNormedGroup.explicitCokernelIso

@[simp]
theorem explicitCokernelIso_hom_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
    explicitCokernelπ f ≫ (explicitCokernelIso f).hom = cokernel.π _ := by
  simp [explicit_cokernel_π, explicit_cokernel_iso, is_colimit.cocone_point_unique_up_to_iso]
#align SemiNormedGroup.explicit_cokernel_iso_hom_π SemiNormedGroup.explicitCokernelIso_hom_π

@[simp]
theorem explicitCokernelIso_inv_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) :
    cokernel.π f ≫ (explicitCokernelIso f).inv = explicitCokernelπ f := by
  simp [explicit_cokernel_π, explicit_cokernel_iso]
#align SemiNormedGroup.explicit_cokernel_iso_inv_π SemiNormedGroup.explicitCokernelIso_inv_π

@[simp]
theorem explicitCokernelIso_hom_desc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z}
    (w : f ≫ g = 0) : (explicitCokernelIso f).hom ≫ cokernel.desc f g w = explicitCokernelDesc w :=
  by
  ext1
  simp [explicit_cokernel_desc, explicit_cokernel_π, explicit_cokernel_iso,
    is_colimit.cocone_point_unique_up_to_iso]
#align SemiNormedGroup.explicit_cokernel_iso_hom_desc SemiNormedGroup.explicitCokernelIso_hom_desc

/-- A special case of `category_theory.limits.cokernel.map` adapted to `explicit_cokernel`. -/
noncomputable def explicitCokernel.map {A B C D : SemiNormedGroup.{u}} {fab : A ⟶ B} {fbd : B ⟶ D}
    {fac : A ⟶ C} {fcd : C ⟶ D} (h : fab ≫ fbd = fac ≫ fcd) :
    explicitCokernel fab ⟶ explicitCokernel fcd :=
  @explicitCokernelDesc _ _ _ fab (fbd ≫ explicitCokernelπ _) <| by simp [reassoc_of h]
#align SemiNormedGroup.explicit_cokernel.map SemiNormedGroup.explicitCokernel.map

/-- A special case of `category_theory.limits.cokernel.map_desc` adapted to `explicit_cokernel`. -/
theorem ExplicitCoker.map_desc {A B C D B' D' : SemiNormedGroup.{u}} {fab : A ⟶ B} {fbd : B ⟶ D}
    {fac : A ⟶ C} {fcd : C ⟶ D} {h : fab ≫ fbd = fac ≫ fcd} {fbb' : B ⟶ B'} {fdd' : D ⟶ D'}
    {condb : fab ≫ fbb' = 0} {condd : fcd ≫ fdd' = 0} {g : B' ⟶ D'} (h' : fbb' ≫ g = fbd ≫ fdd') :
    explicitCokernelDesc condb ≫ g = explicitCokernel.map h ≫ explicitCokernelDesc condd :=
  by
  delta explicit_cokernel.map
  simp [← cancel_epi (explicit_cokernel_π fab), category.assoc, explicit_cokernel_π_desc, h']
#align SemiNormedGroup.explicit_coker.map_desc SemiNormedGroup.ExplicitCoker.map_desc

end ExplicitCokernel

end Cokernel

end SemiNormedGroup


/-
Copyright (c) 2020 Paul van Wamelen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Paul van Wamelen
-/
import number_theory.pythagorean_triples
import ring_theory.coprime.lemmas
import tactic.linear_combination

/-!
# Fermat's Last Theorem for the case n = 4

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
There are no non-zero integers `a`, `b` and `c` such that `a ^ 4 + b ^ 4 = c ^ 4`.
-/

noncomputable theory
open_locale classical

/-- Shorthand for three non-zero integers `a`, `b`, and `c` satisfying `a ^ 4 + b ^ 4 = c ^ 2`.
We will show that no integers satisfy this equation. Clearly Fermat's Last theorem for n = 4
follows. -/
def fermat_42 (a b c : ℤ) : Prop := a ≠ 0 ∧ b ≠ 0 ∧ a ^ 4 + b ^ 4 = c ^ 2

namespace fermat_42

lemma comm {a b c : ℤ} :
 (fermat_42 a b c) ↔ (fermat_42 b a c) :=
 by { delta fermat_42, rw add_comm, tauto }

lemma mul {a b c k : ℤ} (hk0 : k ≠ 0) :
  fermat_42 a b c ↔ fermat_42 (k * a) (k * b) (k ^ 2 * c) :=
begin
  delta fermat_42,
  split,
  { intro f42,
    split, { exact mul_ne_zero hk0 f42.1 },
    split, { exact mul_ne_zero hk0 f42.2.1 },
    { have H : a ^ 4 + b ^ 4 = c ^ 2 := f42.2.2,
      linear_combination k ^ 4 * H } },
  { intro f42,
    split, { exact right_ne_zero_of_mul f42.1 },
    split, { exact right_ne_zero_of_mul f42.2.1 },
    apply (mul_right_inj' (pow_ne_zero 4 hk0)).mp,
    linear_combination f42.2.2 }
end

lemma ne_zero {a b c : ℤ} (h : fermat_42 a b c) : c ≠ 0 :=
begin
  apply ne_zero_pow two_ne_zero _, apply ne_of_gt,
  rw [← h.2.2, (by ring : a ^ 4 + b ^ 4 = (a ^ 2) ^ 2 + (b ^ 2) ^ 2)],
  exact add_pos (sq_pos_of_ne_zero _ (pow_ne_zero 2 h.1))
      (sq_pos_of_ne_zero _ (pow_ne_zero 2 h.2.1))
end

/-- We say a solution to `a ^ 4 + b ^ 4 = c ^ 2` is minimal if there is no other solution with
a smaller `c` (in absolute value). -/
def minimal (a b c : ℤ) : Prop :=
  (fermat_42 a b c) ∧ ∀ (a1 b1 c1 : ℤ), (fermat_42 a1 b1 c1) → int.nat_abs c ≤ int.nat_abs c1

/-- if we have a solution to `a ^ 4 + b ^ 4 = c ^ 2` then there must be a minimal one. -/
lemma exists_minimal {a b c : ℤ} (h : fermat_42 a b c) :
  ∃ (a0 b0 c0), (minimal a0 b0 c0) :=
begin
  let S : set ℕ := { n | ∃ (s : ℤ × ℤ × ℤ), fermat_42 s.1 s.2.1 s.2.2 ∧ n = int.nat_abs s.2.2},
  have S_nonempty : S.nonempty,
  { use int.nat_abs c,
    rw set.mem_set_of_eq,
    use ⟨a, ⟨b, c⟩⟩, tauto },
  let m : ℕ := nat.find S_nonempty,
  have m_mem : m ∈ S := nat.find_spec S_nonempty,
  rcases m_mem with ⟨s0, hs0, hs1⟩,
  use [s0.1, s0.2.1, s0.2.2, hs0],
  intros a1 b1 c1 h1,
  rw ← hs1,
  apply nat.find_min',
  use ⟨a1, ⟨b1, c1⟩⟩, tauto
end

/-- a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` must have `a` and `b` coprime. -/
lemma coprime_of_minimal {a b c : ℤ} (h : minimal a b c) : is_coprime a b :=
begin
  apply int.gcd_eq_one_iff_coprime.mp,
  by_contradiction hab,
  obtain ⟨p, hp, hpa, hpb⟩ := nat.prime.not_coprime_iff_dvd.mp hab,
  obtain ⟨a1, rfl⟩ := (int.coe_nat_dvd_left.mpr hpa),
  obtain ⟨b1, rfl⟩ := (int.coe_nat_dvd_left.mpr hpb),
  have hpc : (p : ℤ) ^ 2 ∣ c,
  { rw [←int.pow_dvd_pow_iff zero_lt_two, ←h.1.2.2],
    apply dvd.intro (a1 ^ 4 + b1 ^ 4), ring },
  obtain ⟨c1, rfl⟩ := hpc,
  have hf : fermat_42 a1 b1 c1,
    exact (fermat_42.mul (int.coe_nat_ne_zero.mpr (nat.prime.ne_zero hp))).mpr h.1,
  apply nat.le_lt_antisymm (h.2 _ _ _ hf),
  rw [int.nat_abs_mul, lt_mul_iff_one_lt_left, int.nat_abs_pow, int.nat_abs_of_nat],
  { exact nat.one_lt_pow _ _ zero_lt_two (nat.prime.one_lt hp) },
  { exact (nat.pos_of_ne_zero (int.nat_abs_ne_zero_of_ne_zero (ne_zero hf))) },
end

/-- We can swap `a` and `b` in a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2`. -/

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has positive `c`. -/
lemma neg_of_minimal {a b c : ℤ} :
 (minimal a b c) → (minimal a b (-c)) :=
begin
  rintros ⟨⟨ha, hb, heq⟩, h2⟩,
  split,
  { apply and.intro ha (and.intro hb _),
    rw heq, exact (neg_sq c).symm },
  rwa (int.nat_abs_neg c),
end

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has `a` odd. -/
lemma exists_odd_minimal {a b c : ℤ} (h : fermat_42 a b c) :
  ∃ (a0 b0 c0), (minimal a0 b0 c0) ∧ a0 % 2 = 1 :=
begin
  obtain ⟨a0, b0, c0, hf⟩ := exists_minimal h,
  cases int.mod_two_eq_zero_or_one a0 with hap hap,
  { cases int.mod_two_eq_zero_or_one b0 with hbp hbp,
    { exfalso,
      have h1 : 2 ∣ (int.gcd a0 b0 : ℤ),
      { exact int.dvd_gcd (int.dvd_of_mod_eq_zero hap) (int.dvd_of_mod_eq_zero hbp) },
        rw int.gcd_eq_one_iff_coprime.mpr (coprime_of_minimal hf) at h1, revert h1, norm_num },
    { exact ⟨b0, ⟨a0, ⟨c0, minimal_comm hf, hbp⟩⟩⟩ } },
  exact ⟨a0, ⟨b0, ⟨c0 , hf, hap⟩⟩⟩,
end

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has
`a` odd and `c` positive. -/
lemma exists_pos_odd_minimal {a b c : ℤ} (h : fermat_42 a b c) :
  ∃ (a0 b0 c0), (minimal a0 b0 c0) ∧ a0 % 2 = 1 ∧ 0 < c0  :=
begin
  obtain ⟨a0, b0, c0, hf, hc⟩ := exists_odd_minimal h,
  rcases lt_trichotomy 0 c0 with (h1 | rfl | h1),
  { use [a0, b0, c0], tauto },
  { exfalso, exact ne_zero hf.1 rfl},
  { use [a0, b0, -c0, neg_of_minimal hf, hc],
    exact neg_pos.mpr h1 },
end

end fermat_42

lemma int.coprime_of_sq_sum {r s : ℤ} (h2 : is_coprime s r) :
  is_coprime (r ^ 2 + s ^ 2) r :=
begin
  rw [sq, sq],
  exact (is_coprime.mul_left h2 h2).mul_add_left_left r
end

lemma int.coprime_of_sq_sum' {r s : ℤ} (h : is_coprime r s) :
  is_coprime (r ^ 2 + s ^ 2) (r * s) :=
begin
  apply is_coprime.mul_right (int.coprime_of_sq_sum (is_coprime_comm.mp h)),
  rw add_comm, apply int.coprime_of_sq_sum h
end

namespace fermat_42

-- If we have a solution to a ^ 4 + b ^ 4 = c ^ 2, we can construct a smaller one. This
-- implies there can't be a smallest solution.
lemma not_minimal {a b c : ℤ}
  (h : minimal a b c) (ha2 : a % 2 = 1) (hc : 0 < c) : false :=
begin
  -- Use the fact that a ^ 2, b ^ 2, c form a pythagorean triple to obtain m and n such that
  -- a ^ 2 = m ^ 2 - n ^ 2, b ^ 2 = 2 * m * n and c = m ^ 2 + n ^ 2
  -- first the formula:
  have ht : pythagorean_triple (a ^ 2) (b ^ 2) c,
  { delta pythagorean_triple,
    linear_combination h.1.2.2 },
  -- coprime requirement:
  have h2 : int.gcd (a ^ 2) (b ^ 2) = 1 :=
    int.gcd_eq_one_iff_coprime.mpr (coprime_of_minimal h).pow,
  -- in order to reduce the possibilities we get from the classification of pythagorean triples
  -- it helps if we know the parity of a ^ 2 (and the sign of c):
  have ha22 : a ^ 2 % 2 = 1, { rw [sq, int.mul_mod, ha2], norm_num },
  obtain ⟨m, n, ht1, ht2, ht3, ht4, ht5, ht6⟩ := ht.coprime_classification' h2 ha22 hc,
  -- Now a, n, m form a pythagorean triple and so we can obtain r and s such that
  -- a = r ^ 2 - s ^ 2, n = 2 * r * s and m = r ^ 2 + s ^ 2
  -- formula:
  have htt : pythagorean_triple a n m,
  { delta pythagorean_triple,
    linear_combination (ht1) },
  -- a and n are coprime, because a ^ 2 = m ^ 2 - n ^ 2 and m and n are coprime.
  have h3 : int.gcd a n = 1,
  { apply int.gcd_eq_one_iff_coprime.mpr,
    apply @is_coprime.of_mul_left_left _ _ _ a,
    rw [← sq, ht1, (by ring : m ^ 2 - n ^ 2 = m ^ 2 + (-n) * n)],
    exact (int.gcd_eq_one_iff_coprime.mp ht4).pow_left.add_mul_right_left (-n) },
  -- m is positive because b is non-zero and b ^ 2 = 2 * m * n and we already have 0 ≤ m.
  have hb20 : b ^ 2 ≠ 0 := mt pow_eq_zero h.1.2.1,
  have h4 : 0 < m,
  { apply lt_of_le_of_ne ht6,
    rintro rfl,
    revert hb20,
    rw ht2, simp },
  obtain ⟨r, s, htt1, htt2, htt3, htt4, htt5, htt6⟩ := htt.coprime_classification' h3 ha2 h4,
  -- Now use the fact that (b / 2) ^ 2 = m * r * s, and m, r and s are pairwise coprime to obtain
  -- i, j and k such that m = i ^ 2, r = j ^ 2 and s = k ^ 2.
  -- m and r * s are coprime because m = r ^ 2 + s ^ 2 and r and s are coprime.
  have hcp : int.gcd m (r * s) = 1,
  { rw htt3,
    exact int.gcd_eq_one_iff_coprime.mpr (int.coprime_of_sq_sum'
      (int.gcd_eq_one_iff_coprime.mp htt4)) },
  -- b is even because b ^ 2 = 2 * m * n.
  have hb2 : 2 ∣ b,
  { apply @int.prime.dvd_pow' _ 2 _ nat.prime_two,
    rw [ht2, mul_assoc], exact dvd_mul_right 2 (m * n) },
  cases hb2 with b' hb2',
  have hs : b' ^ 2 = m * (r * s),
  { apply (mul_right_inj' (by norm_num : (4 : ℤ) ≠ 0)).mp,
    linear_combination (- b - 2 * b') * hb2' + ht2 + 2 * m * htt2 },
  have hrsz : r * s ≠ 0, -- because b ^ 2 is not zero and (b / 2) ^ 2 = m * (r * s)
  { by_contradiction hrsz,
    revert hb20, rw [ht2, htt2, mul_assoc, @mul_assoc _ _ _ r s, hrsz],
    simp },
  have h2b0 : b' ≠ 0,
  { apply ne_zero_pow two_ne_zero,
    rw hs, apply mul_ne_zero, { exact ne_of_gt h4}, { exact hrsz } },
  obtain ⟨i, hi⟩ := int.sq_of_gcd_eq_one hcp hs.symm,
  -- use m is positive to exclude m = - i ^ 2
  have hi' : ¬ m = - i ^ 2,
  { by_contradiction h1,
    have hit : - i ^ 2 ≤ 0, apply neg_nonpos.mpr (sq_nonneg i),
    rw ← h1 at hit,
    apply absurd h4 (not_lt.mpr hit) },
  replace hi : m = i ^ 2, { apply or.resolve_right hi hi' },
  rw mul_comm at hs,
  rw [int.gcd_comm] at hcp,
  -- obtain d such that r * s = d ^ 2
  obtain ⟨d, hd⟩ := int.sq_of_gcd_eq_one hcp hs.symm,
  -- (b / 2) ^ 2 and m are positive so r * s is positive
  have hd' : ¬ r * s = - d ^ 2,
  { by_contradiction h1,
    rw h1 at hs,
    have h2 : b' ^ 2 ≤ 0,
    { rw [hs, (by ring : - d ^ 2 * m = - (d ^ 2 * m))],
      exact neg_nonpos.mpr ((zero_le_mul_right h4).mpr (sq_nonneg d)) },
    have h2' : 0 ≤ b' ^ 2, { apply sq_nonneg b' },
    exact absurd (lt_of_le_of_ne h2' (ne.symm (pow_ne_zero _ h2b0))) (not_lt.mpr h2) },
  replace hd : r * s = d ^ 2, { apply or.resolve_right hd hd' },
  -- r = +/- j ^ 2
  obtain ⟨j, hj⟩ := int.sq_of_gcd_eq_one htt4 hd,
  have hj0 : j ≠ 0,
  { intro h0, rw [h0, zero_pow zero_lt_two, neg_zero, or_self] at hj,
    apply left_ne_zero_of_mul hrsz hj },
  rw mul_comm at hd,
  rw [int.gcd_comm] at htt4,
  -- s = +/- k ^ 2
  obtain ⟨k, hk⟩ := int.sq_of_gcd_eq_one htt4 hd,
  have hk0 : k ≠ 0,
  { intro h0, rw [h0, zero_pow zero_lt_two, neg_zero, or_self] at hk,
    apply right_ne_zero_of_mul hrsz hk },
  have hj2 : r ^ 2 = j ^ 4, { cases hj with hjp hjp; { rw hjp, ring } },
  have hk2 : s ^ 2 = k ^ 4, { cases hk with hkp hkp; { rw hkp, ring } },
  -- from m = r ^ 2 + s ^ 2 we now get a new solution to a ^ 4 + b ^ 4 = c ^ 2:
  have hh : i ^ 2 = j ^ 4 + k ^ 4, { rw [← hi, htt3, hj2, hk2] },
  have hn : n ≠ 0, { rw ht2 at hb20, apply right_ne_zero_of_mul hb20 },
  -- and it has a smaller c: from c = m ^ 2 + n ^ 2 we see that m is smaller than c, and i ^ 2 = m.
  have hic : int.nat_abs i < int.nat_abs c,
  { apply int.coe_nat_lt.mp, rw ← (int.eq_nat_abs_of_zero_le (le_of_lt hc)),
    apply gt_of_gt_of_ge _ (int.abs_le_self_sq i),
    rw [← hi, ht3],
    apply gt_of_gt_of_ge _ (int.le_self_sq m),
    exact lt_add_of_pos_right (m ^ 2) (sq_pos_of_ne_zero n hn) },
  have hic' : int.nat_abs c ≤ int.nat_abs i,
  { apply (h.2 j k i),
    exact ⟨hj0, hk0, hh.symm⟩ },
  apply absurd (not_le_of_lt hic) (not_not.mpr hic')
end

end fermat_42

lemma not_fermat_42 {a b c : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
  a ^ 4 + b ^ 4 ≠ c ^ 2 :=
begin
  intro h,
  obtain ⟨a0, b0, c0, ⟨hf, h2, hp⟩⟩ :=
    fermat_42.exists_pos_odd_minimal (and.intro ha (and.intro hb h)),
  apply fermat_42.not_minimal hf h2 hp
end

theorem not_fermat_4 {a b c : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
  a ^ 4 + b ^ 4 ≠ c ^ 4 :=
begin
  intro heq,
  apply @not_fermat_42 _ _ (c ^ 2) ha hb,
  rw heq, ring
end


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import measure_theory.tactic
import measure_theory.function.special_functions

open_locale big_operators ennreal

variables {α β : Type*} [measurable_space α] [measurable_space β]
  {f g : α → β} {s₁ s₂ : set α} {t₁ t₂ : set β} {μ ν : measure_theory.measure α}

-- Test the use of assumption

example (hf : measurable f) : measurable f := by measurability

-- Test that intro does not unfold `measurable`

example : measurable f → measurable f := by measurability

-- Test the use of apply_assumption to get (h i) from an hypothesis (h : ∀ i, ...).

example  {F : ℕ → α → β} (hF : ∀ i, measurable (F i)) :
  measurable (F 0) :=
by measurability

example {ι} [encodable ι] {S₁ S₂ : ι → set α} (hS₁ : ∀ i, measurable_set (S₁ i))
  (hS₂ : ∀ i, measurable_set (S₂ i)) :
  measurable_set (⋃ i, (S₁ i) ∪ (S₂ i)) :=
by measurability

-- Tests on sets

example (hs₁ : measurable_set s₁) (hs₂ : measurable_set s₂) :
  measurable_set (s₁ ∪ s₁) :=
by measurability

example {ι} [encodable ι] {S : ι → set α} (hs : ∀ i, measurable_set (S i)) :
  measurable_set (⋃ i, S i) :=
by measurability

example (hf : measurable f) (hs₁ : measurable_set s₁) (ht₂ : measurable_set t₂) :
  measurable_set ((f ⁻¹' t₂) ∩ s₁) :=
by measurability

-- Tests on functions

example [has_mul β] [has_measurable_mul₂ β] (hf : measurable f) (c : β) :
  measurable (λ x, c * f x) :=
by measurability  -- uses const_mul, not mul

example [has_add β] [has_measurable_add₂ β] (hf : measurable f) (hg : measurable g) :
  measurable (λ x, f x + g x) :=
by measurability

example [has_add β] [has_measurable_add₂ β] (hf : measurable f) (hg : ae_measurable g μ) :
  ae_measurable (λ x, f x + g x) μ :=
by measurability

example [has_div β] [has_measurable_div₂ β] (hf : measurable f) (hg : measurable g)
  (ht : measurable_set t₂):
  measurable_set ((λ x, f x / g x) ⁻¹' t₂) :=
by measurability

example [add_comm_monoid β] [has_measurable_add₂ β] {s : finset ℕ} {F : ℕ → α → β}
  (hF : ∀ i, ae_measurable (F i) μ) :
  ae_measurable (∑ i in s, (λ x, F (i+1) x + F i x)) μ :=
by measurability

-- even with many assumptions, the tactic is not trapped by a bad lemma
example [topological_space α] [borel_space α] [normed_group β] [borel_space β]
  [has_measurable_add₂ β] [has_measurable_sub₂ β] {s : finset ℕ} {F : ℕ → α → β}
  (hF : ∀ i, measurable (F i)) :
  ae_measurable (∑ i in s, (λ x, F (i+1) x - F i x)) μ :=
by measurability

example : measurable (λ x : ℝ, real.exp (2 * inner x 3)) :=
by measurability


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

! This file was ported from Lean 3 source module linear_algebra.tensor_power
! leanprover-community/mathlib commit ce11c3c2a285bbe6937e26d9792fda4e51f3fe1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.PiTensorProduct
import Mathbin.Logic.Equiv.Fin
import Mathbin.Algebra.DirectSum.Algebra

/-!
# Tensor power of a semimodule over a commutative semirings

We define the `n`th tensor power of `M` as the n-ary tensor product indexed by `fin n` of `M`,
`⨂[R] (i : fin n), M`. This is a special case of `pi_tensor_product`.

This file introduces the notation `⨂[R]^n M` for `tensor_power R n M`, which in turn is an
abbreviation for `⨂[R] i : fin n, M`.

## Main definitions:

* `tensor_power.gsemiring`: the tensor powers form a graded semiring.
* `tensor_power.galgebra`: the tensor powers form a graded algebra.

## Implementation notes

In this file we use `ₜ1` and `ₜ*` as local notation for the graded multiplicative structure on
tensor powers. Elsewhere, using `1` and `*` on `graded_monoid` should be preferred.
-/

open TensorProduct

/-- Homogenous tensor powers $M^{\otimes n}$. `⨂[R]^n M` is a shorthand for
`⨂[R] (i : fin n), M`. -/
@[reducible]
protected def TensorPower (R : Type _) (n : ℕ) (M : Type _) [CommSemiring R] [AddCommMonoid M]
    [Module R M] : Type _ :=
  ⨂[R] i : Fin n, M
#align tensor_power TensorPower

variable {R : Type _} {M : Type _} [CommSemiring R] [AddCommMonoid M] [Module R M]

-- mathport name: tensor_power
scoped[TensorProduct] notation:100 "⨂[" R "]^" n:arg => TensorPower R n

namespace PiTensorProduct

/-- Two dependent pairs of tensor products are equal if their index is equal and the contents
are equal after a canonical reindexing. -/
@[ext]
theorem gradedMonoid_eq_of_reindex_cast {ιι : Type _} {ι : ιι → Type _} :
    ∀ {a b : GradedMonoid fun ii => ⨂[R] i : ι ii, M} (h : a.fst = b.fst),
      reindex R M (Equiv.cast <| congr_arg ι h) a.snd = b.snd → a = b
  | ⟨ai, a⟩, ⟨bi, b⟩ => fun (hi : ai = bi) (h : reindex R M _ a = b) =>
    by
    subst hi
    simpa using h
#align pi_tensor_product.graded_monoid_eq_of_reindex_cast PiTensorProduct.gradedMonoid_eq_of_reindex_cast

end PiTensorProduct

namespace TensorPower

open TensorProduct DirectSum

open PiTensorProduct

/-- As a graded monoid, `⨂[R]^i M` has a `1 : ⨂[R]^0 M`. -/
instance ghasOne : GradedMonoid.GOne fun i => (⨂[R]^i) M where one := tprod R <| @Fin.elim0' M
#align tensor_power.ghas_one TensorPower.ghasOne

-- mathport name: exprₜ1
local notation "ₜ1" => @GradedMonoid.GOne.one ℕ (fun i => (⨂[R]^i) M) _ _

theorem ghasOne_def : ₜ1 = tprod R (@Fin.elim0' M) :=
  rfl
#align tensor_power.ghas_one_def TensorPower.ghasOne_def

/-- A variant of `pi_tensor_prod.tmul_equiv` with the result indexed by `fin (n + m)`. -/
def mulEquiv {n m : ℕ} : (⨂[R]^n) M ⊗[R] (⨂[R]^m) M ≃ₗ[R] (⨂[R]^(n + m)) M :=
  (tmulEquiv R M).trans (reindex R M finSumFinEquiv)
#align tensor_power.mul_equiv TensorPower.mulEquiv

/-- As a graded monoid, `⨂[R]^i M` has a `(*) : ⨂[R]^i M → ⨂[R]^j M → ⨂[R]^(i + j) M`. -/
instance ghasMul : GradedMonoid.GMul fun i => (⨂[R]^i) M
    where mul i j a b :=
    (TensorProduct.mk R _ _).compr₂ (↑(mulEquiv : _ ≃ₗ[R] (⨂[R]^(i + j)) M)) a b
#align tensor_power.ghas_mul TensorPower.ghasMul

-- mathport name: «expr ₜ* »
local infixl:70 " ₜ* " => @GradedMonoid.GMul.mul ℕ (fun i => (⨂[R]^i) M) _ _ _ _

theorem ghasMul_def {i j} (a : (⨂[R]^i) M) (b : (⨂[R]^j) M) : a ₜ* b = mulEquiv (a ⊗ₜ b) :=
  rfl
#align tensor_power.ghas_mul_def TensorPower.ghasMul_def

theorem ghasMul_eq_coe_linearMap {i j} (a : (⨂[R]^i) M) (b : (⨂[R]^j) M) :
    a ₜ* b =
      ((TensorProduct.mk R _ _).compr₂ ↑(mulEquiv : _ ≃ₗ[R] (⨂[R]^(i + j)) M) :
          (⨂[R]^i) M →ₗ[R] (⨂[R]^j) M →ₗ[R] (⨂[R]^(i + j)) M)
        a b :=
  rfl
#align tensor_power.ghas_mul_eq_coe_linear_map TensorPower.ghasMul_eq_coe_linearMap

variable (R M)

/-- Cast between "equal" tensor powers. -/
def cast {i j} (h : i = j) : (⨂[R]^i) M ≃ₗ[R] (⨂[R]^j) M :=
  reindex R M (Fin.cast h).toEquiv
#align tensor_power.cast TensorPower.cast

theorem cast_tprod {i j} (h : i = j) (a : Fin i → M) :
    cast R M h (tprod R a) = tprod R (a ∘ Fin.cast h.symm) :=
  reindex_tprod _ _
#align tensor_power.cast_tprod TensorPower.cast_tprod

@[simp]
theorem cast_refl {i} (h : i = i) : cast R M h = LinearEquiv.refl _ _ :=
  ((congr_arg fun f => reindex R M (RelIso.toEquiv f)) <| Fin.cast_refl h).trans reindex_refl
#align tensor_power.cast_refl TensorPower.cast_refl

@[simp]
theorem cast_symm {i j} (h : i = j) : (cast R M h).symm = cast R M h.symm :=
  reindex_symm _
#align tensor_power.cast_symm TensorPower.cast_symm

@[simp]
theorem cast_trans {i j k} (h : i = j) (h' : j = k) :
    (cast R M h).trans (cast R M h') = cast R M (h.trans h') :=
  reindex_trans _ _
#align tensor_power.cast_trans TensorPower.cast_trans

variable {R M}

@[simp]
theorem cast_cast {i j k} (h : i = j) (h' : j = k) (a : (⨂[R]^i) M) :
    cast R M h' (cast R M h a) = cast R M (h.trans h') a :=
  reindex_reindex _ _ _
#align tensor_power.cast_cast TensorPower.cast_cast

@[ext]
theorem gradedMonoid_eq_of_cast {a b : GradedMonoid fun n => ⨂[R] i : Fin n, M} (h : a.fst = b.fst)
    (h2 : cast R M h a.snd = b.snd) : a = b :=
  by
  refine' graded_monoid_eq_of_reindex_cast h _
  rw [cast] at h2
  rw [← Fin.cast_to_equiv, ← h2]
#align tensor_power.graded_monoid_eq_of_cast TensorPower.gradedMonoid_eq_of_cast

-- named to match `fin.cast_eq_cast`
theorem cast_eq_cast {i j} (h : i = j) : ⇑(cast R M h) = cast (congr_arg _ h) :=
  by
  subst h
  rw [cast_refl]
  rfl
#align tensor_power.cast_eq_cast TensorPower.cast_eq_cast

variable (R)

include R

theorem tprod_mul_tprod {na nb} (a : Fin na → M) (b : Fin nb → M) :
    tprod R a ₜ* tprod R b = tprod R (Fin.append a b) :=
  by
  dsimp [ghas_mul_def, MulEquiv]
  rw [tmul_equiv_apply R M a b]
  refine' (reindex_tprod _ _).trans _
  congr 1
  dsimp only [Fin.append, finSumFinEquiv, Equiv.coe_fn_symm_mk]
  apply funext
  apply Fin.addCases <;> simp
#align tensor_power.tprod_mul_tprod TensorPower.tprod_mul_tprod

omit R

variable {R}

theorem one_mul {n} (a : (⨂[R]^n) M) : cast R M (zero_add n) (ₜ1 ₜ* a) = a :=
  by
  rw [ghas_mul_def, ghas_one_def]
  induction' a using PiTensorProduct.induction_on with r a x y hx hy
  · dsimp only at a
    rw [TensorProduct.tmul_smul, LinearEquiv.map_smul, LinearEquiv.map_smul, ← ghas_mul_def,
      tprod_mul_tprod, cast_tprod]
    congr 2 with i
    rw [Fin.elim0'_append]
    refine' congr_arg a (Fin.ext _)
    simp
  · rw [TensorProduct.tmul_add, map_add, map_add, hx, hy]
#align tensor_power.one_mul TensorPower.one_mul

theorem mul_one {n} (a : (⨂[R]^n) M) : cast R M (add_zero _) (a ₜ* ₜ1) = a :=
  by
  rw [ghas_mul_def, ghas_one_def]
  induction' a using PiTensorProduct.induction_on with r a x y hx hy
  · dsimp only at a
    rw [← TensorProduct.smul_tmul', LinearEquiv.map_smul, LinearEquiv.map_smul, ← ghas_mul_def,
      tprod_mul_tprod R a _, cast_tprod]
    congr 2 with i
    rw [Fin.append_elim0']
    refine' congr_arg a (Fin.ext _)
    simp
  · rw [TensorProduct.add_tmul, map_add, map_add, hx, hy]
#align tensor_power.mul_one TensorPower.mul_one

theorem mul_assoc {na nb nc} (a : (⨂[R]^na) M) (b : (⨂[R]^nb) M) (c : (⨂[R]^nc) M) :
    cast R M (add_assoc _ _ _) (a ₜ* b ₜ* c) = a ₜ* (b ₜ* c) :=
  by
  let mul : ∀ n m : ℕ, (⨂[R]^n) M →ₗ[R] (⨂[R]^m) M →ₗ[R] (⨂[R]^(n + m)) M := fun n m =>
    (TensorProduct.mk R _ _).compr₂ ↑(MulEquiv : _ ≃ₗ[R] (⨂[R]^(n + m)) M)
  -- replace `a`, `b`, `c` with `tprod R a`, `tprod R b`, `tprod R c`
  let e : (⨂[R]^(na + nb + nc)) M ≃ₗ[R] (⨂[R]^(na + (nb + nc))) M := cast R M (add_assoc _ _ _)
  let lhs : (⨂[R]^na) M →ₗ[R] (⨂[R]^nb) M →ₗ[R] (⨂[R]^nc) M →ₗ[R] (⨂[R]^(na + (nb + nc))) M :=
    (LinearMap.llcomp R _ _ _ ((mul _ nc).compr₂ e.to_linear_map)).comp (mul na nb)
  have lhs_eq : ∀ a b c, lhs a b c = e (a ₜ* b ₜ* c) := fun _ _ _ => rfl
  let rhs : (⨂[R]^na) M →ₗ[R] (⨂[R]^nb) M →ₗ[R] (⨂[R]^nc) M →ₗ[R] (⨂[R]^(na + (nb + nc))) M :=
    (LinearMap.llcomp R _ _ _ (LinearMap.lflip R _ _ _) <|
        (LinearMap.llcomp R _ _ _ (mul na _).flip).comp (mul nb nc)).flip
  have rhs_eq : ∀ a b c, rhs a b c = a ₜ* (b ₜ* c) := fun _ _ _ => rfl
  suffices : lhs = rhs
  exact LinearMap.congr_fun (LinearMap.congr_fun (LinearMap.congr_fun this a) b) c
  ext (a b c)
  -- clean up
  simp only [LinearMap.compMultilinearMap_apply, lhs_eq, rhs_eq, tprod_mul_tprod, e, cast_tprod]
  congr with j
  rw [Fin.append_assoc]
  refine' congr_arg (Fin.append a (Fin.append b c)) (Fin.ext _)
  rw [Fin.coe_cast, Fin.coe_cast]
#align tensor_power.mul_assoc TensorPower.mul_assoc

-- for now we just use the default for the `gnpow` field as it's easier.
instance gmonoid : GradedMonoid.GMonoid fun i => (⨂[R]^i) M :=
  { TensorPower.ghasMul,
    TensorPower.ghasOne with
    one_mul := fun a => gradedMonoid_eq_of_cast (zero_add _) (one_mul _)
    mul_one := fun a => gradedMonoid_eq_of_cast (add_zero _) (mul_one _)
    mul_assoc := fun a b c => gradedMonoid_eq_of_cast (add_assoc _ _ _) (mul_assoc _ _ _) }
#align tensor_power.gmonoid TensorPower.gmonoid

/-- The canonical map from `R` to `⨂[R]^0 M` corresponding to the algebra_map of the tensor
algebra. -/
def algebraMap₀ : R ≃ₗ[R] (⨂[R]^0) M :=
  LinearEquiv.symm <| isEmptyEquiv (Fin 0)
#align tensor_power.algebra_map₀ TensorPower.algebraMap₀

theorem algebraMap₀_eq_smul_one (r : R) : (algebraMap₀ r : (⨂[R]^0) M) = r • ₜ1 :=
  by
  simp [algebra_map₀]
  congr
#align tensor_power.algebra_map₀_eq_smul_one TensorPower.algebraMap₀_eq_smul_one

theorem algebraMap₀_one : (algebraMap₀ 1 : (⨂[R]^0) M) = ₜ1 :=
  (algebraMap₀_eq_smul_one 1).trans (one_smul _ _)
#align tensor_power.algebra_map₀_one TensorPower.algebraMap₀_one

theorem algebraMap₀_mul {n} (r : R) (a : (⨂[R]^n) M) :
    cast R M (zero_add _) (algebraMap₀ r ₜ* a) = r • a := by
  rw [ghas_mul_eq_coe_linear_map, algebra_map₀_eq_smul_one, LinearMap.map_smul₂,
    LinearEquiv.map_smul, ← ghas_mul_eq_coe_linear_map, one_mul]
#align tensor_power.algebra_map₀_mul TensorPower.algebraMap₀_mul

theorem mul_algebraMap₀ {n} (r : R) (a : (⨂[R]^n) M) :
    cast R M (add_zero _) (a ₜ* algebraMap₀ r) = r • a := by
  rw [ghas_mul_eq_coe_linear_map, algebra_map₀_eq_smul_one, LinearMap.map_smul,
    LinearEquiv.map_smul, ← ghas_mul_eq_coe_linear_map, mul_one]
#align tensor_power.mul_algebra_map₀ TensorPower.mul_algebraMap₀

theorem algebraMap₀_mul_algebraMap₀ (r s : R) :
    cast R M (add_zero _) (algebraMap₀ r ₜ* algebraMap₀ s) = algebraMap₀ (r * s) :=
  by
  rw [← smul_eq_mul, LinearEquiv.map_smul]
  exact algebra_map₀_mul r (@algebra_map₀ R M _ _ _ s)
#align tensor_power.algebra_map₀_mul_algebra_map₀ TensorPower.algebraMap₀_mul_algebraMap₀

instance gsemiring : DirectSum.Gsemiring fun i => (⨂[R]^i) M :=
  { TensorPower.gmonoid with
    mul_zero := fun i j a => LinearMap.map_zero _
    zero_mul := fun i j b => LinearMap.map_zero₂ _ _
    mul_add := fun i j a b₁ b₂ => LinearMap.map_add _ _ _
    add_mul := fun i j a₁ a₂ b => LinearMap.map_add₂ _ _ _ _
    natCast := fun n => algebraMap₀ (n : R)
    natCast_zero := by rw [Nat.cast_zero, map_zero]
    natCast_succ := fun n => by rw [Nat.cast_succ, map_add, algebra_map₀_one] }
#align tensor_power.gsemiring TensorPower.gsemiring

example : Semiring (⨁ n : ℕ, (⨂[R]^n) M) := by infer_instance

/-- The tensor powers form a graded algebra.

Note that this instance implies `algebra R (⨁ n : ℕ, ⨂[R]^n M)` via `direct_sum.algebra`. -/
instance galgebra : DirectSum.Galgebra R fun i => (⨂[R]^i) M
    where
  toFun := (algebraMap₀ : R ≃ₗ[R] (⨂[R]^0) M).toLinearMap.toAddMonoidHom
  map_one := algebraMap₀_one
  map_mul r s :=
    gradedMonoid_eq_of_cast rfl
      (by
        rw [← LinearEquiv.eq_symm_apply]
        have := algebra_map₀_mul_algebra_map₀ r s
        exact this.symm)
  commutes r x :=
    gradedMonoid_eq_of_cast (add_comm _ _)
      (by
        have := (algebra_map₀_mul r x.snd).trans (mul_algebra_map₀ r x.snd).symm
        rw [← LinearEquiv.eq_symm_apply, cast_symm]
        rw [← LinearEquiv.eq_symm_apply, cast_symm, cast_cast] at this
        exact this)
  smul_def r x :=
    gradedMonoid_eq_of_cast (zero_add x.fst).symm
      (by
        rw [← LinearEquiv.eq_symm_apply, cast_symm]
        exact (algebra_map₀_mul r x.snd).symm)
#align tensor_power.galgebra TensorPower.galgebra

theorem galgebra_toFun_def (r : R) :
    @DirectSum.Galgebra.toFun ℕ R (fun i => (⨂[R]^i) M) _ _ _ _ _ _ _ r = algebraMap₀ r :=
  rfl
#align tensor_power.galgebra_to_fun_def TensorPower.galgebra_toFun_def

example : Algebra R (⨁ n : ℕ, (⨂[R]^n) M) := by infer_instance

end TensorPower


import data.set
import tactic.induction
import data.equiv.denumerable
import data.list
import data.list.sigma

namespace type

@[derive(decidable_eq)]
inductive type (gnd : Type) : Type
| Gnd  : gnd → type
| Unit : type
| Prod : type → type → type
| Fun  : type → type → type

notation `|` G `|` := type.Gnd G
notation `unit`   := type.Unit
infixl ` ∏ `:65 := type.Prod
infixr ` ⊃ `:66 := type.Fun

end type

namespace term

open type

/- λ-calculus terms with a locally nameless representation.

The bound variables are represented by how many abstractions away the
abstraction that bound the variable is. For example,

λx. x (λy. x y) becomes λ (bvar 0) (λ (bvar 1) (bvar 0))

so we do not need the notion of α-equivalence.

The free variables are represented by names, so we can use any type that
  1) is infinite
  2) has decidable equality (decidable_eq)
  3) has a function where given a finite set of names, generates a fresh name
     that does not appear in the set.
ℕ is a good candidate but we just assume an arbitrary `fvar` for this
formalisation.
-/

class fvar (α : Type) :=
[hdec : decidable_eq α]
(fresh : finset α → α)
(hfresh : ∀ S, fresh S ∉ S)

-- Notice that non-finiteness is implied by having the `fresh` function:
instance fvar_is_infinite (α : Type) [fvar α] : infinite α := {
  not_fintype := begin
    intro hfin,
    haveI := hfin,
    have hfresh := fvar.hfresh (@finset.univ α _),
    have hnfresh := @finset.mem_univ α _ (fvar.fresh finset.univ),
    contradiction
  end
}

-- a constant has some given fixed type
class const (α : Type) (gnd : Type) :=
(type_of : α → type gnd)

@[derive(decidable_eq)]
inductive term (gnd con fv : Type) : Type
| Const : con → term
| Bvar  : ℕ → term
| Fvar  : fv → term
| Unit  : term
| Pair  : term → term → term
| Fst   : term → term
| Snd   : term → term
| Abs   : type gnd → term → term -- The bound variable is typed to ensure each
                                 -- term has a unique type.
| App   : term → term → term

notation `|` c `|`                := term.Const c
notation `⌈` i `⌉`                := term.Bvar i
notation `⌊` x `⌋`                := term.Fvar x
notation `⟪⟫`                     := term.Unit
notation `⟪` t1 `, ` t2 `⟫`       := term.Pair t1 t2
notation `fst ` t                  := term.Fst t
notation `snd ` t                  := term.Snd t
notation `Λ ` A `. ` t             := term.Abs A t
infixl    ` ⬝ `:65                 := term.App

variables {gnd con fv : Type} [fvar fv] [const con gnd]
instance : decidable_eq fv := fvar.hdec

def open_term (u : term gnd con fv)
: ℕ → term gnd con fv → term gnd con fv
| k |c| := |c|
| k ⌈i⌉ := if k = i then u else ⌈i⌉
| k ⌊x⌋ := ⌊x⌋
| k ⟪⟫  := ⟪⟫
| k ⟪t1, t2⟫ := ⟪open_term k t1, open_term k t2⟫
| k (fst t) := fst (open_term k t)
| k (snd t) := snd (open_term k t)
| k (Λ A. t) := Λ A. (open_term (k+1) t)
| k (t1 ⬝ t2) := (open_term k t1) ⬝ (open_term k t2)

def open_var (x : fv) (n : ℕ) (t : term gnd con fv) := open_term ⌊x⌋ n t

def close_var (x : fv) : ℕ → term gnd con fv → term gnd con fv
| k |c| := |c|
| k ⌈i⌉ := ⌈i⌉
| k ⌊y⌋ := if x = y then ⌈k⌉ else ⌊y⌋
| k ⟪⟫  := ⟪⟫
| k ⟪t1, t2⟫ := ⟪close_var k t1, close_var k t2⟫
| k (fst t) := fst (close_var k t)
| k (snd t) := snd (close_var k t)
| k (Λ A. t) := Λ A. (close_var (k+1) t)
| k (t1 ⬝ t2) := (close_var k t1) ⬝ (close_var k t2)

def free_vars : term gnd con fv → finset fv
| |c| := ∅
| ⌈i⌉ := ∅
| ⌊y⌋ := {y}
| ⟪⟫  := ∅
| ⟪t1, t2⟫ := free_vars t1 ∪ free_vars t2
| (fst t) := free_vars t
| (snd t) := free_vars t
| (Λ A. t) := free_vars t
| (t1 ⬝ t2) := free_vars t1 ∪ free_vars t2

lemma free_vars_open_term (t1 t2 : term gnd con fv) (n : ℕ)
: free_vars (open_term t2 n t1) = free_vars t1 ∪ free_vars t2 ∨
  free_vars (open_term t2 n t1) = free_vars t1 :=
begin
  induction t1 generalizing n,
  case term.term.Const : t1 n
  { right, simp [free_vars, open_term] },
  case term.term.Bvar : t1 n
  { simp only [free_vars, open_term, finset.empty_union], split_ifs,
    { left, refl },
    { right, unfold free_vars }
  },
  case term.term.Fvar : t1 n
  { right, simp [free_vars, open_term] },
  case term.term.Unit : n
  { right, simp [free_vars, open_term] },
  case term.term.Pair : t1l t1r ihl ihr n
  { simp only [free_vars, open_term, finset.union_assoc],
    specialize ihl n, specialize ihr n,
    with_cases { cases ihl; cases ihr; rw [ihl, ihr] },
    case or.inl or.inl
    { left,
      rw [←finset.union_assoc _ (free_vars t1r) (free_vars t2)],
      rw [finset.union_assoc _ (free_vars t2) (free_vars t1r)],
      rw [finset.union_comm (free_vars t2) (free_vars t1r)],
      simp only [finset.union_assoc, finset.union_right_idem],
    },
    case or.inl or.inr
    { left, ac_refl },
    case or.inr or.inl
    { left, ac_refl },
    case or.inr or.inr
    { right, ac_refl }
  },
  case term.term.Fst : t1 ih n
  { simp only [free_vars, open_term], exact ih n },
  case term.term.Snd : t1 ih n
  { simp only [free_vars, open_term], exact ih n },
  case term.term.Abs : A t1 ih n
  { simp only [free_vars, open_term], exact ih (n + 1) },
  case term.term.App : t1l t1r ihl ihr n
  { simp only [free_vars, open_term, finset.union_assoc],
    specialize ihl n, specialize ihr n,
    with_cases { cases ihl; cases ihr; rw [ihl, ihr] },
    case or.inl or.inl
    { left,
      rw [←finset.union_assoc _ (free_vars t1r) (free_vars t2)],
      rw [finset.union_assoc _ (free_vars t2) (free_vars t1r)],
      rw [finset.union_comm (free_vars t2) (free_vars t1r)],
      simp only [finset.union_assoc, finset.union_right_idem],
    },
    case or.inl or.inr
    { left, ac_refl },
    case or.inr or.inl
    { left, ac_refl },
    case or.inr or.inr
    { right, ac_refl }
  }
end

lemma free_vars_open_term' (t1 t2 : term gnd con fv) (n : ℕ)
: free_vars (open_term t2 n t1) ⊆ free_vars t1 ∪ free_vars t2 :=
begin
  cases free_vars_open_term t1 t2 n,
  { rw h, simp },
  { rw h, exact (free_vars t1).subset_union_left (free_vars t2) }
end

lemma free_vars_open_var (t1 : term gnd con fv) (x : fv) (n : ℕ)
: free_vars (open_var x n t1) = free_vars t1 ∪ {x} ∨
  free_vars (open_var x n t1) = free_vars t1 :=
free_vars_open_term t1 ⌊x⌋ n

notation x ` # ` t := x ∉ free_vars t
abbreviation closed (t : term gnd con fv) := free_vars t = ∅

inductive locally_closed : finset fv → term gnd con fv → Type
| Const : ∀ {Γ c},
----------------------
locally_closed Γ (|c|)

| Fvar : ∀ {Γ x},
x ∈ Γ
----------------------
→ locally_closed Γ ⌊x⌋

| Unit : ∀ {Γ},
-------------------
locally_closed Γ ⟪⟫

| Pair : ∀ {Γ t1 t2},
locally_closed Γ t1 → locally_closed Γ t2
-----------------------------------------
→ locally_closed Γ ⟪t1, t2⟫

| Fst : ∀ {Γ t},
locally_closed Γ t
--------------------------
→ locally_closed Γ (fst t)

| Snd : ∀ {Γ t},
locally_closed Γ t
------------------------
→ locally_closed Γ (snd t)

-- The locally nameless paper says this should be
-- ∃ L : finset fv, ∀ x ∉ L, locally_closed (open_var x 0 t)
-- but in Lean3 constructor arguments can't be inside another inductive type
-- so I have to use a Γ to explicitly track the abstracted variables, which
-- makes the
-- representation even more complicated...
| Abs : ∀ {Γ A t},
(∀ x ∉ free_vars t ∪ Γ, locally_closed (insert x Γ) (open_var x 0 t))
-------------------------------------------------------------------------
→ locally_closed Γ (Λ A. t)

| App : ∀ {Γ t1 t2},
locally_closed Γ t1 → locally_closed Γ t2
-------------------------------------
→ locally_closed Γ (t1 ⬝ t2)

def subst (u : term gnd con fv) (x : fv)
: term gnd con fv → term gnd con fv
| ⌈i⌉ := ⌈i⌉
| |c| := |c|
| ⌊y⌋ := if x = y then u else ⌊y⌋
| ⟪⟫  := ⟪⟫
| ⟪t1, t2⟫ := ⟪subst t1, subst t2⟫
| (fst t) := fst (subst t)
| (snd t) := snd (subst t)
| (Λ A. t) := Λ A. (subst t)
| (t1 ⬝ t2) := (subst t1) ⬝ (subst t2)

theorem open_term_eq_subst_of_open_var (t u : term gnd con fv) (x : fv) (n : ℕ)
(hx : x # t) : open_term u n t = subst u x (open_var x n t) :=
begin
  induction' t generalizing n,
  case term.term.Const : c
  { simp only [open_term, open_var, subst] },
  case term.term.Bvar : n
  { simp only [open_term, open_var],
    split_ifs,
    { simp [subst], },
    { simp [subst], }
  },
  case term.term.Fvar : x_1
  { simp only [open_term, open_var, subst],
    split_ifs,
    { simp only [free_vars, finset.mem_singleton] at hx, contradiction },
    { refl } },
  case term.term.Unit
  { simp only [open_term, open_var, subst] },
  case term.term.Pair : t1 t2 ih1 ih2
  { simp only [free_vars, not_or_distrib, finset.mem_union] at hx,
    specialize ih1 n hx.left,
    specialize ih2 n hx.right,
    simp only [open_term, open_var, subst],
    simp only [open_var] at ih1 ih2,
    exact ⟨ih1, ih2⟩
  },
  case term.term.Fst : t ih
  { simp only [free_vars] at hx,
    specialize ih n hx,
    simp only [open_term, open_var, subst],
    simp only [open_var] at ih,
    exact ih
  },
  case term.term.Snd : t ih
  { simp only [free_vars] at hx,
    specialize ih n hx,
    simp only [open_term, open_var, subst],
    simp only [open_var] at ih,
    exact ih
  },
  case term.term.Abs : A t ih
  { simp only [free_vars] at hx,
    specialize ih (n + 1) hx,
    simp only [open_term, open_var, subst],
    simp only [open_var] at ih,
    exact ⟨rfl, ih⟩
  },
  case term.term.App : t1 t2 ih1 ih2
  { simp only [free_vars, not_or_distrib, finset.mem_union] at hx,
    specialize ih1 n hx.left,
    specialize ih2 n hx.right,
    simp only [open_term, open_var, subst],
    simp only [open_var] at ih1 ih2,
    exact ⟨ih1, ih2⟩
  }
end

end term