import Mathlib.Algebra.Module.Submodule.Lattice
import Mathlib.RingTheory.Ideal.Basic
import Mathlib.RingTheory.Ideal.Operations
import Mathlib.Data.Set.Basic
import Mathlib.RingTheory.UniqueFactorizationDomain
import Mathlib.RingTheory.PrincipalIdealDomain
import Kaplanski4.Absorbing

variable {R : Type _} [CommRing R] (S : Submonoid R)

/-- Explication -/
def foo :=
  { I : Ideal R | (I : Set R) ∩ S = ∅ }

theorem foo_def (P : Ideal R) : P ∈ foo S ↔ (P : Set R) ∩ S = ∅ :=
  Iff.rfl

variable {P : Ideal R} {S} (hP : P ∈ foo S) (hmax : ∀ I ∈ foo S, P ≤ I → I = P)

section Basic

theorem P_neq_top (hP : P ∈ foo S) : P ≠ ⊤ := fun h =>
  ((Set.disjoint_left.1 (Set.disjoint_iff_inter_eq_empty.2 ((foo_def _ _).1 hP)))
      (P.eq_top_iff_one.1 h)) S.one_mem

theorem gt_inter {I : Ideal R} (h : P < I) : ∃ x : R, x ∈ (I : Set R) ∩ S :=
  Set.inter_nonempty.1
    (Set.nonempty_iff_ne_empty.2 fun h₂ =>
      (lt_iff_le_and_ne.1 h).2 (Eq.symm ((hmax I) h₂ (lt_iff_le_and_ne.1 h).1)))

theorem mem_or_mem' : ∀ {x y : R}, x * y ∈ P → x ∈ P ∨ y ∈ P := by
  rintro x y hxy
  by_contra h
  push_neg  at h
  cases' h with h' h''
  let I := P ⊔ Ideal.span {x}
  let J := P ⊔ Ideal.span {y}
  have h₁ : ∃ x : R, x ∈ (I : Set R) ∩ S :=
    by
    refine' gt_inter hmax (lt_of_le_of_ne' le_sup_left _)
    intro hI
    rw [← hI, ← Ideal.span_singleton_le_iff_mem _] at h'
    exact h' le_sup_right
  have h₂ : ∃ x : R, x ∈ (J : Set R) ∩ S :=
    by
    refine' gt_inter hmax (lt_of_le_of_ne' le_sup_left _)
    intro hJ
    rw [← hJ, ← Ideal.span_singleton_le_iff_mem _] at h''
    exact h'' le_sup_right
  rcases h₁, h₂ with ⟨⟨s, ⟨hs, hs'⟩⟩, ⟨t, ⟨ht, ht'⟩⟩⟩
  have h₃ : I * J ≤ P := by
    rw [Ideal.mul_sup _ _ _, Ideal.sup_mul _ _ _, Ideal.sup_mul _ _ _,
      Ideal.span_singleton_mul_span_singleton]
    exact
      sup_le (sup_le Ideal.mul_le_right Ideal.mul_le_left)
        (sup_le Ideal.mul_le_right ((Ideal.span_singleton_le_iff_mem _).2 hxy))
  exact
    Set.eq_empty_iff_forall_not_mem.1 hP (s * t) ⟨h₃ (Ideal.mul_mem_mul hs ht), S.mul_mem hs' ht'⟩

theorem theo3 : P.IsPrime :=
  ⟨P_neq_top hP, fun h => mem_or_mem' hP hmax h⟩

end Basic

section Existence

theorem condition_Zorns_lemma (C : Set (Ideal R)) (hC : C ⊆ foo S) (hC₂ : IsChain (· ≤ ·) C)
    (I : Ideal R) (hI : I ∈ C) : ∃ (P : Ideal R), P ∈ foo S ∧ ∀ J : Ideal R, J ∈ C → J ≤ P := by
  refine' ⟨supₛ C, _, fun z hz => le_supₛ hz⟩
  rw [foo_def, Set.eq_empty_iff_forall_not_mem]
  rintro x hx
  rcases(Submodule.mem_supₛ_of_directed ⟨_, hI⟩ hC₂.directedOn).1 hx.1 with ⟨J, hJ₁, hJ₂⟩
  have hx₂ : (J : Set R) ∩ S ≠ ∅ := Set.nonempty_iff_ne_empty.1 ⟨x, hJ₂, hx.2⟩
  exact hx₂ (hC hJ₁)

theorem prop_2 (hS : (0 : R) ∉ S) : ∃ P ∈ foo S, ∀ I ∈ foo S, P ≤ I → I = P := by
  have hx : (0 : Ideal R) ∈ foo S :=  by
    rw [foo_def, Set.eq_empty_iff_forall_not_mem]
    rintro y ⟨hy₁, hy₂⟩
    rw [SetLike.mem_coe, Ideal.zero_eq_bot, Ideal.mem_bot] at hy₁
    rw [hy₁] at hy₂
    exact hS hy₂
  rcases zorn_nonempty_partialOrder₀ _ condition_Zorns_lemma 0 hx with ⟨J, ⟨hJ, ⟨_, hJ₃⟩⟩⟩
  exact ⟨J, hJ, hJ₃⟩

end Existence

section Kaplansky

theorem Multiset.prod_mem_ideal {I : Ideal R} (s : Multiset R) (hI : I.IsPrime) :
    s.prod ∈ I ↔ ∃ (p : R)(_ : p ∈ s), p ∈ I := by
  classical
    constructor
    · intro hs
      by_contra h
      push_neg  at h
      have hs₃ : s.prod ∉ I
      refine' Multiset.prod_induction _ _ _ _ h
      · rintro a b ha hb
        by_contra h
        cases' (Ideal.isPrime_iff.1 hI).2 h with hI₂ hI₃
        exact ha hI₂
        exact hb hI₃
      exact fun h₂ => (Ideal.isPrime_iff.1 hI).1 ((Ideal.eq_top_iff_one _).2 h₂)
      exact hs₃ hs
    · intro hs
      rcases hs with ⟨p, ⟨hs₂, hs₃⟩⟩
      rw [← Multiset.prod_erase hs₂]
      exact Ideal.mul_mem_right _ _ hs₃

variable (R)

/-- The set of prime elements. -/
def primes :=
  { r : R | Prime r }

variable [IsDomain R]

variable {R}

theorem theo1_droite [UniqueFactorizationMonoid R] {I : Ideal R} (hI : I ≠ ⊥) (hI₂ : I.IsPrime) :
    ∃ x ∈ I, Prime x := by
  classical
    have ha : ∃ a : R, a ∈ I ∧ a ≠ 0 := Submodule.exists_mem_ne_zero_of_ne_bot hI
    rcases ha with ⟨a, ⟨ha₁, ha₂⟩⟩
    cases' UniqueFactorizationMonoid.factors_prod ha₂ with u ha₃
    rw [← ha₃] at ha₁
    cases' (Ideal.IsPrime.mem_or_mem hI₂) ha₁ with ha₄ ha₅
    · rcases(Multiset.prod_mem_ideal (UniqueFactorizationMonoid.factors a) hI₂).1 ha₄ with
        ⟨p, ⟨ha₅, ha₆⟩⟩
      refine' ⟨p, ha₆, UniqueFactorizationMonoid.prime_of_factor p ha₅⟩
    · exfalso
      exact (Ideal.isPrime_iff.1 hI₂).1 (Ideal.eq_top_of_isUnit_mem _ ha₅ (Units.isUnit u))

variable (R)

theorem primes_mem_mul : (Submonoid.closure (primes R)).Absorbing := by
  classical
    rw [Submonoid.absorbing_iff_of_comm]
    intro a b hab
    obtain ⟨m, hm⟩ := Submonoid.exists_multiset_of_mem_closure hab
    revert hm a b
    refine' Multiset.strongInductionOn m _
    rintro s hind b a _ ⟨hprime, hprod⟩
    rcases s.empty_or_exists_mem with (hempty | ⟨i, hi⟩)
    · simp [hempty] at hprod
      exact ⟨1, Submonoid.one_mem _, associated_one_of_mul_eq_one _ hprod.symm⟩
    rw [← Multiset.prod_erase hi] at hprod
    rcases(hprime i hi).dvd_or_dvd ⟨(s.erase i).prod, hprod.symm⟩ with (⟨x, hxb⟩ | ⟨x, hxa⟩)
    · suffices ∃ z ∈ Submonoid.closure (primes R), Associated x z by
        obtain ⟨z, hz, hzx⟩ := this
        refine' ⟨z * i, Submonoid.mul_mem _ hz (Submonoid.subset_closure (hprime _ hi)), _⟩
        rw [hxb, mul_comm z i]
        exact Associated.mul_left i hzx
      rw [hxb, mul_assoc] at hprod
      replace hprod := IsLeftCancelMulZero.mul_left_cancel_of_ne_zero (hprime _ hi).ne_zero hprod
      have hxamem : x * a ∈ Submonoid.closure (primes R) := by
        rw [← hprod]
        exact Submonoid.multiset_prod_mem _ _ fun x hx =>
          Submonoid.subset_closure (hprime _ (Multiset.erase_subset _ _ hx))
      exact hind (s.erase i) (Multiset.erase_lt.2 hi) _ _ hxamem
        ⟨fun y hy => hprime y ((s.erase_subset _) hy), hprod⟩
    · rw [hxa, ← mul_assoc, mul_comm b i, mul_assoc] at hprod
      replace hprod := IsLeftCancelMulZero.mul_left_cancel_of_ne_zero (hprime i hi).ne_zero hprod
      have hbxmem : b * x ∈ Submonoid.closure (primes R) := by
        rw [← hprod]
        exact Submonoid.multiset_prod_mem _ _ fun x hx =>
          Submonoid.subset_closure (hprime _ (Multiset.erase_subset _ _ hx))
      exact hind (s.erase i) (Multiset.erase_lt.2 hi) _ _ hbxmem
        ⟨fun y hy => hprime y ((s.erase_subset _) hy), hprod⟩

