/-
Copyright 2022 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    https://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

Authors: Moritz Firsching, Christopher Schmidt
-/
import tactic
import tactic.qify
import ring_theory.prime
import data.list.prime
import data.nat.sqrt
--set_option trace.simp_lemmas true

open nat
open finset

open_locale nat big_operators
/-!
# Binomial coefficients are (almost) never powers
## TODO
  - Lemmata
  - (1)
  - (2)
  - (3)
  - (4)
### Sylvester's Theorem
There is no proof given in the book, perhaps check out Erdős' for a proof to formalize.
-/
theorem sylvester (k n : ℕ) (h : n ≥ 2*k): ∃ p, p > k ∧ prime p ∧ p ∣ choose n k :=
begin
  sorry,
end

/-!
### Lemmata for Step 1 and Step 2
-/
example (a p : ℕ) (h : p ∣ a) (g : a < p): a = 0 :=
begin
  exact eq_zero_of_dvd_of_lt h g,
end

lemma prime_div_desc_fac (n k m l p : ℕ) (h_1lel : 1 ≤ l) (h_4lek : 4 ≤ k) (h_klen : k ≤ n)
  (h_p : prime p) (h_p_div_binom : p ∣ choose n k) (h_klp : k < p) (H : choose n k = m^l) :
  p^l ∣ n.desc_factorial k :=
