import tactic
import data.matrix.basic
import data.matrix.block
import linear_algebra.matrix.block
import linear_algebra.matrix.nonsingular_inverse
import algebra.group.units
import order.well_founded
import algebra.big_operators.basic

-- allows notation for matrix multiplication and summations
open_locale matrix
open_locale big_operators

/-
Currently, whole framework is for a Eucldiean Domains (some results could be weakened to PID or even weaker), and later lemmas have been restriced to nxn matrices rather than nxm
-/

-- # Elementary Matrices
/-
Defines the basis matrix, all zero's except for a 1 in the (i, j)'th entry and three elementary matrices
Left multiplication acts on rows, right multiplication acts on columns, but the effect of the elementary matrices is expressed as lemmas later

* `add_mult n i j a` - is the matrix that (via multiplication) induces the map which adds `a` times row/column `i` to row/column `j`
* `mul_by_unit n i u` - induces a similar map which multiplies row/column `i` by `u`
-/

-- ## Definiton of the Elementary Matrices

namespace elem_matrix

-- Basis Δ (as called in Jacobson)
def basis (R : Type*) [euclidean_domain R] (n : ℕ) (i j : fin n) : matrix (fin n) (fin n) R :=
(λ i' j', if i = i' ∧ j = j' then 1 else 0)

-- Type I: Add multiple of column/row i to j
def add_mult {R : Type*} [euclidean_domain R] (n : ℕ) (i j : fin n) (a : R) (h : i ≠ j) : matrix (fin n) (fin n) R :=
1 + a • (basis R n i j)

-- Type II: Multiply row/column by a unit
def mul_by_unit {R : Type*} [euclidean_domain R] (n : ℕ) (i : fin n) (u : R) (h : is_unit u) : matrix (fin n) (fin n) R :=
matrix.diagonal (λ i', if i' = i then u else 1)
--1 + (u - 1) • (basis R n i i)

-- Type III: Permutation
def perm (R : Type*) [euclidean_domain R] (n : ℕ) (i j : fin n) : matrix (fin n) (fin n) R :=
(equiv.to_pequiv (equiv.swap i j)).to_matrix
-- 1 - (basis R n i i) - (basis R n j j) + (basis R n i j) + (basis R n j i)

-- ## Elementary Matrices are Invertible (units)
/-
Proof all three elementary matrices are invertible, which is expressed as `is_unit M`, by using equivalence between `is_unit M` and `is_unit (det M)`
-/