variable {R}

theorem theo1_gauche (H : ∀ (I : Ideal R) (_ : I ≠ ⊥) (_ : I.IsPrime), ∃ x ∈ I, Prime x) :
    UniqueFactorizationMonoid R := by
  let S := Submonoid.closure (primes R)
  have hzero : (0 : R) ∉ S
  intro h
  rcases Submonoid.exists_multiset_of_mem_closure h with ⟨l, ⟨hl, hprod⟩⟩
  exact not_prime_zero (hl 0 (Multiset.prod_eq_zero_iff.1 hprod))
  refine' UniqueFactorizationMonoid.of_exists_prime_factors fun a ha => _
  have ha₂ : Ideal.span {a} ∉ foo S := by
    intro h
    rcases prop_2 hzero with ⟨P, ⟨hP, hP₂⟩⟩
    have hP₃ : P ≠ 0 := by
      intro h₂
      rw [h₂, Ideal.zero_eq_bot] at hP₂
      exact ha (Ideal.span_singleton_eq_bot.1 (hP₂ (Ideal.span {a}) h (zero_le (Ideal.span {a}))))
    rcases(H P) hP₃ (theo3 hP hP₂) with ⟨x, ⟨H₃, H₄⟩⟩
    rw [foo_def, Set.eq_empty_iff_forall_not_mem] at hP
    exact hP x ⟨H₃, Submonoid.subset_closure H₄⟩
  rw [foo_def, ← Ne.def] at ha₂
  rcases Set.nonempty_iff_ne_empty.2 ha₂ with ⟨x, ⟨hx, hx₂⟩⟩
  cases' Ideal.mem_span_singleton'.1 (SetLike.mem_coe.1 hx) with b hb
  rw [← hb, mul_comm] at hx₂
  obtain ⟨z, hzmem, hass⟩ := Submonoid.absorbing_iff_of_comm.1 (primes_mem_mul _) _ _ hx₂
  obtain ⟨m, hprime, hprod⟩ := Submonoid.exists_multiset_of_mem_closure hzmem
  refine' ⟨m, hprime, _⟩
  rwa [hprod, Associated.comm]

end Kaplansky


import data.polynomial.derivative

namespace polynomial

open_locale polynomial
theorem bernoulli_rule {R : Type*} [comm_ring R] {p q : R[X]} {x : R} (h : p.is_root x) :
(p*q).derivative.eval x = p.derivative.eval x * q.eval x :=
begin
  rw is_root.def at h,
  simp only [is_root.def, h, derivative_mul, eval_add, eval_mul, zero_mul, add_zero]
end

end polynomial


import data.rat
import data.analysis.topology
import data.set.basic
import init.algebra.classes
import regular_sequence
import order.filter.basic

open set
universe u

variables {T: Type u}[lattice T][is_total T has_le.le]

def left_ray : T → (set T) := λ a, {x : T | x ≤ a}

lemma left_ray_inter(a b: T): left_ray a ∩ left_ray b = left_ray (a ⊓ b) :=
  set.ext (λ x, ⟨(λ h, by rwa [left_ray,mem_set_of_eq, le_inf_iff]),
    (λ h, by rwa [left_ray, mem_inter_eq, mem_set_of_eq, mem_set_of_eq, ← le_inf_iff])⟩)

def left_ray_topology : topological_space ℤ :=
{ is_open := λ U, U = ∅ ∨ U = univ ∨ ∃ z, U = left_ray z,
  is_open_univ := by tauto,
  is_open_inter :=
  begin
    intros U V hU hV,
    rcases hU,
    {
      left,
      rw hU,
      simp,
    },
    {
      cases hU,
      {
        cases hV,
        {
          left,
          rw hV,
          simp,
        },
        {
          cases hV,
          {
            right,
            left,
            rw [hV, hU],
            simp,
          },
          {
            right,
            right,
            rw hU,
            simpa,
          },
        },
      },
      {
        cases hV,
        {
          left,
          rw hV,
          simp,
        },
        {
          cases hV,
          {
            right,
            right,
            rw hV,
            simpa,
          },
          {
            right,
            right,
            obtain ⟨z1, hz1⟩ := hU,
            obtain ⟨z2, hz2⟩ := hV,
            use z1 ⊓ z2,
            rw [hz1, hz2],
            exact left_ray_inter z1 z2,
          },
          },
        },
      },
  end,
  is_open_sUnion := sorry }


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen

! This file was ported from Lean 3 source module linear_algebra.matrix.block
! leanprover-community/mathlib commit 6ca1a09bc9aa75824bf97388c9e3b441fc4ccf3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.Determinant
import Mathbin.LinearAlgebra.Matrix.NonsingularInverse
import Mathbin.Tactic.FinCases

/-!
# Block matrices and their determinant

This file defines a predicate `matrix.block_triangular` saying a matrix
is block triangular, and proves the value of the determinant for various
matrices built out of blocks.

## Main definitions

 * `matrix.block_triangular` expresses that a `o` by `o` matrix is block triangular,
   if the rows and columns are ordered according to some order `b : o → α`

## Main results
  * `matrix.det_of_block_triangular`: the determinant of a block triangular matrix
    is equal to the product of the determinants of all the blocks
  * `matrix.det_of_upper_triangular` and `matrix.det_of_lower_triangular`: the determinant of
    a triangular matrix is the product of the entries along the diagonal

## Tags

matrix, diagonal, det, block triangular

-/

open Finset Function OrderDual

open BigOperators Matrix

universe v

variable {α β m n o : Type _} {m' n' : α → Type _}

variable {R : Type v} [CommRing R] {M N : Matrix m m R} {b : m → α}

namespace Matrix

section LT

variable [LT α]

/-- Let `b` map rows and columns of a square matrix `M` to blocks indexed by `α`s. Then
`block_triangular M n b` says the matrix is block triangular. -/
def BlockTriangular (M : Matrix m m R) (b : m → α) : Prop :=
  ∀ ⦃i j⦄, b j < b i → M i j = 0
#align matrix.block_triangular Matrix.BlockTriangular

@[simp]
protected theorem BlockTriangular.submatrix {f : n → m} (h : M.BlockTriangular b) :
    (M.submatrix f f).BlockTriangular (b ∘ f) := fun i j hij => h hij
#align matrix.block_triangular.submatrix Matrix.BlockTriangular.submatrix

theorem blockTriangular_reindex_iff {b : n → α} {e : m ≃ n} :
    (reindex e e M).BlockTriangular b ↔ M.BlockTriangular (b ∘ e) :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · convert h.submatrix
    simp only [reindex_apply, submatrix_submatrix, submatrix_id_id, Equiv.symm_comp_self]
  · convert h.submatrix
    simp only [comp.assoc b e e.symm, Equiv.self_comp_symm, comp.right_id]
#align matrix.block_triangular_reindex_iff Matrix.blockTriangular_reindex_iff

protected theorem BlockTriangular.transpose :
    M.BlockTriangular b → Mᵀ.BlockTriangular (toDual ∘ b) :=
  swap
#align matrix.block_triangular.transpose Matrix.BlockTriangular.transpose

@[simp]
protected theorem blockTriangular_transpose_iff {b : m → αᵒᵈ} :
    Mᵀ.BlockTriangular b ↔ M.BlockTriangular (ofDual ∘ b) :=
  forall_swap
#align matrix.block_triangular_transpose_iff Matrix.blockTriangular_transpose_iff

@[simp]
theorem blockTriangular_zero : BlockTriangular (0 : Matrix m m R) b := fun i j h => rfl
#align matrix.block_triangular_zero Matrix.blockTriangular_zero

protected theorem BlockTriangular.neg (hM : BlockTriangular M b) : BlockTriangular (-M) b :=
  fun i j h => neg_eq_zero.2 <| hM h
#align matrix.block_triangular.neg Matrix.BlockTriangular.neg

theorem BlockTriangular.add (hM : BlockTriangular M b) (hN : BlockTriangular N b) :
    BlockTriangular (M + N) b := fun i j h => by simp_rw [Pi.add_apply, hM h, hN h, zero_add]
#align matrix.block_triangular.add Matrix.BlockTriangular.add

theorem BlockTriangular.sub (hM : BlockTriangular M b) (hN : BlockTriangular N b) :
    BlockTriangular (M - N) b := fun i j h => by simp_rw [Pi.sub_apply, hM h, hN h, sub_zero]
#align matrix.block_triangular.sub Matrix.BlockTriangular.sub

end LT

section Preorder

variable [Preorder α]