begin
  have h_p_div_ml : p ∣ m^l := by
  { rw ← H,
    exact h_p_div_binom, },
  have h_pl_div_ml : p^l ∣ m^l := by
  { have help : p ∣ m := by
    { exact prime.dvd_of_dvd_pow (h_p)(h_p_div_ml), },
    exact pow_dvd_pow_of_dvd help l, },
  have h_pl_div_binom : p^l ∣ choose n k := by
  { rw H,
    exact h_pl_div_ml, },
  have h_pl_div_fac : p^l ∣ (n.factorial / (k.factorial * (n-k).factorial)) := by
  { rw ← nat.choose_eq_factorial_div_factorial h_klen,
    exact h_pl_div_binom, },
  -- here we start using qify to handle division
  have h_fac_div : (↑k! * ↑(n - k)!) ∣ (n! : ℤ) := by
  { norm_cast,
    exact factorial_mul_factorial_dvd_factorial h_klen, },
  have h_fac_div' : ↑(n - k)! ∣ (n! : ℤ) := dvd_of_mul_left_dvd h_fac_div,
  have h_fac_div'' :  (k! : ℤ) ∣ (↑n! / ↑(n - k)!) := by
  { norm_cast,
    refine (dvd_div_iff ((int.coe_nat_dvd).mp h_fac_div')).mpr _,
    norm_cast at h_fac_div,
    rw mul_comm,
    exact h_fac_div, },
  have h_kfac_ne_zero : (k! : ℚ) ≠ 0 := cast_ne_zero.mpr (factorial_ne_zero k),
  have h_nkfac_ne_zero : ((n - k)! : ℚ) ≠ 0 := cast_ne_zero.mpr (n - k).factorial_ne_zero,
  have : (k! * (n - k)! : ℚ) ≠ 0 := mul_ne_zero h_kfac_ne_zero h_nkfac_ne_zero,
  have h_fraction: (n.factorial / (k.factorial * (n - k).factorial)) =
    (n.factorial / (n - k).factorial) / k.factorial := by
  { zify,
    qify,
    field_simp,
    rw mul_comm,
    left,
    refl, },
  rw h_fraction at h_pl_div_fac,
  have h_pl_div_fac_part: p^l ∣ (n.factorial / (n - k).factorial) := by
  { have h_eq_pl_with_k := exists_eq_mul_right_of_dvd h_pl_div_fac,
    have h_eq_pl : ∃ (r : ℕ), r * p^l = n.factorial / (n - k).factorial := by
    { cases h_eq_pl_with_k with j h_eq,
      use (j * k.factorial),
      have h_rew : j * k.factorial * p^l = p^l * j * k.factorial := by
      { simp only [mul_comm, mul_assoc], },
      rw h_rew,
      rw ← h_eq,
      zify,
      qify,
      field_simp,
      rw mul_comm ((n - k)! : ℚ) _,
      rw mul_assoc, },
    cases h_eq_pl with j h_eq,
    exact dvd.intro_left j h_eq, },
    convert  h_pl_div_fac_part,
    exact desc_factorial_eq_div h_klen,
end

lemma desc_factorial_eq_prod (n : ℕ) : ∀ (k : ℕ), k ≤ n →
  n.desc_factorial k = ∏ i in range k, (n - i) :=
begin
  induction n with n hn,
  { intros h h_klen,
    rw le_zero_iff.mp h_klen,
    simp only [nat.desc_factorial_zero, zero_tsub, range_zero, prod_const, card_empty, pow_zero], },
  { intro k,
    cases k,
    { have := hn 0 (zero_le n),
      intros hsucc,
      simp only [nat.desc_factorial_zero, range_zero, prod_empty], },
    { intro h_klenn,
    rw nat.succ_desc_factorial_succ,
    have h_4lek_n := nat.succ_le_succ_iff.mp h_klenn,
    rw hn k h_4lek_n,
    rw prod_range_succ',
    simp only [nat.succ_sub_succ_eq_sub, tsub_zero],
    rw mul_comm,}, },
end

lemma prime_dvd_prod (p : ℕ) (hp : prime p) {s : finset ℕ } {f : ℕ → ℕ}:
p ∣ ∏ i in s, f i → ∃ i, i ∈ s ∧ p ∣ (f i) :=
begin
  rw ← prod_to_list,
  intro h,
  have := (prime.dvd_prod_iff (hp)).mp h,
  cases this with i hi,
  simp at hi,
  cases hi with hi hpi,
  cases hi with j hj,
  use j,
  cases hj,
  rw ← hj_right at hpi,
  exact ⟨hj_left, hpi⟩,
end

lemma desc_factorial_div_fac (n k p : ℕ) (h_klen : k ≤ n) (hp : _root_.prime p)
(h : p ∣ n.desc_factorial k) : ∃ i ∈ range k, p ∣ n - i :=
begin
  rw desc_factorial_eq_prod n k h_klen at h,
  convert prime_dvd_prod p hp h,
  simp only [mem_Ico, zero_le', true_and, exists_prop, mem_range],
end

lemma factor_in_desc_factorial (n k p l : ℕ) (h_klen : k ≤ n) (h_klp : k < p) (hp: _root_.prime p )
(h_pow_div: p^l ∣ n.desc_factorial k) ( h_1lel : 1 ≤ l):
∃ (i : ℕ), (i ≤ k - 1) ∧ p^l ∣ (n - i) :=
begin
have h_one_fac : 1 ≤ l → ∃! i ∈ (range k), p ∣ (n - i) := by
{ intro hl,
  have h_exists : ∃ (i : ℕ), i  ∈ (range k) ∧ p ∣ (n - i) := by
  { have h_div : p ∣ n.desc_factorial k := by
    { have h_p_div_pl : p ∣ p^l := by
      { nth_rewrite 0 ←pow_one p,
        exact pow_dvd_pow p hl, },
      exact dvd_trans h_p_div_pl h_pow_div, },
    have := desc_factorial_div_fac n k p h_klen hp h_div,
    cases this with j hj,
    use j,
    simp at hj,
    cases hj,
    exact ⟨mem_range.mpr hj_left, hj_right ⟩, },
  cases h_exists with i h_i,
  have h_unique : (i ∈ range k ∧ p ∣ n - i) ∧
                 ∀ (y : ℕ), y ∈ range k → p ∣ n - y → y = i := by
  { split,
    {exact h_i,},
    { cases h_i,
      intros j h_j_left h_j_right,
      simp only [nat.Ico_zero_eq_range, mem_range] at h_j_left,
      simp only [nat.Ico_zero_eq_range, mem_range] at h_i_left,
      cases h_j_right with q_j,
      cases h_i_right with q_i,
      have h_in : i ≤ n := le_trans (le_of_lt h_i_left) h_klen,
      have h_jn : j ≤ n := le_trans (le_of_lt h_j_left) h_klen,
      zify at *,
      have h_i_sub_j : (i : ℤ) - j = p*(q_j - q_i) := by
      { have h : (n : ℤ) - j - (n - i) = p * q_j - p * q_i :=
          congr (congr_arg has_sub.sub h_j_right_h) h_i_right_h,
        simp only [sub_sub_sub_cancel_left] at h,
        rw mul_sub,
        exact h,},
      have h_abs : |(i : ℤ) - j| < k := by
      { have h_pos : (i : ℤ) - j < k - 0 := by
        { have h_help : 0 ≤ j := by
          { exact zero_le j, },
          zify at h_help,
          exact int.sub_lt_sub_of_lt_of_le h_i_left h_help, },
        simp only [tsub_zero] at h_pos,
        have h_neg : -((i : ℤ) - j) < k - 0 := by
        { simp only [neg_sub],
          exact int.sub_lt_sub_of_lt_of_le h_j_left (cast_nonneg i), },
        simp only [neg_sub, tsub_zero] at h_neg,
        cases em ((i : ℤ) - j ≤ 0),
        { have h_help : |(i : ℤ) - j | = -(i - j) := abs_of_nonpos h,
          rw h_help,
          norm_num,
          exact h_neg, },
        { have : (i : ℤ) - j ≥ 0 := by { exact le_of_not_ge h, },
          have h_help : |(i : ℤ) - j| = i - j := abs_of_nonneg this,
          rw h_help,
          exact h_pos, }, },
      have h_abs' : |(i : ℤ) - j| < p := by
      { exact lt_trans h_abs h_klp, },
      have h_abs_div: (p : ℤ) ∣ |(i : ℤ) - j| := by
      { simp only [dvd_abs],
        use (↑q_j - (q_i : ℤ)),
        exact h_i_sub_j, },
      have h_q_diff_zero : |((i : ℤ) - j)| = 0 :=
        int.eq_zero_of_dvd_of_nonneg_of_lt (abs_nonneg (↑i - ↑j)) h_abs' h_abs_div,
      have h_diff : (i : ℤ) - j = 0 := by
      { exact abs_eq_zero.mp h_q_diff_zero, },
      have h_help : (i : ℤ) = j := by
      { exact sub_eq_zero.mp h_diff},
      exact eq.symm h_help, }, },
  refine ⟨i, _⟩,
  simp only [true_and, exists_unique_iff_exists, exists_prop, and_imp],
  exact h_unique, },
  -- new Version

  -- tbc

--induction l with l hl,
--{ use 0,
  --simp only [zero_le', pow_zero, is_unit.dvd, is_unit_one, and_self], },
--{ have h_klp_prod: p ^ l * p = p ^ l.succ := by
  --{ nth_rewrite 1 ←pow_one p,
    --rw ←pow_add p _ _ , },
  --have one_le_succ: 1 ≤ l.succ := by
  --{ rw nat.succ_eq_add_one, simp only [le_add_iff_nonneg_left, zero_le'], },
  --replace h_one_fac := h_one_fac one_le_succ,
  --cases h_one_fac with i hi,
  --simp at hi,
  --use i,
  --sorry,
  --},
  sorry,
end

lemma factor_in_desc_factorial2 (n k p l : ℕ) (h_klen : k ≤ n) (h_klp : k < p) (hp: _root_.prime p )
(h_pow_div: p^l ∣ n.desc_factorial k) ( h_1lel : 1 ≤ l):
∃! (i : ℕ), (i ≤ k - 1) ∧ p^l ∣ (n - i) :=
begin
  sorry,
end

/-!
### Lemmata for Step 2
-/
definition power_div (l z : ℕ) := (finset.range (z + 1)).filter (λ i, i^l ∣ z)

lemma power_div_nonempty (l z : ℕ) : (power_div l z).nonempty :=
begin
 cases (em (0 < z)),
  { use 1,
    rw power_div,
    simp only [mem_filter, mem_range, add_pos_iff, lt_one_iff, eq_self_iff_true,
     or_true, true_and],
    split,
    { exact succ_lt_succ h, },
    { simp only [one_pow, is_unit.dvd, is_unit_one], }, },
  { use 0,
    rw power_div,
    simp only [not_lt, le_zero_iff] at h,
    simp only [mem_filter, mem_range, add_pos_iff, lt_one_iff, eq_self_iff_true, or_true, true_and],
    rw h,
    simp only [dvd_zero],},
end

definition largest_power_divisor (l z : ℕ) : ℕ := (power_div l z).max' (power_div_nonempty l z)

lemma largest_power_divisor_divides (l z : ℕ) : (largest_power_divisor l z)^l ∣ z :=
begin
  have h := (power_div l z).max'_mem (power_div_nonempty l z),
  rw ←largest_power_divisor at h,
  have : (power_div l z) = (finset.range (z + 1)).filter (λ i, i^l ∣ z) := by refl,
  rw this at h,
  simp at h,
  exact h.2,
end

definition mFct (l n : ℕ) : ℕ → ℕ := λ j, (largest_power_divisor l (n - j))

definition aFct (l n : ℕ) : ℕ → ℕ := λ j, (n - j)/(mFct l n j)^l

lemma decompose_n_j (n j l : ℕ) : n - j = (aFct l n j)*(mFct l n j)^l :=
begin
  have : (mFct l n j)^l ∣ n - j := largest_power_divisor_divides l (n - j),
  rw aFct,
  rw nat.div_mul_cancel this,
end

lemma not_lthpow_dvd_a (p l n j : ℕ) (h_p : prime p): ¬ (p^l ∣ (aFct l n j)) :=
begin
  -- maybe different approach needed
  by_contra,
  have h_pl_div_nj : p^l ∣ n - j := by
  { rw decompose_n_j n j l,
    exact dvd_mul_of_dvd_left h (mFct l n j ^ l), },
  have h_pl_div_ml : p^l ∣ (mFct l n j)^l := by
  { dsimp only [mFct],
    have h_lpd_div_nj := largest_power_divisor_divides l (n - j),
    by_contra,
    have h_not_pl_div_nj : ¬(p^l ∣ (n - j)) := by
    { sorry, },
    exact h (false.rec (p ^ l ∣ largest_power_divisor l (n - j) ^ l) (h_not_pl_div_nj h_pl_div_nj)), },
  sorry,
end

/-!
### Lemmata for Step 3
-/
definition s_1tok (k : ℕ) := (finset.range (k + 1)).filter(λ i, 1 ≤ i ∧ i ≤ k)

definition a_values (l n k : ℕ) := finset.image (aFct l n) (range k)

lemma fac_eq_prod (n : ℕ) : n.factorial = ∏ i in Icc 1 n, i :=
begin
  induction n with n h_ind,
  -- induction start
  { simp only [factorial_zero, Icc_eq_empty_of_lt, lt_one_iff, prod_empty], },
  -- indcution step
  { simp only [factorial_succ],
    rw h_ind,
    have h_help : Icc 1 n.succ = (Icc 1 n) ∪ (singleton n.succ) := by
    { refine subset.antisymm _ _,
      -- left in right
      { intros k hk,
        simp only [mem_union, mem_Icc, mem_singleton],
        simp at hk,
        cases em (k ≤ n),
        { left,
          split,
          { exact hk.left, },
          { exact h, }, },
        { right,
          simp only [not_le] at h,
          have h2 := hk.right,
          exact ge_antisymm (succ_le_iff.mpr (h)) h2,}, },
      -- right in left
      { intros k hk,
        simp only [mem_union, mem_Icc, mem_singleton],
        simp at hk,
        cases hk with hk1 hk2,
        { split,
          { exact hk1.left, },
          { have := hk1.right,
            exact le_succ_of_le this, }, },
        { split,
          { rw hk2,
            have help : 0 < n.succ := by
            { exact ne_zero.pos (succ n), },
            exact succ_le_iff.mpr help, },
          { exact (eq.symm hk2).ge}, }, }, },
    have h_help2 : disjoint (Icc 1 n) (singleton n.succ) := by
    { simp only [disjoint_singleton_right, mem_Icc, not_and, not_le],
      intro p,
      rw nat.succ_eq_one_add,
      simp only [lt_add_iff_pos_left, lt_one_iff], },
    rw h_help,
    have h := prod_union h_help2,
    rw h,
    simp,
    apply mul_comm, },
end

/-!
### Lemmata for Step 4
-- maybe we do not need those
-/
lemma h_mul_div (a b : ℕ) (h_b : b ≠ 0) : a * b / b = 1 :=
begin
  sorry,
end

lemma h_div_mul (a b : ℕ) (h_b : b ≠ 0) : a / b * b = 1 :=
begin
  sorry,
end

/-
### Erdo's Theorem
Using ℕ instead of ℤ here, because of the definition of `choose` and because of the inequalities.
-/
theorem binomials_coefficients_never_powers (k l m n : ℕ) (h_2lel : 2 ≤ l) (h_4lek : 4 ≤ k)
(h_klen4 : k ≤ n - 4) : choose n k ≠ m^l :=
begin
  -- Assumption that n ≥ 2k
  have h_wlog : ∀ (k' : ℕ) (h_4lek' : 4 ≤ k') (h_klen4' : k' ≤ n - 4), 2*k' ≤ n → choose n k' ≠ m^l := by
  { clear h_4lek h_klen4 k,
    intros k h_4lek h_klen4 h,
    -- inequalities needed
    have h_klen : k ≤ n := le_trans h_klen4 (nat.sub_le n 4),
    have h_1lel : 1 ≤ l := le_of_succ_le (h_2lel),
    -- proof by contradiciton
    by_contra H,
    -- main proof here proceeding in four steps
    -- STEP (1) : ∃ p prim : n ≥ p^l > k^l ≥ k²
    have h₁: ∃ p, prime p ∧ p^l ≤ n ∧ k^l < p^l ∧ k^2 ≤ k^l := by
    { have h_sylvester := sylvester k n h,
      cases h_sylvester with p hp,
      cases hp with h_klp h_right,
      cases h_right with h_p h_p_div_binom,
      use p,
      split,
      -- prove that p is prim
      { exact h_p, },
      { split,
        -- prove p^l ≤ n
        { -- use of lemmata
          have h_pl_div_desc: p^l ∣ n.desc_factorial k := by
          { exact prime_div_desc_fac n k m l p h_1lel h_4lek h_klen h_p h_p_div_binom h_klp H, },
          have h_klp_pow_dvd := factor_in_desc_factorial n k p l h_klen (gt_iff_lt.mp h_klp) (h_p)
            h_pl_div_desc h_1lel,
          -- working with them
          cases h_klp_pow_dvd with i hi,
          cases hi,
          have : p^l ≤ n - i := by
          { refine  nat.le_of_dvd _ hi_right,
            simp only [tsub_pos_iff_lt],
            have h_ilk : i < k := by
            { have hk : 0 < k := lt_of_lt_of_le four_pos h_4lek,
              zify at hi_left,
              zify,
              exact int.lt_of_le_sub_one hi_left, },
            exact lt_of_lt_of_le h_ilk h_klen, },
          have h_klen4i : n - i ≤ n := nat.sub_le n i,
          exact le_trans this h_klen4i, },
        { split,
          -- prove k^l < p^l
          { exact nat.pow_lt_pow_of_lt_left (h_klp)(gt_of_ge_of_gt h_2lel two_pos), },
          -- prove k² ≤ k^l
          { exact nat.pow_le_pow_of_le_right (pos_of_gt h_4lek) h_2lel,  }, }, }, },
    -- STEP (2) : aⱼ only have prime divisors ≤ k ; aᵢ ≠ aⱼ
    have h₂ : ∀ (j ≤ k - 1),
      (∀ (q : ℕ), q ∣ (aFct l n j) ∧ prime q → q ≤ k) ∧
      (∀ i ≤ k - 1, i ≠ j → (aFct l n i) ≠ (aFct l n j)) := by
    { intros j h_jlek1,
      split,
      -- First Claim: aⱼ only have prime divisors ≤ k
      { intros q hq,
        cases hq with h_q_div_a h_q,
        by_contra h_klq,
        simp only [not_le] at h_klq,
        -- pre work, important result q ∣ n - j and q ∣ choose n k
        have h_q_div_nj : q ∣ (n - j) := by
        { have h_q_div_am := dvd_mul_of_dvd_left h_q_div_a (mFct l n j),
          have h_am_eq_nj : aFct l n j * mFct l n j = n - j := by
          { sorry, },
          rw ← h_am_eq_nj,
          exact h_q_div_am, },
        have h_q_div_desc_fact : q ∣ n.desc_factorial k := by
        { sorry, },
        have h_q_div_binom : q ∣ choose n k := by
        { have h_q_div_desc_fact : q ∣ n.desc_factorial k := by
          { sorry, },
          have h_descfac_div_binom : n.desc_factorial k ∣ choose n k := by
          { sorry, },
          exact dvd_trans h_q_div_desc_fact h_descfac_div_binom, },
        -- introducing lemmata by using q ∣ choose n k
        have h_ql_div_desc: q^l ∣ n.desc_factorial k := by
          { exact prime_div_desc_fac n k m l q h_1lel h_4lek h_klen h_q h_q_div_binom h_klq H, },
        have h_klp_pow_dvd := factor_in_desc_factorial2 n k q l h_klen (gt_iff_lt.mp h_klq) (h_q)
            h_ql_div_desc h_1lel,
        -- working with lemmata
        cases h_klp_pow_dvd with i hi,
        cases hi with h_ex h_uni,
        cases h_ex,
        have h_qldivam : q^l ∣ ((aFct l n i) * (mFct l n i)^l) := by
        { rw ← decompose_n_j n i l,
          exact h_ex_right, },
        have h_qdivml : q ∣ (mFct l n i)^l := by
        { have h_not_ql_div_a := not_lthpow_dvd_a q l n i h_q,
          sorry, },
        have h_qldivml : q^l ∣ (mFct l n i)^l := by
        { have h_qdivm : q ∣ (mFct l n i) := by
          { exact prime.dvd_of_dvd_pow h_q h_qdivml, },
          exact pow_dvd_pow_of_dvd h_qdivm l, },
        have h_qnotdiva : ¬ (q ∣ (aFct l n i)) := by
        { sorry, },
        -- applying result of lemmata by using q ∣ n - j
        have h_ieqj : j = i := by
        { sorry, },
        rw h_ieqj at h_q_div_a,
        exact h_qnotdiva h_q_div_a, },
      -- Second Claim : aᵢ ≠ aⱼ
      { intros i h_ilek1 h_inej,
        -- here we perform the proof by contradiciton which we will use for both cases below
        have h_cases : ∀ (x y : ℕ), (x ≤ k - 1 ∧ y ≤ k - 1 ∧ x < y) → aFct l n x ≠ aFct l n y := by
        { intros x y h,
          cases h with h_x h,
          cases h with h_y h_xley,
          by_contra,
          -- will help us rewriting
          have h_mjlmi : (mFct l n j) + 1 ≤ mFct l n i := by
          { have h_njlni : n - i < n - j := by
            { sorry, },
            have h_amjlami : (aFct l n j) * (mFct l n j)^l < (aFct l n i) * (mFct l n i)^l := by
            { sorry, },
            have h_mjlmi_pow : (mFct n l j)^l < (mFct n l i)^l := by
            { sorry, },
            have h_mjlmi : mFct n l j < mFct n l i := by
            { sorry, },
            sorry, },
          -- n < k²
          have h_sqrtnlk : n.sqrt < k := by
          { have h_ineq1 : n.sqrt < l * (n / 2 + 1).sqrt := by
            { sorry, },
            have h_ineq2 : l * (n / 2 + 1).sqrt ≤ l * (n - k + 1).sqrt := by
            { sorry, },
            have h_ineq3 : l * (n - k + 1).sqrt ≤
              l * ((aFct l n j) * (mFct l n j)^l).sqrt := by
            { sorry, },
            have h_ineq4 : l * ((aFct l n j) * (mFct l n j)^l).sqrt ≤
              (aFct l n j) * l * (mFct l n j)^(l - 1) := by
            { sorry, },
            have h_ineq5 : (aFct l n j) * l * (mFct l n j)^(l - 1) ≤
              (aFct l n j) * ((mFct l n j + 1)^l - (mFct l n j)^l) := by
            { sorry, },
            have h_ineq6 : (aFct l n j) * ((mFct l n j + 1)^l - (mFct l n j)^l) ≤
              (aFct l n j) * ((mFct l n i)^l * (mFct l n j)^l) := by
            { sorry, },
            have h_eq7 : (aFct l n j) * ((mFct l n i)^l * (mFct l n j)^l) = (n - i) - (n - j) := by
            { sorry, },
            have h_eq8 :  (n - i) - (n - j) = j - i := by
            { sorry, },
            have h_ineq9 : j - i < k := by
            { sorry, },
            linarith, },
          have h_nlk2 : n < k^2 := by
          { exact sqrt_lt'.mp h_sqrtnlk, },
          -- usage of h₁ : k² < n
          cases h₁ with p h,
          cases h with h_p h,
          cases h with hplen h,
          cases h with h_kllpl h_k2kl,
          have h_from1 : k^2 < n := by
          { have h_k2lpl : k^2 < p^l := gt_of_gt_of_ge h_kllpl h_k2kl,
            exact gt_of_ge_of_gt hplen h_k2lpl, },
          exact nat.lt_asymm h_nlk2 h_from1, },
        cases em (i < j),
        { -- case i < j using h_cases
          have h_casesij := h_cases i j,
          have h_help : i ≤ k - 1 ∧ j ≤ k - 1 ∧ i < j := by
          { split,
            { exact h_ilek1, },
            { split,
              { exact h_jlek1, },
              { exact h_1, }, }, },
          exact h_casesij h_help, },
        { -- case i > j using h_cases
          simp only [not_lt] at h_1,
          have h_1' := (ne.symm h_inej).lt_of_le h_1,
          have h_casesji := h_cases j i,
          have h_help : j ≤ k - 1 ∧ i ≤ k - 1 ∧ j < i := by
          { split,
            { exact h_jlek1, },
            { split,
              { exact h_ilek1, },
              { exact h_1', }, }, },
          exact ne.symm (h_cases j i h_help), }, }, },
    -- STEP (3) : a_i are integers 1..k
    have h₃ : a_values l n k = s_1tok k := by
    { dsimp only [a_values, s_1tok],
      have h_div : (∏ i in (a_values l n k), i) ∣ k.factorial := by
      { sorry, },
      have h_eq : (∏ i in (a_values l n k), i) = k.factorial := by
      { sorry, },
      rw fac_eq_prod at h_eq,
      sorry, },
    -- divide in two cases
    cases em (l = 2),
    -- Special Case l = 2 by Contradicition
    { have h_4ins : 4 ∈ (s_1tok k) := by
      { dsimp only [s_1tok],
        simp only [mem_filter, mem_range, one_le_bit0_iff, succ_pos', true_and],
        split,
        { exact lt_succ_iff.mpr h_4lek, },
        { exact h_4lek, }, },
      have h_4inavalues : 4 ∈ (a_values l n k) := by
      { rw h₃,
        exact h_4ins, },
      have h_avalue4 : ∃ (j ∈ range k), aFct l n j = 4 := by
      { sorry, },
      cases h_avalue4 with j hj,
      cases hj with h_j h_ais4,
      have h_a : aFct l n j = 2^l := by
      { have h_help : 2 * 2 = 4 := by
        { sorry, },
        rw h_1,
        rw h_1 at h_ais4,
        rw sq 2,
        rw h_help,
        exact h_ais4, },
      dsimp only [aFct] at h_a,
      dsimp only [mFct] at h_a,
      sorry, },
    -- STEP (4) : l ≥ 3 by Contradiciton
    { -- case l ≥ 3
      have h_3lel : 3 ≤ l := by
      { have h_2ll :=(ne.symm h_1).lt_of_le h_2lel,
        exact succ_le_iff.mpr h_2ll, },
      -- main work : n < k³
      have h₄ : n < k^3 := by
      { have h_intro : ∃ (i1 i2 i3 : ℕ), aFct l n i1 = 1 ∧ aFct l n i2 = 2 ∧ aFct l n i3 = 4 := by
        { sorry, },
        cases h_intro with i1 h,
        cases h with i2 h,
        cases h with i3 h,
        cases h with h_a1 h,
        cases h with h_a2 h_a3,
        have h_ineqm : (mFct l n i2)^2 ≠ (mFct l n i1) * (mFct l n i2) := by
        { sorry, },
        -- cases for m₂² ≠ m₁ * m₃
        cases em ((mFct l n i2)^2 > (mFct l n i1) * (mFct l n i3)),
        { -- that is the case being covered in the book
          have h_ineq1 : k * n^(2 / 3) > n := by
          { have h_ineq2 : 2 * (k - 1) * n * (mFct l n i1) * (mFct l n i3) > 2 * n^2 := by
            { have h_ineq3 : 2 * (k - 1) * n > 4 * l * (mFct l n i1)^(l - 1) * (mFct l n i3)^(l - 1) := by
              { sorry, },
              sorry, },
            sorry, },
          sorry, },
        { -- that is the case not being covered in the book
          sorry, }, },
      -- using step 1 for k³ < n
      cases h₁ with p h,
      cases h with h_p h,
      cases h with h_plen h,
      cases h with h_kllpl h_k2kl,
      have h_k3ln : k^3 < n := by
      { have h_k3lpl : k^3 < p^l := by
        { have h_k3lekl : k^3 ≤ k^l := by
          { have h_0lk : 0 < k := by
            { have h_0l4 : 0 < 4 := by
              { exact four_pos, },
              exact gt_of_ge_of_gt h_4lek h_0l4, },
            exact pow_le_pow_of_le_right h_0lk h_3lel, },
          exact gt_of_gt_of_ge h_kllpl h_k3lekl, },
        exact gt_of_ge_of_gt h_plen h_k3lpl, },
      -- contradiciton
      exact nat.lt_asymm h₄ h_k3ln, },
  },

  cases em (n ≥ 2*k) with h_2k,
  { exact h_wlog k h_4lek h_klen4 h_2k},
  { -- transform ¬(n ≥ 2 * k) into (n < 2 * k)
    simp only [not_le] at h,
    -- transform (n.choose k) into (n.choose (n - k))
    have h_klen : k ≤ n := le_trans h_klen4 (nat.sub_le n 4),
    rw ←choose_symm h_klen,
    -- define k' as n - k, such that k' can be used for h_wlog as k'
    -- satisfies all required features
    let k' := n - k,
    have h_k'_def : k' = n - k := by refl,
    -- third requirement: 2 * k' ≤ n
    have h_2k'len : 2 * k' ≤ n := by
    { zify,
      have h': n ≤ 2 * k := le_of_lt h,
      zify at h',
      ring_nf,
      rw sub_le_iff_le_add,
      have := add_le_add_right h' n,
      ring_nf at this,
      exact this, },
    -- second requirement: k ≤ n - 4
    have h_k'len4 : k' ≤ n - 4 := by
    { simp [h_k'_def],
      have help : k + k ≤ n - 4 + k := add_le_add_right h_klen4 k,
      rw ← (two_mul k) at help,
      exact le_trans (le_of_lt h) help, },
    -- first requirement: 4 ≤ k
    have h_4lek' : 4 ≤ k' := by
    { have h_4len : 4 ≤ n := le_trans (le_trans h_4lek h_klen4) (nat.sub_le n 4),
      linarith, },
    -- now we can use h_wlog
    exact h_wlog k' h_4lek' h_k'len4 h_2k'len,},
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.pfun
import tactic.norm_num
import data.equiv.mul_add

/-!
# Natural numbers with infinity

The natural numbers and an extra `top` element `⊤`.

## Main definitions

The following instances are defined:

* `ordered_add_comm_monoid enat`
* `canonically_ordered_add_monoid enat`

There is no additive analogue of `monoid_with_zero`; if there were then `enat` could
be an `add_monoid_with_top`.

* `to_with_top` : the map from `enat` to `with_top ℕ`, with theorems that it plays well
with `+` and `≤`.

* `with_top_add_equiv : enat ≃+ with_top ℕ`
* `with_top_order_iso : enat ≃o with_top ℕ`

## Implementation details

`enat` is defined to be `roption ℕ`.

`+` and `≤` are defined on `enat`, but there is an issue with `*` because it's not
clear what `0 * ⊤` should be. `mul` is hence left undefined. Similarly `⊤ - ⊤` is ambiguous
so there is no `-` defined on `enat`.

Before the `open_locale classical` line, various proofs are made with decidability assumptions.
This can cause issues -- see for example the non-simp lemma `to_with_top_zero` proved by `rfl`,
followed by `@[simp] lemma to_with_top_zero'` whose proof uses `convert`.

## Tags

enat, with_top ℕ
-/
open roption

/-- Type of natural numbers with infinity (`⊤`) -/
def enat : Type := roption ℕ

namespace enat

instance : has_zero enat := ⟨some 0⟩
instance : inhabited enat := ⟨0⟩
instance : has_one enat := ⟨some 1⟩
instance : has_add enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, get x h.1 + get y h.2⟩⟩
instance : has_coe ℕ enat := ⟨some⟩
instance (n : ℕ) : decidable (n : enat).dom := is_true trivial

@[simp] lemma coe_inj {x y : ℕ} : (x : enat) = y ↔ x = y := roption.some_inj

@[simp] lemma dom_coe (x : ℕ) : (x : enat).dom := trivial

instance : add_comm_monoid enat :=
{ add       := (+),
  zero      := (0),
  add_comm  := λ x y, roption.ext' and.comm (λ _ _, add_comm _ _),
  zero_add  := λ x, roption.ext' (true_and _) (λ _ _, zero_add _),
  add_zero  := λ x, roption.ext' (and_true _) (λ _ _, add_zero _),
  add_assoc := λ x y z, roption.ext' and.assoc (λ _ _, add_assoc _ _ _) }

instance : has_le enat := ⟨λ x y, ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy⟩
instance : has_top enat := ⟨none⟩
instance : has_bot enat := ⟨0⟩
instance : has_sup enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, x.get h.1 ⊔ y.get h.2⟩⟩

lemma le_def (x y : enat) : x ≤ y ↔ ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy :=
iff.rfl

@[elab_as_eliminator] protected lemma cases_on {P : enat → Prop} : ∀ a : enat,
  P ⊤ → (∀ n : ℕ, P n) → P a :=
roption.induction_on

@[simp] lemma top_add (x : enat) : ⊤ + x = ⊤ :=
roption.ext' (false_and _) (λ h, h.left.elim)

@[simp] lemma add_top (x : enat) : x + ⊤ = ⊤ :=
by rw [add_comm, top_add]

@[simp, norm_cast] lemma coe_zero : ((0 : ℕ) : enat) = 0 := rfl

@[simp, norm_cast] lemma coe_one : ((1 : ℕ) : enat) = 1 := rfl

@[simp, norm_cast] lemma coe_add (x y : ℕ) : ((x + y : ℕ) : enat) = x + y :=
roption.ext' (and_true _).symm (λ _ _, rfl)

lemma get_coe {x : ℕ} : get (x : enat) true.intro = x := rfl

@[simp, norm_cast] lemma get_coe' (x : ℕ) (h : (x : enat).dom) : get (x : enat) h = x := rfl

lemma coe_add_get {x : ℕ} {y : enat} (h : ((x : enat) + y).dom) :
  get ((x : enat) + y) h = x + get y h.2 := rfl

@[simp] lemma get_add {x y : enat} (h : (x + y).dom) :
  get (x + y) h = x.get h.1 + y.get h.2 := rfl

@[simp] lemma coe_get {x : enat} (h : x.dom) : (x.get h : enat) = x :=
roption.ext' (iff_of_true trivial h) (λ _ _, rfl)

@[simp] lemma get_zero (h : (0 : enat).dom) : (0 : enat).get h = 0 := rfl

@[simp] lemma get_one (h : (1 : enat).dom) : (1 : enat).get h = 1 := rfl

lemma dom_of_le_of_dom {x y : enat} : x ≤ y → y.dom → x.dom := λ ⟨h, _⟩, h

lemma dom_of_le_some {x : enat} {y : ℕ} (h : x ≤ y) : x.dom := dom_of_le_of_dom h trivial

instance decidable_le (x y : enat) [decidable x.dom] [decidable y.dom] : decidable (x ≤ y) :=
if hx : x.dom
then decidable_of_decidable_of_iff
  (show decidable (∀ (hy : (y : enat).dom), x.get hx ≤ (y : enat).get hy),
    from forall_prop_decidable _) $
  by { dsimp [(≤)], simp only [hx, exists_prop_of_true, forall_true_iff] }
else if hy : y.dom
then is_false $ λ h, hx $ dom_of_le_of_dom h hy
else is_true ⟨λ h, (hy h).elim, λ h, (hy h).elim⟩

/-- The coercion `ℕ → enat` preserves `0` and addition. -/
def coe_hom : ℕ →+ enat := ⟨coe, enat.coe_zero, enat.coe_add⟩

instance : partial_order enat :=
{ le          := (≤),
  le_refl     := λ x, ⟨id, λ _, le_refl _⟩,
  le_trans    := λ x y z ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩,
    ⟨hxy₁ ∘ hyz₁, λ _, le_trans (hxy₂ _) (hyz₂ _)⟩,
  le_antisymm := λ x y ⟨hxy₁, hxy₂⟩ ⟨hyx₁, hyx₂⟩, roption.ext' ⟨hyx₁, hxy₁⟩
    (λ _ _, le_antisymm (hxy₂ _) (hyx₂ _)) }

lemma lt_def (x y : enat) : x < y ↔ ∃ (hx : x.dom), ∀ (hy : y.dom), x.get hx < y.get hy :=
begin
  rw [lt_iff_le_not_le, le_def, le_def, not_exists],
  split,
  { rintro ⟨⟨hyx, H⟩, h⟩,
    by_cases hx : x.dom,
    { use hx, intro hy,
      specialize H hy, specialize h (λ _, hy),
      rw not_forall at h, cases h with hx' h,
      rw not_le at h, exact h },
    { specialize h (λ hx', (hx hx').elim),
      rw not_forall at h, cases h with hx' h,
      exact (hx hx').elim } },
  { rintro ⟨hx, H⟩, exact ⟨⟨λ _, hx, λ hy, (H hy).le⟩, λ hxy h, not_lt_of_le (h _) (H _)⟩ }
end

@[simp, norm_cast] lemma coe_le_coe {x y : ℕ} : (x : enat) ≤ y ↔ x ≤ y :=
⟨λ ⟨_, h⟩, h trivial, λ h, ⟨λ _, trivial, λ _, h⟩⟩

@[simp, norm_cast] lemma coe_lt_coe {x y : ℕ} : (x : enat) < y ↔ x < y :=
by rw [lt_iff_le_not_le, lt_iff_le_not_le, coe_le_coe, coe_le_coe]

@[simp] lemma get_le_get {x y : enat} {hx : x.dom} {hy : y.dom} :
  x.get hx ≤ y.get hy ↔ x ≤ y :=
by conv { to_lhs, rw [← coe_le_coe, coe_get, coe_get]}

lemma le_coe_iff (x : enat) (n : ℕ) : x ≤ n ↔ ∃ h : x.dom, x.get h ≤ n :=
begin
  show (∃ (h : true → x.dom), _) ↔ ∃ h : x.dom, x.get h ≤ n,
  simp only [forall_prop_of_true, dom_coe, get_coe'],
  split; rintro ⟨_, _⟩; refine ⟨_, _⟩; intros; try { assumption }
end

lemma lt_coe_iff (x : enat) (n : ℕ) : x < n ↔ ∃ h : x.dom, x.get h < n :=
by simp only [lt_def, forall_prop_of_true, get_coe', dom_coe]

lemma coe_le_iff (n : ℕ) (x : enat) : (n : enat) ≤ x ↔ ∀ h : x.dom, n ≤ x.get h :=
by simpa only [le_def, exists_prop_of_true, dom_coe, forall_true_iff] using iff.rfl

lemma coe_lt_iff (n : ℕ) (x : enat) : (n : enat) < x ↔ ∀ h : x.dom, n < x.get h :=
by simpa only [lt_def, exists_prop_of_true, dom_coe] using iff.rfl

protected lemma zero_lt_one : (0 : enat) < 1 :=
by { norm_cast, norm_num }

instance semilattice_sup_bot : semilattice_sup_bot enat :=
{ sup := (⊔),
  bot := (⊥),
  bot_le := λ _, ⟨λ _, trivial, λ _, nat.zero_le _⟩,
  le_sup_left := λ _ _, ⟨and.left, λ _, le_sup_left⟩,
  le_sup_right := λ _ _, ⟨and.right, λ _, le_sup_right⟩,
  sup_le := λ x y z ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩, ⟨λ hz, ⟨hx₁ hz, hy₁ hz⟩,
    λ _, sup_le (hx₂ _) (hy₂ _)⟩,
  ..enat.partial_order }

instance order_top : order_top enat :=
{ top := (⊤),
  le_top := λ x, ⟨λ h, false.elim h, λ hy, false.elim hy⟩,
  ..enat.semilattice_sup_bot }

lemma dom_of_lt {x y : enat} : x < y → x.dom :=
enat.cases_on x not_top_lt $ λ _ _, trivial

lemma top_eq_none : (⊤ : enat) = none := rfl

@[simp] lemma coe_lt_top (x : ℕ) : (x : enat) < ⊤ :=
lt_of_le_of_ne le_top (λ h, absurd (congr_arg dom h) true_ne_false)

@[simp] lemma coe_ne_top (x : ℕ) : (x : enat) ≠ ⊤ := ne_of_lt (coe_lt_top x)

lemma ne_top_iff {x : enat} : x ≠ ⊤ ↔ ∃(n : ℕ), x = n := roption.ne_none_iff

lemma ne_top_iff_dom {x : enat} : x ≠ ⊤ ↔ x.dom :=
by classical; exact not_iff_comm.1 roption.eq_none_iff'.symm

lemma ne_top_of_lt {x y : enat} (h : x < y) : x ≠ ⊤ :=
ne_of_lt $ lt_of_lt_of_le h le_top

lemma eq_top_iff_forall_lt (x : enat) : x = ⊤ ↔ ∀ n : ℕ, (n : enat) < x :=
begin
  split,
  { rintro rfl n, exact coe_lt_top _ },
  { contrapose!, rw ne_top_iff, rintro ⟨n, rfl⟩, exact ⟨n, irrefl _⟩ }
end

lemma eq_top_iff_forall_le (x : enat) : x = ⊤ ↔ ∀ n : ℕ, (n : enat) ≤ x :=
(eq_top_iff_forall_lt x).trans
⟨λ h n, (h n).le, λ h n, lt_of_lt_of_le (coe_lt_coe.mpr n.lt_succ_self) (h (n + 1))⟩

lemma pos_iff_one_le {x : enat} : 0 < x ↔ 1 ≤ x :=
enat.cases_on x ⟨λ _, le_top, λ _, coe_lt_top _⟩
  (λ n, ⟨λ h, enat.coe_le_coe.2 (enat.coe_lt_coe.1 h),
    λ h, enat.coe_lt_coe.2 (enat.coe_le_coe.1 h)⟩)

noncomputable instance : linear_order enat :=
{ le_total := λ x y, enat.cases_on x
    (or.inr le_top) (enat.cases_on y (λ _, or.inl le_top)
      (λ x y, (le_total x y).elim (or.inr ∘ coe_le_coe.2)
        (or.inl ∘ coe_le_coe.2))),
  decidable_le := classical.dec_rel _,
  ..enat.partial_order }

noncomputable instance : bounded_lattice enat :=
{ inf := min,
  inf_le_left := min_le_left,
  inf_le_right := min_le_right,
  le_inf := λ _ _ _, le_min,
  ..enat.order_top,
  ..enat.semilattice_sup_bot }

lemma sup_eq_max {a b : enat} : a ⊔ b = max a b :=
le_antisymm (sup_le (le_max_left _ _) (le_max_right _ _))
  (max_le le_sup_left le_sup_right)

lemma inf_eq_min {a b : enat} : a ⊓ b = min a b := rfl

instance : ordered_add_comm_monoid enat :=
{ add_le_add_left := λ a b ⟨h₁, h₂⟩ c,
    enat.cases_on c (by simp)
      (λ c, ⟨λ h, and.intro trivial (h₁ h.2),
        λ _, add_le_add_left (h₂ _) c⟩),
  lt_of_add_lt_add_left := λ a b c, enat.cases_on a
    (λ h, by simpa [lt_irrefl] using h)
    (λ a, enat.cases_on b
      (λ h, absurd h (not_lt_of_ge (by rw add_top; exact le_top)))
      (λ b, enat.cases_on c
        (λ _, coe_lt_top _)
        (λ c h,  coe_lt_coe.2 (by rw [← coe_add, ← coe_add, coe_lt_coe] at h;
            exact lt_of_add_lt_add_left h)))),
  ..enat.linear_order,
  ..enat.add_comm_monoid }

instance : canonically_ordered_add_monoid enat :=
{ le_iff_exists_add := λ a b, enat.cases_on b
    (iff_of_true le_top ⟨⊤, (add_top _).symm⟩)
    (λ b, enat.cases_on a
      (iff_of_false (not_le_of_gt (coe_lt_top _))
        (not_exists.2 (λ x, ne_of_lt (by rw [top_add]; exact coe_lt_top _))))
      (λ a, ⟨λ h, ⟨(b - a : ℕ),
          by rw [← coe_add, coe_inj, add_comm, nat.sub_add_cancel (coe_le_coe.1 h)]⟩,
        (λ ⟨c, hc⟩, enat.cases_on c
          (λ hc, hc.symm ▸ show (a : enat) ≤ a + ⊤, by rw [add_top]; exact le_top)
          (λ c (hc : (b : enat) = a + c),
            coe_le_coe.2 (by rw [← coe_add, coe_inj] at hc;
              rw hc; exact nat.le_add_right _ _)) hc)⟩)),
  ..enat.semilattice_sup_bot,
  ..enat.ordered_add_comm_monoid }

protected lemma add_lt_add_right {x y z : enat} (h : x < y) (hz : z ≠ ⊤) : x + z < y + z :=
begin
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩,
  rcases ne_top_iff.mp hz with ⟨k, rfl⟩,
  induction y using enat.cases_on with n,
  { rw [top_add], apply_mod_cast coe_lt_top },
  norm_cast at h, apply_mod_cast add_lt_add_right h
end

protected lemma add_lt_add_iff_right {x y z : enat} (hz : z ≠ ⊤) : x + z < y + z ↔ x < y :=
⟨lt_of_add_lt_add_right, λ h, enat.add_lt_add_right h hz⟩

protected lemma add_lt_add_iff_left {x y z : enat} (hz : z ≠ ⊤) : z + x < z + y ↔ x < y :=
by rw [add_comm z, add_comm z, enat.add_lt_add_iff_right hz]

protected lemma lt_add_iff_pos_right {x y : enat} (hx : x ≠ ⊤) : x < x + y ↔ 0 < y :=
by { conv_rhs { rw [← enat.add_lt_add_iff_left hx] }, rw [add_zero] }

lemma lt_add_one {x : enat} (hx : x ≠ ⊤) : x < x + 1 :=
by { rw [enat.lt_add_iff_pos_right hx], norm_cast, norm_num }

lemma le_of_lt_add_one {x y : enat} (h : x < y + 1) : x ≤ y :=
begin
  induction y using enat.cases_on with n, apply le_top,
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩,
  apply_mod_cast nat.le_of_lt_succ, apply_mod_cast h
end

lemma add_one_le_of_lt {x y : enat} (h : x < y) : x + 1 ≤ y :=
begin
  induction y using enat.cases_on with n, apply le_top,
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩,
  apply_mod_cast nat.succ_le_of_lt, apply_mod_cast h
end

lemma add_one_le_iff_lt {x y : enat} (hx : x ≠ ⊤) : x + 1 ≤ y ↔ x < y :=
begin
  split, swap, exact add_one_le_of_lt,
  intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩,
  induction y using enat.cases_on with n, apply coe_lt_top,
  apply_mod_cast nat.lt_of_succ_le, apply_mod_cast h
end

lemma lt_add_one_iff_lt {x y : enat} (hx : x ≠ ⊤) : x < y + 1 ↔ x ≤ y :=
begin
  split, exact le_of_lt_add_one,
  intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩,
  induction y using enat.cases_on with n, { rw [top_add], apply coe_lt_top },
  apply_mod_cast nat.lt_succ_of_le, apply_mod_cast h
end

lemma add_eq_top_iff {a b : enat} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ :=
by apply enat.cases_on a; apply enat.cases_on b;
  simp; simp only [(enat.coe_add _ _).symm, enat.coe_ne_top]; simp

protected lemma add_right_cancel_iff {a b c : enat} (hc : c ≠ ⊤) : a + c = b + c ↔ a = b :=
begin
  rcases ne_top_iff.1 hc with ⟨c, rfl⟩,
  apply enat.cases_on a; apply enat.cases_on b;
  simp [add_eq_top_iff, coe_ne_top, @eq_comm _ (⊤ : enat)];
  simp only [(enat.coe_add _ _).symm, add_left_cancel_iff, enat.coe_inj, add_comm];
  tauto
end

protected lemma add_left_cancel_iff {a b c : enat} (ha : a ≠ ⊤) : a + b = a + c ↔ b = c :=
by rw [add_comm a, add_comm a, enat.add_right_cancel_iff ha]

section with_top

/-- Computably converts an `enat` to a `with_top ℕ`. -/
def to_with_top (x : enat) [decidable x.dom] : with_top ℕ := x.to_option

lemma to_with_top_top : to_with_top ⊤ = ⊤ := rfl

@[simp] lemma to_with_top_top' {h : decidable (⊤ : enat).dom} : to_with_top ⊤ = ⊤ :=
by convert to_with_top_top

lemma to_with_top_zero : to_with_top 0 = 0 := rfl

@[simp] lemma to_with_top_zero' {h : decidable (0 : enat).dom} : to_with_top 0 = 0 :=
by convert to_with_top_zero

lemma to_with_top_coe (n : ℕ) : to_with_top n = n := rfl

@[simp] lemma to_with_top_coe' (n : ℕ) {h : decidable (n : enat).dom} :
  to_with_top (n : enat) = n :=
by convert to_with_top_coe n

@[simp] lemma to_with_top_le {x y : enat} : Π [decidable x.dom]
  [decidable y.dom], by exactI to_with_top x ≤ to_with_top y ↔ x ≤ y :=
enat.cases_on y (by simp) (enat.cases_on x (by simp) (by intros; simp))

@[simp] lemma to_with_top_lt {x y : enat} [decidable x.dom] [decidable y.dom] :
  to_with_top x < to_with_top y ↔ x < y :=
lt_iff_lt_of_le_iff_le to_with_top_le

end with_top

section with_top_equiv

open_locale classical

@[simp] lemma to_with_top_add {x y : enat} : to_with_top (x + y) = to_with_top x + to_with_top y :=
begin
  apply enat.cases_on y; apply enat.cases_on x,
  { simp },
  { simp },
  { simp },
  -- not sure why `simp` can't do this
  { intros, rw [to_with_top_coe', to_with_top_coe'], norm_cast, exact to_with_top_coe' _ }
end

/-- `equiv` between `enat` and `with_top ℕ` (for the order isomorphism see `with_top_order_iso`). -/
noncomputable def with_top_equiv : enat ≃ with_top ℕ :=
{ to_fun := λ x, to_with_top x,
  inv_fun := λ x, match x with (some n) := coe n | none := ⊤ end,
  left_inv := λ x, by apply enat.cases_on x; intros; simp; refl,
  right_inv := λ x, by cases x; simp [with_top_equiv._match_1]; refl }

@[simp] lemma with_top_equiv_top : with_top_equiv ⊤ = ⊤ :=
to_with_top_top'

@[simp] lemma with_top_equiv_coe (n : nat) : with_top_equiv n = n :=
to_with_top_coe' _

@[simp] lemma with_top_equiv_zero : with_top_equiv 0 = 0 :=
with_top_equiv_coe _

@[simp] lemma with_top_equiv_le {x y : enat} : with_top_equiv x ≤ with_top_equiv y ↔ x ≤ y :=
to_with_top_le

@[simp] lemma with_top_equiv_lt {x y : enat} : with_top_equiv x < with_top_equiv y ↔ x < y :=
to_with_top_lt

/-- `to_with_top` induces an order isomorphism between `enat` and `with_top ℕ`. -/
noncomputable def with_top_order_iso : enat ≃o with_top ℕ :=
{ map_rel_iff' := λ _ _, with_top_equiv_le,
  .. with_top_equiv}

@[simp] lemma with_top_equiv_symm_top : with_top_equiv.symm ⊤ = ⊤ :=
rfl

@[simp] lemma with_top_equiv_symm_coe (n : nat) : with_top_equiv.symm n = n :=
rfl

@[simp] lemma with_top_equiv_symm_zero : with_top_equiv.symm 0 = 0 :=
rfl

@[simp] lemma with_top_equiv_symm_le {x y : with_top ℕ} :
  with_top_equiv.symm x ≤ with_top_equiv.symm y ↔ x ≤ y :=
by rw ← with_top_equiv_le; simp

@[simp] lemma with_top_equiv_symm_lt {x y : with_top ℕ} :
  with_top_equiv.symm x < with_top_equiv.symm y ↔ x < y :=
by rw ← with_top_equiv_lt; simp

/-- `to_with_top` induces an additive monoid isomorphism between `enat` and `with_top ℕ`. -/
noncomputable def with_top_add_equiv : enat ≃+ with_top ℕ :=
{ map_add' := λ x y, by simp only [with_top_equiv]; convert to_with_top_add,
  ..with_top_equiv}

end with_top_equiv

lemma lt_wf : well_founded ((<) : enat → enat → Prop) :=
show well_founded (λ a b : enat, a < b),
by haveI := classical.dec; simp only [to_with_top_lt.symm] {eta := ff};
    exact inv_image.wf _ (with_top.well_founded_lt nat.lt_wf)

instance : has_well_founded enat := ⟨(<), lt_wf⟩

section find

variables (P : ℕ → Prop) [decidable_pred P]

/-- The smallest `enat` satisfying a (decidable) predicate `P : ℕ → Prop` -/
def find : enat := ⟨∃ n, P n, nat.find⟩

@[simp] lemma find_get (h : (find P).dom) : (find P).get h = nat.find h := rfl

lemma find_dom (h : ∃ n, P n) : (find P).dom := h

lemma lt_find (n : ℕ) (h : ∀ m ≤ n, ¬P m) : (n : enat) < find P :=
begin
  rw coe_lt_iff, intro h', rw find_get,
  have := @nat.find_spec P _ h',
  contrapose! this,
  exact h _ this
end

lemma lt_find_iff (n : ℕ) : (n : enat) < find P ↔ (∀ m ≤ n, ¬P m) :=
begin
  refine ⟨_, lt_find P n⟩,
  intros h m hm,
  by_cases H : (find P).dom,
  { apply nat.find_min H, rw coe_lt_iff at h, specialize h H, exact lt_of_le_of_lt hm h },
  { exact not_exists.mp H m }
end

lemma find_le (n : ℕ) (h : P n) : find P ≤ n :=
by { rw le_coe_iff, refine ⟨⟨_, h⟩, @nat.find_min' P _ _ _ h⟩ }

lemma find_eq_top_iff : find P = ⊤ ↔ ∀ n, ¬P n :=
(eq_top_iff_forall_lt _).trans
⟨λ h n, (lt_find_iff P n).mp (h n) _ le_rfl, λ h n, lt_find P n $ λ _ _, h _⟩

end find

noncomputable instance : linear_ordered_add_comm_monoid_with_top enat :=
{ top_add' := top_add,
  .. enat.linear_order,
  .. enat.ordered_add_comm_monoid,
  .. enat.order_top }

end enat


import tactic linear_algebra.linear_independent

variables {ι : Type*} {R : Type*} {V' : Type*} {M : Type*}

section one

variables (a b : ℕ)
#check ({a} : set ℕ)
#check ({a, b} : set ℕ)

variables {v : ι → M} [semiring R] [add_comm_monoid M] [module R M] {a b : R}

#check false.elim
lemma linear_independent_empty_type' (h : ¬ nonempty ι) : linear_independent R v :=
begin
  rw linear_independent_iff,
  intros f hf,
  ext i,
  apply false.elim (h ⟨i⟩),
end

/-
variables (A : ({a} : set ℕ))
#check ⋃ (i : A), i
-/

lemma linear_independent_Union_of_directed' {η : Type*}
  {s : η → set M} (hs : directed (⊆) s)
  (h : ∀ i, linear_independent R (λ x, x : s i → M)) :
  linear_independent R (λ x, x : (⋃ i, s i) → M) :=
begin
  by_cases hη : nonempty η,
  { resetI,
    refine linear_independent_of_finite (⋃ i, s i) (λ t ht ft, _),
    rcases set.finite_subset_Union ft ht with ⟨I, fi, hI⟩,
    rcases hs.finset_le fi.to_finset with ⟨i, hi⟩,
    exact (h i).mono (set.subset.trans hI $ set.bUnion_subset $
      λ j hj, hi j (fi.mem_to_finset.2 hj)) },
  { refine (linear_independent_empty _ _).mono _,
    rintro _ ⟨_, ⟨i, _⟩, _⟩, exact hη ⟨i⟩
  }
end

end one

section two

open set module submodule

variables [ring R] [add_comm_group M] [module R M]

#check
#check

lemma exists_maximal_independent'' (s : ι → M) : ∃ I : set ι, linear_independent R (λ x : I, s x) ∧
  ∀ i ∉ I, ∃ a : R, a ≠ 0 ∧ a • s i ∈ span R (s '' I) :=
begin
  classical,
  sorry
end

end two


structure Fun (α β : Type) : Type where
  toFun : α → β

instance : CoeFun (Fun α β) (fun _ => α → β) where
  coe := Fun.toFun

example (f : Fun α α) : α → α :=
  f ∘ f

example (f : Fun α β) : (γ δ : Type) × (γ → δ) :=
  ⟨_, _, f⟩

structure Equiv (α : Sort _) (β : Sort _) :=
(toFun    : α → β)
(invFun   : β → α)

local infix:25 " ≃ " => Equiv

variable {α β γ : Sort _}

instance : CoeFun (α ≃ β) (λ _ => α → β) := ⟨Equiv.toFun⟩

def Equiv.symm (e : α ≃ β) : β ≃ α := ⟨e.invFun, e.toFun⟩

protected def Equiv.trans (e₁ : α ≃ β) (e₂ : β ≃ γ) : α ≃ γ :=
  ⟨e₂ ∘ e₁, e₁.symm ∘ e₂.symm⟩


import .euclid
import tactic

-- Redo the local notation
--------------------------
local infix ` ≃ `:55 := congruent  -- typed as \ equiv
local infix `⬝`:56 := Segment.mk  -- typed as \ cdot

-- Lemma needed for Proposition 1
lemma hypothesis1_about_circles_radius (s : Segment) :
  let c₁ : Circle := ⟨s.p1, s.p2⟩ in
  let c₂ : Circle := ⟨s.p2, s.p1⟩ in
  distance c₁.center c₂.center ≤ radius c₁ + radius c₂ :=
by simp [radius, radius_segment, distance_not_neg]

-- Another lemma needed for Proposition 1
lemma hypothesis2_about_circles_radius (s : Segment) :
  let c₁ : Circle := ⟨s.p1, s.p2⟩ in
  let c₂ : Circle := ⟨s.p2, s.p1⟩ in
  abs (radius c₁ - radius c₂) ≤ distance c₁.center c₂.center :=
by simp [radius, radius_segment, distance_is_symm, distance_not_neg]

-- # Proposition 1
------------------
theorem construct_equilateral (a b : Point) :
  ∃ (c : Point),
  let abc : Triangle := ⟨a, b, c⟩ in
  is_equilateral abc :=
begin
  set c₁ : Circle := ⟨a, b⟩,
  set c₂ : Circle := ⟨b, a⟩,
  have h₁ := hypothesis1_about_circles_radius (a⬝b),
  have h₂ := hypothesis2_about_circles_radius (a⬝b),
  set c := circles_intersect h₁ h₂,
  use c,
  simp only [],
  have hp₁ := (circles_intersect' h₁ h₂).1,
  have hp₂ := (circles_intersect' h₁ h₂).2,
  set c := circles_intersect h₁ h₂,

    fsplit;  -- Cleaning up the context.
    dsimp only [circumference, sides_of_triangle, radius_segment] at *,
      { rwa segment_symm},
      { transitivity,
        apply cong_symm,
        assumption,
        conv_lhs {rw segment_symm},
        conv_rhs {rw segment_symm},
        assumption},
end

-- Lemma needed for proposition 2
lemma line_circle_intersect {a b : Point} (ne : a ≠ b) {C : Circle} :
     circle_interior a C
  → ∃ x : Point, lies_on x (line_of_points a b ne)
                ∧ x ∈ circumference C
                ∧ between x a b := sorry

-- Use *have* for introducing new facts. Follow it up with a proof of
-- said fact.
-- have x_pos : x > 0, .....

-- Use *let* for introducing new terms (of a given type). Follow it up
-- with a definition of the term.
-- Ex: let x : ℕ := 5

-- Use *set* is similar to *let*, but it additionally replaces every term
-- in the context with the new definition.
-- Ex: set x : ℕ := 5, -> replace x with 5 everywhere

-- Lemma needed for Proposition 2
lemma equilateral_triangle_nonzero_sides {a b c : Point} :
     a ≠ b
  → is_equilateral ⟨a, b, c⟩
  → b ≠ c ∧ c ≠ a :=
begin
  set abc : Triangle := ⟨a, b, c⟩,
  rintros ne_a_b ⟨h₁, h₂⟩,
  set sides := sides_of_triangle abc,
  change sides.fst with a⬝b at h₁ h₂,
  change sides.snd.fst with b⬝c at h₁ h₂,
  change sides.snd.snd with c⬝a at h₁ h₂,
  split,
    { intros eq_b_c,
      subst eq_b_c,
      have eq_a_b : a = b := zero_segment h₁,
      cc},
    { intros eq_c_a,
      subst eq_c_a,
      have eq_b_c : b = c := zero_segment h₂,
      cc},
end

lemma radii_equal {c : Circle} {a b : Point} :
     a ∈ circumference c
  → b ∈ circumference c
  → c.center⬝a ≃ c.center⬝b :=
begin
  intros h₁ h₂,
  transitivity,
    apply cong_symm,
    repeat {assumption},
end

-- # Proposition 2
------------------
theorem segment_copy {a b c : Point} :
     a ≠ b
  → b ≠ c
  → ∃ (l : Point), (a⬝l) ≃ (b⬝c) :=
begin
  intros ne_a_b ne_b_c,
  choose d h using construct_equilateral a b,
  set c₁ : Circle := ⟨b, c⟩,

  have ne_d_b : d ≠ b,
    { symmetry,
      apply (equilateral_triangle_nonzero_sides ne_a_b h).1},
  have b_in_c₁ : circle_interior b c₁ := center_in_circle ne_b_c,

  have db_intersect_c₁ := line_circle_intersect ne_d_b.symm b_in_c₁,
  rcases db_intersect_c₁ with ⟨g, g_on_bd, g_on_c₁, bet_g_b_d⟩,

  set c₂ : Circle := ⟨d, g⟩,
  have ne_d_a : d ≠ a,
    by apply (equilateral_triangle_nonzero_sides ne_a_b h).2,
  have ne_d_g : d ≠ g,
    { rw [distance_pos, distance_is_symm, ←distance_between.1 bet_g_b_d],
      have h₁ : distance b d > 0 := distance_pos.1 ne_d_b.symm,
      have h₂ : distance g b ≥ 0 := distance_not_neg,
      linarith},
  have d_in_c₂ : circle_interior d c₂ := center_in_circle ne_d_g,
  have c_on_c₁ : c ∈ circumference c₁ := radius_on_circumference _ _,
  have a_in_c₂ : circle_interior a c₂,
    { dsimp only [circle_interior, radius, radius_segment],
      rw [distance_is_symm d g, ← distance_between.1 bet_g_b_d],
      rcases h with ⟨h₁, h₂⟩,
      change (sides_of_triangle ⟨a, b, d⟩).fst with a⬝b at h₁ h₂,
      change (sides_of_triangle ⟨a, b, d⟩).snd.fst with b⬝d at h₁ h₂,
      change (sides_of_triangle ⟨a, b, d⟩).snd.snd with d⬝a at h₂ h₂,
      have eq_ad_bd : distance d a = distance b d,
        { rw ← distance_congruent,
          apply cong_symm,
          assumption},
      simp only [eq_ad_bd, lt_add_iff_pos_left],
      have re := radii_equal g_on_c₁ c_on_c₁,
      simp only [distance_congruent] at re,
      rwa [distance_is_symm, re, ← distance_pos]},

  have da_intersect_c₂ := line_circle_intersect ne_d_a.symm a_in_c₂,
  rcases da_intersect_c₂ with ⟨l, l_on_ad, l_on_c₂, bet_l_a_d⟩,

  have dl_eq_da_al : distance d l = distance d a + distance a l,
    { replace bet_l_a_d := between_symm bet_l_a_d,
      rwa [distance_between.1 bet_l_a_d]},
  have dg_eq_db_bg : distance d g = distance d b  + distance b g,
    { replace bet_g_b_d := between_symm bet_g_b_d,
      rwa [distance_between.1 bet_g_b_d]},
  have g_on_c₂ : g ∈ circumference c₂ := radius_on_circumference _ _,

  rcases h with ⟨h₁, h₂⟩,
  set sides := sides_of_triangle ⟨a, b, d⟩,
  change sides.fst with a⬝b at h₁ h₂,
  change sides.snd.fst with b⬝d at h₁ h₂,
  change sides.snd.snd with d⬝a at h₁ h₂,

  use l,
  rw distance_congruent,
  calc distance a l = distance d l - distance d a :
                      by simp only [dl_eq_da_al, add_sub_cancel']
       ... = distance d l - distance b d : by rw distance_congruent.1 h₂
       ... = distance d g - distance b d : by rw distance_congruent.1
                                              (radii_equal l_on_c₂ g_on_c₂)
       ... = distance d g - distance d b : by simp only [distance_is_symm]
       ... = distance b g : by simp only [dg_eq_db_bg, add_sub_cancel']
       ... = distance b c : by rw distance_congruent.1
                               (radii_equal g_on_c₁ c_on_c₁)
end

-- # Proposition 3
------------------
-- To cut off from the greater of two given unequal straight lines a
-- straight line equal to the less.
lemma prop3 (a b c c' : Point) :
     a ≠ c
  → c ≠ c'
  → a ≠ b
  → length (c⬝c') ≤ length (a⬝b)
  → ∃ (e : Point), length (a⬝e) = length (c⬝c') :=
begin
  intros ne_a_c ne_c_c' ne_a_b le_cc'_ab,
  choose d eq_ad_cc' using segment_copy ne_a_c ne_c_c',
  set c₁ : Circle := ⟨a, d⟩,
  have ne_a_d : a ≠ d,
    { intros eq_a_d,
      subst eq_a_d,
      have eq_c_c' : c = c' := zero_segment (cong_symm _ _ eq_ad_cc'),
      cc},
  have a_in_c₁ : circle_interior a c₁ := center_in_circle ne_a_d,
  choose e h using line_circle_intersect ne_a_b a_in_c₁,
  rcases h with ⟨e_on_ab, e_on_c₁, bet_e_a_b⟩,

  use e,
  dsimp only [length],
  have d_on_c₁ : d ∈ circumference c₁ := radius_on_circumference _ _,
  have eq_ae_ad : distance a e = distance a d,
    { apply distance_congruent.1,
      exact radii_equal e_on_c₁ d_on_c₁},
  rw eq_ae_ad,
  apply distance_congruent.1,
  assumption,
end
#exit
-- # Proposition 4
------------------
-- If two triangles have two sides equal to two sides respectively,
-- and have the angles contained by the equal straight lines equal,
-- then they also have the base equal to the base, the triangle equals
-- the triangle, and the remaining angles equal the remaining angles
-- respectively, namely those opposite the equal sides.
-- SAS congruency.
lemma prop4 (a b c d e f : Point) :
     a⬝b ≃ d⬝e
  → a⬝c ≃ d⬝f
  →
begin
  sorry
end

-- # Proposition 5
-- # Proposition 7
-- # Proposition 8
-- # Proposition 10
-- # Proposition 11
-- # Proposition 13
-- # Proposition 14
-- # Proposition 15
-- # Proposition 16
-- # Proposition 18
-- # Proposition 19
-- # Proposition 20
-- # Proposition 22
-- # Proposition 26
-- # Proposition 29
-- # Proposition 31
-- # Proposition 34
-- # Proposition 37
-- # Proposition 41
-- # Proposition 46
-- # Proposition 47
-- # Proposition 48


import analysis.inner_product_space.pi_L2
import linear_algebra.dimension
import linear_algebra.matrix
import linear_algebra.unitary_group

open_locale big_operators matrix

variables {F m n: Type*}
  [is_R_or_C F]
  [fintype m] [fintype n]
  [decidable_eq m] [decidable_eq n]
  [has_lt m] [has_lt n]

theorem thm_2_1_2 (v : n → (euclidean_space F m)) (hon : (orthonormal F v)) :
linear_independent F v := orthonormal.linear_independent hon

def is_unitary (A : matrix n n F) := Aᴴ ⬝ A = 1

def is_orthogonal (A : matrix n n ℝ) := Aᵀ ⬝ A = 1

lemma eq_0_5 (A : matrix n n F) (B : matrix n n F) : B ⬝ A = 1 ↔ A ⬝ B = 1 :=
begin
  apply matrix.mul_eq_one_comm,
end

theorem thm_2_1_4_a_b (A : matrix n n F) : is_unitary A ↔ (is_unit A) ∧ (A⁻¹ = Aᴴ) :=
begin
  split,
  intro h,
  split,
  rw is_unit,
  use A,
  exact Aᴴ,
  simp,
  rw eq_0_5,
  exact h,
  exact h,
  simp,
  apply matrix.inv_eq_left_inv _,
  exact h,
  intro h,
  cases h with h1 h2,
  rw is_unitary,
  rw ← h2,
  rw matrix.is_unit_iff_is_unit_det at h1,
  apply matrix.nonsing_inv_mul A h1,
end

theorem thm_2_1_4_b_c (A : matrix n n F) : (is_unit A) ∧ (A⁻¹ = Aᴴ) ↔ A ⬝ Aᴴ = 1 :=
begin
  split,
  intro h,
  rw eq_0_5,
  cases h with h1 h2,
  rw ← h2,
  rw matrix.is_unit_iff_is_unit_det at h1,
  apply matrix.nonsing_inv_mul A h1,
  intro h,
  split,
  rw is_unit,
  use A,
  use Aᴴ,
  simp,
  exact h,
  simp,
  rw eq_0_5,
  exact h,
  simp,
  apply matrix.inv_eq_right_inv h,
end

theorem thm_2_1_4_c_d (A : matrix n n F) : (A ⬝ Aᴴ = 1) ↔ is_unitary Aᴴ :=
begin
  split,
  intro h,
  rw is_unitary,
  simp,
  exact h,
  rw is_unitary,
  simp,
end

theorem thm_2_1_4_a_d (A : matrix n n F) : is_unitary A ↔ is_unitary Aᴴ :=
begin
  split,
  rw thm_2_1_4_a_b,
  rw thm_2_1_4_b_c,
  exact (thm_2_1_4_c_d A).1,
  rw ← thm_2_1_4_c_d,
  rw ← thm_2_1_4_b_c,
  exact (thm_2_1_4_a_b A).2,
end

def cols (A : matrix m n F) :=
  λ (i : n), (id (Aᵀ i) : (euclidean_space F m))

def rows (A : matrix m n F) :=
  λ (i : m), (id (A i) : (euclidean_space F n))

def has_orthonormal_cols (A : matrix m n F) :=
  orthonormal F (cols A)

lemma entrywise_unitary (A : matrix n n F) (h: is_unitary A) : (∀ (i : n) (j : n), (Aᴴ ⬝ A) i j =  ite (i = j) 1 0) :=
begin
  rw is_unitary at h,
  rw ← matrix.ext_iff at h,
  intros i j,
  rw ← matrix.one_apply,
  apply h,
end

lemma entrywise_inner (A : matrix m n F) : ∀ i j : n, inner (cols A i) (cols A j) = (Aᴴ ⬝ A) i j :=
begin
  intros i j,
  ring,
end

theorem thm_2_1_4_a_e (A : matrix n n F) : is_unitary A ↔ has_orthonormal_cols A :=
begin
  split,
  intro h,
  rw has_orthonormal_cols,
  rw orthonormal_iff_ite,
  apply entrywise_unitary A,
  exact h,
  intro h,
  rw has_orthonormal_cols at h,
  rw orthonormal_iff_ite at h,
  rw is_unitary,
  ext,
  specialize h i j,
  have fact₁ : inner (cols A i) (cols A j) = (Aᴴ ⬝ A) i j, by apply entrywise_inner,
  rw ← fact₁,
  rw matrix.one_apply,
  exact h,
end

def is_isometry (A : matrix n n ℂ) :=
  ∀ (x : (euclidean_space ℂ n)), ∥x∥^2 = ∥ (id (matrix.to_lin' A x) : (euclidean_space ℂ n)) ∥^2

theorem thm_2_1_4_a_g (A : matrix n n ℂ) : is_unitary A ↔ is_isometry A :=
begin
  split,
  intro h,
  rw is_isometry,
  intro x,
  rw pi_Lp.norm_eq_of_L2,
  rw pi_Lp.norm_eq_of_L2,
  rw real.sq_sqrt,
  rw real.sq_sqrt,
  {sorry},
  apply finset.sum_nonneg,
  simp,
  intro i,
  apply sq_nonneg,
  apply finset.sum_nonneg,
  simp,
  intro i,
  apply sq_nonneg,
  {sorry},
end

def is_similar_to (A B : matrix n n F) : Prop := ∃ P : matrix n n F, ((P⁻¹ ⬝ P = 1) ∧ (B = P ⬝ A ⬝ P⁻¹))

theorem thm_2_1_9 (A : matrix n n ℂ) [invertible A] : is_similar_to A⁻¹ Aᴴ ↔ ∃ (B : matrix n n ℂ), (is_unit B) ∧ A = B⁻¹ * Bᴴ :=
begin
  split,
  intro h,
  cases h with S hS,
  cases hS with hS₁ hS₂,
  have : S = Aᴴ ⬝ S ⬝ A,
  begin
    simp [hS₂],
    simp [matrix.mul_assoc],
    rw ←  matrix.mul_assoc S⁻¹ S  A,
    rw hS₁,
    simp,
  end,

  let Sθ : ℝ → matrix n n ℂ := λ (θ : ℝ), (matrix.scalar n (complex.exp(complex.I * θ))) ⬝ S,
  have fact₁: ∀(θ : ℝ), Sθ θ = Aᴴ ⬝ (Sθ θ) ⬝ A,
  begin
    sorry,
  end,
  have fact₂ : ∀(θ : ℝ), (Sθ θ)ᴴ = Aᴴ ⬝ (Sθ θ)ᴴ ⬝ A,
  begin
    sorry,
  end,
  let Hθ : ℝ → matrix n n ℂ := λ (θ : ℝ), Sθ θ + (Sθ θ)ᴴ,
  have fact₃ : ∀(θ : ℝ), Hθ θ = Aᴴ ⬝ (Hθ θ) ⬝ A :=
  begin
    intro θ,
    simp [Hθ],
    rw matrix.mul_add,
    rw matrix.add_mul,
    simp [fact₁ θ, fact₂ θ],
    rw ← fact₁ θ,
    simp,
    sorry,
  end,

  sorry,

  sorry,
end

variables A S : matrix n n ℂ
variable [S = Aᴴ ⬝ S ⬝ A]

noncomputable def Sθ : ℝ → matrix n n ℂ := λ (θ : ℝ), (matrix.scalar n (complex.exp(complex.I * θ))) ⬝ S
noncomputable def Hθ : ℝ → matrix n n ℂ := λ (θ : ℝ), (Sθ S θ) + (Sθ S θ)ᴴ

lemma fact₁: ∀(θ : ℝ), Sθ S θ = Aᴴ ⬝ (Sθ S θ) ⬝ A :=
begin
  sorry,
end
lemma fact₂ : ∀(θ : ℝ), (Sθ S θ)ᴴ = Aᴴ ⬝ (Sθ S θ)ᴴ ⬝ A :=
begin
  sorry,
end

#check fact₁
lemma fact₃ : ∀ (θ : ℝ), Hθ S θ = Aᴴ ⬝ (Hθ S θ) ⬝ A :=
begin
  intro θ,
  simp [Hθ],
  rw matrix.mul_add,
  rw matrix.add_mul,
  unfold Sθ,
  simp,
  rw ← _inst_8,
  -- rw ← fact₂ A S 0 (by simp),
  sorry,
end

def is_upper_triangular (A : matrix n n F) :=
  ∀ (i j : n), j < i → (A i j = 0)

theorem thm_2_1_14_a (A : matrix m n F) (h : fintype.card m ≤ fintype.card n) :
  ∃ Q : (matrix m n F), ∃ R : (matrix n n F),
  (is_upper_triangular R)
    ∧(has_orthonormal_cols Q)
    ∧(A = Q ⬝ R)
    ∧(∀ i : n, is_R_or_C.re (R i i) ≥ 0)
    ∧(∀ i : n, is_R_or_C.im (R i i) = 0) :=
begin
  sorry
end

theorem thm_2_1_18 (X : matrix n n F) (Y : matrix n n F)
  (hx : has_orthonormal_cols X) (hy : has_orthonormal_cols Y) :
  ∃ (U : matrix n n F), (is_unitary U)∧(Y = U ⬝ X) :=
begin
  use Y ⬝ (X⁻¹),
  rw ← thm_2_1_4_a_e at hx,
  rw ← thm_2_1_4_a_e at hy,
  rw thm_2_1_4_a_b at hx,
  rw hx.2,
  rw ← thm_2_1_4_a_b at hx,
  split,
  rw is_unitary,
  simp,
  rw is_unitary at hy,
  rw matrix.mul_assoc,
  rw ← matrix.mul_assoc Yᴴ Y Xᴴ,
  rw hy,
  simp,
  rw ← thm_2_1_4_b_c,
  rw ← thm_2_1_4_a_b,
  exact hx,
  rw is_unitary at hx,
  rw matrix.mul_assoc,
  rw hx,
  simp,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro

! This file was ported from Lean 3 source module data.mv_polynomial.equiv
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.MvPolynomial.Rename
import Mathlib.Data.Polynomial.AlgebraMap
import Mathlib.Data.MvPolynomial.Variables
import Mathlib.Data.Finsupp.Fin
import Mathlib.Logic.Equiv.Fin
import Mathlib.Algebra.BigOperators.Fin

/-!
# Equivalences between polynomial rings

This file establishes a number of equivalences between polynomial rings,
based on equivalences between the underlying types.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type _` (indexing the variables)

+ `R : Type _` `[comm_semiring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

## Tags

equivalence, isomorphism, morphism, ring hom, hom

-/

noncomputable section

open Classical BigOperators Polynomial

open Set Function Finsupp AddMonoidAlgebra

universe u v w x

variable {R : Type u} {S₁ : Type v} {S₂ : Type w} {S₃ : Type x}

namespace MvPolynomial

variable {σ : Type _} {a a' a₁ a₂ : R} {e : ℕ} {s : σ →₀ ℕ}

section Equiv

variable (R) [CommSemiring R]

/-- The ring isomorphism between multivariable polynomials in a single variable and
polynomials over the ground ring.
-/
@[simps]
def pUnitAlgEquiv : MvPolynomial PUnit R ≃ₐ[R] R[X]
    where
  toFun := eval₂ Polynomial.C fun _ => Polynomial.X
  invFun := Polynomial.eval₂ MvPolynomial.C (X PUnit.unit)
  left_inv :=
    by
    let f : R[X] →+* MvPolynomial PUnit R := Polynomial.eval₂RingHom MvPolynomial.C (X PUnit.unit)
    let g : MvPolynomial PUnit R →+* R[X] := eval₂Hom Polynomial.C fun _ => Polynomial.X
    show ∀ p, f.comp g p = p
    apply is_id
    · ext a
      dsimp
      rw [eval₂_C, Polynomial.eval₂_C]
    · rintro ⟨⟩
      dsimp
      rw [eval₂_X, Polynomial.eval₂_X]
  right_inv p :=
    Polynomial.induction_on p (fun a => by rw [Polynomial.eval₂_C, MvPolynomial.eval₂_C])
      (fun p q hp hq => by rw [Polynomial.eval₂_add, MvPolynomial.eval₂_add, hp, hq]) fun p n _ =>
      by
      rw [Polynomial.eval₂_mul, Polynomial.eval₂_pow, Polynomial.eval₂_X, Polynomial.eval₂_C,
        eval₂_mul, eval₂_C, eval₂_pow, eval₂_X]
  map_mul' _ _ := eval₂_mul _ _
  map_add' _ _ := eval₂_add _ _
  commutes' _ := eval₂_C _ _ _
#align mv_polynomial.punit_alg_equiv MvPolynomial.pUnitAlgEquiv

section Map

variable {R} (σ)

/-- If `e : A ≃+* B` is an isomorphism of rings, then so is `map e`. -/
@[simps apply]
def mapEquiv [CommSemiring S₁] [CommSemiring S₂] (e : S₁ ≃+* S₂) :
    MvPolynomial σ S₁ ≃+* MvPolynomial σ S₂ :=
  { map (e : S₁ →+* S₂) with
    toFun := map (e : S₁ →+* S₂)
    invFun := map (e.symm : S₂ →+* S₁)
    left_inv := map_leftInverse e.left_inv
    right_inv := map_rightInverse e.right_inv }
#align mv_polynomial.map_equiv MvPolynomial.mapEquiv

@[simp]
theorem mapEquiv_refl : mapEquiv σ (RingEquiv.refl R) = RingEquiv.refl _ :=
  RingEquiv.ext map_id
#align mv_polynomial.map_equiv_refl MvPolynomial.mapEquiv_refl

@[simp]
theorem mapEquiv_symm [CommSemiring S₁] [CommSemiring S₂] (e : S₁ ≃+* S₂) :
    (mapEquiv σ e).symm = mapEquiv σ e.symm :=
  rfl
#align mv_polynomial.map_equiv_symm MvPolynomial.mapEquiv_symm

@[simp]
theorem mapEquiv_trans [CommSemiring S₁] [CommSemiring S₂] [CommSemiring S₃] (e : S₁ ≃+* S₂)
    (f : S₂ ≃+* S₃) : (mapEquiv σ e).trans (mapEquiv σ f) = mapEquiv σ (e.trans f) :=
  RingEquiv.ext fun p => by
    simp only [RingEquiv.coe_trans, comp_apply, mapEquiv_apply, RingEquiv.coe_ringHom_trans,
      map_map]
#align mv_polynomial.map_equiv_trans MvPolynomial.mapEquiv_trans

variable {A₁ A₂ A₃ : Type _} [CommSemiring A₁] [CommSemiring A₂] [CommSemiring A₃]

variable [Algebra R A₁] [Algebra R A₂] [Algebra R A₃]

/-- If `e : A ≃ₐ[R] B` is an isomorphism of `R`-algebras, then so is `map e`. -/
@[simps apply]
def mapAlgEquiv (e : A₁ ≃ₐ[R] A₂) : MvPolynomial σ A₁ ≃ₐ[R] MvPolynomial σ A₂ :=
  { mapAlgHom (e : A₁ →ₐ[R] A₂), mapEquiv σ (e : A₁ ≃+* A₂) with toFun := map (e : A₁ →+* A₂) }
#align mv_polynomial.map_alg_equiv MvPolynomial.mapAlgEquiv

@[simp]
theorem mapAlgEquiv_refl : mapAlgEquiv σ (AlgEquiv.refl : A₁ ≃ₐ[R] A₁) = AlgEquiv.refl :=
  AlgEquiv.ext map_id
#align mv_polynomial.map_alg_equiv_refl MvPolynomial.mapAlgEquiv_refl

@[simp]
theorem mapAlgEquiv_symm (e : A₁ ≃ₐ[R] A₂) : (mapAlgEquiv σ e).symm = mapAlgEquiv σ e.symm :=
  rfl
#align mv_polynomial.map_alg_equiv_symm MvPolynomial.mapAlgEquiv_symm

@[simp]
theorem mapAlgEquiv_trans (e : A₁ ≃ₐ[R] A₂) (f : A₂ ≃ₐ[R] A₃) :
    (mapAlgEquiv σ e).trans (mapAlgEquiv σ f) = mapAlgEquiv σ (e.trans f) := by
  ext
  simp only [AlgEquiv.trans_apply, mapAlgEquiv_apply, map_map]
  rfl
#align mv_polynomial.map_alg_equiv_trans MvPolynomial.mapAlgEquiv_trans

end Map

section

variable (S₁ S₂ S₃)

/-- The function from multivariable polynomials in a sum of two types,
to multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.

See `sum_ring_equiv` for the ring isomorphism.
-/
def sumToIter : MvPolynomial (Sum S₁ S₂) R →+* MvPolynomial S₁ (MvPolynomial S₂ R) :=
  eval₂Hom (C.comp C) fun bc => Sum.recOn bc X (C ∘ X)
#align mv_polynomial.sum_to_iter MvPolynomial.sumToIter

@[simp]
theorem sumToIter_C (a : R) : sumToIter R S₁ S₂ (C a) = C (C a) :=
  eval₂_C _ _ a
set_option linter.uppercaseLean3 false in
#align mv_polynomial.sum_to_iter_C MvPolynomial.sumToIter_C

@[simp]
theorem sumToIter_Xl (b : S₁) : sumToIter R S₁ S₂ (X (Sum.inl b)) = X b :=
  eval₂_X _ _ (Sum.inl b)
set_option linter.uppercaseLean3 false in
#align mv_polynomial.sum_to_iter_Xl MvPolynomial.sumToIter_Xl

@[simp]
theorem sumToIter_Xr (c : S₂) : sumToIter R S₁ S₂ (X (Sum.inr c)) = C (X c) :=
  eval₂_X _ _ (Sum.inr c)
set_option linter.uppercaseLean3 false in
#align mv_polynomial.sum_to_iter_Xr MvPolynomial.sumToIter_Xr

/-- The function from multivariable polynomials in one type,
with coefficents in multivariable polynomials in another type,
to multivariable polynomials in the sum of the two types.

See `sum_ring_equiv` for the ring isomorphism.
-/
def iterToSum : MvPolynomial S₁ (MvPolynomial S₂ R) →+* MvPolynomial (Sum S₁ S₂) R :=
  eval₂Hom (eval₂Hom C (X ∘ Sum.inr)) (X ∘ Sum.inl)
#align mv_polynomial.iter_to_sum MvPolynomial.iterToSum

theorem iterToSum_C_C (a : R) : iterToSum R S₁ S₂ (C (C a)) = C a :=
  Eq.trans (eval₂_C _ _ (C a)) (eval₂_C _ _ _)
set_option linter.uppercaseLean3 false in
#align mv_polynomial.iter_to_sum_C_C MvPolynomial.iterToSum_C_C

theorem iterToSum_X (b : S₁) : iterToSum R S₁ S₂ (X b) = X (Sum.inl b) :=
  eval₂_X _ _ _
set_option linter.uppercaseLean3 false in
#align mv_polynomial.iter_to_sum_X MvPolynomial.iterToSum_X

variable (σ)

/-- The algebra isomorphism between multivariable polynomials in no variables
and the ground ring. -/
@[simps!]
def isEmptyAlgEquiv [he : IsEmpty σ] : MvPolynomial σ R ≃ₐ[R] R :=
  AlgEquiv.ofAlgHom (aeval (IsEmpty.elim he)) (Algebra.ofId _ _)
    (by
      ext
      simp [Algebra.ofId_apply, algebraMap_eq])
    (by
      ext (i m)
      exact IsEmpty.elim' he i)
#align mv_polynomial.is_empty_alg_equiv MvPolynomial.isEmptyAlgEquiv

/-- The ring isomorphism between multivariable polynomials in no variables
and the ground ring. -/
@[simps!]
def isEmptyRingEquiv [IsEmpty σ] : MvPolynomial σ R ≃+* R :=
  (isEmptyAlgEquiv R σ).toRingEquiv
#align mv_polynomial.is_empty_ring_equiv MvPolynomial.isEmptyRingEquiv

variable {σ}

/-- A helper function for `sum_ring_equiv`. -/
@[simps]
def mvPolynomialEquivMvPolynomial [CommSemiring S₃] (f : MvPolynomial S₁ R →+* MvPolynomial S₂ S₃)
    (g : MvPolynomial S₂ S₃ →+* MvPolynomial S₁ R) (hfgC : (f.comp g).comp C = C)
    (hfgX : ∀ n, f (g (X n)) = X n) (hgfC : (g.comp f).comp C = C) (hgfX : ∀ n, g (f (X n)) = X n) :
    MvPolynomial S₁ R ≃+* MvPolynomial S₂ S₃
    where
  toFun := f
  invFun := g
  left_inv := is_id (RingHom.comp _ _) hgfC hgfX
  right_inv := is_id (RingHom.comp _ _) hfgC hfgX
  map_mul' := f.map_mul
  map_add' := f.map_add
#align mv_polynomial.mv_polynomial_equiv_mv_polynomial MvPolynomial.mvPolynomialEquivMvPolynomial

/-- The ring isomorphism between multivariable polynomials in a sum of two types,
and multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.
-/
def sumRingEquiv : MvPolynomial (Sum S₁ S₂) R ≃+* MvPolynomial S₁ (MvPolynomial S₂ R) := by
  apply
    @mvPolynomialEquivMvPolynomial R (Sum S₁ S₂) _ _ _ _ (sumToIter R S₁ S₂) (iterToSum R S₁ S₂)
  · refine' RingHom.ext fun p => _
    rw [RingHom.comp_apply]
    convert hom_eq_hom ((sumToIter R S₁ S₂).comp ((iterToSum R S₁ S₂).comp C)) C _ _ p
    · ext1 a
      dsimp
      rw [iterToSum_C_C R S₁ S₂, sumToIter_C R S₁ S₂]
    · intro c
      dsimp
      rw [iterToSum_C_X R S₁ S₂, sumToIter_Xr R S₁ S₂]
  · intro b
    rw [iterToSum_X R S₁ S₂, sumToIter_Xl R S₁ S₂]
  · ext1 a
    rw [RingHom.comp_apply, RingHom.comp_apply, sumToIter_C R S₁ S₂, iterToSum_C_C R S₁ S₂]
  · intro n
    cases' n with b c
    · rw [sumToIter_Xl, iterToSum_X]
    · rw [sumToIter_Xr, iterToSum_C_X]
#align mv_polynomial.sum_ring_equiv MvPolynomial.sumRingEquiv

/-- The algebra isomorphism between multivariable polynomials in a sum of two types,
and multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.
-/
def sumAlgEquiv : MvPolynomial (Sum S₁ S₂) R ≃ₐ[R] MvPolynomial S₁ (MvPolynomial S₂ R) :=
  { sumRingEquiv R S₁ S₂ with
    commutes' := by
      intro r
      have A : algebraMap R (MvPolynomial S₁ (MvPolynomial S₂ R)) r = (C (C r) : _) := by rfl
      have B : algebraMap R (MvPolynomial (Sum S₁ S₂) R) r = C r := by rfl
      simp only [sumRingEquiv, mvPolynomialEquivMvPolynomial, Equiv.toFun_as_coe_apply,
        Equiv.coe_fn_mk, B, sumToIter_C, A] }
#align mv_polynomial.sum_alg_equiv MvPolynomial.sumAlgEquiv

section

-- this speeds up typeclass search in the lemma below
attribute [local instance] IsScalarTower.right

/-- The algebra isomorphism between multivariable polynomials in `option S₁` and
polynomials with coefficients in `mv_polynomial S₁ R`.
-/
@[simps!]
def optionEquivLeft : MvPolynomial (Option S₁) R ≃ₐ[R] Polynomial (MvPolynomial S₁ R) :=
  AlgEquiv.ofAlgHom (MvPolynomial.aeval fun o => o.elim Polynomial.X fun s => Polynomial.C (X s))
    (Polynomial.aevalTower (MvPolynomial.rename some) (X none))
    (by ext : 2 <;> simp [← Polynomial.C_eq_algebraMap]) (by ext i : 2; cases i <;> simp)
#align mv_polynomial.option_equiv_left MvPolynomial.optionEquivLeft

end

/-- The algebra isomorphism between multivariable polynomials in `option S₁` and
multivariable polynomials with coefficients in polynomials.
-/
def optionEquivRight : MvPolynomial (Option S₁) R ≃ₐ[R] MvPolynomial S₁ R[X] :=
  AlgEquiv.ofAlgHom (MvPolynomial.aeval fun o => o.elim (C Polynomial.X) X)
    (MvPolynomial.aevalTower (Polynomial.aeval (X none)) fun i => X (Option.some i))
    (by
      ext : 2 <;>
        simp only [MvPolynomial.algebraMap_eq, Option.elim, AlgHom.coe_comp, AlgHom.id_comp,
          IsScalarTower.coe_to_alg_hom', comp_apply, aevalTower_C, Polynomial.aeval_X, aeval_X,
          Option.elim', aevalTower_X, AlgHom.coe_id, id.def, eq_self_iff_true, imp_true_iff])
    (by
      ext ⟨i⟩ : 2 <;>
        simp only [Option.elim, AlgHom.coe_comp, comp_apply, aeval_X, aevalTower_C,
          Polynomial.aeval_X, AlgHom.coe_id, id.def, aevalTower_X])
#align mv_polynomial.option_equiv_right MvPolynomial.optionEquivRight

variable (n : ℕ)

/-- The algebra isomorphism between multivariable polynomials in `fin (n + 1)` and
polynomials over multivariable polynomials in `fin n`.
-/
def finSuccEquiv : MvPolynomial (Fin (n + 1)) R ≃ₐ[R] Polynomial (MvPolynomial (Fin n) R) :=
  (renameEquiv R (_root_.finSuccEquiv n)).trans (optionEquivLeft R (Fin n))
#align mv_polynomial.fin_succ_equiv MvPolynomial.finSuccEquiv

theorem finSuccEquiv_eq :
    (finSuccEquiv R n : MvPolynomial (Fin (n + 1)) R →+* Polynomial (MvPolynomial (Fin n) R)) =
      eval₂Hom (Polynomial.C.comp (C : R →+* MvPolynomial (Fin n) R)) fun i : Fin (n + 1) =>
        Fin.cases Polynomial.X (fun k => Polynomial.C (X k)) i := by
  ext i : 2
  · simp only [finSuccEquiv, optionEquivLeft_apply, aeval_C, AlgEquiv.coe_trans, RingHom.coe_coe,
      coe_eval₂Hom, comp_apply, renameEquiv_apply, eval₂_C, RingHom.coe_comp, rename_C]
    rfl
  · refine' Fin.cases _ _ i <;> simp [finSuccEquiv]
#align mv_polynomial.fin_succ_equiv_eq MvPolynomial.finSuccEquiv_eq

@[simp]
theorem finSuccEquiv_apply (p : MvPolynomial (Fin (n + 1)) R) :
    finSuccEquiv R n p =
      eval₂Hom (Polynomial.C.comp (C : R →+* MvPolynomial (Fin n) R))
        (fun i : Fin (n + 1) => Fin.cases Polynomial.X (fun k => Polynomial.C (X k)) i) p := by
  rw [← finSuccEquiv_eq]
  rfl
#align mv_polynomial.fin_succ_equiv_apply MvPolynomial.finSuccEquiv_apply

theorem finSuccEquiv_comp_C_eq_C {R : Type u} [CommSemiring R] (n : ℕ) :
    (↑(MvPolynomial.finSuccEquiv R n).symm : Polynomial (MvPolynomial (Fin n) R) →+* _).comp
        (Polynomial.C.comp MvPolynomial.C) =
      (MvPolynomial.C : R →+* MvPolynomial (Fin n.succ) R) := by
  refine' RingHom.ext fun x => _
  rw [RingHom.comp_apply]
  refine'
    (MvPolynomial.finSuccEquiv R n).injective
      (Trans.trans ((MvPolynomial.finSuccEquiv R n).apply_symm_apply _) _)
  simp only [MvPolynomial.finSuccEquiv_apply, MvPolynomial.eval₂Hom_C]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.fin_succ_equiv_comp_C_eq_C MvPolynomial.finSuccEquiv_comp_C_eq_C

variable {n} {R}

theorem finSuccEquiv_X_zero : finSuccEquiv R n (X 0) = Polynomial.X := by simp
set_option linter.uppercaseLean3 false in
#align mv_polynomial.fin_succ_equiv_X_zero MvPolynomial.finSuccEquiv_X_zero

theorem finSuccEquiv_X_succ {j : Fin n} : finSuccEquiv R n (X j.succ) = Polynomial.C (X j) := by
  simp
set_option linter.uppercaseLean3 false in
#align mv_polynomial.fin_succ_equiv_X_succ MvPolynomial.finSuccEquiv_X_succ

/-- The coefficient of `m` in the `i`-th coefficient of `fin_succ_equiv R n f` equals the
    coefficient of `finsupp.cons i m` in `f`. -/
theorem finSuccEquiv_coeff_coeff (m : Fin n →₀ ℕ) (f : MvPolynomial (Fin (n + 1)) R) (i : ℕ) :
    coeff m (Polynomial.coeff (finSuccEquiv R n f) i) = coeff (m.cons i) f := by
  induction' f using MvPolynomial.induction_on' with j r p q hp hq generalizing i m
  swap
  · simp only [(finSuccEquiv R n).map_add, Polynomial.coeff_add, coeff_add, hp, hq]
  simp only [finSuccEquiv_apply, coe_eval₂Hom, eval₂_monomial, RingHom.coe_comp, prod_pow,
    Polynomial.coeff_C_mul, coeff_C_mul, coeff_monomial, Fin.prod_univ_succ, Fin.cases_zero,
    Fin.cases_succ, ← map_prod, ← RingHom.map_pow, Function.comp_apply]
  rw [← mul_boole, mul_comm (Polynomial.X ^ j 0), Polynomial.coeff_C_mul_X_pow]; congr 1
  obtain rfl | hjmi := eq_or_ne j (m.cons i)
  · simpa only [cons_zero, cons_succ, if_pos rfl, monomial_eq, C_1, one_mul, prod_pow] using
      coeff_monomial m m (1 : R)
  · simp only [hjmi, if_false]
    obtain hij | rfl := ne_or_eq i (j 0)
    · simp only [hij, if_false, coeff_zero]
    simp only [eq_self_iff_true, if_true]
    have hmj : m ≠ j.tail := by
      rintro rfl
      rw [cons_tail] at hjmi
      contradiction
    simpa only [monomial_eq, C_1, one_mul, prod_pow, Finsupp.tail_apply, if_neg hmj.symm] using
      coeff_monomial m j.tail (1 : R)
#align mv_polynomial.fin_succ_equiv_coeff_coeff MvPolynomial.finSuccEquiv_coeff_coeff

theorem eval_eq_eval_mv_eval' (s : Fin n → R) (y : R) (f : MvPolynomial (Fin (n + 1)) R) :
    eval (Fin.cons y s : Fin (n + 1) → R) f =
      Polynomial.eval y (Polynomial.map (eval s) (finSuccEquiv R n f)) := by
  -- turn this into a def `polynomial.map_alg_hom`
  let φ : (MvPolynomial (Fin n) R)[X] →ₐ[R] R[X] :=
    { Polynomial.mapRingHom (eval s) with
      commutes' := fun r => by
        convert Polynomial.map_C (eval s)
        exact (eval_C _).symm }
  show
    aeval (Fin.cons y s : Fin (n + 1) → R) f =
      (Polynomial.aeval y).comp (φ.comp (finSuccEquiv R n).toAlgHom) f
  congr 2
  apply MvPolynomial.algHom_ext
  rw [Fin.forall_fin_succ]
  simp only [aeval_X, Fin.cons_zero, AlgEquiv.toAlgHom_eq_coe, AlgHom.coe_comp,
    Polynomial.coe_aeval_eq_eval, Polynomial.map_C, AlgHom.coe_mk, RingHom.toFun_eq_coe,
    Polynomial.coe_mapRingHom, comp_apply, finSuccEquiv_apply, eval₂Hom_X',
    Fin.cases_zero, Polynomial.map_X, Polynomial.eval_X, Fin.cons_succ,
    Fin.cases_succ, eval_X, Polynomial.eval_C,
    RingHom.coe_mk, MonoidHom.coe_coe, AlgHom.coe_coe, implies_true, and_self,
    RingHom.toMonoidHom_eq_coe]
#align mv_polynomial.eval_eq_eval_mv_eval' MvPolynomial.eval_eq_eval_mv_eval'

theorem coeff_eval_eq_eval_coeff (s' : Fin n → R) (f : Polynomial (MvPolynomial (Fin n) R))
    (i : ℕ) : Polynomial.coeff (Polynomial.map (eval s') f) i = eval s' (Polynomial.coeff f i) := by
  simp only [Polynomial.coeff_map]
#align mv_polynomial.coeff_eval_eq_eval_coeff MvPolynomial.coeff_eval_eq_eval_coeff

theorem support_coeff_finSuccEquiv {f : MvPolynomial (Fin (n + 1)) R} {i : ℕ} {m : Fin n →₀ ℕ} :
    m ∈ (Polynomial.coeff ((finSuccEquiv R n) f) i).support ↔ Finsupp.cons i m ∈ f.support := by
  apply Iff.intro
  · intro h
    simpa [← finSuccEquiv_coeff_coeff] using h
  · intro h
    simpa [mem_support_iff, ← finSuccEquiv_coeff_coeff m f i] using h
#align mv_polynomial.support_coeff_fin_succ_equiv MvPolynomial.support_coeff_finSuccEquiv

theorem finSuccEquiv_support (f : MvPolynomial (Fin (n + 1)) R) :
    (finSuccEquiv R n f).support = Finset.image (fun m : Fin (n + 1) →₀ ℕ => m 0) f.support := by
  ext i
  rw [Polynomial.mem_support_iff, Finset.mem_image, nonzero_iff_exists]
  constructor
  · rintro ⟨m, hm⟩
    refine' ⟨cons i m, _, cons_zero _ _⟩
    rw [← support_coeff_finSuccEquiv]
    simpa using hm
  · rintro ⟨m, h, rfl⟩
    refine' ⟨tail m, _⟩
    rwa [← coeff, ← mem_support_iff, support_coeff_finSuccEquiv, cons_tail]
#align mv_polynomial.fin_succ_equiv_support MvPolynomial.finSuccEquiv_support

theorem finSuccEquiv_support' {f : MvPolynomial (Fin (n + 1)) R} {i : ℕ} :
    Finset.image (Finsupp.cons i) (Polynomial.coeff ((finSuccEquiv R n) f) i).support =
      f.support.filter fun m => m 0 = i := by
  ext m
  rw [Finset.mem_filter, Finset.mem_image, mem_support_iff]
  conv_lhs =>
    congr
    ext
    rw [mem_support_iff, finSuccEquiv_coeff_coeff, Ne.def]
  constructor
  · rintro ⟨m', ⟨h, hm'⟩⟩
    simp only [← hm']
    exact ⟨h, by rw [cons_zero]⟩
  · intro h
    use tail m
    rw [← h.2, cons_tail]
    simp [h.1]
#align mv_polynomial.fin_succ_equiv_support' MvPolynomial.finSuccEquiv_support'

theorem support_finSuccEquiv_nonempty {f : MvPolynomial (Fin (n + 1)) R} (h : f ≠ 0) :
    (finSuccEquiv R n f).support.Nonempty := by
  simp only [Finset.nonempty_iff_ne_empty, Ne, Polynomial.support_eq_empty]
  refine fun c => h ?_
  let ii := (finSuccEquiv R n).symm
  calc
    f = ii (finSuccEquiv R n f) := by
      simpa only [← AlgEquiv.invFun_eq_symm] using ((finSuccEquiv R n).left_inv f).symm
    _ = ii 0 := by rw [c]
    _ = 0 := by simp
#align mv_polynomial.support_fin_succ_equiv_nonempty MvPolynomial.support_finSuccEquiv_nonempty

theorem degree_finSuccEquiv {f : MvPolynomial (Fin (n + 1)) R} (h : f ≠ 0) :
    (finSuccEquiv R n f).degree = degreeOf 0 f := by
  -- TODO: these should be lemmas
  have h₀ : ∀ {α β : Type _} (f : α → β), (fun x => x) ∘ f = f := fun f => rfl
  have h₁ : ∀ {α β : Type _} (f : α → β), f ∘ (fun x => x) = f := fun f => rfl
  have h₂ : WithBot.some = Nat.cast := rfl

  have h' : ((finSuccEquiv R n f).support.sup fun x => x) = degreeOf 0 f := by
    rw [degreeOf_eq_sup, finSuccEquiv_support f, Finset.sup_image, h₀]
  rw [Polynomial.degree, ← h', ← h₂, Finset.coe_sup_of_nonempty (support_finSuccEquiv_nonempty h),
    Finset.max_eq_sup_coe, h₁]
#align mv_polynomial.degree_fin_succ_equiv MvPolynomial.degree_finSuccEquiv

theorem natDegree_finSuccEquiv (f : MvPolynomial (Fin (n + 1)) R) :
    (finSuccEquiv R n f).natDegree = degreeOf 0 f := by
  by_cases c : f = 0
  · rw [c, (finSuccEquiv R n).map_zero, Polynomial.natDegree_zero, degreeOf_zero]
  · rw [Polynomial.natDegree, degree_finSuccEquiv (by simpa only [Ne.def] )]
    erw [WithBot.unbot'_coe]
    simp
#align mv_polynomial.nat_degree_fin_succ_equiv MvPolynomial.natDegree_finSuccEquiv

theorem degreeOf_coeff_finSuccEquiv (p : MvPolynomial (Fin (n + 1)) R) (j : Fin n) (i : ℕ) :
    degreeOf j (Polynomial.coeff (finSuccEquiv R n p) i) ≤ degreeOf j.succ p := by
  rw [degreeOf_eq_sup, degreeOf_eq_sup, Finset.sup_le_iff]
  intro m hm
  rw [← Finsupp.cons_succ j i m]
  exact Finset.le_sup
    (f := fun (g : Fin (Nat.succ n) →₀ ℕ) => g (Fin.succ j))
    (support_coeff_finSuccEquiv.1 hm)
#align mv_polynomial.degree_of_coeff_fin_succ_equiv MvPolynomial.degreeOf_coeff_finSuccEquiv

end

end Equiv

end MvPolynomial


import tactic

-- start in room 0
-- need to find our way to room gcd(a,b)

/-- Solver docs : Terms of type `maze` are rooms in the game. -/

@[derive has_reflect]
inductive direction : Type
| north | east | south | west

namespace maze

/-
ABC
DEF
GHI
-/

section parameter_a_b

parameters (a b : ℕ)

@[reducible] definition maze := ℤ

instance : has_coe ℤ (maze) := ⟨id⟩

/-- north = +a, south = -a, east = +b, west = -b-/
def go (d : direction) (m : maze) : maze :=
direction.rec_on d
  -- go north = add 8
  (m + a)
    -- go east = add 3
  (m + b)
  -- go south = subtract 8
  (m - a)
  -- go west = subtract 3
  (m - b)

/-- The predicate of being able to escape from the maze -/
inductive can_escape : maze → Prop
| exit : can_escape (nat.gcd a b)
| go : ∀ d x, can_escape (go d x) → can_escape x

end parameter_a_b

end maze

open maze direction

open tactic

meta def go (d : direction) : tactic unit :=
`[apply can_escape.go %%d, unfold maze.go, norm_num,
fail_if_success { guard_target can_escape W } <|> fail "You hit a wall!" ]

meta def tactic.interactive.n := `[go north]
meta def tactic.interactive.s := `[go south]
meta def tactic.interactive.e := `[go east]
meta def tactic.interactive.w := `[go west]

open tactic

meta def out : tactic unit :=
`[apply can_escape.exit <|> fail "you are not at the exit level J"]

-- theorem solve : can_escape A :=
-- begin
--   s,
--   sorry,
-- end

-- I have no solver
-- meta def xyzzy : tactic unit := sorry
-- --`[ {e,n,e,e,out} <|> {n,e,e,out} <|> {e,e,out} <|> {e,out} <|> {out} ]


class One (α : Type u) where
  one : α

instance One.toOfNat1 {α} [One α] : OfNat α (nat_lit 1) where
  ofNat := ‹One α›.1

class MulOneClass (M : Type u) extends One M, Mul M where
  one_mul : ∀ a : M, 1 * a = a
  mul_one : ∀ a : M, a * 1 = a

theorem MulOneClass.ext {M : Type u} : ∀ ⦃m₁ m₂ : MulOneClass M⦄, m₁.mul = m₂.mul → m₁ = m₂ := by
  intro m₁ m₂
  cases m₁ with
  | @mk one₁ mul₁ one_mul₁ mul_one₁ =>
    cases one₁ with | mk one₁ =>
    cases mul₁ with | mk mul₁ =>
    cases m₂ with
    | @mk one₂ mul₂ one_mul₂ mul_one₂ =>
      cases one₂ with | mk one₂ =>
      cases mul₂ with | mk mul₂ =>
        simp
        intro h
        simp [toMul, Mul.mul] at h -- h : mul₁ = mul₂
        cases h
        have := (one_mul₂ one₁).symm.trans (mul_one₁ one₂) -- TODO: make sure we can apply after congr
        subst this
        congr