theorem add_mult_inv {R : Type*} [euclidean_domain R] {n : ℕ} {i j : fin n} {a : R} (h : i ≠ j) : is_unit (add_mult n i j a h) :=
begin
  apply (matrix.is_unit_iff_is_unit_det (add_mult n i j a h)).2,
  by_cases h' : i < j, -- case split to use upper and lower triangular theorems (essentially same argument), could be condensed
  { rw (matrix.det_of_upper_triangular (add_mult n i j a h) _),
    { unfold add_mult,
      unfold basis,
      have h₁ : ∀ (x : fin n), ¬(i = x ∧ j = x),
      { simp [h.symm] },
      simp [h₁] },
    intros k l hlk,
    unfold add_mult,
    unfold basis,
    have h₂ : ¬ (i = k ∧ j = l),
    { rintro ⟨rfl, rfl⟩,
      exact asymm h' hlk },
    simp [h₂, (ne_of_lt hlk).symm] },
  rw (matrix.det_of_lower_triangular (add_mult n i j a h) _),
  { unfold add_mult,
    unfold basis,
    have h₁ : ∀ (x : fin n), ¬(i = x ∧ j = x),
    { simp [h.symm] },
    simp [h₁] },
  intros k l hkl,
  unfold add_mult,
  unfold basis,
  have h₂ : ¬ (i = k ∧ j = l),
  { rintro ⟨rfl, rfl⟩,
    exact h (false.rec (i = j) (h' hkl)) },
  simp [h₂, (ne_of_lt hkl)],
end

theorem mul_by_unit_inv {R : Type*} [euclidean_domain R] {n : ℕ} {i : fin n} {u : R} {h : is_unit u} : is_unit (mul_by_unit n i u h) :=
begin
  apply (matrix.is_unit_iff_is_unit_det (mul_by_unit n i u h)).2,
  unfold mul_by_unit,
  simp [matrix.det_diagonal, finset.prod_ite],
  exact is_unit.pow (finset.filter (λ (x : fin n), x = i) finset.univ).card h,
end

theorem perm_inv {R : Type*} [euclidean_domain R] {n : ℕ} {i j : fin n} : is_unit (perm R n i j) :=
begin
  apply (matrix.is_unit_iff_is_unit_det (perm R n i j)).2, -- has determinant -1
  unfold perm,
  rw matrix.det_permutation,
  by_cases h : i = j,
  { rw equiv.perm.sign_swap',
    simp [h] },
  rw equiv.perm.sign_swap,
  { use -1,
    simp },
  exact h,
end

-- ## Lemmas About The Elementary Matrices
/-
ADD TO LIBRARY IN `data.matrix.pequiv`
This lemma fills in a missing lemma in `data.matrix.pequiv` which is necessary for proof of the effect of the permutation matrix
There are two different expressions of the theorem below, with the second one (using `matrix.submatrix`) being used
-/

/--
variables {m n α : Type*}

lemma to_pequiv_matrix_mul [fintype n] [decidable_eq n] [semiring α] (f : n ≃ n) (M : matrix m n α):
(M ⬝ f.to_pequiv.to_matrix) = λ i j, M i (f.symm j) :=
matrix.ext $ λ i j, by rw [pequiv.matrix_mul_apply, ←equiv.to_pequiv_symm, equiv.to_pequiv_apply]
-/

lemma pequiv.to_pequiv_matrix_mul {m n α : Type*} [fintype n] [decidable_eq n] [semiring α]
  (f : n ≃ n) (M : matrix m n α) : (M ⬝ f.to_pequiv.to_matrix) = M.submatrix id (f.symm) :=
matrix.ext $ λ i j, by rw [pequiv.matrix_mul_apply, ←equiv.to_pequiv_symm,
                           equiv.to_pequiv_apply, matrix.submatrix_apply, id.def]
-- necessary for later lemmas

-- ### Effect of Permutation Matrix
/-
Effect of left and right multiplication by the permutation matrix expressed in two ways each
-/

lemma perm_mul {R : Type*} [euclidean_domain R] {n : ℕ} (A : matrix (fin n) (fin n) R) (k l : fin n) : ∀ (i j : fin n), A i j = ((elem_matrix.perm R n k l) ⬝ A) (ite (i = k) l (ite (i = l) k i)) j
:= λ i j, by { unfold elem_matrix.perm, simp [pequiv.to_pequiv_mul_matrix, ←equiv.swap_apply_def] }

lemma perm_mul' {R : Type*} [euclidean_domain R] {n : ℕ} (A : matrix (fin n) (fin n) R) (k l : fin n) : ∀ (i j : fin n), ((elem_matrix.perm R n k l) ⬝ A) i j = A (ite (i = k) l (ite (i = l) k i)) j
:= λ i j, by { unfold elem_matrix.perm, simp [pequiv.to_pequiv_mul_matrix, equiv.swap_apply_def] }

lemma mul_perm {R : Type*} [euclidean_domain R] {n : ℕ} (A : matrix (fin n) (fin n) R) (k l : fin n) : ∀ (i j : fin n), A i j = (A ⬝ (elem_matrix.perm R n k l)) i (ite (j = k) l (ite (j = l) k j))
:= λ i j, by { unfold elem_matrix.perm, simp [pequiv.to_pequiv_matrix_mul, ←equiv.swap_apply_def] }

lemma mul_perm' {R : Type*} [euclidean_domain R] {n : ℕ} (A : matrix (fin n) (fin n) R) (k l : fin n) : ∀ (i j : fin n), (A ⬝ (elem_matrix.perm R n k l)) i j = A i (ite (j = k) l (ite (j = l) k j))
:= λ i j, by { unfold elem_matrix.perm, simp [pequiv.to_pequiv_matrix_mul, equiv.swap_apply_def] }

lemma perm_eq_id {R : Type*} [euclidean_domain R] {n : ℕ} : ∀ {i : fin n}, elem_matrix.perm R n i i = (1 : matrix (fin n) (fin n) R) :=
begin
  intro i,
  unfold perm,
  simp,
end

-- ### Effect of Add Mult Matrix

-- Left Mult
lemma add_mult_mul {R : Type*} [euclidean_domain R] {n : ℕ} (A : matrix (fin n) (fin n) R) (i j : fin n) (c : R) (h : i ≠ j) : ((add_mult n i j c h) ⬝ A) i j  = (A i j) + c * (A j j)  :=
begin
  rw matrix.mul_apply,
  unfold add_mult basis,
  simp,
  ring_nf,
  rw finset.sum_add_distrib,
  rw fintype.sum_eq_add_sum_compl i,
  simp,
  rw finset.sum_eq_zero _,
  intros x hx,
  rw [finset.mem_compl, finset.mem_singleton] at hx,
  simp [matrix.one_apply_ne (ne_comm.mp hx)]
end

-- Right Mult
lemma mul_add_mult {R : Type*} [euclidean_domain R] {n : ℕ} (A : matrix (fin n) (fin n) R) (i j : fin n) (c : R) (h : i ≠ j) : (A ⬝ (add_mult n i j c h)) i j  = (A i j) + c * (A i i) :=
begin
  rw matrix.mul_apply,
  unfold add_mult basis,
  simp,
  ring_nf,
  simp [add_mul],
  rw finset.sum_add_distrib,
  rw fintype.sum_eq_add_sum_compl j,
  simp,
  rw finset.sum_eq_zero _,
  { ring_nf },
  intros x hx,
  rw [finset.mem_compl, finset.mem_singleton] at hx,
  simp [matrix.one_apply_ne hx]
end

/-
No lemmas about the effect of the `unit_mul` elementary matrix since it isn't used in the restriced snf definition (where we don't require diagonal entries successively divide)
-/

end elem_matrix

-- # Equivalence of m x n matrices
/-
Basic Framework for the equivalence of matrices, that this is an equivalence relation and that left and right multiplication by invertable (`is_unit`) matrices preserves equivalence
-/

namespace matrix_equiv_rel

-- ## Equivalence Definition
-- two mxn matrices A and B are quivalent if A = M B N and M and N are invertible
def r (R : Type*) [euclidean_domain R] (m n : ℕ) : (matrix (fin m) (fin n) R) → (matrix (fin m) (fin n) R) → Prop :=
λ A, (λ B, ∃ (M : matrix (fin m) (fin m) R) (N : matrix (fin n) (fin n) R), (is_unit M) ∧ (is_unit N) ∧ ( A = M ⬝ B ⬝ N ))

-- ## Matrix Equivalence is an Equivalence Relation

lemma r_refl {R : Type*} [euclidean_domain R] {m n : ℕ} : reflexive (r R m n) :=
begin
  intro A,
  use [1,1],
  finish,
end

lemma r_symm {R : Type*} [euclidean_domain R] {m n : ℕ} : symmetric (r R m n) :=
begin
  rintros A B ⟨M, N, hM, hN, h⟩,
  use [M⁻¹, N⁻¹],
  simp [matrix.nonsing_inv_eq_ring_inverse, hM, hN] ,
  simp [← matrix.nonsing_inv_eq_ring_inverse],
  calc
    B = (M⁻¹ ⬝ M) ⬝ B ⬝ (N ⬝ N⁻¹) : by {simp [matrix.mul_nonsing_inv N ((matrix.is_unit_iff_is_unit_det N).mp hN), matrix.nonsing_inv_mul M ((matrix.is_unit_iff_is_unit_det M).mp hM)]}
    ... = M⁻¹ ⬝ (M ⬝ B ⬝ N) ⬝ N⁻¹ : by {simp [matrix.mul_assoc]}
    ... = M⁻¹ ⬝ A ⬝ N⁻¹ : by {rw h}
end

lemma r_trans {R : Type*} [euclidean_domain R] {m n : ℕ} : transitive (r R m n) :=
begin
  rintros A B C ⟨M₁, N₁, hM₁, hN₁, h₁⟩ ⟨M₂, N₂, hM₂, hN₂, h₂⟩,
  use [M₁ ⬝ M₂, N₂ ⬝ N₁],
  split,
  { exact is_unit.mul hM₁ hM₂ },
  split,
  { exact is_unit.mul hN₂ hN₁ },
  calc
    A = M₁ ⬝ B ⬝ N₁ : h₁
    ... = M₁ ⬝ (M₂ ⬝ C ⬝ N₂) ⬝ N₁ : by {rw h₂}
    ... = M₁ ⬝ M₂ ⬝ C ⬝ (N₂ ⬝ N₁) : by {simp only [matrix.mul_assoc]}
end

theorem r_equiv {R : Type*} [euclidean_domain R] {m n : ℕ} : equivalence (r R m n) := ⟨r_refl, r_symm, r_trans⟩

-- ## Basic Equivalence Lemmas

-- left and right multiplication by invertible matrix preserves equivalence (in particular the elementary matrices)

lemma unit_mul {R : Type*} [euclidean_domain R] {m n : ℕ} (M : matrix (fin m) (fin n) R) (A : matrix (fin m) (fin m) R) (h : is_unit A) : r R m n M (A ⬝ M) :=
begin
  use [A⁻¹, 1],
  simp [matrix.nonsing_inv_eq_ring_inverse, h, ← matrix.mul_assoc, ← matrix.mul_eq_mul, (ring.inverse_mul_cancel A h)]
end

lemma mul_unit {R : Type*} [euclidean_domain R] {m n : ℕ} (M : matrix (fin m) (fin n) R) (A : matrix (fin n) (fin n) R) (h : is_unit A) : r R m n M (M ⬝ A) :=
begin
  use [1, A⁻¹],
  simp [matrix.nonsing_inv_eq_ring_inverse, h, matrix.mul_assoc, ← matrix.mul_eq_mul, (ring.mul_inverse_cancel A h)]
end

end matrix_equiv_rel

-- # Smith Normal Form

-- Notation for euclidean_domain.r, the well_founded relation to replace euclidean valuation function
local infix ` ≺ `:50 := euclidean_domain.r

-- If `δ` was the euclidean valuation function, as in Jacobson book, then we have the following equivalence `a ≺ b  ↔  δ(a) < δ(b)`

namespace smith_norm_form

-- ## Definitions

-- Simple version of smith normal form, without division condition, and limited to nxn
-- See full definition in comments at bottom
def snf {n : ℕ} {R : Type*} [euclidean_domain R] [decidable_eq R] (A : matrix (fin n) (fin n) R) : Prop :=
∃ (d : (fin n) → R) (r : ℕ), (A = matrix.diagonal d) ∧ (∀ (i : fin n), ↑i ≥ r ↔ d i = 0 ) --∧ (∀ (i j : fin n), (i ≤ j) → ↑j < r → (d i) ∣ (d j))

-- desired form for induction step
def simple_block_diag {R : Type*} [euclidean_domain R] {n : ℕ} (a : R) (A : matrix (fin n) (fin n) R) : matrix (fin (n + 1)) (fin (n + 1)) R :=
matrix.reindex (fin_sum_fin_equiv.trans fin_add_flip) (fin_sum_fin_equiv.trans fin_add_flip) (matrix.from_blocks (a • (1 : matrix (fin 1) (fin 1) R)) 0 0 A)
-- use `matrix.submatrix` instead?
/-
a 0 0 0
0 (   )
0 | A |
0 (   )
-/

-- An element of a matrix (over a ED) is minimal if it's non zero and has minimal valuation (excluding zeros)
def is_minimal {R : Type*} [euclidean_domain R] {n : ℕ} (A : matrix (fin n) (fin n) R) (k l : fin n) : Prop := (A k l ≠ 0) ∧ (∀ (i j : fin n), A i j ≠ 0 → ¬((A i j) ≺ (A k l)))

-- ## Lemmas Setting Up Main Result

-- Every non-zero matrix has an element with minimal valuation
-- this lemma specifically can give the indices of the minimal element
lemma min_valuation_of_mat {R : Type*} [euclidean_domain R] [decidable_eq R] {n : ℕ} (A : matrix (fin n) (fin n) R) (hA0 : A ≠ 0) : ∃ (k l : fin n), is_minimal A k l :=
begin
  -- A as a finset without the zero's
  let A' := finset.filter (λ (a : R), a ≠ 0) (finset.image₂ A finset.univ finset.univ),
  -- A has a non-zero element
  have hA0' : ∃ (i' j' : fin n), A i' j' ≠ 0,
  { by_contra h',
    push_neg at h',
    have : A = 0,
    ext A,
    exact h' _ _,
    contradiction },
  rcases hA0' with ⟨i', j', hA0'⟩,
  -- A' is nonempty
  have hA'ne : A'.nonempty,
  { use A i' j',
    simp [A'],
    use [i', j'] },
  -- A' has a minimal element since ≺ is well founded
  rcases (well_founded.has_min euclidean_domain.r_well_founded (↑A') hA'ne) with ⟨m, hm, hmin⟩,
  rcases ((finset.mem_image₂).mp (finset.mem_of_mem_filter m hm)) with ⟨k, l, _, _, hmin'⟩,
  use [k, l],
  split,
  { rw hmin',
    exact (finset.mem_filter.mp hm).2 },
  intros i j h,
  have h'' : (A i j) ∈ A',
  { dsimp [A'],
    rw finset.mem_filter,
    split,
    { rw finset.mem_image₂,
      use [i, j],
      simp },
    exact h },
  rw hmin',
  exact hmin (A i j) h''
end

-- Moves minimal element to top left
lemma minimal_element_to_00 {R : Type*} [euclidean_domain R] [decidable_eq R] {n : ℕ} (A : matrix (fin (n + 1)) (fin (n + 1)) R)  (hA0 : A ≠ 0) : ∃ (B : matrix (fin (n + 1)) (fin (n + 1)) R), is_minimal B 0 0 ∧ matrix_equiv_rel.r R (n + 1) (n + 1) A B :=
begin
  rcases (min_valuation_of_mat A hA0) with ⟨i, j, h⟩, -- A i j is minimal elt of A
  use ((elem_matrix.perm R (n + 1) 0 i) ⬝ A ⬝ (elem_matrix.perm R (n + 1) 0 j)),
  split,
  { -- minimal element is at 0 0
    have aux : ∀ (k : fin (n + 1)), (ite (k = 0) k (ite (k = k) 0 k)) = 0,
      { have hj : j = 0 ∨ j ≠ 0, by tauto,
        cases hj;
        simp [hj] },
    have h₁ : A i j = ((elem_matrix.perm R (n + 1) 0 i) ⬝ A ⬝ (elem_matrix.perm R (n + 1) 0 j)) 0 0,
    { have H₁ := (elem_matrix.mul_perm ((elem_matrix.perm R (n + 1) 0 i) ⬝ A) 0 j) 0 j,
      rw [aux j] at H₁,
      rw [← H₁, ((elem_matrix.perm_mul A 0 i) i j), aux i] },
    have h₂ : ∀ (i' j' : fin (n + 1)), ∃ (k l : fin (n + 1)), A k l = ((elem_matrix.perm R (n + 1) 0 i) ⬝ A ⬝ (elem_matrix.perm R (n + 1) 0 j)) i' j',
    { intros i' j',
      -- Very manual solution
      have hi' : i' = 0 ∨ i' = i ∨ (i' ≠ 0 ∧ i' ≠ i), by tauto,
      have hj' : j' = 0 ∨ j' = j ∨ (j' ≠ 0 ∧ j' ≠ j), by tauto,
      have hi : i = 0 ∨ i ≠ 0, by tauto,
      have hj : j = 0 ∨ j ≠ 0, by tauto,
      cases hi;
      cases hj,
      { rw [hi, hj, elem_matrix.perm_eq_id],
        use [i', j'],
        simp },
      { rw [hi, elem_matrix.perm_eq_id],
        simp,
        rcases hj' with hj' | hj' | ⟨hj'₁, hj'₂⟩,
        { use [i', j],
          rw [hj', (elem_matrix.mul_perm A 0 j) i' j, aux j] },
        { use [i', 0],
          simp [hj', (elem_matrix.mul_perm A 0 j) i' 0] },
        { use [i', j'],
          simp [(elem_matrix.mul_perm A 0 j) i' j', hj'₁, hj'₂] } },
      { rw [hj, elem_matrix.perm_eq_id],
        simp,
        rcases hi' with hi' | hi' | ⟨hi'₁, hi'₂⟩,
        { use [i, j'],
          rw [hi', (elem_matrix.perm_mul A 0 i) i j', aux i] },
        { use [0, j'],
          simp [hi', (elem_matrix.perm_mul A 0 i) 0 j'] },
        { use [i', j'],
          simp [(elem_matrix.perm_mul A 0 i) i' j', hi'₁, hi'₂] } },
      { have H₁ := elem_matrix.mul_perm ((elem_matrix.perm R (n + 1) 0 i) ⬝ A) 0 j,
        have H₂ := elem_matrix.perm_mul A 0 i,
        rcases hi' with hi' | hi' | ⟨hi'₁, hi'₂⟩;
        rcases hj' with hj' | hj' | ⟨hj'₁, hj'₂⟩,
        { rw [hi', hj'] at *,
          use [i, j],
          have H₁' := H₁ 0 j,
          rw [aux j] at H₁',
          rw [← H₁', (H₂ i j), aux i] },
        { rw [hi', hj'] at *,
          use [i, 0],
          have H₁' := H₁ 0 0,
          simp at H₁',
          rw [← H₁', (H₂ i 0), aux i] },
        { rw [hi'] at *,
          use [i, j'],
          have H₁' := H₁ 0 j',
          simp [hj'₁, hj'₂] at H₁',
          rw [← H₁', (H₂ i j'), aux i] },
        { rw [hi', hj'] at *,
          use [0, j],
          have H₁' := H₁ i j,
          rw [aux j] at H₁',
          simp [← H₁', (H₂ 0 j)] },
        { rw [hi', hj'] at *,
          use [0, 0],
          have H₁' := H₁ i 0,
          simp at H₁',
          simp [← H₁', (H₂ 0 0)] },
        { rw hi' at *,
          use [0, j'],
          have H₁' := H₁ i j',
          simp [hj'₁, hj'₂] at H₁',
          simp [← H₁', (H₂ 0 j')] },
        { rw hj' at *,
          use [i', j],
          have H₁' := H₁ i' j,
          rw aux j at H₁',
          simp [← H₁', (H₂ i' j), hi'₁, hi'₂] },
        { rw hj' at *,
          use [i', 0],
          have H₁' := H₁ i' 0,
          simp at H₁',
          simp [← H₁', (H₂ i' 0), hi'₁, hi'₂] },
        { use [i', j'],
          have H₁' := H₁ i' j',
          simp [hj'₁, hj'₂] at H₁',
          simp [← H₁', (H₂ i' j'), hi'₁, hi'₂] } } },
    unfold is_minimal at h ⊢,
    rw ← h₁,
    split,
    { exact h.1 },
    intros i' j' H,
    rcases h₂ i' j' with ⟨k, l, h'⟩,
    rw ← h' at H ⊢,
    exact h.2 k l H },
  -- matrices are equivalent
  have h₁ := matrix_equiv_rel.unit_mul A (elem_matrix.perm R (n + 1) 0 i) elem_matrix.perm_inv,
  have h₂ := matrix_equiv_rel.mul_unit ((elem_matrix.perm R (n + 1) 0 i) ⬝ A) (elem_matrix.perm R (n + 1) 0 j) elem_matrix.perm_inv,
  exact matrix_equiv_rel.r_trans h₁ h₂,
end

-- Assume B 0 0 doesn't divide all elements in row 1 or column 1, then perform EA to give a new (smaller) minimal element
lemma temp1 {R : Type*} [euclidean_domain R] [decidable_eq R] {n : ℕ} (A : matrix (fin (n + 1)) (fin (n + 1)) R)  (hA0 : A ≠ 0) (h00 : is_minimal A 0 0) (i : fin (n + 1)) (H : ¬(A 0 0 ∣ A i 0) ∨ ¬(A 0 0 ∣ A 0 i) ) : ∃ (B : matrix (fin (n + 1)) (fin (n + 1)) R), ((B i 0 ≺ A 0 0) ∨ (B 0 i ≺ A 0 0)) ∧ matrix_equiv_rel.r R (n + 1) (n + 1) A B :=
begin
  have hi : i ≠ 0,
    { intro hc,
      rw hc at H,
      cases H;
      contradiction },
  cases H,
  -- Argument for column 0 and row 0 are almost identical but do have small differences
  -- column 0
  { let B := (elem_matrix.add_mult (n + 1) i 0 (-((A i 0) / (A 0 0))) hi),
    have h' : is_unit B,
    { exact @elem_matrix.add_mult_inv R _inst_1 (n + 1) i 0 (-((A i 0) / (A 0 0))) hi },
    use [B ⬝ A],
    split,
    { left,
      -- minimal valuation is lower
      have h : (B ⬝ A) i 0 = (A i 0) % (A 0 0),
      { simp [euclidean_domain.mod_eq_sub_mul_div],
        rw elem_matrix.add_mult_mul A i 0 (-((A i 0) / (A 0 0))) hi,
        ring_nf },
      rw h,
      exact euclidean_domain.remainder_lt (A i 0) h00.1 },
    -- matrices are equivalent
    -- unfold matrix_equiv_rel.r,
    use [B⁻¹, 1],
    simp,
    split,
    { cases h' with u h',
      use u⁻¹,
      simp [h'] },
    simp [← matrix.mul_assoc, matrix.nonsing_inv_mul B ((matrix.is_unit_iff_is_unit_det B).1 h')] },
  -- row zero
  let B := (elem_matrix.add_mult (n + 1) 0 i (-((A 0 i) / (A 0 0))) hi.symm),
  have h' : is_unit B,
    { exact @elem_matrix.add_mult_inv R _inst_1 (n + 1) 0 i (-((A 0 i) / (A 0 0))) hi.symm },
  use [A ⬝ B],
  split,
  { right,
    -- minimal valuation is lower
    have h : (A ⬝ B) 0 i = (A 0 i) % (A 0 0),
    { simp [euclidean_domain.mod_eq_sub_mul_div],
      rw elem_matrix.mul_add_mult A 0 i (-((A 0 i) / (A 0 0))) hi.symm,
      ring_nf },
    rw h,
    exact euclidean_domain.remainder_lt (A 0 i) h00.1 },
  -- matrices are equivalent
  -- unfold matrix_equiv_rel.r,
  use [1, B⁻¹],
  simp,
  split,
  { cases h' with u h',
    use u⁻¹,
    simp [h'] },
  have := ((matrix.is_unit_iff_is_unit_det B).1 h'),
  simp [matrix.mul_assoc, matrix.mul_nonsing_inv B ((matrix.is_unit_iff_is_unit_det B).1 h')]
end

-- __1__ Assume B 0 0 does divide all elements in row 1 or column 1, then can make them all into zero's __For Loop Implementation__

-- __2__ We will always be in one of the above cases, if first one, there will be finitely many steps to second case (using well founded tactics, see extended EA and gcd processes proof) By The Equation Compiler and __Using_Well_Founded__

-- inductive steps between n and (n + 1)
-- __3__
lemma equiv_simple_block_diag {R : Type*} [euclidean_domain R] {n : ℕ} (h : n > 0) (A : matrix (fin (n + 1)) (fin (n + 1)) R) : ∃ (B : matrix (fin n) (fin n) R) (b : R), matrix_equiv_rel.r R (n + 1) (n + 1) A (simple_block_diag b B) :=
begin
  unfold simple_block_diag,
  sorry
end
-- use `matrix.submatrix`?

-- __4__
lemma temp2 {R : Type*} [euclidean_domain R] [decidable_eq R] {n : ℕ} (hn : n > 0) (A : matrix (fin n) (fin n) R) (B : matrix (fin n) (fin n) R) (hB : snf B) (hA : matrix_equiv_rel.r R n n A B) {a : R} : ∃ (C : matrix (fin (n + 1)) (fin (n + 1)) R), matrix_equiv_rel.r R (n + 1) (n + 1) (simple_block_diag a A) C ∧ snf C := sorry

-- Show that any zero matrix is in smith normal form
-- show that any non-zero 1x1 matrix is in smith normal form

/-
__Miscellaneous Defintions of SNF not currently implemented__

def smith_norm_form {n : ℕ} {D : Type*} [euclidean_domain D] (A : matrix (fin n) (fin n) D) : Prop :=
∃ (d : (fin n) → D) (r : ℕ), (A = matrix.diagonal d) ∧ (∀ (i : fin n), ↑i ≥ r ↔ d i = 0 ) ∧ (∀ (i j : fin n), (i ≤ j) → ↑j < r → (d i) ∣ (d j))

-- # Smith Normal Form (limited to nxn matrices)

def smith_norm_form {n : ℕ} {D : Type*} [euclidean_domain D] (A : matrix (fin n) (fin n) D) : Prop :=
∃ (d : (fin n) → D) (r : ℕ), (A = matrix.diagonal d) ∧ (∀ (i : fin n), ↑i ≥ r ↔ d i = 0 ) ∧ (∀ (i j : fin n), (i ≤ j) → ↑j < r → (d i) ∣ (d j))

-- # Main Theorem

theorem mat_equiv_to_smith_norm_mat {n : ℕ} {D : Type*} {D : Type*} [euclidean_domain D] (A : matrix (fin n) (fin n) D) : ∃ (B : matrix (fin n) (fin n) D), smith_norm_form B ∧ (matrix_equiv_rel.R D n n A B) :=
begin
  sorry
end

-/

end smith_norm_form


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

! This file was ported from Lean 3 source module order.partition.equipartition
! leanprover-community/mathlib commit b363547b3113d350d053abdf2884e9850a56b205
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Equitable
import Mathlib.Order.Partition.Finpartition

/-!
# Finite equipartitions

This file defines finite equipartitions, the partitions whose parts all are the same size up to a
difference of `1`.

## Main declarations

* `Finpartition.IsEquipartition`: Predicate for a `Finpartition` to be an equipartition.
-/

open Finset Fintype

namespace Finpartition

variable {α : Type _} [DecidableEq α] {s t : Finset α} (P : Finpartition s)

/-- An equipartition is a partition whose parts are all the same size, up to a difference of `1`. -/
def IsEquipartition : Prop :=
  (P.parts : Set (Finset α)).EquitableOn card
#align finpartition.is_equipartition Finpartition.IsEquipartition

theorem isEquipartition_iff_card_parts_eq_average :
    P.IsEquipartition ↔
      ∀ a : Finset α,
        a ∈ P.parts → a.card = s.card / P.parts.card ∨ a.card = s.card / P.parts.card + 1 :=
  by simp_rw [IsEquipartition, Finset.equitableOn_iff, P.sum_card_parts]
#align finpartition.is_equipartition_iff_card_parts_eq_average
    Finpartition.isEquipartition_iff_card_parts_eq_average

variable {P}

theorem Set.Subsingleton.isEquipartition (h : (P.parts : Set (Finset α)).Subsingleton) :
    P.IsEquipartition :=
  Set.Subsingleton.equitableOn h _
#align finpartition.set.subsingleton.is_equipartition Finpartition.Set.Subsingleton.isEquipartition

theorem IsEquipartition.card_parts_eq_average (hP : P.IsEquipartition) (ht : t ∈ P.parts) :
    t.card = s.card / P.parts.card ∨ t.card = s.card / P.parts.card + 1 :=
  P.isEquipartition_iff_card_parts_eq_average.1 hP _ ht
#align finpartition.is_equipartition.card_parts_eq_average Finpartition.IsEquipartition.card_parts_eq_average

theorem IsEquipartition.average_le_card_part (hP : P.IsEquipartition) (ht : t ∈ P.parts) :
    s.card / P.parts.card ≤ t.card := by
  rw [← P.sum_card_parts]
  exact Finset.EquitableOn.le hP ht
#align finpartition.is_equipartition.average_le_card_part Finpartition.IsEquipartition.average_le_card_part

theorem IsEquipartition.card_part_le_average_add_one (hP : P.IsEquipartition) (ht : t ∈ P.parts) :
    t.card ≤ s.card / P.parts.card + 1 := by
  rw [← P.sum_card_parts]
  exact Finset.EquitableOn.le_add_one hP ht
#align finpartition.is_equipartition.card_part_le_average_add_one Finpartition.IsEquipartition.card_part_le_average_add_one

/-! ### Discrete and indiscrete finpartition -/

variable (s) -- [Decidable (a = ⊥)]

theorem bot_isEquipartition : (⊥ : Finpartition s).IsEquipartition :=
  Set.equitableOn_iff_exists_eq_eq_add_one.2 ⟨1, by simp⟩
#align finpartition.bot_is_equipartition Finpartition.bot_isEquipartition

theorem top_isEquipartition [Decidable (s = ⊥)] : (⊤ : Finpartition s).IsEquipartition :=
  Set.Subsingleton.isEquipartition (parts_top_subsingleton _)
#align finpartition.top_is_equipartition Finpartition.top_isEquipartition

theorem indiscrete_isEquipartition {hs : s ≠ ∅} : (indiscrete hs).IsEquipartition := by
  rw [IsEquipartition, indiscrete_parts, coe_singleton]
  exact Set.equitableOn_singleton s _
#align finpartition.indiscrete_is_equipartition Finpartition.indiscrete_isEquipartition

end Finpartition


def zeroEqualsZero : 0 = 0 := rfl
#check zeroEqualsZero

theorem theorem1 : 2 = 1 + 1 := rfl
#check theorem1
#reduce theorem1

theorem theorem1' : 2 = 1 + 1 := eq.refl 2
#check theorem1'
#reduce theorem1'

theorem theorem2 : tt = tt := rfl
#check theorem2
#reduce theorem2

/- Doesn't work due to memory constraints-/
theorem theorem3 : "Hello Lean" = "Hello " ++ "Lean" := rfl
#check theorem3

theorem pythagorean : 3*3 + 4*4 = 5*5 := rfl
#check pythagorean
#reduce pythagorean

-- a = b, b = a
#check eq.symm

/-
    (T: Type) (a,b: T) (a Eq b: a = b)
    ----------------------------------

-/


import tactic
import data.nat.basic

open nat

lemma div_3_le_9 (x : ℕ) (h9 : x ≤ 9) (h3 : 3 ∣ x) : x = 0 ∨ x = 3 ∨ x = 6 ∨ x = 9 :=
begin
    cases h3 with k h3k,
    have : k ≤ 3 := by linarith,
    interval_cases k; dec_trivial!,
end


import tactic
import data.real.basic
import data.set
import reals_ps

/--
A sequence a n is monotone increasing iff each term is greater than or equal to the last.
-/
def monotone_increasing (a : ℕ → ℝ) : Prop :=
∀(n : ℕ),  a n ≤ a (n+1)

lemma monotone_increasing_def {a : ℕ → ℝ} :
  monotone_increasing a ↔ ∀(n : ℕ),  a n ≤ a (n+1) := by refl

--The induction tactic won't start at n so we need to prove this lemma first to get what we want.
lemma monotone_increasing_add {a : ℕ → ℝ}:
 monotone_increasing a → ∀(n : ℕ), ∀ (m : ℕ),  a n ≤ a (m+n):=
begin
  intro h,
  intros n m,
  induction m,
  rw zero_add,
  rw nat.succ_eq_one_add,
  have h2: a (m_n + n) ≤ a ( (m_n + n) + 1),
  rw monotone_increasing_def at h,
  specialize h (m_n + n),
  exact h,
  rw add_assoc,
  rw add_comm,
  linarith,
end

--An equivalent definition of monotone increasing. We need both for the theorems later!
lemma monotone_increasing_ind {a : ℕ → ℝ}:
monotone_increasing a ↔ ∀(n : ℕ), ∀ (m : ℕ), n ≤ m → a n ≤ a m :=
begin
  split,
  {
    intro h,
    intros n m,
    intro h2,
    have h3 : ∃ (r: ℕ), n + r = m,
    use m - n,
    linarith,
    cases h3 with s hs,
    rw ←hs,
    rw add_comm,
    apply monotone_increasing_add, exact h,
  },
  {
    intro h,
    intro n,
    specialize h n (n+1),
    apply h,
    norm_num,
  }
end

/--
A sequence is monotone decreasing iff each term is less than or equal to the last.
-/
def monotone_decreasing (a : ℕ → ℝ) : Prop :=
  ∀(n : ℕ), a (n+1) ≤ a n

/-
The corresponding lemma is not needed here since we don't directly prove the
monotone convergence theorem for decreasing sequences.
-/

/--
A function f : ℕ → ℕ is strictly increasing if each f(x + 1) > f(x) for every x.
-/
def strictly_increasing (a : ℕ → ℕ) : Prop :=
  ∀(n : ℕ), a n < a (n + 1)

/--
Given a sequence a n and an index i, a i is a peak of a n iff
all following terms are smaller.
-/
def peak (a : ℕ → ℝ) (i : ℕ) : Prop:=
  ∀(n : ℕ), i < n → a n < a i

/--
Takes a function f : ℕ → ℕ and an initial value i : ℕ and returns a function g : ℕ → ℕ such that
g(n) = g^(n+1)(i)
-/
def recursive (f : ℕ → ℕ) (i : ℕ) : ℕ → ℕ
| 0       :=  f i
| (x + 1) :=  f (recursive x)

/--
A monotone increasing sequence that is bounded above converges to some limit.
-/
theorem bdd_inc_seq_converges {a : ℕ → ℝ} (hb: ∃(M:ℝ), ∀(n: ℕ), a n ≤ M) (hm : monotone_increasing a): ∃(l : ℝ), tendsto a l :=
begin
  let S := set.range a,
  have hsb : bdd_above S, --Prove that S is bounded above
  cases hb with M hbh,
  use M,
  intro a,
  intro as,
  rw set.mem_range at as,
  cases as with ay,
  specialize hbh ay,
  rw ←as_h,
  exact hbh,
  let t := Sup S,
  use t, -- this is the limit
  intro eps,
  intro heps,
  let d := t - eps/2,
  have hds : d ≤ t,
  norm_num,
  linarith,
  rw real.le_Sup_iff at hds,
  {
    specialize hds (-eps/2), --go at most epsilon away from the supremum
    have hxs: (∃ (x : ℝ) (H : x ∈ S), d + -eps/2 < x), apply hds, linarith,
    cases hxs with x hxsi,
    cases hxsi with xs hxs_h,
    rw set.mem_range at xs,
    cases xs with b,
    use b,
    intro n,
    intro hbn,
    --We use the other definition of monotone increasing here.
    have han_ab: a n ≥ a b,
    rw monotone_increasing_ind at hm,
    specialize hm b n,
    apply hm,
    exact hbn,
    rw abs_sub_comm (a n) t,
    have hnomod: |t - a n| = t - a n, -- remove the modulus so linarith works
    rw abs_eq_self,
    rw sub_nonneg,
    apply le_cSup,
    exact hsb,
    rw set.mem_range,
    use n,
    rw hnomod,
    rw ←xs_h at hxs_h,
    change  t - eps/2 + -eps / 2 < a b at hxs_h,
    linarith,
  },
  {exact hsb,}, --We have already proven that S is bounded above. For some reason this comes after the main goal.
  { --S is non empty
    use a 1,
    rw set.mem_range,
    use 1,
  }
end

/--
A monotone decreasing sequence that is bounded below converges to some limit.
-/
theorem bdd_dec_seq_converges {a : ℕ → ℝ} (hb: ∃(M:ℝ), ∀(n: ℕ), M ≤ a n) (hm : monotone_decreasing a): ∃(l : ℝ), tendsto a l :=
begin
  -- recycle the proof for increasing sequences
  -- and combine with tendsto_neg (modified to be an iff so we can go both ways)
  let b := (λ n, - a n),
  have hi: monotone_increasing b,
  intro n,
  specialize hm n,
  change -a (n + 1) ≥ -a n,
  norm_num, exact hm,
  cases hb,
  have hbt: ∃(M:ℝ), ∀(n: ℕ), b n ≤ M,
  use -hb_w,
  change ∀ (n : ℕ), -a n ≤ -hb_w,
  intro n,
  specialize hb_h n,
  norm_num, exact hb_h,
  have hbc: ∃(s : ℝ), tendsto b s,
  apply bdd_inc_seq_converges,
  exact hbt,
  exact hi,
  cases hbc with nl hnl,
  use -nl,
  rw tendsto_neg_iff,
  rw neg_neg,
  exact hnl,
end

/--
A bounded sequence has a convergent subsequence.
-/
theorem bolzano_weierstrass {a : ℕ → ℝ} (hb: ∃(M:ℝ), ∀(n: ℕ), |a n| ≤ M) :
∃(n: ℕ → ℕ) (hn: strictly_increasing n) (l : ℝ), tendsto (λ t, a (n t)) l :=
begin
  --Either there are infinitely many peaks or finitely many peaks.
  by_cases (∀(t : ℕ), ∃(u: ℕ), u > t ∧ peak a u),
  {
    choose r hr using h,
    let s := recursive r 0,
    have hinc : strictly_increasing s,
    {
      intro n,
      specialize hr (s n),
      cases hr with hi,
      exact hi,
    },
    --Prove that every point in the subsequence is a peak.
    --The hypothesis hr is not quite what we need since given s(n) it tells us that s(n+1) is a peak.
    have hpeak: ∀(n : ℕ), peak a (s n),{
      intro n,
      by_cases n = 0,
      rw h,
      change peak a (r 0),
      specialize hr 0,
      cases hr,
      exact hr_right,
      have h2 : ∃ (c : ℕ), n = c.succ,
      apply nat.exists_eq_succ_of_ne_zero,
      exact h,
      cases h2,
      rw h2_h,
      change peak a (r (s h2_w)),
      specialize hr (s h2_w),
      cases hr,
      exact hr_right,
    },
    --Prove monotonicity.
    have hsmi : monotone_decreasing (λ t, a (s t)),
    {
      intro n,
      change a ( s ( n + 1)) ≤ a ( s n ),
      specialize hpeak n,
      specialize hpeak (s (n + 1)),
      specialize hinc n,
      have g: a (s (n + 1)) < a (s n),
      apply hpeak, exact hinc,
      linarith,
    },
    --Plug in all the right functions and proofs to end the proof for this case.
    use s,
    split,
    exact hinc,
    apply bdd_dec_seq_converges,
    cases hb,
    use -hb_w,
    intro n,
    specialize hb_h (s n),
    exact neg_le_of_abs_le hb_h,
    exact hsmi,
  },{
    have h2: ∃ (p : ℕ), ∀ (q : ℕ), p < q → (∃ (n : ℕ), q < n ∧ a q ≤ a n),
    --Some logic to get this into a form that is easier to work with.
    {
      rw not_forall at h, cases h,
      use h_w, rw not_exists at h_h,
      intro q,
      specialize h_h q,
      rw not_and at h_h,
      intro hnq,
      have hp: ¬peak a q,
      apply h_h, exact hnq,
      change ¬(∀(n : ℕ), n > q → a n < a q) at hp,
      rw not_forall at hp,
      cases hp,
      use hp_w,
      rw ←not_lt,
      rw ←not_le,
      rw ←not_or_distrib,
      rw ←not_lt,
      rw gt_iff_lt at hp_h,
      rw ←imp_iff_not_or,
      exact hp_h
    },
    --More tinkering so that the hypothesis works with the choose tactic.
    cases h2 with p h3,
    have h4: ∀ (r : ℕ), ∃ (n : ℕ), r < n ∧ a (r + (p+1)) ≤ a (n+ (p+1)),
    intro r, specialize h3 (r + (p+1)),
    have h5: (∃ (n : ℕ), r + (p+1) < n ∧ a (r + (p+1)) ≤ a n),
    apply h3,
    rw add_comm,
    rw add_assoc,
    rw lt_add_iff_pos_right,
    exact nat.zero_lt_one_add r,
    cases h5,
    cases h5_h,
    use h5_w - (p + 1),
    split,
    rw lt_tsub_iff_right,
    exact h5_h_left,
    --We haven't proven that h5_w - (p + 1) exists in ℕ.
    have h6: h5_w - (p + 1) + (p + 1) = h5_w,
    apply nat.sub_add_cancel,
    linarith [h5_h_left],
    rw h6,
    exact h5_h_right,
    -- Construct the subsequence
    choose b hbs using h4,
    let c := recursive b 0,
    let s := (λ n, c n + (p + 1)),

    have hinc : strictly_increasing s,
    {
      intro n,
      specialize hbs (c n),
      cases hbs,
      rw add_lt_add_iff_right,
      exact hbs_left,
    },
    -- Prove that it's monotone to apply the theorem.
    have hmi : monotone_increasing (λ n, a (s n)),
    {
      intro n,
      specialize hbs (c n),
      cases hbs,
      exact hbs_right,
    },
    use s,
    split,
    exact hinc,
    apply bdd_inc_seq_converges,
    cases hb,
    use hb_w,
    intro n,
    specialize hb_h (s n),
    apply le_of_abs_le,
    exact hb_h,
    exact hmi,
  }
end
#lint


/- 30 Aug 2019 -/
-- degree
-- incidence matrix
-- adjacency matrix

/-
## Definitions:
* A sequence of nonnegative integers is called `graphic` if it is the degree
  sequence of a simple graph.

how does one write dn where n is a subscript?

Havel-Hakimi Theorem: Let d_1 ≥ d_2 ≥ ... ≥ d_n ≥ 0 be a (finite) sequence of
nonnegative integers. The sequence is graphic iff the sequence
  d_2 - 1, ... , d_(t + 1) - 1, d_(t + 2), ... , d_n, where t = d_1, is graphic.

Let 0 ≤ d_1 ≤ d_2 ≤ ... ≤ d_n be a (finite) sequence of
nonnegative integers. The sequence is graphic iff the sequence
  d_2 - 1, ... , d_(t + 1) - 1, d_(t + 2), ... , d_n, where t = d_1 is graphic.
-/

import data.list.sort
import combinatorics.simple_graph.basic
import data.multiset.sort

universe u
variables (V : Type u) [fintype V]

-- what type should i use?
  -- `list.sorted` or `list.pairwise`
-- i think i can just use nat since that includes zero

-- oh god i need some kind of counter? or index
-- copy over the sequence except erase largest element and
  -- subtract one from the n next largest elements
def sub_one_n_times' (n : ℕ) (l : list ℕ) : list ℕ :=
(l.take n).map (nat.pred) ++ l.drop n
-- this one works i think, but ordering does matter

/-def list.pos_filter (l : list ℕ) : list ℕ := l.filter (λ n, 0 < n)
-- this probably already exists, just don't feel like looking it up

def n_pos_list_check (n : ℕ) (l : list ℕ) : Prop := n ≤ l.pos_filter.length-/

-- def nth_is_pos (n : ℕ) (l : list ℕ) [l.sorted (≤)] : Prop := 0 < (l.nth n)
-- bad

def sub_one_n_times (n : ℕ) (l : list ℕ) (h : l.sorted (≥)) : option (list ℕ) :=
  if n ≤ (l.filter (λ n, 0 < n)).length then some (sub_one_n_times' n l) else none

def havel_hakimi' (l : list ℕ) (h : l.sorted (≥)) : option (list ℕ) :=
  if (l.filter (λ n, 0 < n)) = [] then some [] else sub_one_n_times l.head l.tail h.tail
-- you can't get the empty list out of applying sub_one_n_times and removing the largest degree repeatedly, so when
  -- you get the empty list, you're done
-- is there another way of doing it? is there something else i can return
-- also need to re-sort

def havel_hakimi_step (l : list ℕ) (h : l.sorted (≥)) : multiset ℕ := sub_one_n_times' l.head l.tail

-- ideas for degree sequence
  -- multiset of vertices, take the image
  -- `multiset.sort` to get sorted list
variables {V}

def simple_graph.degree_multiset (G : simple_graph V) [decidable_rel G.adj] : multiset ℕ := finset.univ.val.map (λ v, G.degree v)

def simple_graph.degree_sequence (G : simple_graph V) [decidable_rel G.adj] : list ℕ := G.degree_multiset.sort (≥)
-- test out definition - good for algebraic graph theory? - look through lecture notes

--variables (l : list ℕ) [l.sorted (≥)]

-- in pseudocode,
-- a multiset ℕ is graphic if it is the degree sequence of some graph `G`
def graphic' (s : multiset ℕ) : Prop := ∃ (G : simple_graph V) [decidable_rel G.adj], by exactI s = G.degree_multiset

-- a sorted list is graphic if blah blah
def graphic (l : list ℕ) : Prop := ∃ (n : ℕ) (G : simple_graph $ fin n) [decidable_rel G.adj], by exactI l = G.degree_sequence

-- theorem statement from wikipedia:
/-
Let `S = (d_{1},\dots ,d_{n})` be a finite list of nonnegative integers that is nonincreasing.
List `S` is graphic if and only if the finite list `S' = (d_{2}-1,d_{3}-1,\dots ,d_{{d_{1}+1}}-1,d_{{d_{1}+2}},\dots ,d_{n})`
has nonnegative integers and is graphic.
-/
variables (S : list ℕ) (h : S.sorted (≥))

def simple_graph.degree' (G : simple_graph V) [decidable_rel G.adj] : V → ℕ := λ v, G.degree v

theorem havel_hakimi_A : graphic S → (S.head ≤ (S.filter (λ n, 0 < n)).length) ∧ graphic ((havel_hakimi_step S h).sort (≥)) :=
begin
  intros h2,
  split,
  { -- this is just the fact that S.head is largest degree, so the vertex with that degree is adjacent
    -- to S.head many vertices, which then means that they have degree at least 1
    rcases h2 with ⟨n, G, hdec, hds⟩,
    have h3 : S.head = (@simple_graph.degree_sequence (fin n) _ G hdec).head,
    exact congr_arg list.head hds,
    let d1 := (@simple_graph.degree_sequence (fin n) _ G hdec).head,
    -- let v1 := simple_graph.degree_multiset⁻¹ G d1, -- how to get to the preimage of the map in degree_multiset
    sorry },
  { -- the proof here is that performing the algorithm step is allowed because you can do the edge swap
    sorry },
end

lemma havel_hakimi_B : (S.head ≤ (S.filter (λ n, 0 < n)).length) ∧ graphic ((havel_hakimi_step S h).sort (≥)) →  graphic S :=
begin
  intros h2,
  rcases h2 with ⟨hnneg, n, G, hdec, hds⟩,
  sorry,
end

theorem havel_hakimi : graphic S ↔ (S.head ≤ (S.filter (λ n, 0 < n)).length) ∧ graphic ((havel_hakimi_step S h).sort (≥)) :=
 ⟨havel_hakimi_A S h, havel_hakimi_B S h⟩

variables (G : simple_graph V) [decidable_eq V] (v w x y : V)
variables (h1 : G.adj v w) (h2 : G.adj x y) (hn1 : ¬ G.adj v x) (hn2 : ¬ G.adj w y)

def new_graph : simple_graph V :=
{ adj := λ a b, if (((a = v) ∧ (b = w)) ∨ ((a = v) ∧ (b = x)) ∨ (((a = w) ∧ (b = y)) ∨ ((a = x) ∧ (b = y)))) then ¬ G.adj a b
                else G.adj a b,
  -- there's gotta be a better way of doing this
  sym := λ a b,
  begin
    simp,
    intros h,
    sorry,
  end,
  loopless := sorry, }

/-def new_graph : simple_graph V :=
{ adj := λ a b, if ((a ≠ v) ∧ (a ≠ w)) ∨ ((b ≠ x) ∧ (b ≠ y)) then G.adj a b
                else ¬ G.adj a b,
  -- there's gotta be a better way of doing this
  sym := λ a b,
  begin
    simp,
    intros h,
  end,
  loopless := _ }-/

-- okay shit this is gonna be annoying

-- going to need to show that the max degree is le the number of remaining vertices

-- sequence D is graphic if ∃ (G : simple_graph V), D is deg seq for G

-- for proof, need to define swapping edge algo
  -- BUT FIRST we need to define edge deletion lmao


theorem Ex013(a b : Prop): (a → b) → (¬b → ¬a) :=
  assume H1:a → b,
    assume H2:¬b,
    show ¬a, from not.intro
    (
      assume H3:a,
      have b,from H1 H3,
      show false, from H2 this
    )


import analysis.specific_limits
import data.int.parity
import topology.sequences

attribute [instance] classical.prop_decidable

/-
Lemmas from that file were hidden in my course, or restating things which
were proved without name in previous files.
-/

notation `|`x`|` := abs x

-- The mathlib version is unusable because it is stated in terms of ≤
lemma ge_max_iff {α : Type*} [linear_order α] {p q r : α} : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q :=
max_le_iff

/- No idea why this is not in mathlib-/
lemma eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y :=
begin
  intro h,
  apply eq_of_abs_sub_nonpos,
  by_contradiction H,
  push_neg at H,
  specialize h ( |x-y|/2) (by linarith),
  linarith,
end

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

lemma unique_limit {u l l'} : seq_limit u l → seq_limit u l' → l = l' :=
begin
  intros hl hl',
  apply eq_of_abs_sub_le_all,
  intros ε ε_pos,
  specialize hl (ε/2) (by linarith),
  cases hl with N hN,
  specialize hl' (ε/2) (by linarith),
  cases hl' with N' hN',
  specialize hN (max N N') (le_max_left _ _),
  specialize hN' (max N N') (le_max_right _ _),
  calc |l - l'| = |(l-u (max N N')) + (u (max N N') -l')| : by ring
  ... ≤ |l - u (max N N')| + |u (max N N') - l'| : by apply abs_add
  ... =  |u (max N N') - l| + |u (max N N') - l'| : by rw abs_sub
  ... ≤ ε/2 + ε/2 : by linarith
  ... = ε : by ring,
end

lemma le_of_le_add_all {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split ; linarith,
end

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

lemma lt_sup {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  intro y,
  contrapose!,
  exact hx.right y,
end

lemma squeeze {u v w : ℕ → ℝ} {l} (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  cases hw ε ε_pos with N' hN',
  use max N N',
  intros n hn,
  rw ge_max_iff at hn,
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize h n,
  specialize h' n,
  rw abs_le at *,
  split ; linarith
end

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  apply le_of_le_add_all,
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  specialize hN N (by linarith),
  specialize ineg N,
  rw abs_le at hN,
  linarith,
end

lemma inv_succ_le_all :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  convert metric.tendsto_at_top.mp (tendsto_one_div_add_at_top_nhds_0_nat),
  apply propext,
  simp only [real.dist_eq, sub_zero],
  split,
    intros h ε ε_pos,
    cases h (ε/2) (by linarith) with N hN,
    use N,
    intros n hn,
    rw abs_of_pos (nat.one_div_pos_of_nat : 1/(n+1 : ℝ) > 0),
    specialize hN n hn,
    linarith,
  intros h ε ε_pos,
  cases h ε (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_of_pos (@nat.one_div_pos_of_nat ℝ _ n) at hN,
  linarith,
end

lemma limit_const (x : ℝ) : seq_limit (λ n, x) x :=
λ ε ε_pos, ⟨0, λ _ _, by simp [le_of_lt ε_pos]⟩

lemma limit_of_sub_le_inv_succ {u : ℕ → ℝ} {x : ℝ} (h : ∀ n, |u n - x| ≤ 1/(n+1)) :
seq_limit u x :=
begin
  intros ε ε_pos,
  rcases inv_succ_le_all ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  specialize h n,
  specialize hN n hn,
  linarith,
end

lemma limit_const_add_inv_succ (x : ℝ) : seq_limit (λ n, x + 1/(n+1)) x :=
limit_of_sub_le_inv_succ (λ n, by rw abs_of_pos ; linarith [@nat.one_div_pos_of_nat ℝ _ n])

lemma limit_const_sub_inv_succ (x : ℝ) : seq_limit (λ n, x - 1/(n+1)) x :=
begin
  refine limit_of_sub_le_inv_succ (λ n, _),
  rw [show x - 1 / (n + 1) - x = -(1/(n+1)), by ring, abs_neg,  abs_of_pos],
  linarith [@nat.one_div_pos_of_nat ℝ _ n]
end

lemma id_le_extraction {φ}: extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

lemma seq_limit_id : tendsto_infinity (λ n, n) :=
begin
  intros A,
  cases exists_nat_gt A with N hN,
  use N,
  intros n hn,
  have : (n : ℝ) ≥ N, exact_mod_cast hn,
  linarith,
end

variables {u : ℕ → ℝ} {l : ℝ} {φ : ℕ → ℕ}

open set filter

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a

lemma bolzano_weierstrass {a b : ℝ} {u : ℕ → ℝ} (h : ∀ n, u n ∈ Icc a b) :
∃ c ∈ Icc a b, cluster_point u c :=
begin
  rcases (compact_Icc : is_compact (Icc a b)).tendsto_subseq h with ⟨c, c_in, φ, hφ, lim⟩,
  use [c, c_in, φ, hφ],
  simp_rw [metric.tendsto_nhds, eventually_at_top, real.dist_eq] at lim,
  intros ε ε_pos,
  rcases lim ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  exact le_of_lt (hN n hn)
end

lemma not_seq_limit_of_tendstoinfinity {u : ℕ → ℝ} :
  tendsto_infinity u → ∀ x, ¬ seq_limit u x :=
begin
  intros lim_infinie x lim_x,
  cases lim_x 1 (by linarith) with N hN,
  cases lim_infinie (x+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  rw abs_le at hN,
  linarith,
end

open real

lemma sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ Icc a b) :
  ∃ x ∈ Icc a b, is_sup A x :=
begin
  have b_maj :  ∀ (y : ℝ), y ∈ A → y ≤ b,
    from λ y y_in, (h y_in).2,
  have Sup_maj : upper_bound A (Sup A),
  { intro x,
    apply real.le_Sup,
    use [b, b_maj] } ,
  refine ⟨Sup A, _, _⟩,
  { split,
    { cases hnonvide with x x_in,
      exact le_trans (h x_in).1 (Sup_maj _ x_in) },
    { apply Sup_le_ub A hnonvide b_maj } },
  { use Sup_maj,
    intros y y_in,
    rwa real.Sup_le _ hnonvide ⟨b, b_maj⟩ },
end

lemma subseq_tendsto_of_tendsto (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_le_extraction hφ n,
end
namespace tactic.interactive
open tactic

meta def check_me : tactic unit :=
`[ { repeat { unfold seq_limit},
   repeat { unfold continue_en },
   push_neg,
   try { simp only [exists_prop] },
   try { exact iff.rfl },
   done } <|> fail "That's not quite right. Please try again." ]

end tactic.interactive


/- # LoVe Exercise 3: Forward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Connectives and Quantifiers
1.1. Supply structured proofs of the following lemmas. -/

lemma I (a : Prop) :
  a → a :=
assume ha,
ha

lemma K (a b : Prop) :
  a → b → b :=
assume ha,
assume hb,
hb

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
assume habc,
assume b,
assume a,
habc a b

lemma proj_1st (a : Prop) :
  a → a → a :=
assume ha,
assume ha2,
ha

/- Please give a different answer than for `proj_1st`. -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
assume ha,
I (a)

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
assume habc,
assume ha,
assume hac,
assume hb,
hac ha

/- 1.2. Supply a structured proof of the contraposition rule. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
assume hab,
assume hnob,
assume ha,
hnob (hab (ha))

/- 1.3. Supply a structured proof of the distributivity of `∀` over `∧`. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
iff.intro
(
  assume h1,
  and.intro
  (
    assume x,
    and.elim_left (h1 x)
  )
  (
    assume x,
    and.elim_right (h1 x)
  )
)
(
  assume h1,
  assume x,
  and.intro
  (
    and.elim_left h1 x
  )
  (
    and.elim_right h1 x
  )
)

/- 1.4. Reuse, if possible, the lemma `forall_and` you proved above to prove
the following instance of the lemma. -/

lemma forall_and_inst {α : Type} (r s : α → α → Prop) :
  (∀x, r x x ∧ s x x) ↔ (∀x, r x x) ∧ (∀x, s x x) :=
forall_and (λ x:α, r x x)(λ x:α, s x x)

/- ## Question 2: Chain of Equalities
2.1. Write the following proof using `calc`.
      `(a + b) * (a + b)`
    `= a * (a + b) + b * (a + b)`
    `= a * a + a * b + b * a + b * b`
    `= a * a + a * b + a * b + b * b`
    `= a * a + 2 * a * b + b * b`
Hint: You might need the tactics `simp` and `cc` and the lemmas `mul_add`,
`add_mul`, and `two_mul`. -/

lemma binomial_square (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
sorry

/- 2.2. Prove the same argument again, this time as a structured proof. Try to
reuse as much of the above proof idea as possible. -/

lemma binomial_square₂ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
sorry

/- 2.3. Prove the same lemma again, this time using tactics. -/

lemma binomial_square₃ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
begin
  sorry
end

/- ## Question 3 (**optional**): One-Point Rules
3.1 (**optional**). Prove that the following wrong formulation of the one-point
rule for `∀` is inconsistent, using a structured proof. -/

axiom forall.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∀x : α, x = t ∧ p x) ↔ p t

lemma proof_of_false :
  false :=
begin
  have wrong : (∀x, x = 0 ∧ true) ↔ true :=
    @forall.one_point_wrong ℕ 0 (λ_, true),
  simp at wrong,
  have one_eq_zero : 1 = 0 :=
    wrong 1,
  cc
end

/- 3.2 (**optional**). Prove that the following wrong formulation of the
one-point rule for `∃` is inconsistent, using a tactical or structured proof. -/

axiom exists.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∃x : α, x = t → p x) ↔ p t

lemma proof_of_false₂ :
  false :=
begin
  have wrong : (∃x, x ≠ 0) ↔ false :=
    @exists.one_point_wrong ℕ 0 (λ_, false),
  simp at wrong,
  have one_eq_zero : 1 = 0 :=
    wrong 1,
  cc
end

end LoVe


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que, para todo a ∈ ℝ, la función constante
--    s(x) = a
-- converge a a.
-- ----------------------------------------------------------------------

import .Definicion_de_convergencia

lemma converges_to_const
  (a : ℝ)
  : converges_to (λ x : ℕ, a) a :=
begin
  intros ε εpos,
  use 0,
  intros n nge,
  dsimp,
  rw sub_self,
  rw abs_zero,
  exact εpos,
end

-- Prueba
-- ======

/-
a : ℝ
⊢ converges_to (λ (x : ℕ), a) a
  >> intros ε εpos,
a ε : ℝ,
εpos : ε > 0
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs ((λ (x : ℕ), a) n - a) < ε
  >> use 0,
⊢ ∀ (n : ℕ), n ≥ 0 → abs ((λ (x : ℕ), a) n - a) < ε
  >> intros n nge,
n : ℕ,
nge : n ≥ 0
⊢ abs ((λ (x : ℕ), a) n - a) < ε
  >> dsimp,
⊢ abs (a - a) < ε
  >> rw sub_self,
⊢ abs 0 < ε
  >> rw abs_zero,
⊢ abs 0 < ε
  >> exact εpos,
no goals
-/

-- Comentario: Se han usado los lemas
-- + sub_self a : a - a = 0
-- + abs_zero : abs 0 = 0

variables (a : ℝ)
-- #check @sub_self _ _ a
-- #check @abs_zero _ _


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard.
Thanks: Imperial College London, leanprover-community
-/

-- We will assume that the real numbers are a field.
import data.real.basic

/-!
# The complex numbers

We define the complex numbers, and prove that they are a ring.

We also "extract some basic API" (e.g. we prove that
two complex numbers are equal iff they have the same
real and imaginary parts)

This file has no `sorry`s in. All of the other levels:

`Level_01_of_real.lean`
`Level_02_I.lean`
`Level_03_conj.lean`
`Level_04_norm_sq.lean`
`Level_05_field.lean`
`Level_06_alg_closed.lean`

have sorrys, indicating puzzles to be solved.

# Main Definitions

`zero` : the complex number 0
`one` : the complex number 1
`add` -- addition of two complex numbers
`neg` -- negation of a complex number
`mul` -- multiplication of two complex numbers

# Main Theorem

`comm_ring` : The complex numbers are a commutative ring.

-/

/-- A complex number is defined to be a structure consisting of two real
  numbers, the real part and the imaginary part of the complex numberd. -/
structure complex : Type :=
(re : ℝ) (im : ℝ)

-- Let's use the usual notation for the complex numbers
notation `ℂ` := complex

-- You make the complex number with real part 3 and imaginary part 4 like this:
example : ℂ :=
{ re := 3,
  im := 4 }

-- Or like this:
example : ℂ := complex.mk 3 4

-- or like this:
example : ℂ := ⟨3, 4⟩

-- They all give the same complex number.

example : complex.mk 3 4 = ⟨3, 4⟩ := begin refl end  -- "true by definition"

-- All of our definitions, like `zero` and `one`, will all
-- live in the `complex` namespace.

namespace complex

-- If you have a complex number, then you can get its real and
-- imaginary parts with the `re` and `im` functions.

example : ℝ := re(mk 3 4) -- this term is (3 : ℝ)

example : re(mk 3 4) = 3 := begin refl end

-- Computer scientists prefer the style `z.re` to `re(z)` for some reason.

example : (mk 3 4).re = 3 := begin refl end

example (z : ℂ) : re(z) = z.re := begin refl end

-- Before we start making the basic
-- We now prove the basic theorems and make the basic definitions for
-- complex numbers. For example, we will define addition and multiplication on
-- the complex numbers, and prove that it is a commutative ring.
-- TODO fix

/-! # Defining the ring structure on ℂ -/

-- Our main goal is to prove that the complexes are a ring. Let's
-- define the structure first; the zero, one, addition and multiplication
-- on the complexes.

/-! ## zero (0) -/

/-- The complex number with real part 0 and imaginary part 0 -/
def zero : ℂ := ⟨0, 0⟩

-- Now we set up notation so that `0 : ℂ` will mean `zero`.

/-- notation `0` for `zero` -/
instance : has_zero ℂ := ⟨zero⟩

-- Let's prove the two basic properties, both of which are true by definition,
-- and then tag them with the appropriate attributes.
@[simp] lemma zero_re : re(0 : ℂ) = 0 := begin refl end
@[simp] lemma zero_im : im(0 : ℂ) = 0 := begin refl end

/-! ## one (1) -/

-- Now let's do the same thing for 1.

/-- The complex number with real part 1 and imaginary part 0 -/
def one : ℂ := ⟨1, 0⟩

/-- Notation `1` for `one` -/
instance : has_one ℂ := ⟨one⟩

-- name the basic properties and tag them with `simp`
@[simp] lemma one_re : re(1 : ℂ) = 1 := begin refl end
@[simp] lemma one_im : im(1 : ℂ) = 0 := begin refl end

/-! ## add (+) -/

-- Now let's define addition

/-- addition `z+w` of complex numbers -/
def add (z w : ℂ) : ℂ := ⟨z.re + w.re, z.im + w.im⟩

/-- Notation `+` for addition -/
instance : has_add ℂ := ⟨add⟩

-- basic properties
@[simp] lemma add_re (z w : ℂ) : re(z + w) = re(z) + re(w) := begin refl end
@[simp] lemma add_im (z w : ℂ) : im(z + w) = im(z) + im(w) := begin refl end

/-! ## neg (-) -/

-- negation

/-- The negation `-z` of a complex number `z` -/
def neg (z : ℂ) : ℂ := ⟨-re(z), -im(z)⟩

/-- Notation `-` for negation -/
instance : has_neg ℂ := ⟨neg⟩

-- how neg interacts with re and im
@[simp] lemma neg_re (z : ℂ) : re(-z) = -re(z) := begin refl end
@[simp] lemma neg_im (z : ℂ) : im(-z) = -im(z) := begin refl end

/-! ## mul (*) -/

-- multiplication

/-- Multiplication `z*w` of two complex numbers -/
def mul (z w : ℂ) : ℂ :=
  ⟨re(z) * re(w) - im(z) * im(w), re(z) * im(w) + im(z) * re(w)⟩

/-- Notation `*` for multiplication -/
instance : has_mul ℂ := ⟨mul⟩

-- how `mul` reacts with `re` and `im`
@[simp] lemma mul_re (z w : ℂ) : re(z * w) = re(z) * re(w) - im(z) * im(w) :=
begin
  refl
end

@[simp] lemma mul_im (z w : ℂ) : im(z * w) = re(z) * im(w) + im(z) * re(w) :=
rfl

/-! ## Example of what `simp` can now do

example (a b c : ℂ) :
  re(a*(b+c)) = re(a) * (re(b) + re(c)) - im(a) * (im(b) + im(c)) :=
begin
  simp,
end

-/

/-! # `ext` : A mathematical triviality -/

/-
Two complex numbers with the same and imaginary parts are equal. This is an
"extensionality lemma", i.e. a lemma of the form "if two things are made from
the same pieces, they are equal". This is not hard to prove, but we want to
give the result a name so we can tag it with the `ext` attribute, meaning that
the `ext` tactic will know it. To add to the confusion, let's call the
theorem `ext` :-)
-/

/-- If two complex numbers z and w have equal real and imaginary parts,
    they are equal -/
@[ext] theorem ext {z w : ℂ}
  (hre : re(z) = re(w)) (him : im(z) = im(w)) : z = w :=
begin
  cases z with zr zi,
  cases w with ww wi,
  simp * at *,
end

/-! # Theorem:  The complex numbers are a commutative ring

Proof: we've defined all the structure, and every axiom can be checked by
reducing it to checking real and imaginary parts with `ext`, expanding
everything out with `simp`, and then using the fact that the real numbers are
a commutative ring (which we already know)

-/

/-- The complex numbers are a commutative ring -/
instance : comm_ring ℂ :=
begin
  -- first the data
  refine_struct {
      zero := (0 : ℂ), add := (+), neg := has_neg.neg, one := 1, mul := (*),
  ..};
  -- now the axioms
  -- of which there seem to be 11
  -- Note the semicolons, which mean "apply next tactic to all goals".

  -- First introduce the variables
  intros;
  -- we now have to prove an equality between two complex numbers.
  -- It suffices to check on real and imaginary parts
  ext;
  -- the simplifier can simplify stuff like re(a+0)
  simp;
  -- all the goals now are identities between *real* numbers,
  -- and the reals are already known to be a ring
  ring,
end

/-

That is the end of the proof that the complexes form a ring. We built
a basic API which was honed towards the general idea that to prove
certain statements about the complex numbers, for example distributivity,
we could just check on real and imaginary parts. We trained the
simplifier to expand out things like re(z*w) in terms
of re(z), im(z), re(w), im(w).

-/

/-!

# Optional (for mathematicians) : more basic infrastructure, and term mode

-/

/-!
## `ext` revisited

Recall extensionality:

theorem ext {z w : ℂ}
  (hre : re(z) = re(w)) (him : im(z) = im(w)) : z = w := ...

Here is another tactic mode proof of extensionality. Note that we have moved
the hypotheses to the other side of the colon; this does not
change the theorem. This proof shows the power
of the `rintros` tactic.
-/

theorem ext' : ∀ z w : ℂ, z.re = w.re → z.im = w.im → z = w :=
begin
  rintros ⟨zr, zi⟩ ⟨_, _⟩ ⟨rfl⟩ ⟨rfl⟩,
  refl,
end

/-!

Explanation: `rintros` does `cases` as many times as you like using this cool
`⟨ ⟩` syntax for the case splits. Note that if you say that a proof of `a = b`
is `rfl` then Lean will define a to be b, or b to be a, and not even introduce
new notation for it.

-/

-- Here is the same proof in term mode.

theorem ext'' : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

/-!
## `eta`
-/

/-
We prove the mathematically obvious statement that the
complex number whose real part is re(z) and whose imaginary
part is im(z) is of course equal to z.
-/

/-- ⟨z.re, z.im⟩ is equal to z -/
@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z :=
begin
  intro z,
  cases z with x y,
  /-
    goal now looks complicated, and contains terms which look
    like {re := a, im := b}.re which obviously simplify to a.
    The `dsimp` tactic will do some tidying up for us, although
    it is not logically necessary. `dsimp` does definitional simplification.
  -/
  dsimp,
  -- Now we see the goal can be solved by reflexivity
  refl,
end

/-
The proof was "unfold everything, and it's true by definition".
This proof does not teach a mathematician anything, so we may as well write
it in term mode. Many tactics have term mode equivalent.
The equation compiler does the `intro` and `cases` steps,
and `dsimp` was unnecessary -- the two sides of the equation
were definitionally equal.
-/

theorem eta' : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨x, y⟩ := rfl

/-!
## ext_iff
-/

/-
Note that `ext` is an implication -- if re(z)=re(w) and im(z)=im(w) then z=w.
The below variant `ext_iff` is the two-way implication: two complex
numbers are equal if and only if they have the same real and imaginary part.
Let's first see a tactic mode proof. See how the `ext` tactic is used?
After it is applied, we have two goals, both of which are hypotheses.
The semicolon means "apply the next tactic to all the goals
produced by this one"
-/

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
begin
  split,
  { intro H,
    simp [H]},
  {
    rintro ⟨hre, him⟩,
    ext; assumption,
  }
end

-- Again this is easy to write in term mode, and no mathematician
-- wants to read the proof anyway.

theorem ext_iff' {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

end complex

/-!

# some last comments on the `simp` tactic

Some equalities, even if obvious, had to be given names, because we want `simp`
to be able to use them. In short, the `simp` tactic tries to solve
goals of the form A = B, when `refl` doesn't work (i.e. the goals are
not definitionally equal) but when any mathematician would be able
to simplify A and B via "obvious" steps such as `0 + x = x` or
`⟨z.re, z.im⟩ = z`. These things are sometimes not true by definition,
but they should be tagged as being well-known ways to simplify an equality.
When building our API for the complex numbers, if we prove a theorem of the
form `A = B` where `B` is a bit simpler than `A`, we should probably
tag it with the `@[simp]` attribute, so `simp` can use it.

Note: `simp` does *not* prove "all simple things". It proves *equalities*.
It proves `A = B` when, and only when, it can do it by applying
its "simplification rules", where a simplification rule is simply a proof
of a theorem of the form `A = B` and `B` is simpler than `A`.
-/


import tactic tactic.explode

open classical

/- Fill in the `sorry`s below -/

local attribute [instance, priority 0] prop_decidable

example (p : Prop) : p ∨ ¬ p :=
begin
  by_cases p,
  { left, assumption },
  { right, assumption }
end

example (p : Prop) : p ∨ ¬ p :=
begin
  by_cases h' : p,
  { left, exact h' },
  { right, exact h' }
end

example (p : Prop) : p ∨ ¬ p :=
begin
  by_cases h' : p,
  { exact or.inl h' },
  { exact or.inr h' }
end

/-
Give a calculational proof of the theorem log_mul below. You can use the
rewrite tactic `rw` (and `calc` if you want), but not `simp`.

These objects are actually defined in mathlib, but for now, we'll
just declare them.
-/

constant real : Type
@[instance] constant  orreal : ordered_ring real
constants (log exp : real → real)
constant  log_exp_eq : ∀ x, log (exp x) = x
constant  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
constant  exp_pos    : ∀ x, exp x > 0
constant  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

attribute [ematch] log_exp_eq exp_log_eq exp_pos exp_add

example (x y z : real) :
  exp (x + y + z) = exp x * exp y * exp z :=
by rw[exp_add, exp_add]

example (y : real) (h : y > 0)  : exp (log y) = y :=
exp_log_eq ‹_›

theorem log_mul' {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y :=
begin
  rw[<-exp_log_eq hx, <-exp_log_eq hy, <-exp_add],
  simp only [log_exp_eq]
end

section

variables {p q r : Prop}

example : (p → q) → (¬q → ¬p) :=
by finish

example : (p → (q → r)) → (p ∧ q → r) :=
by finish

example : p ∧ ¬q → ¬(p → q) :=
by finish

example : (¬p ∨ q) → (p → q) :=
by intros; cc

example : (p ∨ q → r) → (p → r) ∧ (q → r) :=
by intros; finish

example : (p → q) → (¬p ∨ q) :=
by intros; finish

end

section

variables {α β : Type} (p q : α → Prop) (r : α → β → Prop)

example : (∀ x, p x) ∧ (∀ x, q x) → ∀ x, p x ∧ q x :=
begin
  intros a x, cases a, fsplit, work_on_goal 0 { solve_by_elim }, solve_by_elim
end

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
begin
  intro H, cases H, tidy, left, finish, right, finish
end

example : (∃ x, ∀ y, r x y) → ∀ y, ∃ x, r x y :=
begin
  intro H, cases H,
  /- `tidy` says -/ intros y, fsplit, work_on_goal 1 { solve_by_elim }
end

theorem e1 : (¬ ∃ x, p x) → ∀ x, ¬ p x :=
begin
  intro H, push_neg at H, exact H
end

example : (¬ ∀ x, ¬ p x) → ∃ x, p x :=
begin
  intro H, push_neg at H, from ‹_›
end

example : (¬ ∀ x, ¬ p x) → ∃ x, p x :=
begin
  intro H, push_neg at H, from ‹_›
end

end

section

/-
There is a man in the town who is the barber. The barber shaves all men who do not shave themselves.

Does the barber shave himself?
-/

variables (man : Type) (barber : man)
variable  (shaves : man → man → Prop)

example (H : ∀ x : man, shaves barber x ↔ ¬ shaves x x) : false :=
by {[smt] eblast_using[H barber]}

end

section

variables {α : Type} (p : α → Prop) (r : Prop) (a : α)

include a
example : (r → ∃ x, p x) → ∃ x, (r → p x) :=
begin
  by_cases r,
    {intro H, specialize H ‹_›, cases H with x Hx,
    use x, intro, from ‹_›},

    {intro H, use a}
end

end

/-
Prove the theorem below, using only the ring properties of ℤ enumerated
in Section 4.2 and the theorem sub_self. You should probably work out
a pen-and-paper proof first.
-/

example (x : ℤ) : x * 0 = 0 :=
by simp

section
open list

variable {α : Type*}
variables s t : list α
variable a : α

example : length (s ++ t) = length s + length t :=
by simp

end

/-
Define an inductive data type consisting of terms built up from the
following constructors:

  `const n`, a constant denoting the natural number n
  `var n`, a variable, numbered n
  `plus s t`, denoting the sum of s and t
  `times s t`, denoting the product of s and t
-/

inductive nat_term
| const : ℕ → nat_term
| var : ℕ → nat_term
| plus : nat_term → nat_term → nat_term
| times : nat_term → nat_term → nat_term

open nat_term

/-
Recursively define a function that evaluates any such term with respect to
an assignment `val : ℕ → ℕ` of values to the variables.

For example, if `val 4 = 3
-/

def eval (val : ℕ → ℕ) : nat_term → ℕ
| (const k) := k
| (var k) := val k
| (plus s t) := (eval s) + (eval t)
| (times s t) := (eval s) * (eval t)

/-
Test it out by using #eval on some terms. You can use the following `val` function. In that case, for example, we would expect to have

  eval val (plus (const 2) (var 1)) = 5
-/

def val : ℕ → ℕ
| 0 := 4
| 1 := 3
| 2 := 8
| _ := 0

example : eval val (plus (const 2) (var 1)) = 5 := rfl

#eval eval val (plus (const 2) (var 1))

/-
Below, we define a function `rev` that reverses a list. It uses an auxiliary function
`append1`.

If you can, prove that the length of the list is preserved, and that
`rev (rev l) = l` for every `l`. The theorem below is given as an example, and should
be helpful.

Note that when you use the equation compiler to define a function foo, `rw [foo]` uses
one of the defining equations if it can. For example, `rw [append1, ...]` in the theorem
uses the second equation in the definition of `append1`
-/

section

open list
variable {α : Type*}

def append1 (a : α) : list α → list α
| nil      := [a]
| (b :: l) := b :: (append1 l)

def rev : list α → list α
| nil := nil
| (a :: l) := append1 a (rev l)

theorem length_append1 (a : α) (l : list α): length (append1 a l) = length l + 1 :=
begin
  induction l,
    { simp[append1] },
    { unfold append1 at l_ih ⊢, finish }
end

theorem length_rev (l : list α) : length (rev l) = length l :=
begin
  induction l,
    { unfold rev },
    { unfold rev, finish[length_append1] }
end

lemma hd_rev (a : α) (l : list α) :
  a :: rev l =  rev (append1 a l) :=
begin
  induction l,
    { simp[rev, append1] },
    { rw[rev, append1, rev, <-l_ih, append1] }
end

theorem rev_rev (l : list α) : rev (rev l) = l :=
begin
  induction l,
    { refl },
    { conv {to_rhs, rw[<-l_ih], rw[hd_rev]}, refl }
end

end


/- LoVe Homework 2: Tactical Proofs -/

import .love02_tactical_proofs_exercise

namespace LoVe

/- Question 2 (**optional**): Logical Connectives -/

/- 2.1 (**optional**). Prove the following property about double negation.

Hint: You will need to apply the elimination rule for `false` at a key point in
the proof. -/

lemma herman (p : Prop) : ¬¬ (¬¬ p → p) :=
begin
  intro hnnnpp,
  apply hnnnpp,
  intro hnnp,
  apply false.elim,
  apply hnnp,
  intro hp,
  apply hnnnpp,
  intro hnnp,
  exact hp
end

/- 2.2 (**optional**). Prove the missing link in our chain of classical axiom
implications.

Hint: You will need to apply the double negation hypothesis for `p ∨ ¬ p`. You
will also need the left and right introduction rules for `or` at some point. -/

#check excluded_middle
#check peirce
#check double_negation

lemma em_of_dn : double_negation → excluded_middle :=
begin
  simp [double_negation, excluded_middle],
  intros hdoubleneg p,
  apply hdoubleneg,
  intro hnponp,
  apply hnponp,
  apply or.intro_right,
  intro hnp,
  apply hnponp,
  apply or.intro_left,
  assumption
end

/- 2.3 (**optional**). We have proved three of the six possible implications
between `excluded_middle`, `peirce`, and `double_negation`. State and prove the
three missing implications, exploiting the three theorems we already have. -/

#check peirce_of_em
#check dn_of_peirce
#check em_of_dn

lemma dn_imp_peirce : double_negation → peirce :=
begin
  intro h,
  apply peirce_of_em,
  apply em_of_dn,
  exact h
end

lemma peirce_imp_em : peirce → excluded_middle :=
begin
  intro h,
  apply em_of_dn,
  apply dn_of_peirce,
  exact h
end

lemma em_imp_dn : excluded_middle → double_negation :=
begin
  intro h,
  apply dn_of_peirce,
  apply peirce_of_em,
  exact h
end

end LoVe


import ring_theory.localization.basic

open is_localization

variables {A : Type*} (B : Type*) [comm_ring A] [comm_ring B] [algebra A B]
variables {S : submonoid A} [is_localization S B]
-- L'hypothèse `is_localization S B` signifie que `B=S⁻¹ A`.
/-- The typeclass `is_localization (S : submodule A) B` where `B` is an `A`-algebra
expresses that `B` is isomorphic to the localization of `A` at `S`. -/

lemma prod_units (u v : A) : is_unit u → is_unit v → is_unit (u * v) :=
begin
  intros hu hv,
  simp only [is_unit.mul_iff],
  split,
  exact hu,
  exact hv,
end

variable (f : A →+* A)
#check (f : A →+ A)
#check (f: A → A)

lemma inv_unit (u v : Aˣ) : is_unit (u⁻¹) :=
begin
  use u⁻¹,
  use u,
  exact mul_left_inv u, --mais `simp` aurait marché! Et si vous écrivez `squeeze_simp` il vous dit
  --comment il a fait! Pensez bien que si on doit suffrir pour montrer que dans un groupe le produit
  -- d'un élément avec son inverse fait l'identité, on peut se tirer une balle! C'est fort probablement
  -- quelque chose que `simp` doit savoir résoudre!

  exact mul_right_inv u,
  simp only [units.coe_mk],
end

example (a : S) : is_unit (algebra_map A B a) :=
begin
  apply map_units,
end

lemma becomes_unit (a : A) : a ∈ S → is_unit (algebra_map A B a) :=
begin
  intro ha,
 -- J'imagine qu'on est d'accord qu'il faut "en gros" faire la même chose que dans l'`exemple l.36`:
 -- Le problème est que si on fait
--  `apply map_units`, --on reçoit l'erreur
--  `invalid apply tactic, failed to unify`
--   `is_unit (⇑(algebra_map A B) a)`
--  	 `with`
--   `is_unit (⇑(algebra_map ?m_3 ?m_1) ↑?m_7)`
-- Essayons de le comprendre: on voudrait `?m_3=A`, puis `?m_1=B` et `↑?m_7=a`. Pour voir ce qui
-- se passe, il est parfois commode d'utiliser un `have :=`, qui ne mène nulle part mais nous fait
-- voir ce que Lean attend: par exemple,
-- have premier := map_units,
-- fait apparaître un terme `premier` qui demande clairement en variables un Type `S` qui doit être un
-- `comm_semiring`, puis un terme `?m_1` qui n'apparaît pas mais dont on comprend que `S` doit
-- être une algèbre sur `?m_1` (regardez `_inst_3`), et après un terme `self` qui doit être une
-- preuve que `S` est un localisé à `?m_3`. Ces variables bizarres sont nommées ainsi automatiquement
-- par Lean, parce que si on lui fournit un terme de type `is_localization ?m_3 S` il comprendra qui
-- est `?m_3`. Chez nous, `B` est un localisé de `A` à `S`, donc à la fin on voudra
-- * ?m_1=A
-- * ?m_3=S
-- * S = B
-- On peut alors améliorer `premier` en
-- have deuxieme := map_units B,
-- et on aurait même envie de prendre `y = a` maintenant... *MAIS* on voit bien que `y` doit être un
-- terme de type `↥?m_3 = ↥S` et non pas de type `S`... il y a une flèchette vers le haut. En effet
-- `have := deuxieme a,`
-- (que je vous conseille de tester) donne un erreur. D'ailleurs, vous voyez que si vous
-- clickez sur `↥?m_3` vous voyez que ça doit être un `Type` alors que `?m_3` est un `submonoid`...
-- Le point est que `a` est un terme de type `A` et `deuxieme` veut un terme de type `S`: on peut le
-- créer!
let b : S := ⟨a, ha⟩,
-- Grâce à `ha`, qui nous dit que `a` *appartient* à `S`, on a crée un terme de type `↥S`, où la
-- flêche indique qu'on regarde maintenant `S` comme un type à part entière. On peut donc conclure
-- avec
  exact map_units B b,
  -- (si vous voyez plein de goals, encore, c'est parce que j'ai introduit plein de choses à vérifier
  -- dans `premier` et `deuxième`: si vous les commentez, vous voyez le `goals_accomplished`.
  -- D'ailleurs, on a pas besoin de déclarer `b`: on pourrait simplement faire
  -- exact map_units B ⟨a, ha⟩),
end

lemma from_S (a : A) (v : B) (h : algebra_map A B a = v) : ∃ s : S, mk' B a s = v :=
begin
 use (1:S),
 rw mk'_eq_iff_eq_mul,
 rw ← h,
 simp only [submonoid.coe_one, map_one, mul_one],
end

lemma unit_from_S (a : A) (v : Bˣ) : a ∈ S → is_unit ((algebra_map A B a) * v):=
begin
  intro ha,
  let b : S := ⟨a, ha⟩,
  apply prod_units,
  apply map_units B b,
  simp only [units.is_unit],
end

/- J'admets avoir résolu les deux derniers exercices plutôt en déduisant de ce que je pouvais comprendre des
lemmes de algebra_map et is_localization, qu'en les comprenant réellement -/

include B
variables {C : Type*} [comm_ring C]
/-
Ce qu' on est en train de dire dans la définition suivante est que si vous avez un morphisme
d'anneaux `f : A → C` qui envoie tout élément de `S` sur une unité de `C`, alors vous pouvez étendre
`f` à un morphisme `F : B=S⁻¹A → C`. Moralement, comme les éléments de `B` sont de la forme `a/s`
avec `a ∈ A` et `s ∈ S` vous pouvez définir l'extension `F` par la formule `F(a/s) = f(a)/f(s)` ce
qui a un sens d'après l'hypothèse que `f(s)` est une unité.
-/

def extended {f : A →+* C} (hf : ∀ s : S, is_unit (f s)) : (B →+* C) :=
{ to_fun := λ b, f((sec S b).1) * ((hf (sec S b).2).unit)⁻¹.1,
  map_one' := _,
  map_mul' := _,
  map_zero' := _,
  map_add' := _ }

--***Question:***: Savez-vous quelle est la différence entre les parenthèses `(` et `{`?
/- les () sont des éléments nécessaires à rentre pour que lean comprenne de quoi on parle, les {} peuvent être déduit
des autres hypothèses -/
lemma injective {f : A →+* C} (hf : ∀ s : S, is_unit (f s)) (h_inj: function.injective f) :
  function.injective (extended B hf) := sorry


-- Contributors : Adarsh, Anurag, Nikhesh, Sainiranjan.

import Mathlib
import PnP2023.Lec_02_03.InductiveTypes

/-!
Vectors, i.e., lists of a fixed length, can be defined in (at least) two ways. One way is as an indexed inductive type `Vec`, as we saw in lecture and is in the file `InductiveTypes.lean`.

A different definition is as a subtype `Vector` of lists consisting of those of a fixed length. This is the definition used in `mathlib` and is recalled below.

```lean
/-- `Vector α n` is the type of lists of length `n` with elements of type `α`. -/
def Vector (α : Type u) (n : ℕ) :=
  { l : List α // l.length = n }
```

In this lab, you will relate the two definitions by constructing functions that convert between the two definitions and prove that these functions are inverses of each other.
-/
universe u

/-- Convert a `Vector` to a `Vec` -/
def Vec.ofVector {α : Type u}: (n : ℕ) →  Vector α n → Vec α n
| 0, _ => Vec.nil
| k + 1, ⟨ head :: tail, h ⟩ => by
  have h1 : tail.length = k := by
    simp [List.length_cons] at h
    assumption
  apply Vec.cons head (Vec.ofVector k ⟨ tail, h1⟩ )

/-- Convert a `Vec` to a `Vector` -/
def Vec.toVector {α : Type u}: (n : ℕ) →  Vec α n → Vector α n
| 0, _ => ⟨ [], rfl ⟩
| k + 1, Vec.cons head tail => ⟨ head :: (Vec.toVector k tail).val, by
    simp [List.length]; apply (Vec.toVector k tail).property⟩

/-- Mapping a `Vec` to a `Vector` and back gives the original `Vec` -/
theorem Vec.ofVector.toVector {α : Type u} (n : ℕ) (v : Vec α n) :
  Vec.ofVector n (Vec.toVector n v) = v :=
  match n with
  | 0 => by
    rw [Vec.ofVector]
    match v with
    | Vec.nil => rfl

  | k + 1 => by
    match v with
    | Vec.cons head tail =>
      simp [Vec.ofVector]
      apply Vec.ofVector.toVector k tail

/-- Mapping a `Vector` to a `Vec` and back gives the original `Vector` -/
theorem Vec.toVector.ofVector {α : Type u} (n : ℕ) (v : Vector α n) :
  Vec.toVector n (Vec.ofVector n v) = v :=
  match n with
  | 0 => by
    rw [Vec.toVector]
    match v with
    | Vector.nil => rfl

  | k + 1 => by
    match v with
    | ⟨ head :: tail, h⟩ =>
      simp[toVector]
      simp[ofVector]


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland

! This file was ported from Lean 3 source module algebra.ring.defs
! leanprover-community/mathlib commit 76de8ae01554c3b37d66544866659ff174e66e1f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Basic
import Mathlib.Algebra.GroupWithZero.Defs
import Mathlib.Data.Int.Cast.Defs
import Mathlib.Logic.Nontrivial
import Mathlib.Tactic.Spread

/-!
# Semirings and rings

This file defines semirings, rings and domains. This is analogous to `Algebra.Group.Defs` and
`Algebra.Group.Basic`, the difference being that the former is about `+` and `*` separately, while
the present file is about their interaction.

## Main definitions

* `Distrib`: Typeclass for distributivity of multiplication over addition.
* `HasDistribNeg`: Typeclass for commutativity of negation and multiplication. This is useful when
  dealing with multiplicative submonoids which are closed under negation without being closed under
  addition, for example `units`.
* `(NonUnital_)(NonAssoc_)(Semi)ring`: Typeclasses for possibly non-unital or non-associative
  rings and semirings. Some combinations are not defined yet because they haven't found use.

## Tags

`Semiring`, `CommSemiring`, `Ring`, `CommRing`, domain, `IsDomain`, nonzero, units
-/

universe u v w x

variable {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

open Function

/-!
### `distrib` class
-/

/-- A typeclass stating that multiplication is left and right distributive
over addition. -/
class Distrib (R : Type _) extends Mul R, Add R where
  /-- Multiplication is left distributive over addition -/
  protected left_distrib : ∀ a b c : R, a * (b + c) = a * b + a * c
  /-- Multiplication is right distributive over addition -/
  protected right_distrib : ∀ a b c : R, (a + b) * c = a * c + b * c
#align distrib Distrib

/-- A typeclass stating that multiplication is left distributive over addition. -/
class LeftDistribClass (R : Type _) [Mul R] [Add R] where
  /-- Multiplication is left distributive over addition -/
  protected left_distrib : ∀ a b c : R, a * (b + c) = a * b + a * c
#align left_distrib_class LeftDistribClass

/-- A typeclass stating that multiplication is right distributive over addition. -/
class RightDistribClass (R : Type _) [Mul R] [Add R] where
  /-- Multiplication is right distributive over addition -/
  protected right_distrib : ∀ a b c : R, (a + b) * c = a * c + b * c
#align right_distrib_class RightDistribClass

-- see Note [lower instance priority]
instance (priority := 100) Distrib.leftDistribClass (R : Type _) [Distrib R] : LeftDistribClass R :=
  ⟨Distrib.left_distrib⟩
#align distrib.left_distrib_class Distrib.leftDistribClass

-- see Note [lower instance priority]
instance (priority := 100) Distrib.rightDistribClass (R : Type _) [Distrib R] :
    RightDistribClass R :=
  ⟨Distrib.right_distrib⟩
#align distrib.right_distrib_class Distrib.rightDistribClass

theorem left_distrib [Mul R] [Add R] [LeftDistribClass R] (a b c : R) :
    a * (b + c) = a * b + a * c :=
  LeftDistribClass.left_distrib a b c
#align left_distrib left_distrib

alias left_distrib ← mul_add
#align mul_add mul_add

theorem right_distrib [Mul R] [Add R] [RightDistribClass R] (a b c : R) :
    (a + b) * c = a * c + b * c :=
  RightDistribClass.right_distrib a b c
#align right_distrib right_distrib

alias right_distrib ← add_mul
#align add_mul add_mul

theorem distrib_three_right [Mul R] [Add R] [RightDistribClass R] (a b c d : R) :
    (a + b + c) * d = a * d + b * d + c * d := by simp [right_distrib]
#align distrib_three_right distrib_three_right

/-!
### Semirings
-/

/-- A not-necessarily-unital, not-necessarily-associative semiring. -/
class NonUnitalNonAssocSemiring (α : Type u) extends AddCommMonoid α, Distrib α, MulZeroClass α
#align non_unital_non_assoc_semiring NonUnitalNonAssocSemiring

/-- An associative but not-necessarily unital semiring. -/
class NonUnitalSemiring (α : Type u) extends NonUnitalNonAssocSemiring α, SemigroupWithZero α
#align non_unital_semiring NonUnitalSemiring

/-- A unital but not-necessarily-associative semiring. -/
class NonAssocSemiring (α : Type u) extends NonUnitalNonAssocSemiring α, MulZeroOneClass α,
    AddCommMonoidWithOne α
#align non_assoc_semiring NonAssocSemiring

class Semiring (α : Type u) extends NonUnitalSemiring α, NonAssocSemiring α, MonoidWithZero α
#align semiring Semiring

section DistribMulOneClass

variable [Add α] [MulOneClass α]

theorem add_one_mul [RightDistribClass α] (a b : α) : (a + 1) * b = a * b + b := by
  rw [add_mul, one_mul]
#align add_one_mul add_one_mul

theorem mul_add_one [LeftDistribClass α] (a b : α) : a * (b + 1) = a * b + a := by
  rw [mul_add, mul_one]
#align mul_add_one mul_add_one

theorem one_add_mul [RightDistribClass α] (a b : α) : (1 + a) * b = b + a * b := by
  rw [add_mul, one_mul]
#align one_add_mul one_add_mul

theorem mul_one_add [LeftDistribClass α] (a b : α) : a * (1 + b) = a + a * b := by
  rw [mul_add, mul_one]
#align mul_one_add mul_one_add

end DistribMulOneClass

section NonAssocSemiring

variable [NonAssocSemiring α]

-- Porting note: was [has_add α] [mul_one_class α] [right_distrib_class α]
theorem two_mul (n : α) : 2 * n = n + n :=
  (congrArg₂ _ one_add_one_eq_two.symm rfl).trans <| (right_distrib 1 1 n).trans (by rw [one_mul])
#align two_mul two_mul

-- Porting note: was [has_add α] [mul_one_class α] [right_distrib_class α]
set_option linter.deprecated false in
theorem bit0_eq_two_mul (n : α) : bit0 n = 2 * n :=
  (two_mul _).symm
#align bit0_eq_two_mul bit0_eq_two_mul

-- Porting note: was [has_add α] [mul_one_class α] [left_distrib_class α]
theorem mul_two (n : α) : n * 2 = n + n :=
  (congrArg₂ _ rfl one_add_one_eq_two.symm).trans <| (left_distrib n 1 1).trans (by rw [mul_one])
#align mul_two mul_two

end NonAssocSemiring

@[to_additive]
theorem mul_ite {α} [Mul α] (P : Prop) [Decidable P] (a b c : α) :
    (a * if P then b else c) = if P then a * b else a * c := by split_ifs <;> rfl
#align mul_ite mul_ite
#align add_ite add_ite

@[to_additive]
theorem ite_mul {α} [Mul α] (P : Prop) [Decidable P] (a b c : α) :
    (if P then a else b) * c = if P then a * c else b * c := by split_ifs <;> rfl
#align ite_mul ite_mul
#align ite_add ite_add

-- We make `mul_ite` and `ite_mul` simp lemmas,
-- but not `add_ite` or `ite_add`.
-- The problem we're trying to avoid is dealing with
-- summations of the form `∑ x in s, (f x + ite P 1 0)`,
-- in which `add_ite` followed by `sum_ite` would needlessly slice up
-- the `f x` terms according to whether `P` holds at `x`.
-- There doesn't appear to be a corresponding difficulty so far with
-- `mul_ite` and `ite_mul`.
attribute [simp] mul_ite ite_mul

-- Porting note: no @[simp] because simp proves it
theorem mul_boole {α} [MulZeroOneClass α] (P : Prop) [Decidable P] (a : α) :
    (a * if P then 1 else 0) = if P then a else 0 := by simp
#align mul_boole mul_boole

-- Porting note: no @[simp] because simp proves it
theorem boole_mul {α} [MulZeroOneClass α] (P : Prop) [Decidable P] (a : α) :
    (if P then 1 else 0) * a = if P then a else 0 := by simp
#align boole_mul boole_mul

theorem ite_mul_zero_left {α : Type _} [MulZeroClass α] (P : Prop) [Decidable P] (a b : α) :
    ite P (a * b) 0 = ite P a 0 * b := by by_cases h : P <;> simp [h]
#align ite_mul_zero_left ite_mul_zero_left

theorem ite_mul_zero_right {α : Type _} [MulZeroClass α] (P : Prop) [Decidable P] (a b : α) :
    ite P (a * b) 0 = a * ite P b 0 := by by_cases h : P <;> simp [h]
#align ite_mul_zero_right ite_mul_zero_right

theorem ite_and_mul_zero {α : Type _} [MulZeroClass α] (P Q : Prop) [Decidable P] [Decidable Q]
    (a b : α) : ite (P ∧ Q) (a * b) 0 = ite P a 0 * ite Q b 0 := by
  simp only [← ite_and, ite_mul, mul_ite, mul_zero, zero_mul, and_comm]
#align ite_and_mul_zero ite_and_mul_zero

/-- A non-unital commutative semiring is a `NonUnitalSemiring` with commutative multiplication.
In other words, it is a type with the following structures: additive commutative monoid
(`AddCommMonoid`), commutative semigroup (`CommSemigroup`), distributive laws (`Distrib`), and
multiplication by zero law (`MulZeroClass`). -/
class NonUnitalCommSemiring (α : Type u) extends NonUnitalSemiring α, CommSemigroup α
#align non_unital_comm_semiring NonUnitalCommSemiring

class CommSemiring (R : Type u) extends Semiring R, CommMonoid R
#align comm_semiring CommSemiring

-- see Note [lower instance priority]
instance (priority := 100) CommSemiring.toNonUnitalCommSemiring [CommSemiring α] :
    NonUnitalCommSemiring α :=
  { inferInstanceAs (CommMonoid α), inferInstanceAs (CommSemiring α) with }
#align comm_semiring.to_non_unital_comm_semiring CommSemiring.toNonUnitalCommSemiring

-- see Note [lower instance priority]
instance (priority := 100) CommSemiring.toCommMonoidWithZero [CommSemiring α] :
    CommMonoidWithZero α :=
  { inferInstanceAs (CommMonoid α), inferInstanceAs (CommSemiring α) with }
#align comm_semiring.to_comm_monoid_with_zero CommSemiring.toCommMonoidWithZero

section CommSemiring

variable [CommSemiring α] {a b c : α}

theorem add_mul_self_eq (a b : α) : (a + b) * (a + b) = a * a + 2 * a * b + b * b := by
  simp only [two_mul, add_mul, mul_add, add_assoc, mul_comm b]
#align add_mul_self_eq add_mul_self_eq

end CommSemiring

section HasDistribNeg

/-- Typeclass for a negation operator that distributes across multiplication.

This is useful for dealing with submonoids of a ring that contain `-1` without having to duplicate
lemmas. -/
class HasDistribNeg (α : Type _) [Mul α] extends InvolutiveNeg α where
  /-- Negation is left distributive over multiplication -/
  neg_mul : ∀ x y : α, -x * y = -(x * y)
  /-- Negation is right distributive over multiplication -/
  mul_neg : ∀ x y : α, x * -y = -(x * y)
#align has_distrib_neg HasDistribNeg

section Mul

variable [Mul α] [HasDistribNeg α]

@[simp]
theorem neg_mul (a b : α) : -a * b = -(a * b) :=
  HasDistribNeg.neg_mul _ _
#align neg_mul neg_mul

@[simp]
theorem mul_neg (a b : α) : a * -b = -(a * b) :=
  HasDistribNeg.mul_neg _ _
#align mul_neg mul_neg

theorem neg_mul_neg (a b : α) : -a * -b = a * b := by simp
#align neg_mul_neg neg_mul_neg

theorem neg_mul_eq_neg_mul (a b : α) : -(a * b) = -a * b :=
  (neg_mul _ _).symm
#align neg_mul_eq_neg_mul neg_mul_eq_neg_mul

theorem neg_mul_eq_mul_neg (a b : α) : -(a * b) = a * -b :=
  (mul_neg _ _).symm
#align neg_mul_eq_mul_neg neg_mul_eq_mul_neg

theorem neg_mul_comm (a b : α) : -a * b = a * -b := by simp
#align neg_mul_comm neg_mul_comm

end Mul

section MulOneClass

variable [MulOneClass α] [HasDistribNeg α]

theorem neg_eq_neg_one_mul (a : α) : -a = -1 * a := by simp
#align neg_eq_neg_one_mul neg_eq_neg_one_mul

/-- An element of a ring multiplied by the additive inverse of one is the element's additive
  inverse. -/
theorem mul_neg_one (a : α) : a * -1 = -a := by simp
#align mul_neg_one mul_neg_one

/-- The additive inverse of one multiplied by an element of a ring is the element's additive
  inverse. -/
theorem neg_one_mul (a : α) : -1 * a = -a := by simp
#align neg_one_mul neg_one_mul

end MulOneClass

section MulZeroClass

variable [MulZeroClass α] [HasDistribNeg α]

instance (priority := 100) MulZeroClass.negZeroClass : NegZeroClass α where
  __ := inferInstanceAs (Zero α); __ := inferInstanceAs (InvolutiveNeg α)
  neg_zero := by rw [← zero_mul (0 : α), ← neg_mul, mul_zero, mul_zero]
#align mul_zero_class.neg_zero_class MulZeroClass.negZeroClass

end MulZeroClass

end HasDistribNeg

/-!
### Rings
-/

/-- A not-necessarily-unital, not-necessarily-associative ring. -/
class NonUnitalNonAssocRing (α : Type u) extends AddCommGroup α, NonUnitalNonAssocSemiring α
#align non_unital_non_assoc_ring NonUnitalNonAssocRing

-- We defer the instance `NonUnitalNonAssocRing.toHasDistribNeg` to `Algebra.Ring.Basic`
-- as it relies on the lemma `eq_neg_of_add_eq_zero_left`.
/-- An associative but not-necessarily unital ring. -/
class NonUnitalRing (α : Type _) extends NonUnitalNonAssocRing α, NonUnitalSemiring α
#align non_unital_ring NonUnitalRing

/-- A unital but not-necessarily-associative ring. -/
class NonAssocRing (α : Type _) extends NonUnitalNonAssocRing α, NonAssocSemiring α,
    AddCommGroupWithOne α
#align non_assoc_ring NonAssocRing

class Ring (R : Type u) extends Semiring R, AddCommGroup R, AddGroupWithOne R
#align ring Ring

section NonUnitalNonAssocRing

variable [NonUnitalNonAssocRing α]

instance (priority := 100) NonUnitalNonAssocRing.toHasDistribNeg : HasDistribNeg α where
  neg := Neg.neg
  neg_neg := neg_neg
  neg_mul a b := eq_neg_of_add_eq_zero_left <| by rw [← right_distrib, add_left_neg, zero_mul]
  mul_neg a b := eq_neg_of_add_eq_zero_left <| by rw [← left_distrib, add_left_neg, mul_zero]
#align non_unital_non_assoc_ring.to_has_distrib_neg NonUnitalNonAssocRing.toHasDistribNeg

theorem mul_sub_left_distrib (a b c : α) : a * (b - c) = a * b - a * c := by
  simpa only [sub_eq_add_neg, neg_mul_eq_mul_neg] using mul_add a b (-c)
#align mul_sub_left_distrib mul_sub_left_distrib

alias mul_sub_left_distrib ← mul_sub
#align mul_sub mul_sub

theorem mul_sub_right_distrib (a b c : α) : (a - b) * c = a * c - b * c := by
  simpa only [sub_eq_add_neg, neg_mul_eq_neg_mul] using add_mul a (-b) c
#align mul_sub_right_distrib mul_sub_right_distrib

alias mul_sub_right_distrib ← sub_mul
#align sub_mul sub_mul

variable {a b c d e : α}

/-- An iff statement following from right distributivity in rings and the definition
  of subtraction. -/
theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
  calc
    a * e + c = b * e + d ↔ a * e + c = d + b * e := by simp [add_comm]
    _ ↔ a * e + c - b * e = d :=
      Iff.intro
        (fun h => by
          rw [h]
          simp)
        fun h => by
        rw [← h]
        simp
    _ ↔ (a - b) * e + c = d := by simp [sub_mul, sub_add_eq_add_sub]

#align mul_add_eq_mul_add_iff_sub_mul_add_eq mul_add_eq_mul_add_iff_sub_mul_add_eq

/-- A simplification of one side of an equation exploiting right distributivity in rings
  and the definition of subtraction. -/
theorem sub_mul_add_eq_of_mul_add_eq_mul_add (h : a * e + c = b * e + d) : (a - b) * e + c = d :=
  calc
    (a - b) * e + c = a * e + c - b * e := by simp [sub_mul, sub_add_eq_add_sub]
    _ = d := by rw [h]; simp [@add_sub_cancel α]

#align sub_mul_add_eq_of_mul_add_eq_mul_add sub_mul_add_eq_of_mul_add_eq_mul_add

end NonUnitalNonAssocRing

section NonAssocRing

variable [NonAssocRing α]

theorem sub_one_mul (a b : α) : (a - 1) * b = a * b - b := by rw [sub_mul, one_mul]
#align sub_one_mul sub_one_mul

theorem mul_sub_one (a b : α) : a * (b - 1) = a * b - a := by rw [mul_sub, mul_one]
#align mul_sub_one mul_sub_one

theorem one_sub_mul (a b : α) : (1 - a) * b = b - a * b := by rw [sub_mul, one_mul]
#align one_sub_mul one_sub_mul

theorem mul_one_sub (a b : α) : a * (1 - b) = a - a * b := by rw [mul_sub, mul_one]
#align mul_one_sub mul_one_sub

end NonAssocRing

section Ring

variable [Ring α] {a b c d e : α}

-- A (unital, associative) ring is a not-necessarily-unital ring
-- see Note [lower instance priority]
instance (priority := 100) Ring.toNonUnitalRing : NonUnitalRing α where
  __ := ‹Ring α›
  zero_mul := fun a => add_left_cancel (a := 0 * a) <| by rw [← add_mul, zero_add, add_zero]
  mul_zero := fun a => add_left_cancel (a := a * 0) <| by rw [← mul_add, add_zero, add_zero]
#align ring.to_non_unital_ring Ring.toNonUnitalRing

-- A (unital, associative) ring is a not-necessarily-associative ring
-- see Note [lower instance priority]
instance (priority := 100) Ring.toNonAssocRing : NonAssocRing α where
  __ := ‹Ring α›
  zero_mul := fun a => add_left_cancel (a := 0 * a) <| by rw [← add_mul, zero_add, add_zero]
  mul_zero := fun a => add_left_cancel (a := a * 0) <| by rw [← mul_add, add_zero, add_zero]
#align ring.to_non_assoc_ring Ring.toNonAssocRing

/- The instance from `Ring` to `Semiring` happens often in linear algebra, for which all the basic
definitions are given in terms of semirings, but many applications use rings or fields. We increase
a little bit its priority above 100 to try it quickly, but remaining below the default 1000 so that
more specific instances are tried first. -/
instance (priority := 200) : Semiring α :=
  { ‹Ring α› with }
#align ring.to_semiring Ring.toSemiring

end Ring

/-- A non-unital commutative ring is a `NonUnitalRing` with commutative multiplication. -/
class NonUnitalCommRing (α : Type u) extends NonUnitalRing α, CommSemigroup α
#align non_unital_comm_ring NonUnitalCommRing

-- see Note [lower instance priority]
instance (priority := 100) NonUnitalCommRing.toNonUnitalCommSemiring [s : NonUnitalCommRing α] :
    NonUnitalCommSemiring α :=
  { s with }
#align non_unital_comm_ring.to_non_unital_comm_semiring NonUnitalCommRing.toNonUnitalCommSemiring

class CommRing (α : Type u) extends Ring α, CommMonoid α
#align comm_ring CommRing

instance (priority := 100) CommRing.toCommSemiring [s : CommRing α] : CommSemiring α :=
  { s with }
#align comm_ring.to_comm_semiring CommRing.toCommSemiring

-- see Note [lower instance priority]
instance (priority := 100) CommRing.toNonUnitalCommRing [s : CommRing α] : NonUnitalCommRing α :=
  { s with }
#align comm_ring.to_non_unital_comm_ring CommRing.toNonUnitalCommRing

-- see Note [lower instance priority]
instance (priority := 100) CommRing.toAddCommGroupWithOne [s : CommRing α] :
    AddCommGroupWithOne α :=
  { s with }

/-- A domain is a nontrivial semiring such multiplication by a non zero element is cancellative,
  on both sides. In other words, a nontrivial semiring `R` satisfying
  `∀ {a b c : R}, a ≠ 0 → a * b = a * c → b = c` and
  `∀ {a b c : R}, b ≠ 0 → a * b = c * b → a = c`.

  This is implemented as a mixin for `Semiring α`.
  To obtain an integral domain use `[CommRing α] [IsDomain α]`. -/
class IsDomain (α : Type u) [Semiring α] extends IsCancelMulZero α, Nontrivial α : Prop
#align is_domain IsDomain


/-
Let's construct a fully formal and certifiable correct proof of the
commutativity of conjunction.
-/

-- theorem and_commutes : ∀ (P Q : Prop), P ∧ Q → Q ∧ P := _

theorem                           -- keyword: we're going to create a proof
and_commutes:                     -- this will be its name
∀ (P Q : Prop), P ∧ Q → Q ∧ P     -- the proposition/claim to be proved
:=                                -- bind the proof to the name, and_commutes
begin                             -- ⊢ ∀ (P Q : Prop), P ∧ Q → Q ∧ P
  assume P Q,                     -- P Q : Prop ⊢ P ∧ Q → Q ∧ P       (∀-intro)
  assume h : P ∧ Q,               -- P Q : Prop, h : P ∧ Q ⊢ Q ∧ P    (→ intro)
  let p : P := and.elim_left h,   -- P Q : Prop, h : P ∧ Q, p : P ⊢ Q ∧ P   (∧-elim-left)
  let q : Q := and.elim_right h,  -- P Q : Prop, h : P ∧ Q, p : P, q : Q ⊢ Q ∧ P  (right)
  apply and.intro q p,            -- QED (that means the claim has been proven)
end

/-
Theorem: Logical "and" is commutative.

Proof: Assume P and Q are arbitrary but specific propositions,
and that we have proof of P ∧ Q. From this proof we can derive
proofs of P and of Q separately (using and elimination). Then
we can combine these proofs in the opposite order to construct
a proof of Q ∧ P.
-/

-- Here are two versions of a formal proof

theorem         -- a keyword saying we're going to construct a proof
or_commutes:   -- the name we'll give to the proof once it's accepted
∀ (P Q : Prop), P ∧ Q → Q ∨ P -- the proposition that's to be proved
:=              -- syntax for binding a name to a (proof) value
begin           -- and now, between begin/end, we build the proof
/-
  intros P Q,
  assume h : P ∨ Q,
  apply or.elim h _ _,

  -- case where P ∨ Q is true because P is
  assume p : P,
  apply or.intro_right,
  exact p,

  -- case where P ∨ Q is true because Q is
  assume q : Q,
  apply or.intro_left,
  exact q,
-/
  -- In either case, we can prove that Q ∨ P is true. QED.
assume P Q h,
cases h with p q,      -- applies or.elim to h
exact or.inr p,
-- exact or.inl q,
end

example :
  ∀ (P Q R S: Prop),
    R → P ∨ Q ∨ R ∨ S :=
begin
  intros P Q R S,
  assume r,
  apply or.intro_right,
  apply or.intro_right,
  apply or.intro_left,
  assumption,
end

example : ∀ (P Q R S: Prop),
    Q → R → P ∨ Q ∨ R ∨ S := _

example :
  ∀ (P Q R: Prop),
    (P ∨ Q) ∧ R →
    (P ∧ R) ∨ (Q ∧ R) :=
begin
  intros P Q R h,
  cases h with pq r,
  cases pq with p q,
  apply or.intro_left,
  apply and.intro p r,
  apply or.intro_right,
  apply and.intro q r,
end

/-

-/

example :
  ∀ (P Q R S: Prop),
    (P ∨ Q) ∧ (R ∨ S) →
    (P ∧ R) ∨ (P ∧ S) ∨ (Q ∧ R) ∨ (Q ∧ S) :=
begin
  intros P Q R S h,
  cases h,
  cases h_left with p q,
  cases h_right with r s,

  apply or.intro_left,
  apply and.intro p r,

  apply or.intro_right,
  apply or.intro_left,
  apply and.intro p s,

  cases h_right with r s,
  apply or.intro_right,
  apply or.intro_right,
  apply or.intro_left,
  apply and.intro q r,

  apply or.intro_right,
  apply or.intro_right,
  apply or.intro_right,
  apply and.intro q s,
end

#print or_commutes