theorem blockTriangular_diagonal [DecidableEq m] (d : m → R) : BlockTriangular (diagonal d) b :=
  fun i j h => diagonal_apply_ne' d fun h' => ne_of_lt h (congr_arg _ h')
#align matrix.block_triangular_diagonal Matrix.blockTriangular_diagonal

theorem blockTriangular_blockDiagonal' [DecidableEq α] (d : ∀ i : α, Matrix (m' i) (m' i) R) :
    BlockTriangular (blockDiagonal' d) Sigma.fst :=
  by
  rintro ⟨i, i'⟩ ⟨j, j'⟩ h
  apply block_diagonal'_apply_ne d i' j' fun h' => ne_of_lt h h'.symm
#align matrix.block_triangular_block_diagonal' Matrix.blockTriangular_blockDiagonal'

theorem blockTriangular_blockDiagonal [DecidableEq α] (d : α → Matrix m m R) :
    BlockTriangular (blockDiagonal d) Prod.snd :=
  by
  rintro ⟨i, i'⟩ ⟨j, j'⟩ h
  rw [block_diagonal'_eq_block_diagonal, block_triangular_block_diagonal']
  exact h
#align matrix.block_triangular_block_diagonal Matrix.blockTriangular_blockDiagonal

end Preorder

section LinearOrder

variable [LinearOrder α]

theorem BlockTriangular.mul [Fintype m] {M N : Matrix m m R} (hM : BlockTriangular M b)
    (hN : BlockTriangular N b) : BlockTriangular (M * N) b :=
  by
  intro i j hij
  apply Finset.sum_eq_zero
  intro k hk
  by_cases hki : b k < b i
  · simp_rw [hM hki, MulZeroClass.zero_mul]
  · simp_rw [hN (lt_of_lt_of_le hij (le_of_not_lt hki)), MulZeroClass.mul_zero]
#align matrix.block_triangular.mul Matrix.BlockTriangular.mul

end LinearOrder

theorem upper_two_blockTriangular [Preorder α] (A : Matrix m m R) (B : Matrix m n R)
    (D : Matrix n n R) {a b : α} (hab : a < b) :
    BlockTriangular (fromBlocks A B 0 D) (Sum.elim (fun i => a) fun j => b) := by
  rintro (c | c) (d | d) hcd <;> first |simpa [hab.not_lt] using hcd|simp
#align matrix.upper_two_block_triangular Matrix.upper_two_blockTriangular

/-! ### Determinant -/

variable [DecidableEq m] [Fintype m] [DecidableEq n] [Fintype n]

theorem equiv_block_det (M : Matrix m m R) {p q : m → Prop} [DecidablePred p] [DecidablePred q]
    (e : ∀ x, q x ↔ p x) : (toSquareBlockProp M p).det = (toSquareBlockProp M q).det := by
  convert Matrix.det_reindex_self (Equiv.subtypeEquivRight e) (to_square_block_prop M q)
#align matrix.equiv_block_det Matrix.equiv_block_det

@[simp]
theorem det_toSquareBlock_id (M : Matrix m m R) (i : m) : (M.toSquareBlock id i).det = M i i :=
  letI : Unique { a // id a = i } := ⟨⟨⟨i, rfl⟩⟩, fun j => Subtype.ext j.property⟩
  (det_unique _).trans rfl
#align matrix.det_to_square_block_id Matrix.det_toSquareBlock_id

theorem det_toBlock (M : Matrix m m R) (p : m → Prop) [DecidablePred p] :
    M.det =
      (fromBlocks (toBlock M p p) (toBlock M p fun j => ¬p j) (toBlock M (fun j => ¬p j) p) <|
          toBlock M (fun j => ¬p j) fun j => ¬p j).det :=
  by
  rw [← Matrix.det_reindex_self (Equiv.sumCompl p).symm M]
  rw [det_apply', det_apply']
  congr ; ext σ; congr ; ext
  generalize hy : σ x = y
  cases x <;> cases y <;>
    simp only [Matrix.reindex_apply, to_block_apply, Equiv.symm_symm, Equiv.sumCompl_apply_inr,
      Equiv.sumCompl_apply_inl, from_blocks_apply₁₁, from_blocks_apply₁₂, from_blocks_apply₂₁,
      from_blocks_apply₂₂, Matrix.submatrix_apply]
#align matrix.det_to_block Matrix.det_toBlock

theorem two_block_triangular_det (M : Matrix m m R) (p : m → Prop) [DecidablePred p]
    (h : ∀ i, ¬p i → ∀ j, p j → M i j = 0) :
    M.det = (toSquareBlockProp M p).det * (toSquareBlockProp M fun i => ¬p i).det :=
  by
  rw [det_to_block M p]
  convert det_from_blocks_zero₂₁ (to_block M p p) (to_block M p fun j => ¬p j)
      (to_block M (fun j => ¬p j) fun j => ¬p j)
  ext
  exact h (↑i) i.2 (↑j) j.2
#align matrix.two_block_triangular_det Matrix.two_block_triangular_det

theorem two_block_triangular_det' (M : Matrix m m R) (p : m → Prop) [DecidablePred p]
    (h : ∀ i, p i → ∀ j, ¬p j → M i j = 0) :
    M.det = (toSquareBlockProp M p).det * (toSquareBlockProp M fun i => ¬p i).det :=
  by
  rw [M.two_block_triangular_det fun i => ¬p i, mul_comm]
  simp_rw [Classical.not_not]
  congr 1
  exact equiv_block_det _ fun _ => not_not.symm
  simpa only [Classical.not_not] using h
#align matrix.two_block_triangular_det' Matrix.two_block_triangular_det'

protected theorem BlockTriangular.det [DecidableEq α] [LinearOrder α] (hM : BlockTriangular M b) :
    M.det = ∏ a in univ.image b, (M.toSquareBlock b a).det :=
  by
  induction' hs : univ.image b using Finset.strongInduction with s ih generalizing m
  subst hs
  cases isEmpty_or_nonempty m
  · simp
  let k := (univ.image b).max' (univ_nonempty.image _)
  rw [two_block_triangular_det' M fun i => b i = k]
  · have : univ.image b = insert k ((univ.image b).eraseₓ k) :=
      by
      rw [insert_erase]
      apply max'_mem
    rw [this, prod_insert (not_mem_erase _ _)]
    refine' congr_arg _ _
    let b' := fun i : { a // b a ≠ k } => b ↑i
    have h' : block_triangular (M.to_square_block_prop fun i => b i ≠ k) b' := hM.submatrix
    have hb' : image b' univ = (image b univ).eraseₓ k := by
      convert image_subtype_ne_univ_eq_image_erase k b
    rw [ih _ (erase_ssubset <| max'_mem _ _) h' hb']
    refine' Finset.prod_congr rfl fun l hl => _
    let he : { a // b' a = l } ≃ { a // b a = l } :=
      haveI hc : ∀ i, b i = l → b i ≠ k := fun i hi => ne_of_eq_of_ne hi (ne_of_mem_erase hl)
      Equiv.subtypeSubtypeEquivSubtype hc
    simp only [to_square_block_def]
    rw [← Matrix.det_reindex_self he.symm fun i j : { a // b a = l } => M ↑i ↑j]
    rfl
  · intro i hi j hj
    apply hM
    rw [hi]
    apply lt_of_le_of_ne _ hj
    exact Finset.le_max' (univ.image b) _ (mem_image_of_mem _ (mem_univ _))
#align matrix.block_triangular.det Matrix.BlockTriangular.det

theorem BlockTriangular.det_fintype [DecidableEq α] [Fintype α] [LinearOrder α]
    (h : BlockTriangular M b) : M.det = ∏ k : α, (M.toSquareBlock b k).det :=
  by
  refine' h.det.trans (prod_subset (subset_univ _) fun a _ ha => _)
  have : IsEmpty { i // b i = a } := ⟨fun i => ha <| mem_image.2 ⟨i, mem_univ _, i.2⟩⟩
  exact det_is_empty
#align matrix.block_triangular.det_fintype Matrix.BlockTriangular.det_fintype

theorem det_of_upper_triangular [LinearOrder m] (h : M.BlockTriangular id) :
    M.det = ∏ i : m, M i i :=
  by
  haveI : DecidableEq R := Classical.decEq _
  simp_rw [h.det, image_id, det_to_square_block_id]
#align matrix.det_of_upper_triangular Matrix.det_of_upper_triangular

theorem det_of_lower_triangular [LinearOrder m] (M : Matrix m m R) (h : M.BlockTriangular toDual) :
    M.det = ∏ i : m, M i i := by
  rw [← det_transpose]
  exact det_of_upper_triangular h.transpose
#align matrix.det_of_lower_triangular Matrix.det_of_lower_triangular

/-! ### Invertible -/

theorem BlockTriangular.toBlock_inverse_mul_toBlock_eq_one [LinearOrder α] [Invertible M]
    (hM : BlockTriangular M b) (k : α) :
    ((M⁻¹.toBlock (fun i => b i < k) fun i => b i < k) ⬝
        M.toBlock (fun i => b i < k) fun i => b i < k) =
      1 :=
  by
  let p i := b i < k
  have h_sum :
    M⁻¹.toBlock p p ⬝ M.to_block p p +
        (M⁻¹.toBlock p fun i => ¬p i) ⬝ M.to_block (fun i => ¬p i) p =
      1 :=
    by rw [← to_block_mul_eq_add, inv_mul_of_invertible M, to_block_one_self]
  have h_zero : M.to_block (fun i => ¬p i) p = 0 :=
    by
    ext (i j)
    simpa using hM (lt_of_lt_of_le j.2 (le_of_not_lt i.2))
  simpa [h_zero] using h_sum
#align matrix.block_triangular.to_block_inverse_mul_to_block_eq_one Matrix.BlockTriangular.toBlock_inverse_mul_toBlock_eq_one

/-- The inverse of an upper-left subblock of a block-triangular matrix `M` is the upper-left
subblock of `M⁻¹`. -/
theorem BlockTriangular.inv_toBlock [LinearOrder α] [Invertible M] (hM : BlockTriangular M b)
    (k : α) :
    (M.toBlock (fun i => b i < k) fun i => b i < k)⁻¹ =
      M⁻¹.toBlock (fun i => b i < k) fun i => b i < k :=
  inv_eq_left_inv <| hM.toBlock_inverse_mul_toBlock_eq_one k
#align matrix.block_triangular.inv_to_block Matrix.BlockTriangular.inv_toBlock

/-- An upper-left subblock of an invertible block-triangular matrix is invertible. -/
def BlockTriangular.invertibleToBlock [LinearOrder α] [Invertible M] (hM : BlockTriangular M b)
    (k : α) : Invertible (M.toBlock (fun i => b i < k) fun i => b i < k) :=
  invertibleOfLeftInverse _ ((⅟ M).toBlock (fun i => b i < k) fun i => b i < k) <| by
    simpa only [inv_of_eq_nonsing_inv] using hM.to_block_inverse_mul_to_block_eq_one k
#align matrix.block_triangular.invertible_to_block Matrix.BlockTriangular.invertibleToBlock

/-- A lower-left subblock of the inverse of a block-triangular matrix is zero. This is a first step
towards `block_triangular.inv_to_block` below. -/
theorem toBlock_inverse_eq_zero [LinearOrder α] [Invertible M] (hM : BlockTriangular M b) (k : α) :
    (M⁻¹.toBlock (fun i => k ≤ b i) fun i => b i < k) = 0 :=
  by
  let p i := b i < k
  let q i := ¬b i < k
  have h_sum : M⁻¹.toBlock q p ⬝ M.to_block p p + M⁻¹.toBlock q q ⬝ M.to_block q p = 0 :=
    by
    rw [← to_block_mul_eq_add, inv_mul_of_invertible M, to_block_one_disjoint]
    rw [disjoint_iff_inf_le]
    exact fun i h => h.1 h.2
  have h_zero : M.to_block q p = 0 := by
    ext (i j)
    simpa using hM (lt_of_lt_of_le j.2 <| le_of_not_lt i.2)
  have h_mul_eq_zero : M⁻¹.toBlock q p ⬝ M.to_block p p = 0 := by simpa [h_zero] using h_sum
  haveI : Invertible (M.to_block p p) := hM.invertible_to_block k
  have : (fun i => k ≤ b i) = q := by
    ext
    exact not_lt.symm
  rw [this, ← Matrix.zero_mul (M.to_block p p)⁻¹, ← h_mul_eq_zero,
    mul_inv_cancel_right_of_invertible]
#align matrix.to_block_inverse_eq_zero Matrix.toBlock_inverse_eq_zero

/-- The inverse of a block-triangular matrix is block-triangular. -/
theorem blockTriangular_inv_of_blockTriangular [LinearOrder α] [Invertible M]
    (hM : BlockTriangular M b) : BlockTriangular M⁻¹ b :=
  by
  induction' hs : univ.image b using Finset.strongInduction with s ih generalizing m
  subst hs
  intro i j hij
  haveI : Inhabited m := ⟨i⟩
  let k := (univ.image b).max' (univ_nonempty.image _)
  let b' := fun i : { a // b a < k } => b ↑i
  let A := M.to_block (fun i => b i < k) fun j => b j < k
  obtain hbi | hi : b i = k ∨ _ := (le_max' _ (b i) <| mem_image_of_mem _ <| mem_univ _).eq_or_lt
  · have : M⁻¹.toBlock (fun i => k ≤ b i) (fun i => b i < k) ⟨i, hbi.ge⟩ ⟨j, hbi ▸ hij⟩ = 0 := by
      simp only [to_block_inverse_eq_zero hM k, Pi.zero_apply]
    simp [this.symm]
  haveI : Invertible A := hM.invertible_to_block _
  have hA : A.block_triangular b' := hM.submatrix
  have hb' : image b' univ ⊂ image b univ :=
    by
    convert image_subtype_univ_ssubset_image_univ k b _ (fun a => a < k) (lt_irrefl _)
    convert max'_mem _ _
  have hij' : b' ⟨j, hij.trans hi⟩ < b' ⟨i, hi⟩ := by simp_rw [b', Subtype.coe_mk, hij]
  simp [hM.inv_to_block k, (ih (image b' univ) hb' hA rfl hij').symm]
#align matrix.block_triangular_inv_of_block_triangular Matrix.blockTriangular_inv_of_blockTriangular

end Matrix


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

import data.equiv.ring
import group_theory.group_action.group
import ring_theory.subring.basic

/-!
# Group action on rings

This file defines the typeclass of monoid acting on semirings `mul_semiring_action M R`,
and the corresponding typeclass of invariant subrings.

Note that `algebra` does not satisfy the axioms of `mul_semiring_action`.

## Implementation notes

There is no separate typeclass for group acting on rings, group acting on fields, etc.
They are all grouped under `mul_semiring_action`.

## Tags

group action, invariant subring

-/

universes u v
open_locale big_operators

/-- Typeclass for multiplicative actions by monoids on semirings.

This combines `distrib_mul_action` with `mul_distrib_mul_action`. -/
class mul_semiring_action (M : Type u) (R : Type v) [monoid M] [semiring R]
  extends distrib_mul_action M R :=
(smul_one : ∀ (g : M), (g • 1 : R) = 1)
(smul_mul : ∀ (g : M) (x y : R), g • (x * y) = (g • x) * (g • y))

section semiring

variables (M G : Type u) [monoid M] [group G]
variables (A R S F : Type v) [add_monoid A] [semiring R] [comm_semiring S] [division_ring F]

-- note we could not use `extends` since these typeclasses are made with `old_structure_cmd`
@[priority 100]
instance mul_semiring_action.to_mul_distrib_mul_action [h : mul_semiring_action M R] :
  mul_distrib_mul_action M R :=
{ ..h }

/-- Each element of the monoid defines a semiring homomorphism. -/
@[simps]
def mul_semiring_action.to_ring_hom [mul_semiring_action M R] (x : M) : R →+* R :=
{ .. mul_distrib_mul_action.to_monoid_hom R x,
  .. distrib_mul_action.to_add_monoid_hom R x }

theorem to_ring_hom_injective [mul_semiring_action M R] [has_faithful_scalar M R] :
  function.injective (mul_semiring_action.to_ring_hom M R) :=
λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, ring_hom.ext_iff.1 h r

/-- Each element of the group defines a semiring isomorphism. -/
@[simps]
def mul_semiring_action.to_ring_equiv [mul_semiring_action G R] (x : G) : R ≃+* R :=
{ .. distrib_mul_action.to_add_equiv R x,
  .. mul_semiring_action.to_ring_hom G R x }

section
variables {M G R}

/-- A stronger version of `submonoid.distrib_mul_action`. -/
instance submonoid.mul_semiring_action [mul_semiring_action M R] (H : submonoid M) :
  mul_semiring_action H R :=
{ smul := (•),
  .. H.mul_distrib_mul_action,
  .. H.distrib_mul_action }

/-- A stronger version of `subgroup.distrib_mul_action`. -/
instance subgroup.mul_semiring_action [mul_semiring_action G R] (H : subgroup G) :
  mul_semiring_action H R :=
H.to_submonoid.mul_semiring_action

/-- A stronger version of `subsemiring.distrib_mul_action`. -/
instance subsemiring.mul_semiring_action {R'} [semiring R'] [mul_semiring_action R' R]
  (H : subsemiring R') :
  mul_semiring_action H R :=
H.to_submonoid.mul_semiring_action

/-- A stronger version of `subring.distrib_mul_action`. -/
instance subring.mul_semiring_action {R'} [ring R'] [mul_semiring_action R' R]
  (H : subring R') :
  mul_semiring_action H R :=
H.to_subsemiring.mul_semiring_action

end

section simp_lemmas

variables {M G A R F}

attribute [simp] smul_one smul_mul' smul_zero smul_add

/-- Note that `smul_inv'` refers to the group case, and `smul_inv` has an additional inverse
on `x`. -/
@[simp] lemma smul_inv'' [mul_semiring_action M F] (x : M) (m : F) : x • m⁻¹ = (x • m)⁻¹ :=
(mul_semiring_action.to_ring_hom M F x).map_inv _

end simp_lemmas

end semiring

section ring

variables (M : Type u) [monoid M] {R : Type v} [ring R] [mul_semiring_action M R]
variables (S : subring R)
open mul_action

/-- A typeclass for subrings invariant under a `mul_semiring_action`. -/
class is_invariant_subring : Prop :=
(smul_mem : ∀ (m : M) {x : R}, x ∈ S → m • x ∈ S)

instance is_invariant_subring.to_mul_semiring_action [is_invariant_subring M S] :
  mul_semiring_action M S :=
{ smul := λ m x, ⟨m • x, is_invariant_subring.smul_mem m x.2⟩,
  one_smul := λ s, subtype.eq $ one_smul M s,
  mul_smul := λ m₁ m₂ s, subtype.eq $ mul_smul m₁ m₂ s,
  smul_add := λ m s₁ s₂, subtype.eq $ smul_add m s₁ s₂,
  smul_zero := λ m, subtype.eq $ smul_zero m,
  smul_one := λ m, subtype.eq $ smul_one m,
  smul_mul := λ m s₁ s₂, subtype.eq $ smul_mul' m s₁ s₂ }

end ring


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Type class for encodable types.
Note that every encodable type is countable.
-/
import data.fintype data.list data.list.sort data.sum data.nat.div data.countable data.equiv
import data.finset
open option list nat function

structure encodable [class] (A : Type) :=
(encode : A → nat) (decode : nat → option A) (encodek : ∀ a, decode (encode a) = some a)

open encodable

definition countable_of_encodable {A : Type} : encodable A → countable A :=
assume e : encodable A,
have injective encode, from
  λ (a₁ a₂ : A) (h : encode a₁ = encode a₂),
    have decode A (encode a₁) = decode A (encode a₂), by rewrite h,
    by rewrite [*encodek at this]; injection this; assumption,
exists.intro encode this

definition encodable_fintype [instance] {A : Type} [h₁ : fintype A] [h₂ : decidable_eq A] :
  encodable A :=
encodable.mk
  (λ a, find a (elements_of A))
  (λ n, nth (elements_of A) n)
  (λ a, find_nth (fintype.complete a))

definition encodable_nat [instance] : encodable nat :=
encodable.mk (λ a, a) (λ n, some n) (λ a, rfl)

definition encodable_option [instance] {A : Type} [h : encodable A] : encodable (option A) :=
encodable.mk
  (λ o, match o with
        | some a := succ (encode a)
        | none := 0
        end)
  (λ n, if n = 0 then some none else some (decode A (pred n)))
  (λ o,
    begin
    cases o with a,
      begin esimp end,
      begin esimp, rewrite [if_neg !succ_ne_zero, encodable.encodek] end
    end)

section sum
variables {A B : Type}
variables [h₁ : encodable A] [h₂ : encodable B]
include h₁ h₂

private definition encode_sum : sum A B → nat
| (sum.inl a) := 2 * encode a
| (sum.inr b) := 2 * encode b + 1

private definition decode_sum (n : nat) : option (sum A B) :=
if n % 2 = 0 then
   match decode A (n / 2) with
   | some a := some (sum.inl a)
   | none   := none
   end
else
   match decode B ((n - 1) / 2) with
   | some b := some (sum.inr b)
   | none   := none
   end

open decidable
private theorem decode_encode_sum : ∀ s : sum A B, decode_sum (encode_sum s) = some s
| (sum.inl a) :=
  have aux : 2 > (0:nat), from dec_trivial,
  begin
    esimp [encode_sum, decode_sum],
    rewrite [mul_mod_right, if_pos (eq.refl (0 : nat)), nat.mul_div_cancel_left _ aux,
             encodable.encodek]
  end
| (sum.inr b) :=
  have aux₁ : 2 > (0:nat),       from dec_trivial,
  have aux₂ : 1 % 2 = (1:nat), by rewrite [nat.mod_def],
  have aux₃ : 1 ≠ (0:nat),       from dec_trivial,
  begin
    esimp [encode_sum, decode_sum],
    rewrite [add.comm, add_mul_mod_self_left, aux₂, if_neg aux₃, nat.add_sub_cancel_left,
             nat.mul_div_cancel_left _ aux₁, encodable.encodek]
  end

definition encodable_sum [instance] : encodable (sum A B) :=
encodable.mk
  (λ s, encode_sum s)
  (λ n, decode_sum n)
  (λ s, decode_encode_sum s)
end sum

section prod
variables {A B : Type}
variables [h₁ : encodable A] [h₂ : encodable B]
include h₁ h₂

private definition encode_prod : A × B → nat
| (a, b) := mkpair (encode a) (encode b)

private definition decode_prod (n : nat) : option (A × B) :=
match unpair n with
| (n₁, n₂) :=
  match decode A n₁ with
  | some a :=
    match decode B n₂ with
    | some b := some (a, b)
    | none   := none
    end
  | none   := none
  end
end

private theorem decode_encode_prod : ∀ p : A × B, decode_prod (encode_prod p) = some p
| (a, b) :=
  begin
    esimp [encode_prod, decode_prod, prod.cases_on],
    rewrite [unpair_mkpair],
    esimp,
    rewrite [*encodable.encodek]
  end

definition encodable_product [instance] : encodable (A × B) :=
encodable.mk
  encode_prod
  decode_prod
  decode_encode_prod
end prod

section list
variables {A : Type}
variables [h : encodable A]
include h

private definition encode_list_core : list A → nat
| []     := 0
| (a::l) := mkpair (encode a) (encode_list_core l)

private theorem encode_list_core_cons (a : A) (l : list A) : encode_list_core (a::l) = mkpair (encode a) (encode_list_core l) :=
rfl

private definition encode_list (l : list A) : nat :=
mkpair (length l) (encode_list_core l)

private definition decode_list_core : nat → nat → option (list A)
| 0        v  := some []
| (succ n) v  :=
  match unpair v with
  | (v₁, v₂) :=
    match decode A v₁ with
    | some a :=
      match decode_list_core n v₂ with
      | some l := some (a::l)
      | none   := none
      end
    | none   := none
    end
  end

private theorem decode_list_core_succ (n v : nat) :
  decode_list_core (succ n) v =
    match unpair v with
    | (v₁, v₂) :=
      match decode A v₁ with
      | some a :=
        match decode_list_core n v₂ with
        | some l := some (a::l)
        | none   := none
        end
      | none   := none
      end
    end
:= rfl

private definition decode_list (n : nat) : option (list A) :=
match unpair n with
| (l, v) := decode_list_core l v
end

private theorem decode_encode_list_core : ∀ l : list A, decode_list_core (length l) (encode_list_core l) = some l
| []     := rfl
| (a::l) :=
  begin
    rewrite [encode_list_core_cons, length_cons, add_one (length l), decode_list_core_succ],
    rewrite [unpair_mkpair],
    esimp [prod.cases_on],
    rewrite [decode_encode_list_core l],
    rewrite [encodable.encodek],
  end

private theorem decode_encode_list (l : list A) : decode_list (encode_list l) = some l :=
begin
  esimp [encode_list, decode_list],
  rewrite [unpair_mkpair],
  esimp [prod.cases_on],
  apply decode_encode_list_core
end

definition encodable_list [instance] : encodable (list A) :=
encodable.mk
  encode_list
  decode_list
  decode_encode_list
end list

section finset
variable {A : Type}
variable [encA : encodable A]
include encA

private definition enle (a b : A) : Prop := encode a ≤ encode b

private lemma enle.refl (a : A) : enle a a :=
!le.refl

private lemma enle.trans (a b c : A) : enle a b → enle b c → enle a c :=
assume h₁ h₂, le.trans h₁ h₂

private lemma enle.total (a b : A) : enle a b ∨ enle b a :=
!le.total

private lemma enle.antisymm (a b : A) : enle a b → enle b a → a = b :=
assume h₁ h₂,
have encode a = encode b, from le.antisymm h₁ h₂,
have decode A (encode a) = decode A (encode b), by rewrite this,
have some a = some b, by rewrite [*encodek at this]; exact this,
option.no_confusion this (λ e, e)

private definition decidable_enle [instance] (a b : A) : decidable (enle a b) :=
decidable_le (encode a) (encode b)

variables [decA : decidable_eq A]
include decA

private definition ensort (l : list A) : list A :=
sort enle l

open subtype perm
private lemma sorted_eq_of_perm {l₁ l₂ : list A} (h : l₁ ~ l₂) : ensort l₁ = ensort l₂ :=
list.sort_eq_of_perm_core enle.total enle.trans enle.refl enle.antisymm h

private definition encode_finset (s : finset A) : nat :=
quot.lift_on s
  (λ l, encode (ensort (elt_of l)))
  (λ l₁ l₂ p,
    have elt_of l₁ ~ elt_of l₂,                     from p,
    have ensort (elt_of l₁) = ensort (elt_of l₂), from sorted_eq_of_perm this,
    by rewrite this)

private definition decode_finset (n : nat) : option (finset A) :=
match decode (list A) n with
| some l₁ := some (finset.to_finset l₁)
| none    := none
end

private theorem decode_encode_finset (s : finset A) : decode_finset (encode_finset s) = some s :=
quot.induction_on s (λ l,
  begin
    unfold encode_finset, unfold decode_finset, rewrite encodek, esimp, congruence,
    apply quot.sound, cases l with l nd,
    show erase_dup (ensort l) ~ l, from
      have nodup (ensort l), from nodup_of_perm_of_nodup (perm.symm !sort_perm) nd,
      calc erase_dup (ensort l) = ensort l : erase_dup_eq_of_nodup this
                ...             ~ l        : sort_perm
  end)

definition encodable_finset [instance] : encodable (finset A) :=
encodable.mk
  encode_finset
  decode_finset
  decode_encode_finset
end finset

section subtype
open subtype decidable
variable {A : Type}
variable {P : A → Prop}
variable [encA : encodable A]
variable [decP : decidable_pred P]

include encA
private definition encode_subtype : {a : A | P a} → nat
| (tag v h) := encode v

include decP
private definition decode_subtype (v : nat) : option {a : A | P a} :=
match decode A v with
| some a := if h : P a then some (tag a h) else none
| none   := none
end

private lemma decode_encode_subtype : ∀ s : {a : A | P a}, decode_subtype (encode_subtype s) = some s
| (tag v h) :=
  begin
    unfold [encode_subtype, decode_subtype], rewrite encodek, esimp,
    rewrite [dif_pos h]
  end

definition encodable_subtype [instance] : encodable {a : A | P a} :=
encodable.mk
  encode_subtype
  decode_subtype
  decode_encode_subtype
end subtype

definition encodable_of_left_injection
             {A B : Type} [h₁ : encodable A]
             (f : B → A) (finv : A → option B) (linv : ∀ b, finv (f b) = some b) : encodable B :=
encodable.mk
  (λ b, encode (f b))
  (λ n,
    match decode A n with
    | some a := finv a
    | none   := none
    end)
  (λ b,
    begin
      esimp,
      rewrite [encodable.encodek],
      esimp [option.cases_on],
      rewrite [linv]
    end)

section
open equiv

definition encodable_of_equiv {A B : Type} [h : encodable A] : A ≃ B → encodable B
| (mk f g l r) :=
  encodable_of_left_injection g (λ a, some (f a))
    (λ b, by rewrite r; reflexivity)
end

/-
Choice function for encodable types  and decidable predicates.
We provide the following API

choose      {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] : (∃ x, p x) → A :=
choose_spec {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] (ex : ∃ x, p x) : p (choose ex) :=
-/
section find_a
parameters {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p]
include c
include d

private definition pn (n : nat) : Prop :=
match decode A n with
| some a := p a
| none   := false
end

private definition decidable_pn : decidable_pred pn :=
λ n,
match decode A n with
| some a := λ e : decode A n = some a,
  match d a with
  | decidable.inl t :=
    begin
      unfold pn, rewrite e, esimp [option.cases_on],
      exact (decidable.inl t)
    end
  | decidable.inr f :=
    begin
      unfold pn, rewrite e, esimp [option.cases_on],
      exact (decidable.inr f)
    end
  end
| none   := λ e : decode A n = none,
  begin
    unfold pn, rewrite e, esimp [option.cases_on],
    exact decidable_false
  end
end (eq.refl (decode A n))

private definition ex_pn_of_ex : (∃ x, p x) → (∃ x, pn x) :=
assume ex,
obtain (w : A) (pw : p w), from ex,
exists.intro (encode w)
  begin
    unfold pn, rewrite [encodek], esimp, exact pw
  end

private lemma decode_ne_none_of_pn {n : nat} : pn n → decode A n ≠ none :=
assume pnn e,
begin
  rewrite [▸ (match decode A n with | some a := p a | none   := false end) at pnn],
  rewrite [e at pnn], esimp [option.cases_on] at pnn,
  exact (false.elim pnn)
end

open subtype

private definition of_nat (n : nat) : pn n → { a : A | p a } :=
match decode A n with
| some a := λ (e : decode A n = some a),
  begin
    unfold pn, rewrite e, esimp [option.cases_on], intro pa,
    exact (tag a pa)
  end
| none   := λ (e : decode A n = none) h, absurd e (decode_ne_none_of_pn h)
end (eq.refl (decode A n))

private definition find_a : (∃ x, p x) → {a : A | p a} :=
suppose ∃ x, p x,
have    ∃ x, pn x, from ex_pn_of_ex this,
let r := @nat.find _ decidable_pn this in
have pn r, from @nat.find_spec pn decidable_pn this,
of_nat r this
end find_a

namespace encodable
open subtype

definition choose {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] : (∃ x, p x) → A :=
assume ex, elt_of (find_a ex)

theorem choose_spec {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] (ex : ∃ x, p x) : p (choose ex) :=
has_property (find_a ex)

theorem axiom_of_choice {A : Type} {B : A → Type} {R : Π x, B x → Prop} [c : Π a, encodable (B a)] [d : ∀ x y, decidable (R x y)]
                        : (∀x, ∃y, R x y) → ∃f, ∀x, R x (f x) :=
assume H,
have ∀x, R x (choose (H x)), from take x, choose_spec (H x),
exists.intro _ this

theorem skolem {A : Type} {B : A → Type} {P : Π x, B x → Prop} [c : Π a, encodable (B a)] [d : ∀ x y, decidable (P x y)]
               : (∀x, ∃y, P x y) ↔ ∃f, (∀x, P x (f x)) :=
iff.intro
  (suppose (∀ x, ∃y, P x y), axiom_of_choice this)
  (suppose (∃ f, (∀x, P x (f x))),
   take x, obtain (fw : ∀x, B x) (Hw : ∀x, P x (fw x)), from this,
     exists.intro (fw x) (Hw x))
end encodable

namespace quot
section
open setoid encodable
parameter {A : Type}
parameter {s : setoid A}
parameter [decR : ∀ a b : A, decidable (a ≈ b)]
parameter [encA : encodable A]
include decR
include encA

-- Choose equivalence class representative
definition rep (q : quot s) : A :=
choose (exists_rep q)

theorem rep_spec (q : quot s) : ⟦rep q⟧ = q :=
choose_spec (exists_rep q)

private definition encode_quot (q : quot s) : nat :=
encode (rep q)

private definition decode_quot (n : nat) : option (quot s) :=
match decode A n with
| some a := some ⟦ a ⟧
| none   := none
end

private lemma decode_encode_quot (q : quot s) : decode_quot (encode_quot q) = some q :=
quot.induction_on q (λ l, begin unfold [encode_quot, decode_quot], rewrite encodek, esimp, rewrite rep_spec end)

definition encodable_quot : encodable (quot s) :=
encodable.mk
  encode_quot
  decode_quot
  decode_encode_quot
end
end quot
attribute quot.encodable_quot [instance]


/-
Four natural lemmas missing from the quotient fintype API.
Author: Adrián Doña Mateo

These were contributed to mathlib in
[#6964](https://github.com/leanprover-community/mathlib/pull/6964/).

An apostrophe was added at the end of the names to avoid clashes.
-/

import data.fintype.basic

-- These lemmas were added to src/data/fintype/basic.lean.

variables {α β : Type*}

namespace fintype
variables [fintype α] [fintype β]

lemma card_le_of_surjective' (f : α → β) (h : function.surjective f) : card β ≤ card α :=
card_le_of_injective _ (function.injective_surj_inv h)

lemma card_lt_of_surjective_not_injective' [fintype α] [fintype β] (f : α → β)
  (h : function.surjective f) (h' : ¬function.injective f) : card β < card α :=
card_lt_of_injective_not_surjective _ (function.injective_surj_inv h) $ λ hg,
have w : function.bijective (function.surj_inv h) := ⟨function.injective_surj_inv h, hg⟩,
h' $ (injective_iff_surjective_of_equiv (equiv.of_bijective _ w).symm).mpr h

end fintype

theorem fintype.card_quotient_le' [fintype α] (s : setoid α) [decidable_rel ((≈) : α → α → Prop)] :
  fintype.card (quotient s) ≤ fintype.card α :=
fintype.card_le_of_surjective _ (surjective_quotient_mk _)

theorem fintype.card_quotient_lt' [fintype α] {s : setoid α} [decidable_rel ((≈) : α → α → Prop)]
  {x y : α} (h1 : x ≠ y) (h2 : x ≈ y) : fintype.card (quotient s) < fintype.card α :=
fintype.card_lt_of_surjective_not_injective _ (surjective_quotient_mk _) $ λ w,
h1 (w $ quotient.eq.mpr h2)


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

! This file was ported from Lean 3 source module order.minimal
! leanprover-community/mathlib commit 59694bd07f0a39c5beccba34bd9f413a160782bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Antichain
import Mathlib.Order.UpperLower.Basic

/-!
# Minimal/maximal elements of a set

This file defines minimal and maximal of a set with respect to an arbitrary relation.

## Main declarations

* `maximals r s`: Maximal elements of `s` with respect to `r`.
* `minimals r s`: Minimal elements of `s` with respect to `r`.

## TODO

Do we need a `Finset` version?
-/

open Function Set

variable {α : Type _} (r r₁ r₂ : α → α → Prop) (s t : Set α) (a b : α)

/-- Turns a set into an antichain by keeping only the "maximal" elements. -/
def maximals : Set α :=
  { a ∈ s | ∀ ⦃b⦄, b ∈ s → r a b → r b a }
#align maximals maximals

/-- Turns a set into an antichain by keeping only the "minimal" elements. -/
def minimals : Set α :=
  { a ∈ s | ∀ ⦃b⦄, b ∈ s → r b a → r a b }
#align minimals minimals

theorem maximals_subset : maximals r s ⊆ s :=
  sep_subset _ _
#align maximals_subset maximals_subset

theorem minimals_subset : minimals r s ⊆ s :=
  sep_subset _ _
#align minimals_subset minimals_subset

@[simp]
theorem maximals_empty : maximals r ∅ = ∅ :=
  sep_empty _
#align maximals_empty maximals_empty

@[simp]
theorem minimals_empty : minimals r ∅ = ∅ :=
  sep_empty _
#align minimals_empty minimals_empty

@[simp]
theorem maximals_singleton : maximals r {a} = {a} :=
  (maximals_subset _ _).antisymm <|
    singleton_subset_iff.2 <|
      ⟨rfl, by
        rintro b (rfl : b = a)
        exact id⟩
#align maximals_singleton maximals_singleton

@[simp]
theorem minimals_singleton : minimals r {a} = {a} :=
  maximals_singleton _ _
#align minimals_singleton minimals_singleton

theorem maximals_swap : maximals (swap r) s = minimals r s :=
  rfl
#align maximals_swap maximals_swap

theorem minimals_swap : minimals (swap r) s = maximals r s :=
  rfl
#align minimals_swap minimals_swap

section IsAntisymm

variable {r s t a b} [IsAntisymm α r]

theorem eq_of_mem_maximals (ha : a ∈ maximals r s) (hb : b ∈ s) (h : r a b) : a = b :=
  antisymm h <| ha.2 hb h
#align eq_of_mem_maximals eq_of_mem_maximals

theorem eq_of_mem_minimals (ha : a ∈ minimals r s) (hb : b ∈ s) (h : r b a) : a = b :=
  antisymm (ha.2 hb h) h
#align eq_of_mem_minimals eq_of_mem_minimals

variable (r s)

theorem maximals_antichain : IsAntichain r (maximals r s) := fun _a ha _b hb hab h =>
  hab <| eq_of_mem_maximals ha hb.1 h
#align maximals_antichain maximals_antichain

theorem minimals_antichain : IsAntichain r (minimals r s) :=
  haveI := IsAntisymm.swap r
  (maximals_antichain _ _).swap
#align minimals_antichain minimals_antichain

end IsAntisymm

-- porting note: new lemma
theorem maximals_of_symm [IsSymm α r] : maximals r s = s :=
  sep_eq_self_iff_mem_true.2 <| fun _ _ _ _ => symm

-- porting note: new lemma
theorem minimals_of_symm [IsSymm α r] : minimals r s = s :=
  sep_eq_self_iff_mem_true.2 <| fun _ _ _ _ => symm

theorem maximals_eq_minimals [IsSymm α r] : maximals r s = minimals r s := by
  rw [minimals_of_symm, maximals_of_symm]
#align maximals_eq_minimals maximals_eq_minimals

variable {r r₁ r₂ s t a}

-- porting note: todo: use `h.induction_on`
theorem Set.Subsingleton.maximals_eq (h : s.Subsingleton) : maximals r s = s := by
  rcases h.eq_empty_or_singleton with (rfl | ⟨x, rfl⟩)
  exacts [minimals_empty _, maximals_singleton _ _]
#align set.subsingleton.maximals_eq Set.Subsingleton.maximals_eq

theorem Set.Subsingleton.minimals_eq (h : s.Subsingleton) : minimals r s = s :=
  h.maximals_eq
#align set.subsingleton.minimals_eq Set.Subsingleton.minimals_eq

theorem maximals_mono [IsAntisymm α r₂] (h : ∀ a b, r₁ a b → r₂ a b) :
    maximals r₂ s ⊆ maximals r₁ s := fun a ha =>
  ⟨ha.1, fun b hb hab => by
    have := eq_of_mem_maximals ha hb (h _ _ hab)
    subst this
    exact hab⟩
#align maximals_mono maximals_mono

theorem minimals_mono [IsAntisymm α r₂] (h : ∀ a b, r₁ a b → r₂ a b) :
    minimals r₂ s ⊆ minimals r₁ s := fun a ha =>
  ⟨ha.1, fun b hb hab => by
    have := eq_of_mem_minimals ha hb (h _ _ hab)
    subst this
    exact hab⟩
#align minimals_mono minimals_mono

theorem maximals_union : maximals r (s ∪ t) ⊆ maximals r s ∪ maximals r t := by
  intro a ha
  obtain h | h := ha.1
  · exact Or.inl ⟨h, fun b hb => ha.2 <| Or.inl hb⟩
  · exact Or.inr ⟨h, fun b hb => ha.2 <| Or.inr hb⟩
#align maximals_union maximals_union

theorem minimals_union : minimals r (s ∪ t) ⊆ minimals r s ∪ minimals r t :=
  maximals_union
#align minimals_union minimals_union

theorem maximals_inter_subset : maximals r s ∩ t ⊆ maximals r (s ∩ t) := fun _a ha =>
  ⟨⟨ha.1.1, ha.2⟩, fun _b hb => ha.1.2 hb.1⟩
#align maximals_inter_subset maximals_inter_subset

theorem minimals_inter_subset : minimals r s ∩ t ⊆ minimals r (s ∩ t) :=
  maximals_inter_subset
#align minimals_inter_subset minimals_inter_subset

theorem inter_maximals_subset : s ∩ maximals r t ⊆ maximals r (s ∩ t) := fun _a ha =>
  ⟨⟨ha.1, ha.2.1⟩, fun _b hb => ha.2.2 hb.2⟩
#align inter_maximals_subset inter_maximals_subset

theorem inter_minimals_subset : s ∩ minimals r t ⊆ minimals r (s ∩ t) :=
  inter_maximals_subset
#align inter_minimals_subset inter_minimals_subset

theorem IsAntichain.maximals_eq (h : IsAntichain r s) : maximals r s = s :=
  (maximals_subset _ _).antisymm fun a ha =>
    ⟨ha, fun b hb hab => by
      obtain rfl := h.eq ha hb hab
      exact hab⟩
#align is_antichain.maximals_eq IsAntichain.maximals_eq

theorem IsAntichain.minimals_eq (h : IsAntichain r s) : minimals r s = s :=
  h.flip.maximals_eq
#align is_antichain.minimals_eq IsAntichain.minimals_eq

@[simp]
theorem maximals_idem : maximals r (maximals r s) = maximals r s :=
  (maximals_subset _ _).antisymm fun _a ha => ⟨ha, fun _b hb => ha.2 hb.1⟩
#align maximals_idem maximals_idem

@[simp]
theorem minimals_idem : minimals r (minimals r s) = minimals r s :=
  maximals_idem
#align minimals_idem minimals_idem

/-- If `maximals r s` is included in but *shadows* the antichain `t`, then it is actually
equal to `t`. -/
theorem IsAntichain.max_maximals (ht : IsAntichain r t) (h : maximals r s ⊆ t)
    (hs : ∀ ⦃a⦄, a ∈ t → ∃ b ∈ maximals r s, r b a) : maximals r s = t := by
  refine' h.antisymm fun a ha => _
  obtain ⟨b, hb, hr⟩ := hs ha
  rwa [of_not_not fun hab => ht (h hb) ha (Ne.symm hab) hr]
#align is_antichain.max_maximals IsAntichain.max_maximals

/-- If `minimals r s` is included in but *shadows* the antichain `t`, then it is actually
equal to `t`. -/
theorem IsAntichain.max_minimals (ht : IsAntichain r t) (h : minimals r s ⊆ t)
    (hs : ∀ ⦃a⦄, a ∈ t → ∃ b ∈ minimals r s, r a b) : minimals r s = t := by
  refine' h.antisymm fun a ha => _
  obtain ⟨b, hb, hr⟩ := hs ha
  rwa [of_not_not fun hab => ht ha (h hb) hab hr]
#align is_antichain.max_minimals IsAntichain.max_minimals

variable [PartialOrder α]

theorem IsLeast.mem_minimals (h : IsLeast s a) : a ∈ minimals (· ≤ ·) s :=
  ⟨h.1, fun _b hb _ => h.2 hb⟩
#align is_least.mem_minimals IsLeast.mem_minimals

theorem IsGreatest.mem_maximals (h : IsGreatest s a) : a ∈ maximals (· ≤ ·) s :=
  ⟨h.1, fun _b hb _ => h.2 hb⟩
#align is_greatest.mem_maximals IsGreatest.mem_maximals

theorem IsLeast.minimals_eq (h : IsLeast s a) : minimals (· ≤ ·) s = {a} :=
  eq_singleton_iff_unique_mem.2 ⟨h.mem_minimals, fun _b hb => eq_of_mem_minimals hb h.1 <| h.2 hb.1⟩
#align is_least.minimals_eq IsLeast.minimals_eq

theorem IsGreatest.maximals_eq (h : IsGreatest s a) : maximals (· ≤ ·) s = {a} :=
  eq_singleton_iff_unique_mem.2 ⟨h.mem_maximals, fun _b hb => eq_of_mem_maximals hb h.1 <| h.2 hb.1⟩
#align is_greatest.maximals_eq IsGreatest.maximals_eq

theorem IsAntichain.minimals_upperClosure (hs : IsAntichain (· ≤ ·) s) :
    minimals (· ≤ ·) (upperClosure s : Set α) = s :=
  hs.max_minimals
    (fun a ⟨⟨b, hb, hba⟩, _⟩ => by rwa [eq_of_mem_minimals ‹a ∈ _› (subset_upperClosure hb) hba])
    fun a ha =>
    ⟨a, ⟨subset_upperClosure ha, fun b ⟨c, hc, hcb⟩ hba => by rwa [hs.eq' ha hc (hcb.trans hba)]⟩,
      le_rfl⟩
#align is_antichain.minimals_upper_closure IsAntichain.minimals_upperClosure

theorem IsAntichain.maximals_lowerClosure (hs : IsAntichain (· ≤ ·) s) :
    maximals (· ≤ ·) (lowerClosure s : Set α) = s :=
  hs.to_dual.minimals_upperClosure
#align is_antichain.maximals_lower_closure IsAntichain.maximals_lowerClosure


import SciLean.Core
import SciLean.Core.HomDoodle

namespace SciLean

  variable {X Y} {ι} [Enumtype ι] [FinVec X ι] [SemiHilbert Y]
    ---[SemiHilbert (X→Y)] [SemiHilbert (X → X → Y)]

  #check smoothDiff†

  #check adjoint
  -- #check (λ f : X → Y => ∂ f)†

  #check differential†

  noncomputable
  def divergence (f : X → X → Y) : X → Y :=
    λ x => ∑ i, ∂ f x (𝔼 i) (𝔼 i)

  @[simp]
  theorem diff_adj_is_divergence (f : X → X → Y) [IsSmooth f] [∀ x, IsLin (f x)]
  : (smoothDiff† (λ x ⟿ λ dx ⊸ f x dx)) = λ x ⟿ ∑ i, ∂ f x (𝔼 i) (𝔼 i) := sorry

  @[simp]
  theorem diff_adj_is_divergence' (f : X → X → Y) [IsSmooth f] [∀ x, IsLin (f x)]
  : (λ (f : X ⟿ Y) => (λ x ⟿ λ dx ⊸ ∂ f.1 x dx))† = λ f' => λ x ⟿ ∑ i : ι, (∂ f'.1 x (𝔼 i)) (𝔼 i) := sorry

  #check @diff_adj_is_divergence

  variable (f : X → Y)

  #check ∂ f


import luc_double_squares

lemma prod_pos (a b n: ℕ ) (h: n=a*b) (h2: 0<n) : 0<b:=
begin
    by_contra, push_neg at a_1, interval_cases b, rw mul_zero at h, rw h at h2, linarith
end

lemma product_ineq (a b n: ℕ ) (h: 2≤ a) (h3: 0 <n): n=a*b → b <n ∧ 0<b:=
begin
    intro h2, rw nat.succ_le_iff at h, rw h2, nth_rewrite_lhs 0 ← one_mul b,
    have h1:=prod_pos a b n h2 h3,
    have h2:= mul_lt_mul h (le_refl b) h1 (zero_le a), split, assumption'
end

lemma coprime_squares_factors (a b n: ℕ ) (h: a*b=n^2) (h1: nat.coprime a b) (h2: 0 <n): ∃ (r : ℕ), a=r^2:=
begin
    revert b, revert a, revert h2, apply nat.strong_induction_on n,
    {intros m hd h0 a b h h1, cases lt_or_le a 2,
    {interval_cases a, {use 0, ring}, {use 1, ring}},
    {cases nat.exists_prime_and_dvd h_1 with p h3, cases h3.2 with x h4,
    have h5: p ∣ a*b, {use x*b, rw h4,  rw mul_assoc}, rw h at h5,
    have h6:= nat.prime.dvd_of_dvd_pow h3.1 h5,
    have h7:= nat.pow_dvd_pow_of_dvd h6 2, rw ← h at h7,
    have h9: ¬ p ∣ b, {by_contra,
    have i1: 2 ≤  nat.gcd a b, {apply le_trans (nat.prime.two_le h3.1), apply nat.le_of_dvd (nat.gcd_pos_of_pos_left b (show 0<a, by linarith)), apply nat.dvd_gcd h3.2 a_1},
    have h1': nat.gcd a b=1, {exact h1}, rw h1' at i1, linarith},
    have h10: (p^2).coprime b, {apply nat.coprime.symm, exact nat.prime.coprime_pow_of_not_dvd h3.1 h9},
    have h11:= nat.coprime.dvd_of_dvd_mul_right h10 h7, cases h11 with y h11, cases h6 with z h6, rw h6 at h, rw h11 at h, rw nat.mul_pow at h,
    have h12: p^2>0, apply nat.pow_pos, apply gt_of_ge_of_gt (nat.prime.two_le h3.1) (show 2>0, by linarith), rw mul_assoc at h, rw nat.mul_right_inj h12 at h,
    have h13:= product_ineq p z (m) (nat.prime.two_le h3.1) h0 h6, rw h11 at h1,
    have h14:= hd z h13.1 h13.2 y b h (nat.coprime.coprime_mul_left h1), cases h14 with r h14, use p*r, rw h11, rw h14, rw nat.mul_pow}}
end

lemma squares_factors ( a b n:ℕ) (h: a*b=n^2) (h1: 0<n) : ∃ (r s: ℕ ), a=(nat.gcd a b)*r^2 ∧ b = (nat.gcd a b)*s^2:=
begin
    cases nat.eq_zero_or_pos (nat.gcd a b) with g0 g0,
    {simp [nat.eq_zero_of_gcd_eq_zero_right g0] at *, rw nat.pow_two at h, rw eq_comm at h, rw nat.mul_eq_zero at h, rw (or_self (n=0)) at h, rw h at h1, linarith},
    {rcases nat.exists_coprime g0 with ⟨ x, y ,g3, g1, g2 ⟩, rw g1 at h, nth_rewrite 1 g2 at h,
    have g4: (nat.gcd a b)^2 ∣ n^2, {use x*y, rw ← h, ring},
    rw nat.pow_dvd_pow_iff (show 0<2, by linarith) at g4, cases g4 with s g4, rw mul_comm at h, rw ← mul_assoc at h, nth_rewrite 1 mul_assoc at h, nth_rewrite 2 mul_comm at h,
    repeat {rw mul_assoc at h}, rw ← pow_two at h, rw ← mul_assoc at h, rw g4 at h,rw nat.mul_pow at h, repeat {rw nat.pow_eq_pow at h}, rw mul_comm at h,
    have g5:= mul_pos g0 g0, rw ← nat.pow_two at g5, rw nat.mul_right_inj g5 at h,
    have g6:= coprime_squares_factors y x s h g3.symm (prod_pos (nat.gcd a b) s n g4 h1), cases g6 with r g6, rw mul_comm at h,
    have g7:= coprime_squares_factors x y s h g3 (prod_pos (nat.gcd a b) s n g4 h1), cases g7 with s g7, rw g6 at g2, rw g7 at g1, rw mul_comm at g2, rw mul_comm at g1, use s, use r, cc}
end

theorem fib_squares (n k: ℕ ) (h: fib n =k^2) : n=0 ∨ n=1 ∨ n=2 ∨ n=12:=
begin
    cases res_mod_4' n with h0 h1', cases div_algo n 2 with  w h1, rw h0 at h1, rw add_zero at h1, swap,
    {cases div_algo n 4 with s h2',cases h1' with h1 h_1,
    {cases nat_case_bash s 0 with g2 g3, swap,
    {cases g3 with q g3, rw add_zero q at g3, cases decomp_pow_3 s (show s>0, by linarith) with r g4, rcases g4 with ⟨ u, g4, g5 ⟩, rw add_comm at h2',
    have g6:=double_not_zero_mod3 u g5,
    have g7:=fun_gen_add 1 u n s q r (n%4) (luc(2*u)) (fib) h2' g3 g4 (mod_fib (2*1*u) g6), repeat{rw mul_one at g7},
    rw h at g7, rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd at g7, apply_fun (λ (a: zmod (luc(2*u))), (a- fib(n%4))) at g7,
    have H: (k^2 : zmod (luc(2*u))) = -fib(n%4), {simp at g7, exact g7},
    rw h1 at H, rw [show fib 1 =1, from rfl] at H, simp at H,
    have g10:= non_res_3_mod_4 _ _ (luc_pos (2*u)) H, rw luc_mod_4 (2*u) g6 at g10, contradiction},
    {simp * at *}},

    {have h2: n=4*(s+1)-1,
        {rw add_comm at h2', rw h2', rw h_1, rw mul_add, rw mul_one, rw nat.add_sub_assoc (show 1 ≤ 4, by linarith), rw add_comm},
    cases decomp_pow_3 (s+1) (show s+1>0, by linarith) with r g4, rcases g4 with ⟨ u, g4, g5 ⟩,
    have g6:=double_not_zero_mod3 u g5,
    have g7:= fun_gen_add 1 u (4*u-1 + 2*2*(s+1)) (s+1) s r (4*u-1) (luc(2*u)) (fib) (show 4*u-1+2*2*(s+1) = 4*u-1+2*2*(s+1), from rfl) (show s+1=s+1, from rfl) g4 (mod_fib (2*u) g6),
    have g8:= mod_fib (2*u) g6 (4*(s+1)-1),
    have i1: 1 ≤ 2*(2*u),
        {have h2: 1 ≤ u, {by_contra, push_neg at a, interval_cases u, linarith},
        ring, apply le_trans (show 1 ≤ 4*1, by linarith), linarith},
    have g9:= mod_fib_sub (2*u) (1) (g6.1) (g6.2) (i1),
    rw (show (-1 :ℤ )^(1+1) = 1, by ring) at g9, rw one_mul at g9, norm_cast at g9, rw (show 2*(2*u)=4*u, by ring) at *,
    have g10: 4*(s+1)-1+4*u = 4*u -1+2*2*(s+1), {rw (show 2*2 =4, from rfl), rw add_sub_add _ _ _ (i1) (show 1 ≤ 4*(s+1), by linarith)}, rw g10 at g8,
    have g11:= nat.dvd_add g8 g9, rw add_assoc at g11, nth_rewrite 1 ← add_assoc at g11, nth_rewrite 4 add_comm at g11, repeat {rw ← add_assoc at g11}, rw add_assoc at g11, rw nat.dvd_add_right g7 at g11,
    rw h2 at h, rw h at g11, rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd at g11, apply_fun (λ (a: zmod (luc(2*u))), (a- fib (1))) at g11,
    have H: (↑ k^2 : zmod (luc((2*u)))) = -fib(1), {simp at g11, simp, rw ← g11}, rw (show fib 1 =1, from rfl) at H, simp at H,
    have g12:= non_res_3_mod_4 _ _ (luc_pos(2*u)) H, rw luc_mod_4 (2*u) g6 at g12, contradiction}},

    {rw h1 at h, rw fib_2k w at h,cases nat_case_bash k 0, swap,
    {cases classical.em (w%3=0),
    {rw ← nat.dvd_iff_mod_eq_zero at h_2, cases h_2 with x h_2, rw h_2 at h, cases h_1 with s h_1, rw add_zero s at h_1, cases squares_factors _ _ _ h (show 0 <k, by linarith) with b h3, rcases h3 with ⟨ a, h3, h4⟩, rw fib_luc_gcd x at *,
    have h5:= luc_double_square (3*x) _ h4, rw h_2 at h1, cases h5 with h51 h52,
    {rw h51 at h1, rw mul_zero at h1, left, assumption},
    {rw h52 at h1, repeat{right}, rw h1, ring}},
    {cases h_1 with s h1', rw add_zero (s) at h1', cases squares_factors _ _ _ h (show 0 <k, by linarith) with b h3, rcases h3 with ⟨ a, h3, h4⟩, rw fib_luc_gcd_2 w h_2 at *, rw one_mul at h4,
    have h5:= luc_square w _ h4, cases h5 with h51 h52,
    {rw h51 at h1, rw mul_one at h1, cc },
    {rw h52 at h_2, rw (show 3%3 =0, from rfl) at h_2, contradiction}}},
    {rw le_zero_iff_eq at h_1, rw h_1 at h, rw (show 0^2=0, from rfl) at h, rw nat.mul_eq_zero at h, cases h with hx hy,
    {cases nat_case_bash w 0,
    {rw le_zero_iff_eq at h, rw h at h1, rw h1, simp},
    {cases h with k h, rw add_zero k at h, rw h at hx,
    have i1:= fib_pos k, linarith}},
    have i2:= luc_pos w, linarith}}
end