import tactic

/-

# For which positive integers n does n+1 divide n^2+1?

This is the first question in Sierpinski's book "250 elementary problems
in number theory".

Here's the trick: n+1 divides n^2-1 so if it divides n^2+1
then it divides (n^2+1)-(n^2-1)=2, and n+1>=2 so n+1=2 giving
n=1 as the only solution.

-/

#eval (2 : ℕ) - 3
#eval (2 : ℤ) - 3

--set_option pp.notation false

example (n : ℕ) (hn : 0 < n) : (n + 1) ∣ (n^2 + 1) ↔ n = 1 :=
begin
  split,
  { rintro ⟨c, hc⟩,
    have h1 : (n : ℤ)^2 - 1 = (n + 1) * (n - 1) := by ring,
    zify at hc,
    have h2 : ((n : ℤ) + 1) ∣ 2,
    { use c - (n - 1),
      rw [mul_sub, ← hc, ← h1],
      ring },
    have h3 : (n : ℤ) + 1 ≤ 2 := int.le_of_dvd zero_lt_two h2,
    linarith },
  { rintro rfl,
    norm_num }
end


-- Suma_de_potencias_de_dos.lean
-- Suma de potencias de dos
-- José A. Alonso Jiménez
-- Sevilla, 25 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    1 + 2 + 2² + 2³ + ... + 2⁽ⁿ⁻¹⁾ = 2ⁿ - 1
-- ---------------------------------------------------------------------

import algebra.big_operators
import tactic
open finset nat

open_locale big_operators
set_option pp.structure_projections false

variable (n : ℕ)

-- 1ª demostración
example :
  ∑ k in range n, 2^k = 2^n - 1 :=
begin
  induction n with n HI,
  { simp, },
  { calc ∑ k in range (succ n), 2^k
         = ∑ k in range n, 2^k + 2^n
             : sum_range_succ (λ x, 2 ^ x) n
     ... = (2^n - 1) + 2^n
             : congr_arg2 (+) HI rfl
     ... = (2^n + 2^n) - 1
             : by omega
     ... = 2^n * 2 - 1
             : by {congr; simp}
     ... = 2^(succ n) - 1
             : by {congr' 1; ring_nf}, },
end


import algebra.big_operators data.real.cau_seq tactic.ring algebra.archimedean data.nat.choose analysis.limits

open nat is_absolute_value

variables {α : Type*} {β : Type*} (f g : ℕ → α) (n m : ℕ)

local infix `^` := monoid.pow
local notation f ` ∑ ` : 90 n : 90  := finset.sum (finset.range n) f

section sum_range
variable [add_comm_monoid α]

lemma sum_range_succ : f ∑ succ n = f n + f ∑ n :=
have h : n ∉ finset.range n := by rw finset.mem_range; exact lt_irrefl _,
by rw [finset.range_succ, finset.sum_insert h]

lemma sum_range_succ' : ∀ n : ℕ, f ∑ succ n = (λ m, f (succ m)) ∑ n + f 0
| 0        := by simp
| (succ n) := by rw [sum_range_succ (λ m, f (succ m)), add_assoc, ← sum_range_succ'];
                 exact sum_range_succ _ _

lemma sum_range_comm : f ∑ n = (λ m, f (n - (succ m))) ∑ n :=
begin
  induction n with n hi,
  { simp },
  { rw [sum_range_succ, sum_range_succ', hi, succ_sub_one, add_comm],
    simp [succ_sub_succ] }
end

end sum_range

theorem binomial [comm_semiring α] (x y : α) : ∀ n : ℕ,
    (x + y)^n = (λ m, x^m * y^(n - m) * choose n m) ∑ succ n
| 0        := by simp
| (succ n) :=
begin
  rw [_root_.pow_succ, binomial, add_mul, finset.mul_sum, finset.mul_sum, sum_range_succ, sum_range_succ',
      sum_range_succ, sum_range_succ', add_assoc, ← add_assoc (_ ∑ n), ← finset.sum_add_distrib],
  have h₁ : x * (x^n * y^(n - n) * choose n n) = x^succ n * y^(succ n - succ n)
      * choose (succ n) (succ n) :=
    by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
  have  h₂ : y * (x^0 * y^(n - 0) * choose n 0) = x^0 * y^(succ n - 0) * choose (succ n) 0 :=
    by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
  have h₃ : (λ m, x * (x^m * y^(n - m) * choose n m) + y * (x^succ m * y^(n - succ m)
      * choose n (succ m))) ∑ n
      = (λ m, x^succ m * y^(succ n - succ m) * ↑(choose (succ n) (succ m))) ∑ n :=
    finset.sum_congr rfl
      begin
        assume m hm,
        rw finset.mem_range at hm,
        rw [← mul_assoc y, ← mul_assoc y, mul_right_comm y, ← _root_.pow_succ, add_one, ← succ_sub hm],
        simp [succ_sub_succ, _root_.pow_succ, choose_succ_succ, mul_add, mul_comm,
            mul_assoc, mul_left_comm]
      end,
  rw [h₁, h₂, h₃]
end

#check binomial


section
variable (α : Type) (p q : α → Prop) (r : α → α → Prop)

/- UNIVERSAL QUANTIFICATION -/

-- We can leave off `: α` if Lean can infer it (here via `p`/`q`)
example : (∀ x, p x) → (∀ x, p x → q x) → (∀ x, q x) :=
  fun hp hpq x => hpq x (hp x)

-- The reverse direction of the slides example
example : (∀ x, p x ∧ q x) → (∀ x, p x) ∧ (∀ x, q x) :=
  -- for the `⟨...⟩` and `.left/right` notations, see Solutions/Exercise1.lean
  fun hpq => ⟨fun x => And.left (hpq x),
              fun x => (hpq x).right⟩

-- TODO: Prove the corresponding forward/reverse lemma(s) for `∨` (that hold)!
-- hint: input `∀` as `\all`
example : (∀ x, p x) ∨ (∀ x, q x) → (∀ x, p x ∨ q x) :=
  -- We can match multiple terms separated by commas in parallel
  -- Here `fun | ...` is short for `fun h x => match h, x with | ...`
  fun | Or.inl hp, x => Or.inl (hp x)
      | Or.inr hq, x => Or.inr (hq x)

-- We can bind multiple variables in a single `∀`
example : (∀ x y, r x y) → (∀ y x, r x y) :=
  fun h y x => h x y

/- EXISTENTIAL QUANTIFICATION -/

/-
Interestingly, in contrast to the universal quantifier, the existential quantifier is not primitive
but can be specified as an inductive type:
```
inductive Exists (p : α → Prop) : Prop where
  | intro (w : α) (h : p w) : Exists p
```
That is, `Exists.intro` takes/offers a "witness" and a proof that the predicate holds for the witness.
Instead of `Exists (fun x => p x)`, we can also write `∃ x, p x` (input `∃` as `\ex`).
-/

example : (∃ x, p x ∧ q x) → (∃ x, p x) ∧ (∃ x, q x) :=
  fun | Exists.intro x hpq => ⟨Exists.intro x hpq.left, Exists.intro x hpq.right⟩

example : ¬(∃ x, p x) → (∀ x, ¬ p x) :=
  fun h x hp => h ⟨x, hp⟩

example : (∀ x, ¬ p x) → ¬(∃ x, p x) :=
  fun hnotp ⟨x, hpx⟩ => hnotp x hpx

example : (∃ x, ¬ p x) → ¬ (∀ x, p x) :=
  fun ⟨x, hnotpx⟩ hp => hnotpx (hp x)

section
open Classical
-- The following example can only be solved using the classical axioms
-- This one is pretty tricky again, don't feel bad about skipping it
-- hint: use the following helper theorem that can be derived from `em`:
#check byContradiction
-- hint: you may even need to use it more than once
example : ¬(∀ x, p x) → (∃ x, ¬ p x) :=
  fun hnotp => byContradiction (fun h => hnotp (fun x => byContradiction (fun hpx => h ⟨x, hpx⟩)))
end

-- TODO: Decide for yourself what variables you need to model and prove the following
-- important real-world observation, which is sometimes called "drinker paradox":
--   "If there is at least one person in the pub, then there is someone in the pub such that,
--    if (s)he is drinking, then everyone in the pub is drinking."
-- hint: you can define "is in pub" either as a predicate variable on a "Person" type (`(Person : Type)`),
--   or, more simply, directly as a type "Occupant" since we are not interested in persons outside the pub
-- hint: you might need classical logic again
section Drinker

open Classical
-- NOTE: instead of `(∃ p : Occupant, True)`, the equivalent simple `Occupant` could also be used
example (Occupant : Type) (drinking : Occupant → Prop) : (∃ p : Occupant, True) →
    ∃ p, drinking p → ∀ p', drinking p' :=
  fun ⟨p, _⟩ => match em (∃ p', ¬ drinking p') with
    | Or.inl ⟨p', hp'nodrink⟩ => ⟨p', fun hp'drink => False.elim (hp'nodrink hp'drink)⟩
    | Or.inr h => ⟨p, fun hpdrink p' => byContradiction (fun hp'nodrink => h ⟨p', hp'nodrink⟩)⟩

end Drinker

/- EQUALITY -/

example : ∀ a b c : α, a = b → b = c → a = c :=
  fun a b c hab hbc => hab ▸ hbc

example : ∀ a : α, ∃ b : α, b = a :=
  fun a => ⟨a, rfl⟩

-- "`Eq` is the least reflexive relation"
example : (∀ a, r a a) → (∀ a b, a = b → r a b) :=
  fun hrrefl a b hab =>
    hab ▸ hrrefl a

end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Tim Baanen
-/
import data.matrix.pequiv
import data.matrix.block
import data.fintype.card
import group_theory.perm.fin
import group_theory.perm.sign
import algebra.algebra.basic
import tactic.ring
import linear_algebra.alternating
import linear_algebra.pi

/-!
# Determinant of a matrix

This file defines the determinant of a matrix, `matrix.det`, and its essential properties.

## Main definitions

 - `matrix.det`: the determinant of a square matrix, as a sum over permutations
 - `matrix.det_row_alternating`: the determinant, as an `alternating_map` in the rows of the matrix

## Main results

 - `det_mul`: the determinant of `A ⬝ B` is the product of determinants
 - `det_zero_of_row_eq`: the determinant is zero if there is a repeated row
 - `det_block_diagonal`: the determinant of a block diagonal matrix is a product
   of the blocks' determinants

## Implementation notes

It is possible to configure `simp` to compute determinants. See the file
`test/matrix.lean` for some examples.

-/

universes u v w z
open equiv equiv.perm finset function

namespace matrix
open_locale matrix big_operators

variables {m n : Type*} [decidable_eq n] [fintype n] [decidable_eq m] [fintype m]
variables {R : Type v} [comm_ring R]

local notation `ε` σ:max := ((sign σ : ℤ ) : R)

/-- `det` is an `alternating_map` in the rows of the matrix. -/
def det_row_alternating : alternating_map R (n → R) R n :=
((multilinear_map.mk_pi_algebra R n R).comp_linear_map (linear_map.proj)).alternatization

/-- The determinant of a matrix given by the Leibniz formula. -/
abbreviation det (M : matrix n n R) : R :=
det_row_alternating M

lemma det_apply (M : matrix n n R) :
  M.det = ∑ σ : perm n, σ.sign • ∏ i, M (σ i) i :=
multilinear_map.alternatization_apply _ M

-- This is what the old definition was. We use it to avoid having to change the old proofs below
lemma det_apply' (M : matrix n n R) :
  M.det = ∑ σ : perm n, ε σ * ∏ i, M (σ i) i :=
by simp [det_apply, units.smul_def]

@[simp] lemma det_diagonal {d : n → R} : det (diagonal d) = ∏ i, d i :=
begin
  rw det_apply',
  refine (finset.sum_eq_single 1 _ _).trans _,
  { intros σ h1 h2,
    cases not_forall.1 (mt equiv.ext h2) with x h3,
    convert mul_zero _,
    apply finset.prod_eq_zero,
    { change x ∈ _, simp },
    exact if_neg h3 },
  { simp },
  { simp }
end

@[simp] lemma det_zero (h : nonempty n) : det (0 : matrix n n R) = 0 :=
(det_row_alternating : alternating_map R (n → R) R n).map_zero

@[simp] lemma det_one : det (1 : matrix n n R) = 1 :=
by rw [← diagonal_one]; simp [-diagonal_one]

lemma det_is_empty [is_empty n] {A : matrix n n R} : det A = 1 :=
by simp [det_apply]

@[simp] lemma coe_det_is_empty [is_empty n] : (det : matrix n n R → R) = function.const _ 1 :=
by { ext, exact det_is_empty, }

lemma det_eq_one_of_card_eq_zero {A : matrix n n R} (h : fintype.card n = 0) : det A = 1 :=
begin
  haveI : is_empty n := fintype.card_eq_zero_iff.mp h,
  exact det_is_empty,
end

/-- If `n` has only one element, the determinant of an `n` by `n` matrix is just that element.
Although `unique` implies `decidable_eq` and `fintype`, the instances might
not be syntactically equal. Thus, we need to fill in the args explicitly. -/
@[simp]
lemma det_unique {n : Type*} [unique n] [decidable_eq n] [fintype n] (A : matrix n n R) :
  det A = A (default n) (default n) :=
by simp [det_apply, univ_unique]

lemma det_eq_elem_of_subsingleton [subsingleton n] (A : matrix n n R) (k : n) :
  det A = A k k :=
begin
  convert det_unique _,
  exact unique_of_subsingleton k
end

lemma det_eq_elem_of_card_eq_one {A : matrix n n R} (h : fintype.card n = 1) (k : n) :
  det A = A k k :=
begin
  haveI : subsingleton n := fintype.card_le_one_iff_subsingleton.mp h.le,
  exact det_eq_elem_of_subsingleton _ _
end

lemma det_mul_aux {M N : matrix n n R} {p : n → n} (H : ¬bijective p) :
  ∑ σ : perm n, (ε σ) * ∏ x, (M (σ x) (p x) * N (p x) x) = 0 :=
begin
  obtain ⟨i, j, hpij, hij⟩ : ∃ i j, p i = p j ∧ i ≠ j,
  { rw [← fintype.injective_iff_bijective, injective] at H,
    push_neg at H,
    exact H },
  exact sum_involution
    (λ σ _, σ * swap i j)
    (λ σ _,
      have ∏ x, M (σ x) (p x) = ∏ x, M ((σ * swap i j) x) (p x),
        from fintype.prod_equiv (swap i j) _ _ (by simp [apply_swap_eq_self hpij]),
      by simp [this, sign_swap hij, prod_mul_distrib])
    (λ σ _ _, (not_congr mul_swap_eq_iff).mpr hij)
    (λ _ _, mem_univ _)
    (λ σ _, mul_swap_involutive i j σ)
end

@[simp] lemma det_mul (M N : matrix n n R) : det (M ⬝ N) = det M * det N :=
calc det (M ⬝ N) = ∑ p : n → n, ∑ σ : perm n, ε σ * ∏ i, (M (σ i) (p i) * N (p i) i) :
  by simp only [det_apply', mul_apply, prod_univ_sum, mul_sum,
    fintype.pi_finset_univ]; rw [finset.sum_comm]
... = ∑ p in (@univ (n → n) _).filter bijective, ∑ σ : perm n,
    ε σ * ∏ i, (M (σ i) (p i) * N (p i) i) :
  eq.symm $ sum_subset (filter_subset _ _)
    (λ f _ hbij, det_mul_aux $ by simpa only [true_and, mem_filter, mem_univ] using hbij)
... = ∑ τ : perm n, ∑ σ : perm n, ε σ * ∏ i, (M (σ i) (τ i) * N (τ i) i) :
  sum_bij (λ p h, equiv.of_bijective p (mem_filter.1 h).2) (λ _ _, mem_univ _)
    (λ _ _, rfl) (λ _ _ _ _ h, by injection h)
    (λ b _, ⟨b, mem_filter.2 ⟨mem_univ _, b.bijective⟩, coe_fn_injective rfl⟩)
... = ∑ σ : perm n, ∑ τ : perm n, (∏ i, N (σ i) i) * ε τ * (∏ j, M (τ j) (σ j)) :
  by simp only [mul_comm, mul_left_comm, prod_mul_distrib, mul_assoc]
... = ∑ σ : perm n, ∑ τ : perm n, (((∏ i, N (σ i) i) * (ε σ * ε τ)) * ∏ i, M (τ i) i) :
  sum_congr rfl (λ σ _, fintype.sum_equiv (equiv.mul_right σ⁻¹) _ _
    (λ τ,
      have ∏ j, M (τ j) (σ j) = ∏ j, M ((τ * σ⁻¹) j) j,
        by { rw ← σ⁻¹.prod_comp, simp only [equiv.perm.coe_mul, apply_inv_self] },
      have h : ε σ * ε (τ * σ⁻¹) = ε τ :=
        calc ε σ * ε (τ * σ⁻¹) = ε ((τ * σ⁻¹) * σ) :
          by { rw [mul_comm, sign_mul (τ * σ⁻¹)], simp only [int.cast_mul, units.coe_mul] }
        ... = ε τ : by simp only [inv_mul_cancel_right],
      by { simp_rw [equiv.coe_mul_right, h], simp only [this] }))
... = det M * det N : by simp only [det_apply', finset.mul_sum, mul_comm, mul_left_comm]

/-- The determinant of a matrix, as a monoid homomorphism. -/
def det_monoid_hom : matrix n n R →* R :=
{ to_fun := det,
  map_one' := det_one,
  map_mul' := det_mul }

@[simp] lemma coe_det_monoid_hom : (det_monoid_hom : matrix n n R → R) = det := rfl

/-- On square matrices, `mul_comm` applies under `det`. -/
lemma det_mul_comm (M N : matrix m m R) : det (M ⬝ N) = det (N ⬝ M) :=
by rw [det_mul, det_mul, mul_comm]

/-- On square matrices, `mul_left_comm` applies under `det`. -/
lemma det_mul_left_comm (M N P : matrix m m R) : det (M ⬝ (N ⬝ P)) = det (N ⬝ (M ⬝ P)) :=
by rw [←matrix.mul_assoc, ←matrix.mul_assoc, det_mul, det_mul_comm M N, ←det_mul]

/-- On square matrices, `mul_right_comm` applies under `det`. -/
lemma det_mul_right_comm (M N P : matrix m m R) :
  det (M ⬝ N ⬝ P) = det (M ⬝ P ⬝ N) :=
by rw [matrix.mul_assoc, matrix.mul_assoc, det_mul, det_mul_comm N P, ←det_mul]

lemma det_units_conj (M : units (matrix m m R)) (N : matrix m m R) :
  det (↑M ⬝ N ⬝ ↑M⁻¹ : matrix m m R) = det N :=
by rw [det_mul_right_comm, ←mul_eq_mul, ←mul_eq_mul, units.mul_inv, one_mul]

lemma det_units_conj' (M : units (matrix m m R)) (N : matrix m m R) :
  det (↑M⁻¹ ⬝ N ⬝ ↑M : matrix m m R) = det N := det_units_conj M⁻¹ N

/-- Transposing a matrix preserves the determinant. -/
@[simp] lemma det_transpose (M : matrix n n R) : Mᵀ.det = M.det :=
begin
  rw [det_apply', det_apply'],
  refine fintype.sum_bijective _ inv_involutive.bijective _ _ _,
  intros σ,
  rw sign_inv,
  congr' 1,
  apply fintype.prod_equiv σ,
  intros,
  simp
end

/-- Permuting the columns changes the sign of the determinant. -/
lemma det_permute (σ : perm n) (M : matrix n n R) : matrix.det (λ i, M (σ i)) = σ.sign * M.det :=
((det_row_alternating : alternating_map R (n → R) R n).map_perm M σ).trans
  (by simp [units.smul_def])

/-- Permuting rows and columns with the same equivalence has no effect. -/
@[simp]
lemma det_minor_equiv_self (e : n ≃ m) (A : matrix m m R) :
  det (A.minor e e) = det A :=
begin
  rw [det_apply', det_apply'],
  apply fintype.sum_equiv (equiv.perm_congr e),
  intro σ,
  rw equiv.perm.sign_perm_congr e σ,
  congr' 1,
  apply fintype.prod_equiv e,
  intro i,
  rw [equiv.perm_congr_apply, equiv.symm_apply_apply, minor_apply],
end

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_minor_equiv_self`; this one is unsuitable because
`matrix.reindex_apply` unfolds `reindex` first.
-/
lemma det_reindex_self (e : m ≃ n) (A : matrix m m R) : det (reindex e e A) = det A :=
det_minor_equiv_self e.symm A

/-- The determinant of a permutation matrix equals its sign. -/
@[simp] lemma det_permutation (σ : perm n) :
  matrix.det (σ.to_pequiv.to_matrix : matrix n n R) = σ.sign :=
by rw [←matrix.mul_one (σ.to_pequiv.to_matrix : matrix n n R), pequiv.to_pequiv_mul_matrix,
  det_permute, det_one, mul_one]

@[simp] lemma det_smul (A : matrix n n R) (c : R) : det (c • A) = c ^ fintype.card n * det A :=
calc det (c • A) = det (matrix.mul (diagonal (λ _, c)) A) : by rw [smul_eq_diagonal_mul]
             ... = det (diagonal (λ _, c)) * det A        : det_mul _ _
             ... = c ^ fintype.card n * det A             : by simp [card_univ]

/-- Multiplying each row by a fixed `v i` multiplies the determinant by
the product of the `v`s. -/
lemma det_mul_row (v : n → R) (A : matrix n n R) :
  det (λ i j, v j * A i j) = (∏ i, v i) * det A :=
calc det (λ i j, v j * A i j) = det (A ⬝ diagonal v) : congr_arg det $ by { ext, simp [mul_comm] }
                          ... = (∏ i, v i) * det A : by rw [det_mul, det_diagonal, mul_comm]

/-- Multiplying each column by a fixed `v j` multiplies the determinant by
the product of the `v`s. -/
lemma det_mul_column (v : n → R) (A : matrix n n R) :
  det (λ i j, v i * A i j) = (∏ i, v i) * det A :=
multilinear_map.map_smul_univ _ v A

@[simp]

section hom_map

variables {S : Type w} [comm_ring S]

lemma _root_.ring_hom.map_det (f : R →+* S) (M : matrix n n R) :
  f M.det = matrix.det (f.map_matrix M) :=
by simp [matrix.det_apply', f.map_sum, f.map_prod]

lemma _root_.ring_equiv.map_det (f : R ≃+* S) (M : matrix n n R) :
  f M.det = matrix.det (f.map_matrix M) :=
f.to_ring_hom.map_det _

lemma _root_.alg_hom.map_det [algebra R S] {T : Type z} [comm_ring T] [algebra R T]
  (f : S →ₐ[R] T) (M : matrix n n S) :
  f M.det = matrix.det (f.map_matrix M) :=
f.to_ring_hom.map_det _

lemma _root_.alg_equiv.map_det [algebra R S] {T : Type z} [comm_ring T] [algebra R T]
  (f : S ≃ₐ[R] T) (M : matrix n n S) :
  f M.det = matrix.det (f.map_matrix M) :=
f.to_alg_hom.map_det _

end hom_map

@[simp] lemma det_conj_transpose [star_ring R] (M : matrix m m R) : det (Mᴴ) = star (det M) :=
((star_ring_aut : ring_aut R).map_det _).symm.trans $ congr_arg star M.det_transpose

section det_zero
/-!
### `det_zero` section

Prove that a matrix with a repeated column has determinant equal to zero.
-/

lemma det_eq_zero_of_row_eq_zero {A : matrix n n R} (i : n) (h : ∀ j, A i j = 0) : det A = 0 :=
(det_row_alternating : alternating_map R (n → R) R n).map_coord_zero i (funext h)

lemma det_eq_zero_of_column_eq_zero {A : matrix n n R} (j : n) (h : ∀ i, A i j = 0) : det A = 0 :=
by { rw ← det_transpose, exact det_eq_zero_of_row_eq_zero j h, }

variables {M : matrix n n R} {i j : n}

/-- If a matrix has a repeated row, the determinant will be zero. -/
theorem det_zero_of_row_eq (i_ne_j : i ≠ j) (hij : M i = M j) : M.det = 0 :=
(det_row_alternating : alternating_map R (n → R) R n).map_eq_zero_of_eq M hij i_ne_j

/-- If a matrix has a repeated column, the determinant will be zero. -/
theorem det_zero_of_column_eq (i_ne_j : i ≠ j) (hij : ∀ k, M k i = M k j) : M.det = 0 :=
by { rw [← det_transpose, det_zero_of_row_eq i_ne_j], exact funext hij }

end det_zero

lemma det_update_row_add (M : matrix n n R) (j : n) (u v : n → R) :
  det (update_row M j $ u + v) = det (update_row M j u) + det (update_row M j v) :=
(det_row_alternating : alternating_map R (n → R) R n).map_add M j u v

lemma det_update_column_add (M : matrix n n R) (j : n) (u v : n → R) :
  det (update_column M j $ u + v) = det (update_column M j u) + det (update_column M j v) :=
begin
  rw [← det_transpose, ← update_row_transpose, det_update_row_add],
  simp [update_row_transpose, det_transpose]
end

lemma det_update_row_smul (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_row M j $ s • u) = s * det (update_row M j u) :=
(det_row_alternating : alternating_map R (n → R) R n).map_smul M j s u

lemma det_update_column_smul (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_column M j $ s • u) = s * det (update_column M j u) :=
begin
  rw [← det_transpose, ← update_row_transpose, det_update_row_smul],
  simp [update_row_transpose, det_transpose]
end

lemma det_update_row_smul' (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_row (s • M) j u) = s ^ (fintype.card n - 1) * det (update_row M j u) :=
multilinear_map.map_update_smul _ M j s u

lemma det_update_column_smul' (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_column (s • M) j u) = s ^ (fintype.card n - 1) * det (update_column M j u) :=
begin
  rw [← det_transpose, ← update_row_transpose, transpose_smul, det_update_row_smul'],
  simp [update_row_transpose, det_transpose]
end

section det_eq

/-! ### `det_eq` section

Lemmas showing the determinant is invariant under a variety of operations.
-/
lemma det_eq_of_eq_mul_det_one {A B : matrix n n R}
  (C : matrix n n R) (hC : det C = 1) (hA : A = B ⬝ C) : det A = det B :=
calc det A = det (B ⬝ C) : congr_arg _ hA
       ... = det B * det C : det_mul _ _
       ... = det B : by rw [hC, mul_one]

lemma det_eq_of_eq_det_one_mul {A B : matrix n n R}
  (C : matrix n n R) (hC : det C = 1) (hA : A = C ⬝ B) : det A = det B :=
calc det A = det (C ⬝ B) : congr_arg _ hA
       ... = det C * det B : det_mul _ _
       ... = det B : by rw [hC, one_mul]

lemma det_update_row_add_self (A : matrix n n R) {i j : n} (hij : i ≠ j) :
  det (update_row A i (A i + A j)) = det A :=
by simp [det_update_row_add,
    det_zero_of_row_eq hij ((update_row_self).trans (update_row_ne hij.symm).symm)]

lemma det_update_column_add_self (A : matrix n n R) {i j : n} (hij : i ≠ j) :
  det (update_column A i (λ k, A k i + A k j)) = det A :=
by { rw [← det_transpose, ← update_row_transpose, ← det_transpose A],
     exact det_update_row_add_self Aᵀ hij }

lemma det_update_row_add_smul_self (A : matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
  det (update_row A i (A i + c • A j)) = det A :=
by simp [det_update_row_add, det_update_row_smul,
  det_zero_of_row_eq hij ((update_row_self).trans (update_row_ne hij.symm).symm)]

lemma det_update_column_add_smul_self (A : matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
  det (update_column A i (λ k, A k i + c • A k j)) = det A :=
by { rw [← det_transpose, ← update_row_transpose, ← det_transpose A],
      exact det_update_row_add_smul_self Aᵀ hij c }

lemma det_eq_of_forall_row_eq_smul_add_const_aux
  {A B : matrix n n R} {s : finset n} : ∀ (c : n → R) (hs : ∀ i, i ∉ s → c i = 0)
  (k : n) (hk : k ∉ s) (A_eq : ∀ i j, A i j = B i j + c i * B k j),
  det A = det B :=
begin
  revert B,
  refine s.induction_on _ _,
  { intros A c hs k hk A_eq,
    have : ∀ i, c i = 0,
    { intros i,
      specialize hs i,
      contrapose! hs,
      simp [hs] },
    congr,
    ext i j,
    rw [A_eq, this, zero_mul, add_zero], },
  { intros i s hi ih B c hs k hk A_eq,
    have hAi : A i = B i + c i • B k := funext (A_eq i),
    rw [@ih (update_row B i (A i)) (function.update c i 0), hAi,
        det_update_row_add_smul_self],
    { exact mt (λ h, show k ∈ insert i s, from h ▸ finset.mem_insert_self _ _) hk },
    { intros i' hi',
      rw function.update_apply,
      split_ifs with hi'i, { refl },
      { exact hs i' (λ h, hi' ((finset.mem_insert.mp h).resolve_left hi'i)) } },
    { exact λ h, hk (finset.mem_insert_of_mem h) },
    { intros i' j',
      rw [update_row_apply, function.update_apply],
      split_ifs with hi'i,
      { simp [hi'i] },
      rw [A_eq, update_row_ne (λ (h : k = i), hk $ h ▸ finset.mem_insert_self k s)] } }
end

/-- If you add multiples of row `B k` to other rows, the determinant doesn't change. -/
lemma det_eq_of_forall_row_eq_smul_add_const
  {A B : matrix n n R} (c : n → R) (k : n) (hk : c k = 0)
  (A_eq : ∀ i j, A i j = B i j + c i * B k j) :
  det A = det B :=
det_eq_of_forall_row_eq_smul_add_const_aux c
  (λ i, not_imp_comm.mp $ λ hi, finset.mem_erase.mpr
    ⟨mt (λ (h : i = k), show c i = 0, from h.symm ▸ hk) hi, finset.mem_univ i⟩)
  k (finset.not_mem_erase k finset.univ) A_eq

lemma det_eq_of_forall_row_eq_smul_add_pred_aux {n : ℕ} (k : fin (n + 1)) :
  ∀ (c : fin n → R) (hc : ∀ (i : fin n), k < i.succ → c i = 0)
    {M N : matrix (fin n.succ) (fin n.succ) R}
    (h0 : ∀ j, M 0 j = N 0 j)
    (hsucc : ∀ (i : fin n) j, M i.succ j = N i.succ j + c i * M i.cast_succ j),
    det M = det N :=
begin
  refine fin.induction _ (λ k ih, _) k;
    intros c hc M N h0 hsucc,
  { congr,
    ext i j,
    refine fin.cases (h0 j) (λ i, _) i,
    rw [hsucc, hc i (fin.succ_pos _), zero_mul, add_zero] },

  set M' := update_row M k.succ (N k.succ) with hM',
  have hM : M = update_row M' k.succ (M' k.succ + c k • M k.cast_succ),
  { ext i j,
    by_cases hi : i = k.succ,
    { simp [hi, hM', hsucc, update_row_self] },
    rw [update_row_ne hi, hM', update_row_ne hi] },

  have k_ne_succ : k.cast_succ ≠ k.succ := (fin.cast_succ_lt_succ k).ne,
  have M_k : M k.cast_succ = M' k.cast_succ := (update_row_ne k_ne_succ).symm,

  rw [hM, M_k, det_update_row_add_smul_self M' k_ne_succ.symm, ih (function.update c k 0)],
  { intros i hi,
    rw [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ, fin.coe_succ, nat.lt_succ_iff] at hi,
    rw function.update_apply,
    split_ifs with hik, { refl },
    exact hc _ (fin.succ_lt_succ_iff.mpr (lt_of_le_of_ne hi (ne.symm hik))) },
  { rwa [hM', update_row_ne (fin.succ_ne_zero _).symm] },
  intros i j,
  rw function.update_apply,
  split_ifs with hik,
  { rw [zero_mul, add_zero, hM', hik, update_row_self] },
  rw [hM', update_row_ne ((fin.succ_injective _).ne hik), hsucc],
  by_cases hik2 : k < i,
  { simp [hc i (fin.succ_lt_succ_iff.mpr hik2)] },
  rw update_row_ne,
  apply ne_of_lt,
  rwa [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ, fin.coe_succ, nat.lt_succ_iff, ← not_lt]
end

/-- If you add multiples of previous rows to the next row, the determinant doesn't change. -/
lemma det_eq_of_forall_row_eq_smul_add_pred {n : ℕ}
  {A B : matrix (fin (n + 1)) (fin (n + 1)) R} (c : fin n → R)
  (A_zero : ∀ j, A 0 j = B 0 j)
  (A_succ : ∀ (i : fin n) j, A i.succ j = B i.succ j + c i * A i.cast_succ j) :
  det A = det B :=
det_eq_of_forall_row_eq_smul_add_pred_aux (fin.last _) c
  (λ i hi, absurd hi (not_lt_of_ge (fin.le_last _)))
  A_zero A_succ

/-- If you add multiples of previous columns to the next columns, the determinant doesn't change. -/
lemma det_eq_of_forall_col_eq_smul_add_pred {n : ℕ}
  {A B : matrix (fin (n + 1)) (fin (n + 1)) R} (c : fin n → R)
  (A_zero : ∀ i, A i 0 = B i 0)
  (A_succ : ∀ i (j : fin n), A i j.succ = B i j.succ + c j * A i j.cast_succ) :
  det A = det B :=
by { rw [← det_transpose A, ← det_transpose B],
     exact det_eq_of_forall_row_eq_smul_add_pred c A_zero (λ i j, A_succ j i) }

end det_eq

@[simp] lemma det_block_diagonal {o : Type*} [fintype o] [decidable_eq o] (M : o → matrix n n R) :
  (block_diagonal M).det = ∏ k, (M k).det :=
begin
  -- Rewrite the determinants as a sum over permutations.
  simp_rw [det_apply'],
  -- The right hand side is a product of sums, rewrite it as a sum of products.
  rw finset.prod_sum,
  simp_rw [finset.mem_univ, finset.prod_attach_univ, finset.univ_pi_univ],
  -- We claim that the only permutations contributing to the sum are those that
  -- preserve their second component.
  let preserving_snd : finset (equiv.perm (n × o)) :=
    finset.univ.filter (λ σ, ∀ x, (σ x).snd = x.snd),
  have mem_preserving_snd : ∀ {σ : equiv.perm (n × o)},
    σ ∈ preserving_snd ↔ ∀ x, (σ x).snd = x.snd :=
    λ σ, finset.mem_filter.trans ⟨λ h, h.2, λ h, ⟨finset.mem_univ _, h⟩⟩,
  rw ← finset.sum_subset (finset.subset_univ preserving_snd) _,
  -- And that these are in bijection with `o → equiv.perm m`.
  rw (finset.sum_bij (λ (σ : ∀ (k : o), k ∈ finset.univ → equiv.perm n) _,
                        prod_congr_left (λ k, σ k (finset.mem_univ k))) _ _ _ _).symm,
  { intros σ _,
    rw mem_preserving_snd,
    rintros ⟨k, x⟩,
    simp only [prod_congr_left_apply] },
  { intros σ _,
    rw [finset.prod_mul_distrib, ←finset.univ_product_univ, finset.prod_product_right],
    simp only [sign_prod_congr_left, units.coe_prod, int.cast_prod, block_diagonal_apply_eq,
      prod_congr_left_apply] },
  { intros σ σ' _ _ eq,
    ext x hx k,
    simp only at eq,
    have : ∀ k x, prod_congr_left (λ k, σ k (finset.mem_univ _)) (k, x) =
                  prod_congr_left (λ k, σ' k (finset.mem_univ _)) (k, x) :=
      λ k x, by rw eq,
    simp only [prod_congr_left_apply, prod.mk.inj_iff] at this,
    exact (this k x).1 },
  { intros σ hσ,
    rw mem_preserving_snd at hσ,
    have hσ' : ∀ x, (σ⁻¹ x).snd = x.snd,
    { intro x, conv_rhs { rw [← perm.apply_inv_self σ x, hσ] } },
    have mk_apply_eq : ∀ k x, ((σ (x, k)).fst, k) = σ (x, k),
    { intros k x,
      ext,
      { simp only},
      { simp only [hσ] } },
    have mk_inv_apply_eq : ∀ k x, ((σ⁻¹ (x, k)).fst, k) = σ⁻¹ (x, k),
    { intros k x,
      conv_lhs { rw ← perm.apply_inv_self σ (x, k) },
      ext,
      { simp only [apply_inv_self] },
      { simp only [hσ'] } },
    refine ⟨λ k _, ⟨λ x, (σ (x, k)).fst, λ x, (σ⁻¹ (x, k)).fst, _, _⟩, _, _⟩,
    { intro x,
      simp only [mk_apply_eq, inv_apply_self] },
    { intro x,
      simp only [mk_inv_apply_eq, apply_inv_self] },
    { apply finset.mem_univ },
    { ext ⟨k, x⟩,
      { simp only [coe_fn_mk, prod_congr_left_apply] },
      { simp only [prod_congr_left_apply, hσ] } } },
  { intros σ _ hσ,
    rw mem_preserving_snd at hσ,
    obtain ⟨⟨k, x⟩, hkx⟩ := not_forall.mp hσ,
    rw [finset.prod_eq_zero (finset.mem_univ (k, x)), mul_zero],
    rw [← @prod.mk.eta _ _ (σ (k, x)), block_diagonal_apply_ne],
    exact hkx }
end

/-- The determinant of a 2x2 block matrix with the lower-left block equal to zero is the product of
the determinants of the diagonal blocks. For the generalization to any number of blocks, see
`matrix.upper_block_triangular_det`. -/
lemma upper_two_block_triangular_det
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
  (matrix.from_blocks A B 0 D).det = A.det * D.det :=
begin
  classical,
  simp_rw det_apply',
  convert
    (sum_subset (subset_univ ((sum_congr_hom m n).range : set (perm (m ⊕ n))).to_finset) _).symm,
  rw sum_mul_sum,
  simp_rw univ_product_univ,
  rw (sum_bij (λ (σ : perm m × perm n) _, equiv.sum_congr σ.fst σ.snd) _ _ _ _).symm,
  { intros σ₁₂ h,
    simp only [],
    erw [set.mem_to_finset, monoid_hom.mem_range],
    use σ₁₂,
    simp only [sum_congr_hom_apply] },
  { simp only [forall_prop_of_true, prod.forall, mem_univ],
    intros σ₁ σ₂,
    rw fintype.prod_sum_type,
    simp_rw [equiv.sum_congr_apply, sum.map_inr, sum.map_inl, from_blocks_apply₁₁,
      from_blocks_apply₂₂],
    have hr : ∀ (a b c d : R), (a * b) * (c * d) = a * c * (b * d), { intros, ac_refl },
    rw hr,
    congr,
    rw [sign_sum_congr, units.coe_mul, int.cast_mul] },
  { intros σ₁ σ₂ h₁ h₂,
    dsimp only [],
    intro h,
    have h2 : ∀ x, perm.sum_congr σ₁.fst σ₁.snd x = perm.sum_congr σ₂.fst σ₂.snd x,
    { intro x, exact congr_fun (congr_arg to_fun h) x },
    simp only [sum.map_inr, sum.map_inl, perm.sum_congr_apply, sum.forall] at h2,
    ext,
    { exact h2.left x },
    { exact h2.right x }},
  { intros σ hσ,
    erw [set.mem_to_finset, monoid_hom.mem_range] at hσ,
    obtain ⟨σ₁₂, hσ₁₂⟩ := hσ,
    use σ₁₂,
    rw ←hσ₁₂,
    simp },
  { intros σ hσ hσn,
    have h1 : ¬ (∀ x, ∃ y, sum.inl y = σ (sum.inl x)),
    { by_contradiction,
      rw set.mem_to_finset at hσn,
      apply absurd (mem_sum_congr_hom_range_of_perm_maps_to_inl _) hσn,
      rintros x ⟨a, ha⟩,
      rw [←ha], exact h a },
    obtain ⟨a, ha⟩ := not_forall.mp h1,
    cases hx : σ (sum.inl a) with a2 b,
    { have hn := (not_exists.mp ha) a2,
      exact absurd hx.symm hn },
    { rw [finset.prod_eq_zero (finset.mem_univ (sum.inl a)), mul_zero],
      rw [hx, from_blocks_apply₂₁], refl }}
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column 0. -/
lemma det_succ_column_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
  det A = ∑ i : fin n.succ, (-1) ^ (i : ℕ) * A i 0 *
    det (A.minor i.succ_above fin.succ) :=
begin
  rw [matrix.det_apply, finset.univ_perm_fin_succ, ← finset.univ_product_univ],
  simp only [finset.sum_map, equiv.to_embedding_apply, finset.sum_product, matrix.minor],
  refine finset.sum_congr rfl (λ i _, fin.cases _ (λ i, _) i),
  { simp only [fin.prod_univ_succ, matrix.det_apply, finset.mul_sum,
        equiv.perm.decompose_fin_symm_apply_zero, fin.coe_zero, one_mul,
        equiv.perm.decompose_fin.symm_sign, equiv.swap_self, if_true, id.def, eq_self_iff_true,
        equiv.perm.decompose_fin_symm_apply_succ, fin.succ_above_zero, equiv.coe_refl, pow_zero,
        mul_smul_comm] },
  -- `univ_perm_fin_succ` gives a different embedding of `perm (fin n)` into
  -- `perm (fin n.succ)` than the determinant of the submatrix we want,
  -- permute `A` so that we get the correct one.
  have : (-1 : R) ^ (i : ℕ) = i.cycle_range.sign,
  { simp [fin.sign_cycle_range] },
  rw [fin.coe_succ, pow_succ, this, mul_assoc, mul_assoc, mul_left_comm ↑(equiv.perm.sign _),
      ← det_permute, matrix.det_apply, finset.mul_sum, finset.mul_sum],
  -- now we just need to move the corresponding parts to the same place
  refine finset.sum_congr rfl (λ σ _, _),
  rw [equiv.perm.decompose_fin.symm_sign, if_neg (fin.succ_ne_zero i)],
  calc ((-1) * σ.sign : ℤ) • ∏ i', A (equiv.perm.decompose_fin.symm (fin.succ i, σ) i') i'
      = ((-1) * σ.sign : ℤ) • (A (fin.succ i) 0 *
        ∏ i', A (((fin.succ i).succ_above) (fin.cycle_range i (σ i'))) i'.succ) :
    by simp only [fin.prod_univ_succ, fin.succ_above_cycle_range,
      equiv.perm.decompose_fin_symm_apply_zero, equiv.perm.decompose_fin_symm_apply_succ]
  ... = (-1) * (A (fin.succ i) 0 * (σ.sign : ℤ) •
        ∏ i', A (((fin.succ i).succ_above) (fin.cycle_range i (σ i'))) i'.succ) :
    by simp only [mul_assoc, mul_comm, neg_mul_eq_neg_mul_symm, one_mul, zsmul_eq_mul, neg_inj,
      neg_smul, fin.succ_above_cycle_range],
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row 0. -/
lemma det_succ_row_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
  det A = ∑ j : fin n.succ, (-1) ^ (j : ℕ) * A 0 j *
    det (A.minor fin.succ j.succ_above) :=
by { rw [← det_transpose A, det_succ_column_zero],
     refine finset.sum_congr rfl (λ i _, _),
     rw [← det_transpose],
     simp only [transpose_apply, transpose_minor, transpose_transpose] }

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row `i`. -/
lemma det_succ_row {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (i : fin n.succ) :
  det A = ∑ j : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
    det (A.minor i.succ_above j.succ_above) :=
begin
  simp_rw [pow_add, mul_assoc, ← mul_sum],
  have : det A = (-1 : R) ^ (i : ℕ) * (i.cycle_range⁻¹).sign * det A,
  { calc det A = ↑((-1 : units ℤ) ^ (i : ℕ) * (-1 : units ℤ) ^ (i : ℕ) : units ℤ) * det A :
             by simp
           ... = (-1 : R) ^ (i : ℕ) * (i.cycle_range⁻¹).sign * det A :
             by simp [-int.units_mul_self] },
  rw [this, mul_assoc],
  congr,
  rw [← det_permute, det_succ_row_zero],
  refine finset.sum_congr rfl (λ j _, _),
  rw [mul_assoc, matrix.minor, matrix.minor],
  congr,
  { rw [equiv.perm.inv_def, fin.cycle_range_symm_zero] },
  { ext i' j',
    rw [equiv.perm.inv_def, fin.cycle_range_symm_succ] },
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column `j`. -/
lemma det_succ_column {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (j : fin n.succ) :
  det A = ∑ i : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
    det (A.minor i.succ_above j.succ_above) :=
by { rw [← det_transpose, det_succ_row _ j],
     refine finset.sum_congr rfl (λ i _, _),
     rw [add_comm, ← det_transpose, transpose_apply, transpose_minor, transpose_transpose] }

/-- Determinant of 0x0 matrix -/
@[simp] lemma det_fin_zero {A : matrix (fin 0) (fin 0) R} : det A = 1 :=
det_is_empty

/-- Determinant of 1x1 matrix -/
lemma det_fin_one (A : matrix (fin 1) (fin 1) R) : det A = A 0 0  := det_unique A

/-- Determinant of 2x2 matrix -/
lemma det_fin_two (A : matrix (fin 2) (fin 2) R) :
  det A = A 0 0 * A 1 1 - A 0 1 * A 1 0 :=
begin
  simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
  ring
end

/-- Determinant of 3x3 matrix -/
lemma det_fin_three (A : matrix (fin 3) (fin 3) R) :
  det A = A 0 0 * A 1 1 * A 2 2 - A 0 0 * A 1 2 * A 2 1 - A 0 1 * A 1 0 * A 2 2
  + A 0 1 * A 1 2 * A 2 0 + A 0 2 * A 1 0 * A 2 1 - A 0 2 * A 1 1 * A 2 0 :=
begin
  simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
  ring
end

end matrix


import data.num.basic
set_option pp.structure_projections false

namespace mth1001

section setup

@[derive has_reflect, derive decidable_eq]
inductive mynat : Type
| zero  : mynat
| S : mynat → mynat

open mynat

def add : mynat → mynat → mynat
| a   zero        := a                --     a + zero = a
| a   (S b)    := S (add a b)        -- a + (S b) = S (a + b)

notation a `+` b := add a b

end setup

section addition

open mynat

lemma add_zero  (a : mynat) : a + zero = a := rfl
lemma add_S (a b : mynat) : a + S b = S (a + b) := rfl

-- Exercise 117:
lemma zero_add (a : mynat) :  zero + a = a:=
begin
  induction a with k hk,
  { sorry, },
  { sorry, },
end

-- Exercise 118:
/-
Note that multiple applications of `rw h` (for some lemma or equation `h`)
can be replaced with `repeat {rw h}`.
-/
lemma add_assoc (a b c : mynat) : (a + b) + c = a + (b + c) :=
begin
  induction c with k hk,
  { sorry, },
  { sorry, },
end

-- Exercise 119:
lemma S_add (a b : mynat) : (S a) + b = S (a + b) :=
begin
  sorry
end

-- Exercise 120:
lemma S_eq_add_one (a : mynat) : S a = a + S zero :=
begin
  sorry
end

-- Exercise 121:
lemma add_comm (a b : mynat) : a + b = b + a :=
begin
  sorry
end

end addition

section multiplication

open mynat

-- Next result adapted from data/nat/basic.lean
inductive less_than_or_equal (a : mynat) : mynat → Prop
| refl : less_than_or_equal a
| step : Π {b}, less_than_or_equal b → less_than_or_equal (S b)

def mul : mynat → mynat → mynat
| a   zero      := zero
| a   (S b)  := (mul a b) + a

notation a `*` b := mul a b

open mynat

lemma mul_zero (a : mynat) : a * zero = zero := rfl
lemma mul_S (a b : mynat) : a * (S b) = (a * b) + a := rfl

-- Exercise 122:
lemma zero_mul (a : mynat) : zero * a = zero :=
begin
  sorry
end

-- Exercise 123:
lemma S_mul (a b : mynat) : (S a) * b = a * b + b :=
begin
  sorry
end

-- Exercise 124:
lemma mul_comm (a b : mynat) : a * b = b * a :=
begin
  sorry
end

/-
In the remainder of this section, we prove associativity of multiplication.
-/

-- Exercise 125:
lemma mul_add (a b c : mynat) : a * (b + c) = a * b + a * c :=
begin
  sorry
end

-- Exercise 126:
lemma mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) :=
begin
  sorry
end

end multiplication

end mth1001


namespace Mt.Utils.Nat

theorem max_of_le {a b : Nat} : a ≤ b → a.max b = b :=by
  intro h ; simp only [Nat.max, h, ite_true]

theorem max_of_eq' {a b : Nat} : a = b → a.max b = b :=
  λ h => max_of_le (by rw [h] ; constructor)

theorem max_of_eq {a b : Nat} : a = b → a.max b = a :=by
  intro h ; rw [max_of_eq' h] ; exact h.symm

theorem max_of_gt {a b : Nat} : a > b → a.max b = a :=by
  intro h ; simp only [Nat.max, Nat.not_le_of_gt h, ite_false]

theorem max_of_ge {a b : Nat} : a ≥ b → a.max b = a :=by
  intro h
  cases Nat.eq_or_lt_of_le h <;> rename_i h
  . exact max_of_eq h.symm
  . exact max_of_gt h

theorem max_of_lt {a b : Nat} : a < b → a.max b = b :=max_of_le ∘ Nat.le_of_lt

theorem max_comm  : ∀ a b : Nat, a.max b = b.max a :=by
  intro a b
  cases Nat.lt_or_ge a b <;> rename_i h
  . rw [max_of_lt h, max_of_gt h]
  cases Nat.eq_or_lt_of_le h <;> (clear h ; rename_i h)
  . rw [max_of_eq h, max_of_eq' h.symm]
  . rw [max_of_lt h, max_of_gt h]

theorem max_assoc : ∀ a b c : Nat, (a.max b).max c = a.max (b.max c) :=by
  intros a b c
  cases Nat.lt_or_ge a b
  <;> cases Nat.lt_or_ge b c
  <;> rename_i ab bc
  . rw [max_of_lt ab, max_of_lt bc, max_of_lt (trans ab bc)]
  . rw [max_of_lt ab, max_of_ge bc, max_of_lt ab]
  . rw [max_of_ge ab, max_of_lt bc]
  . rw [max_of_ge ab, max_of_ge bc, max_of_ge ab]
    exact max_of_ge (trans bc ab : c ≤ a)

theorem zero_max  : ∀ a : Nat, ((0 : Nat).max a) = a :=by
  intro a
  simp only [Nat.max, Nat.zero_le, ite_true]

theorem max_zero  : ∀ a : Nat, (a.max 0) = a :=fun a => calc
  (a.max 0) = Nat.max 0 a :=max_comm ..
          _ = a           :=zero_max a

theorem max_le {a b c : Nat} : a.max b ≤ c ↔ a ≤ c ∧ b ≤ c :=by
  constructor <;> intro h
  <;> (cases Nat.lt_or_ge a b) <;> rename_i ab
  . rw [max_of_lt ab] at h
    exact ⟨Nat.le_of_lt (trans ab h), h⟩
  . rw [max_of_ge ab] at h
    exact ⟨h, trans ab h⟩
  . rw [max_of_lt ab]
    exact h.right
  . rw [max_of_ge ab]
    exact h.left

end Mt.Utils.Nat


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

import data.nat.prime
import data.nat.totient
import algebra.periodic
import data.finset.locally_finite
import data.nat.count
import data.nat.nth

/-!
# The Prime Counting Function

In this file we define the prime counting function: the function on natural numbers that returns
the number of primes less than or equal to its input.

## Main Results

The main definitions for this file are

- `nat.prime_counting`: The prime counting function π
- `nat.prime_counting'`: π(n - 1)

We then prove that these are monotone in `nat.monotone_prime_counting` and
`nat.monotone_prime_counting'`. The last main theorem `nat.prime_counting'_add_le` is an upper
bound on `π'` which arises by observing that all numbers greater than `k` and not coprime to `k`
are not prime, and so only at most `φ(k)/k` fraction of the numbers from `k` to `n` are prime.

## Notation

We use the standard notation `π` to represent the prime counting function (and `π'` to represent
the reindexed version).

-/

namespace nat
open finset

/--
A variant of the traditional prime counting function which gives the number of primes
*strictly* less than the input. More convenient for avoiding off-by-one errors.
-/
def prime_counting' : ℕ → ℕ := nat.count prime

/-- The prime counting function: Returns the number of primes less than or equal to the input. -/
def prime_counting (n : ℕ) : ℕ := prime_counting' (n + 1)

localized "notation `π` := nat.prime_counting" in nat
localized "notation `π'` := nat.prime_counting'" in nat

lemma monotone_prime_counting' : monotone prime_counting' := count_monotone prime

lemma monotone_prime_counting : monotone prime_counting :=
λ a b a_le_b, monotone_prime_counting' (add_le_add_right a_le_b 1)

@[simp] lemma prime_counting'_nth_eq (n : ℕ) : π' (nth prime n) = n :=
count_nth_of_infinite _ infinite_set_of_prime _

@[simp] lemma prime_nth_prime (n : ℕ) : prime (nth prime n) :=
nth_mem_of_infinite _ infinite_set_of_prime _

/-- A linear upper bound on the size of the `prime_counting'` function -/
lemma prime_counting'_add_le {a k : ℕ} (h0 : 0 < a) (h1 : a < k) (n : ℕ) :
  π' (k + n) ≤ π' k + nat.totient a * (n / a + 1) :=
calc π' (k + n)
    ≤ ((range k).filter (prime)).card + ((Ico k (k + n)).filter (prime)).card :
        begin
          rw [prime_counting', count_eq_card_filter_range, range_eq_Ico,
              ←Ico_union_Ico_eq_Ico (zero_le k) (le_self_add), filter_union],
          apply card_union_le,
        end
... ≤ π' k + ((Ico k (k + n)).filter (prime)).card :
        by rw [prime_counting', count_eq_card_filter_range]
... ≤ π' k + ((Ico k (k + n)).filter (coprime a)).card :
        begin
          refine add_le_add_left (card_le_of_subset _) k.prime_counting',
          simp only [subset_iff, and_imp, mem_filter, mem_Ico],
          intros p succ_k_le_p p_lt_n p_prime,
          split,
          { exact ⟨succ_k_le_p, p_lt_n⟩, },
          { rw coprime_comm,
            exact coprime_of_lt_prime h0 (gt_of_ge_of_gt succ_k_le_p h1) p_prime, },
        end
... ≤ π' k + totient a * (n / a + 1) :
        begin
          rw [add_le_add_iff_left],
          exact Ico_filter_coprime_le k n h0,
        end

end nat


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.multiset.range
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Multiset.Basic
import Mathlib.Data.List.Range

/-! # `Multiset.range n` gives `{0, 1, ..., n-1}` as a multiset. -/

open List Nat

namespace Multiset

-- range
/-- `range n` is the multiset lifted from the list `range n`,
  that is, the set `{0, 1, ..., n-1}`. -/
def range (n : ℕ) : Multiset ℕ :=
  List.range n
#align multiset.range Multiset.range

@[simp]
theorem range_zero : range 0 = 0 :=
  rfl
#align multiset.range_zero Multiset.range_zero

@[simp]
theorem range_succ (n : ℕ) : range (succ n) = n ::ₘ range n := by
  rw [range, List.range_succ, ← coe_add, add_comm]; rfl
#align multiset.range_succ Multiset.range_succ

@[simp]
theorem card_range (n : ℕ) : card (range n) = n :=
  length_range _
#align multiset.card_range Multiset.card_range

theorem range_subset {m n : ℕ} : range m ⊆ range n ↔ m ≤ n :=
  List.range_subset
#align multiset.range_subset Multiset.range_subset

@[simp]
theorem mem_range {m n : ℕ} : m ∈ range n ↔ m < n :=
  List.mem_range
#align multiset.mem_range Multiset.mem_range

--Porting note: removing @[simp], `simp` can prove it
theorem not_mem_range_self {n : ℕ} : n ∉ range n :=
  List.not_mem_range_self
#align multiset.not_mem_range_self Multiset.not_mem_range_self

theorem self_mem_range_succ (n : ℕ) : n ∈ range (n + 1) :=
  List.self_mem_range_succ n
#align multiset.self_mem_range_succ Multiset.self_mem_range_succ

theorem range_add (a b : ℕ) : range (a + b) = range a + (range b).map (a + .) :=
  congr_arg ((↑) : List ℕ → Multiset ℕ) (List.range_add _ _)
#align multiset.range_add Multiset.range_add

theorem range_disjoint_map_add (a : ℕ) (m : Multiset ℕ) :
    (range a).Disjoint (m.map (a + .)) :=
  by
  intro x hxa hxb
  rw [range, mem_coe, List.mem_range] at hxa
  obtain ⟨c, _, rfl⟩ := mem_map.1 hxb
  exact (self_le_add_right _ _).not_lt hxa
#align multiset.range_disjoint_map_add Multiset.range_disjoint_map_add

theorem range_add_eq_union (a b : ℕ) : range (a + b) = range a ∪ (range b).map (a + .) :=
  by
  rw [range_add, add_eq_union_iff_disjoint]
  apply range_disjoint_map_add
#align multiset.range_add_eq_union Multiset.range_add_eq_union

end Multiset


/-
Copyright (c) 2021 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import topology.continuous_on

/-!
# Left and right continuity

In this file we prove a few lemmas about left and right continuous functions:

* `continuous_within_at_Ioi_iff_Ici`: two definitions of right continuity
  (with `(a, ∞)` and with `[a, ∞)`) are equivalent;
* `continuous_within_at_Iio_iff_Iic`: two definitions of left continuity
  (with `(-∞, a)` and with `(-∞, a]`) are equivalent;
* `continuous_at_iff_continuous_left_right`, `continuous_at_iff_continuous_left'_right'` :
  a function is continuous at `a` if and only if it is left and right continuous at `a`.

## Tags

left continuous, right continuous
-/

open set filter
open_locale topological_space

section partial_order

variables {α β : Type*} [topological_space α] [partial_order α] [topological_space β]

lemma continuous_within_at_Ioi_iff_Ici {a : α} {f : α → β} :
  continuous_within_at f (Ioi a) a ↔ continuous_within_at f (Ici a) a :=
by simp only [← Ici_diff_left, continuous_within_at_diff_self]

lemma continuous_within_at_Iio_iff_Iic {a : α} {f : α → β} :
  continuous_within_at f (Iio a) a ↔ continuous_within_at f (Iic a) a :=
@continuous_within_at_Ioi_iff_Ici αᵒᵈ _ ‹topological_space α› _ _ _ f

end partial_order

variables {α β : Type*} [topological_space α] [linear_order α] [topological_space β]

lemma nhds_left_sup_nhds_right (a : α) :
  𝓝[≤] a ⊔ 𝓝[≥] a = 𝓝 a :=
by rw [← nhds_within_union, Iic_union_Ici, nhds_within_univ]

lemma nhds_left'_sup_nhds_right (a : α) :
  𝓝[<] a ⊔ 𝓝[≥] a = 𝓝 a :=
by rw [← nhds_within_union, Iio_union_Ici, nhds_within_univ]

lemma nhds_left_sup_nhds_right' (a : α) :
  𝓝[≤] a ⊔ 𝓝[>] a = 𝓝 a :=
by rw [← nhds_within_union, Iic_union_Ioi, nhds_within_univ]

lemma continuous_at_iff_continuous_left_right {a : α} {f : α → β} :
  continuous_at f a ↔ continuous_within_at f (Iic a) a ∧ continuous_within_at f (Ici a) a :=
by simp only [continuous_within_at, continuous_at, ← tendsto_sup, nhds_left_sup_nhds_right]

lemma continuous_at_iff_continuous_left'_right' {a : α} {f : α → β} :
  continuous_at f a ↔ continuous_within_at f (Iio a) a ∧ continuous_within_at f (Ioi a) a :=
by rw [continuous_within_at_Ioi_iff_Ici, continuous_within_at_Iio_iff_Iic,
  continuous_at_iff_continuous_left_right]


import data.nat.gcd

open nat
/-1. Let a and b be coprime positive integers (recall that coprime here means gcd(a, b) = 1).
I open a fast food restaurant which sells chicken nuggets in two sizes –
you can either buy a box with a nuggets in, or a box with b nuggets in.
Prove that there is some integer N with the property that for all integers m ≥ N,
it is possible to buy exactly m nuggets. -/
variables {a b N m c d : ℕ}

theorem chicken_mcnugget (hp: gcd a b = 1) (h1: a > 0) (h2 : b >0): ∃ N, ∀ m ≥ N, m = a*c + b*d := sorry


-- https://www.youtube.com/watch?v=8upRv9wjHp0
inductive A
| i : ℤ → A
| pred : A → A
| succ : A → A
| plus : A → A → A
| mult : A → A → A
.
open A

instance : has_one A := ⟨ A.i 1 ⟩
instance : has_add A := ⟨ A.plus ⟩

-- Natural semantics -- Big-step == Binary relation ↓ ⊆ A × ℤ
inductive natsem_A : A → ℤ → Prop
| r1 : ∀ i : ℤ, natsem_A (A.i i) i
| r2 : ∀ e i, natsem_A e i → natsem_A (pred e) (i - 1)
| r3 : ∀ e i, natsem_A e i → natsem_A (succ e) (i + 1)
| r4 : ∀ e₁ e₂ i j, (natsem_A e₁ i) → (natsem_A e₂ j) → natsem_A (plus e₁ e₂) (i + j)
| r5 : ∀ e₁ e₂ i j, (natsem_A e₁ i) → (natsem_A e₂ j) → natsem_A (plus e₁ e₂) (i * j)

notation a ` ⇓ ` b := natsem_A a b

example : (plus 4 (succ 2)) ⇓ 7 := sorry

--Evaluator semantics of A
def eval : A → ℤ
| (i x) := x
| (pred e) := (eval e) - 1
| (succ e) := (eval e) + 1
| (plus e₁ e₂) := (eval e₁) + (eval e₂)
| (mult e₁ e₂) := (eval e₁) * (eval e₂)

#reduce eval (plus 4 (succ 2))

-- SOS semantics of A == Binary relation ⟶ ⊆ A × A
inductive sossem_A : A → A → Prop
--axioms
| sos1 : ∀ i,   sossem_A (pred (A.i i)) (A.i (i - 1))           -- i:ℤ
| sos2 : ∀ i,   sossem_A (succ (A.i i)) (A.i (i + 1))
| sos3 : ∀ i j, sossem_A (plus (A.i i) (A.i j)) (A.i (i + j))
| sos4 : ∀ i j, sossem_A (mult (A.i i) (A.i j)) (A.i (i * j))
--contexts -- these contexts are known are the compatible closure
| sos05 : ∀ e₁ e₂,    sossem_A e₁ e₂ → sossem_A (pred e₁) (pred e₂)
| sos06 : ∀ e₁ e₂,    sossem_A e₁ e₂ → sossem_A (succ e₁) (succ e₂)
| sos07 : ∀ e₁ e₂ e₃, sossem_A e₁ e₂ → sossem_A (plus e₁ e₃) (plus e₂ e₃)
| sos08 : ∀ e₁ e₂ e₃, sossem_A e₁ e₂ → sossem_A (plus e₃ e₁) (plus e₃ e₂)
| sos09 : ∀ e₁ e₂ e₃, sossem_A e₁ e₂ → sossem_A (mult e₁ e₃) (mult e₂ e₃)
| sos10 : ∀ e₁ e₂ e₃, sossem_A e₁ e₂ → sossem_A (mult e₃ e₁) (mult e₃ e₂)

notation a ` ⟶ ` b := sossem_A a b

inductive sos_closure : A → A → Prop
| step : ∀ e₁ e₂, (e₁ ⟶ e₂) → sos_closure e₁ e₂
| reflexive : ∀ e, sos_closure e e
| transitive : ∀ e₁ e₂ e₃, sos_closure e₁ e₂ → sos_closure e₂ e₃ → sos_closure e₁ e₃

notation a ` ⟶* ` b := sos_closure a b

--I need something that extracts the value from A.i i in SOS
lemma natural_imp_sos : ∀ e i, (e ⇓ i) → (e ⟶* (A.i i)) := sorry
lemma sos_imp_natural : ∀ e i, (e ⟶* (A.i i)) → (e ⇓ i) := sorry

theorem natural_equivalent_sos : ∀ e i, (e ⇓ i) ↔ (e ⟶* (A.i i)) :=
begin
    intros, split; apply natural_imp_sos <|> apply sos_imp_natural
end

-- Reduction semantics of A
inductive axiom_redsem_A : A → A → Prop
--axioms
| red1 : ∀ i,   axiom_redsem_A (pred (A.i i)) (A.i (i - 1))           -- i:ℤ
| red2 : ∀ i,   axiom_redsem_A (succ (A.i i)) (A.i (i + 1))
| red3 : ∀ i j, axiom_redsem_A (plus (A.i i) (A.i j)) (A.i (i + j))
| red4 : ∀ i j, axiom_redsem_A (mult (A.i i) (A.i j)) (A.i (i * j))

inductive ctx
| hole
| pred : ctx → ctx
| succ : ctx → ctx
| plus {e}: ctx → e → ctx | Plus {e}: e → ctx → ctx
| mult {e}: ctx → e → ctx | Mult {e}: e → ctx → ctx


/- LoVe Exercise 12: Basic Mathematical Structures -/

import .lovelib
import .love12_basic_mathematical_structures_demo

namespace LoVe

set_option pp.beta true

/- Question 1: Type Classes -/

namespace btree

/- Recall the datatype `btree` we introduced earlier: -/

#check btree

/- The following function takes two trees and attaches copies of the second
tree to each leaf of the first tree. -/

def append {α : Type} : btree α -> btree α -> btree α
| empty          y := y
| (node a x₁ x₂) y := node a (append x₁ y) (append x₂ y)

#reduce append (node 1 empty empty) (node 2 empty empty)

/- 1.1. Prove the following two lemmas by induction on `x`. -/

lemma append_assoc {α : Type} (x y z : btree α) :
  append (append x y) z = append x (append y z) :=
begin
  induction x,
  case btree.empty {
    refl },
  case btree.node : a x₁ x₂ ih₁ ih₂ {
    simp [append, ih₁, ih₂] }
end

lemma append_empty {α : Type} (x : btree α) :
  append x empty = x :=
begin
  induction x,
  case btree.empty {
    refl },
  case btree.node : a x₁ x₂ ih₁ ih₂ {
    simp [append, ih₁, ih₂] }
end

/- 1.2. Declare btree an instance of `add_monoid` using `append` as addition
operator. -/

#print add_monoid

instance {α : Type} : add_monoid (btree α) :=
{ add       := append,
  add_assoc := append_assoc,
  zero      := empty,
  add_zero  := append_empty,
  zero_add  := begin intro x, refl end }

/- 1.3. Explain why `btree` with `append` as addition cannot be declared an
instance of `add_group`. -/

#print add_group

/- If `t₁` is a non-empty tree, `append t₁ t₂` will always yield a nonempty
tree. Therefore, there is no inverse of a non-empty tree. No matter what we
choose `neg`  to be, we will not able to prove `add_left_neg`. -/

/- 1.4. (**optional**) Prove the following lemma illustrating why this does not
constitute an `add_group`. -/

lemma example_no_inverse :
  ∃x : btree ℕ, ∀ y : btree ℕ, append y x ≠ empty :=
begin
  use node 0 empty empty,
  intros y hy,
  cases y,
  cases hy,
  cases hy
end

end btree

/- Question 2: Multisets and Finsets -/

/- Recall the following definitions from the lecture: -/

#check nodes_multiset
#check nodes_finset
#check nodes_list

/- 2.1. Prove that the multiset of nodes does not change when mirroring a tree.

Hint: Use induction on t and `ac_refl`. -/

lemma nodes_multiset_mirror (t : btree ℕ) :
  nodes_multiset (mirror t) = nodes_multiset t :=
begin
  induction t with a t₁ t₂ h₁ h₂,
  refl,
  rw nodes_multiset,
  rw mirror,
  rw [←h₁, ←h₂],
  rw nodes_multiset,
  ac_refl
end

/- 2.2. Prove that the finset of nodes does not change when mirroring a tree.

Hint: Use induction on t and `ac_refl`. -/

example (t : btree ℕ) :
  nodes_finset (mirror t) = nodes_finset t :=
begin
  induction t with a t₁ t₂ h₁ h₂,
  refl,
  rw nodes_finset,
  rw mirror,
  rw [←h₁, ←h₂],
  rw nodes_finset,
  ac_refl
end

/- 2.3. Prove that this does not hold for the list of nodes by providing an
example of a btree `t` for which `nodes_list t ≠ nodes_list (mirror t)`.

Hint: If you define a suitable counterexample, the proof below will succeed
without modifying it. -/

def counterexample : btree ℕ :=
node 0 (node 1 empty empty) (node 2 empty empty)

#reduce nodes_list counterexample
#reduce nodes_list (mirror counterexample)

example :
  ∃t : btree ℕ, nodes_list t ≠ nodes_list (mirror t) :=
begin
  use counterexample,
  exact dec_trivial
end

end LoVe


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

Elegant pairing function.
-/
import data.nat.sqrt
open prod decidable

namespace nat

/-- Pairing function for the natural numbers. -/
def mkpair (a b : ℕ) : ℕ :=
if a < b then b*b + a else a*a + a + b

/-- Unpairing function for the natural numbers. -/
def unpair (n : ℕ) : ℕ × ℕ :=
let s := sqrt n in
if n - s*s < s then (n - s*s, s) else (s, n - s*s - s)

@[simp] theorem mkpair_unpair (n : ℕ) : mkpair (unpair n).1 (unpair n).2 = n :=
let s := sqrt n in begin
  dsimp [unpair], change sqrt n with s,
  have sm : s * s + (n - s * s) = n := nat.add_sub_cancel' (sqrt_le _),
  by_cases h : n - s * s < s; simp [h, mkpair],
  { exact sm },
  { have hl : n - s*s - s ≤ s :=
      nat.sub_le_left_of_le_add (nat.sub_le_left_of_le_add $
      by rw ← add_assoc; apply sqrt_le_add),
    suffices : s * s + (s + (n - s * s - s)) = n, {simpa [not_lt_of_ge hl]},
    rwa [nat.add_sub_cancel' (le_of_not_gt h)] }
end

theorem mkpair_unpair' {n a b} (H : unpair n = (a, b)) : mkpair a b = n :=
by simpa [H] using mkpair_unpair n

@[simp] theorem unpair_mkpair (a b : ℕ) : unpair (mkpair a b) = (a, b) :=
begin
  by_cases a < b; simp [h, mkpair],
  { show unpair (a + b * b) = (a, b),
    have be : sqrt (a + b * b) = b,
    { rw [add_comm, sqrt_add_eq],
      exact le_trans (le_of_lt h) (le_add_left _ _) },
    simp [unpair, be, nat.add_sub_cancel, h] },
  { show unpair (a + (b + a * a)) = (a, b),
    have ae : sqrt (a + (b + a * a)) = a,
    { rw [← add_assoc, add_comm, sqrt_add_eq],
      exact add_le_add_left (le_of_not_gt h) _ },
    have : a ≤ a + (b + a * a) - a * a,
    { rw nat.add_sub_assoc (nat.le_add_left _ _), apply nat.le_add_right },
    simp [unpair, ae, not_lt_of_ge this],
    show a + (b + a * a) - a * a - a = b,
    rw [nat.add_sub_assoc (nat.le_add_left _ _),
        nat.add_sub_cancel, nat.add_sub_cancel_left] }
end

theorem unpair_lt {n : ℕ} (n1 : n ≥ 1) : (unpair n).1 < n :=
let s := sqrt n in begin
  simp [unpair], change sqrt n with s,
  by_cases h : n - s * s < s; simp [h],
  { exact lt_of_lt_of_le h (sqrt_le_self _) },
  { simp at h,
    have s0 : s > 0 := sqrt_pos.2 n1,
    exact lt_of_le_of_lt h (nat.sub_lt_self n1 (mul_pos s0 s0)) }
end

theorem unpair_le_left : ∀ (n : ℕ), (unpair n).1 ≤ n
| 0     := dec_trivial
| (n+1) := le_of_lt (unpair_lt (nat.succ_pos _))

theorem le_mkpair_left (a b : ℕ) : a ≤ mkpair a b :=
by simpa using unpair_le_left (mkpair a b)

theorem le_mkpair_right (a b : ℕ) : b ≤ mkpair a b :=
by by_cases h : a < b; simp [mkpair, h];
   [exact le_trans (le_mul_self _) (le_add_left _ _),
    exact le_trans (le_add_right _ _) (le_add_left _ _)]

theorem unpair_le_right (n : ℕ) : (unpair n).2 ≤ n :=
by simpa using le_mkpair_right n.unpair.1 n.unpair.2

theorem mkpair_lt_mkpair_left {a₁ a₂} (b) (h : a₁ < a₂) : mkpair a₁ b < mkpair a₂ b :=
begin
  by_cases h₁ : a₁ < b; simp [mkpair, h₁],
  { by_cases h₂ : a₂ < b; simp [mkpair, h₂, h],
    simp at h₂,
    exact add_lt_add_of_lt_of_le (lt_of_lt_of_le h₁ h₂)
      (le_trans (mul_self_le_mul_self h₂) (le_add_left _ _)) },
  { simp at h₁,
    simp [not_lt_of_gt (lt_of_le_of_lt h₁ h)],
    exact add_lt_add h (add_lt_add_left (mul_self_lt_mul_self h) _) }
end

theorem mkpair_lt_mkpair_right (a) {b₁ b₂} (h : b₁ < b₂) : mkpair a b₁ < mkpair a b₂ :=
begin
  by_cases h₁ : a < b₁; simp [mkpair, h₁],
  { simp [mkpair, lt_trans h₁ h, h],
    exact mul_self_lt_mul_self h },
  { by_cases h₂ : a < b₂; simp [mkpair, h₂, h],
    simp at h₁,
    rwa [add_comm, ← sqrt_lt, sqrt_add_eq],
    exact le_trans h₁ (le_add_left _ _) }
end

end nat


import tactic
import data.real.basic
import data.int.gcd
import number_theory.padics
import data.nat.prime_norm_num

/-!

## Exercises about numbers and casts

-/

/-!

## First exercises

These first examples are just to get you comfortable with
`norm_num`, `norm_cast`, and friends.

-/

example : 12345 < 67890 :=
begin
  norm_num
end

example {α : Type} [linear_ordered_field α] : 123 + 45 < 67890/3 :=
begin
  norm_num
end

example : nat.prime 17 :=
begin
  norm_num
end

-- prove either this or its negation!
example : ¬ 7/3 > 2 :=
begin
  norm_num
end

example (x : ℝ) (hx : x < 50*50) : x < 25*100 :=
begin
  norm_num at hx ⊢,
  assumption
end

example (x : ℤ) (hx : (x : ℝ) < 25*100) : x < 25*100 :=
begin
  assumption_mod_cast
end

example (x : ℤ) (hx : (x : ℝ) < 2500) : x < 25*100 :=
begin
  norm_num,
  assumption_mod_cast
end

example (p q r : ℕ) (h : r < p - q) (hpq : q ≤ p) : (r : ℝ) < p - q :=
begin
  exact_mod_cast h,
end

example (p q r : ℕ) (hr : r < p + 2 - p) : (r : ℤ) < 5 :=
begin
  have : p ≤ p + 2, by linarith,
  zify [this] at hr,
  linarith
end

/-!

## Exercise 2

This comes from the development of the p-adic numbers.
`norm_cast` is very useful here, since we need to talk about values in
ℕ, ℤ, ℚ, ℚ_p, and ℤ_p.

We've done some work to get you started. You might look for the lemmas:
-/

open padic_val_rat

#check zpow_le_of_le
#check zpow_nonneg
#check of_int_multiplicity

example {p n : ℕ} (hp : p.prime) {z : ℤ} (hd : ↑(p^n) ∣ z) : padic_norm p z ≤ ↑p ^ (-n : ℤ) :=
begin
  -- this lemma will be useful later in the proof.
  -- ignore the "inst" argument; just use `apply aux_lemma` when you need it!
  have aux_lemma : ∀ inst, (n : ℤ) ≤ (multiplicity ↑p z).get inst,
  { intro,
    norm_cast,
    rw [← part_enat.coe_le_coe, part_enat.coe_get],
    apply multiplicity.le_multiplicity_of_pow_dvd,
    assumption_mod_cast },

  unfold padic_norm, split_ifs with hz hz,
  { apply zpow_nonneg,
    exact_mod_cast le_of_lt hp.pos },
  { apply zpow_le_of_le,
    exact_mod_cast le_of_lt hp.one_lt,
    apply neg_le_neg,
    rw of_int_multiplicity hp.ne_one _,
    { apply aux_lemma },
    { assumption_mod_cast } }
end

/-!

## Exercise 3

This seems like a very natural way to write the theorem
"If `a` and `b` are coprime, then there are coefficients `u` and `v` such that `u*a + v*b = 1`."

But I've made a mistake! What did I do wrong? Correct the statement of the theorem and prove it.

I've started you off with a lemma that will be useful.
You might find the `specialize` tactic to be handy as well:
if you have `h : ∀ (x y : T), R x y` and `a, b : T` in the context, then
`specialize h a b` will change the type of `h` to `R a b`.

If you want to peek at the definition of coprime, you can use
`unfold nat.coprime at h`.

-/

-- notice that I've changed the existential to be over ℤ!
example (p q : ℕ) (h : nat.coprime p q) : ∃ u v : ℤ, u*p+v*q = 1 :=
begin
  have := nat.gcd_eq_gcd_ab,
  specialize this p q,
  unfold nat.coprime at h,
  rw h at this,
  norm_cast at this,
  use [p.gcd_a q, p.gcd_b q],
  rw this,
  ring
end

/-!

## Exercise 4

We did an example together that was similar to this.

This one takes a bit more arithmetic work.
To save you some time, here are some lemmas that may be useful!
(You may not need all of them, depending on how you approach it.)

Remember you can also use `library_search` to try to find useful lemmas.

A hint: you might find it helpful to do this once you've introduced `n`.
```
have n_pos: 0 < n,
{ ... }
```

-/

#check sub_le_iff_le_add
#check add_le_add_iff_left
#check div_le_iff
#check mul_one_div_cancel
#check mul_le_mul_left

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

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

example : seq_limit (λ n : ℕ, (n+1)/n) 1 :=
begin
  -- we start like before
  intros ε ε_pos,
  dsimp,

  -- the witness to the existential must be a nat: use `nat.ceil` instead of `ceil`!
  use nat.ceil (1/ε),
  intros n hn,

  -- this proof is used a few times below, so we separate it as an assumption
  have n_pos : 0 < n,
    -- I've written the proofs of the calc block separately, but you could inline them
  { calc 0 < nat.ceil (1/ε) : _
       ... ≤ n : _,
    { rw nat.lt_ceil, simp, assumption },
    { assumption } },

  -- this chain of rewrites generates some side conditions that we get rid of below
  rw [abs_of_nonneg, sub_le_iff_le_add, div_le_iff, add_mul, one_mul,
      add_comm _ (n : ℝ), add_le_add_iff_left],

  -- this calc proof finishes the "main goal"
  { calc 1 = ε * (1/ε) : _
       ... ≤ ε * nat.ceil (1/ε) : _
       ... ≤ ε * n : _,
    { symmetry, apply mul_one_div_cancel, linarith },
    { rw mul_le_mul_left ε_pos, apply nat.le_ceil },
    { rw mul_le_mul_left ε_pos, exact_mod_cast hn } },

  -- we try to discharge the side conditions with as little work as possible
  { assumption_mod_cast },
  { field_simp,
    rw one_le_div; norm_cast; linarith }
end


import data.real.basic
import order.filter.at_top_bot
import order.liminf_limsup
import topology.metric_space.basic
import topology.algebra.order.monotone_convergence
import topology.instances.nnreal

open_locale filter topological_space

theorem real.exists_is_glb {S : set ℝ} (hne : S.nonempty) (hbdd : bdd_below S) :
  ∃ x, is_glb S x :=
begin
  set T := - S with hT,
  have hT_ne : T.nonempty := set.nonempty_neg.mpr hne,
  have hT_bdd : bdd_above T := bdd_above_neg.mpr hbdd,
  use -classical.some (real.exists_is_lub T hT_ne hT_bdd),
  simpa [← is_lub_neg] using (classical.some_spec (real.exists_is_lub T hT_ne hT_bdd)),
end

/- lemma le_of_is_lub {α : Type*} [preorder α] (S : set α) (B : α) (hB : is_lub S B) :
  ∀ s ∈ S, s ≤ B :=
begin
  intros s hs,
  simp [is_lub, is_least, mem_upper_bounds] at hB,
  exact hB.1 s hs,
end
 -/
lemma filter.tendsto_of_is_bounded_monotone {f : ℕ → ℝ} (h_bdd : bdd_above (set.range f))
  (h_mon : monotone f) : ∃ r : ℝ, filter.tendsto f filter.at_top (𝓝 r) :=
begin
  obtain ⟨B, hB⟩ := (real.exists_is_lub ((set.range f)) (set.range_nonempty f) h_bdd),
  use B,
  exact tendsto_at_top_is_lub h_mon hB,
end

lemma real.tendsto_of_is_bounded_antitone {f : ℕ → ℝ} (h_bdd : bdd_below (set.range f))
  (h_ant : antitone f) : ∃ r : ℝ, filter.tendsto f filter.at_top (𝓝 r) :=
begin
  obtain ⟨B, hB⟩ := (real.exists_is_glb (set.range_nonempty f) h_bdd),
  use B,
  exact tendsto_at_top_is_glb h_ant hB,
end

lemma nnreal.tendsto_of_is_bounded_antitone {f : ℕ → nnreal} (h_bdd : bdd_below (set.range f))
  (h_ant : antitone f) : ∃ r : nnreal, filter.tendsto f filter.at_top (𝓝 r) :=
begin
  have h_bdd_0 : (0 : ℝ) ∈ lower_bounds (set.range (λ (n : ℕ), (f n : ℝ))),
  { intros r hr,
    obtain ⟨n, hn⟩ := set.mem_range.mpr hr,
    simp_rw [← hn],
    exact nnreal.coe_nonneg _ },
  have h_bdd : bdd_below (set.range (λ n, (f n : ℝ))) := ⟨0, h_bdd_0⟩,
  obtain ⟨L, hL⟩ := real.tendsto_of_is_bounded_antitone h_bdd h_ant,
  have hL0 : 0 ≤ L,
  { have h_glb : is_glb (set.range (λ n, (f n : ℝ))) L := is_glb_of_tendsto_at_top h_ant hL,
    exact (le_is_glb_iff h_glb).mpr h_bdd_0 },
  use ⟨L, hL0⟩,
  rw ← nnreal.tendsto_coe,
  exact hL,
end


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

Elegant pairing function.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.sqrt
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

namespace nat

/-- Pairing function for the natural numbers. -/
def mkpair (a : ℕ) (b : ℕ) : ℕ := ite (a < b) (b * b + a) (a * a + a + b)

/-- Unpairing function for the natural numbers. -/
def unpair (n : ℕ) : ℕ × ℕ :=
  let s : ℕ := sqrt n;
  ite (n - s * s < s) (n - s * s, s) (s, n - s * s - s)

@[simp] theorem mkpair_unpair (n : ℕ) : mkpair (prod.fst (unpair n)) (prod.snd (unpair n)) = n :=
  sorry

theorem mkpair_unpair' {n : ℕ} {a : ℕ} {b : ℕ} (H : unpair n = (a, b)) : mkpair a b = n := sorry

@[simp] theorem unpair_mkpair (a : ℕ) (b : ℕ) : unpair (mkpair a b) = (a, b) := sorry

theorem unpair_lt {n : ℕ} (n1 : 1 ≤ n) : prod.fst (unpair n) < n := sorry

theorem unpair_le_left (n : ℕ) : prod.fst (unpair n) ≤ n :=
  nat.cases_on n (idRhs (prod.fst (unpair 0) ≤ 0) (of_as_true trivial))
    fun (n : ℕ) => idRhs (prod.fst (unpair (n + 1)) ≤ n + 1) (le_of_lt (unpair_lt (succ_pos n)))

theorem le_mkpair_left (a : ℕ) (b : ℕ) : a ≤ mkpair a b := sorry

theorem le_mkpair_right (a : ℕ) (b : ℕ) : b ≤ mkpair a b := sorry

theorem unpair_le_right (n : ℕ) : prod.snd (unpair n) ≤ n := sorry

theorem mkpair_lt_mkpair_left {a₁ : ℕ} {a₂ : ℕ} (b : ℕ) (h : a₁ < a₂) : mkpair a₁ b < mkpair a₂ b :=
  sorry

theorem mkpair_lt_mkpair_right (a : ℕ) {b₁ : ℕ} {b₂ : ℕ} (h : b₁ < b₂) :
    mkpair a b₁ < mkpair a b₂ :=
  sorry

end nat

namespace set

theorem Union_unpair_prod {α : Type u_1} {β : Type u_2} {s : ℕ → set α} {t : ℕ → set β} :
    (Union fun (n : ℕ) => set.prod (s (prod.fst (nat.unpair n))) (t (prod.snd (nat.unpair n)))) =
        set.prod (Union fun (n : ℕ) => s n) (Union fun (n : ℕ) => t n) :=
  sorry

end Mathlib


/- LoVe Homework 5: Inductive Predicates -/

import .lovelib

namespace LoVe

/- Question 1: Lambda-Terms -/

/- Recall the following type of λ-terms from question 3 of exercise 4. -/

inductive lam : Type
| var : string → lam
| abs : string → lam → lam
| app : lam → lam → lam

export lam (var abs app)

/- 1.1. Define an inductive predicate `is_abs` that returns true if and only if
its argument has an `abs` constructor at the top level. -/

-- enter your definition here

/- 1.2. Define an inductive predicate `is_βnf` that determines whether a lambda
term is in β-normal form (https://en.wikipedia.org/wiki/Beta_normal_form).

Hint: Use `is_abs` somewhere. -/

-- enter your definition here

/- Question 2: Transitive Closure -/

/- In mathematics, the transitive closure `R+` of a binary relation `R` over a
set `A` can be defined as the smallest solution satisfying the following rules:

    (base) for all a, b ∈ A, if a R b, then a R+ b;
    (step) for all a, b, c ∈ A, if a R b and b R+ c, then a R+ c.

In Lean, we can define this concept as follows, by identifying the set `A` with
the type `α`: -/

inductive tc₁ {α : Type} (r : α → α → Prop) : α → α → Prop
| base : ∀a b, r a b → tc₁ a b
| step : ∀a b c, r a b → tc₁ b c → tc₁ a c

/- 2.1. Rule `(step)` makes it convenient to extend transitive chains by adding
links to the left. Another way to define the transitive closure `R+` would use
the following rule instead of `(step)`, with a preference for the right:

    (pets) for all a, b, c ∈ A, if a R+ b and b R c, then a R+ c.

Define a predicate `tc₂` that embodies this alternative definition. -/

-- enter your definition here

/- 2.2. Yet another definition of the transitive closure `R+` would use the
following symmetric rule instead of `(step)` or `(pets)`:

    (trans) for all a, b, c ∈ A, if a R+ b and b R+ c, then a R+ c.

Define a predicate `tc₃` that embodies this alternative definition. -/

-- enter your definition here

/- 2.3. Prove that `(step)` also holds as a lemma about `tc₃`. -/

lemma tc₃_step {α : Type} (r : α → α → Prop) (a b c : α) (rab : r a b)
    (tbc : tc₃ r b c) :
  tc₃ r a c :=
sorry

/- 2.4 (**optional**). Prove by rule induction on the `tc₁ r a b` premise below
that `(pets)` also holds as a lemma about `tc₁` as defined above.  -/

lemma tc₁_pets {α : Type} (r : α → α → Prop) (c : α) :
  ∀a b, tc₁ r a b → r b c → tc₁ r a c :=
sorry

/- 2.5 (**optional**). Prove by rule induction that `(trans)` also holds as a
lemma about `tc₁`. -/

lemma tc₁_trans {α : Type} (r : α → α → Prop) (c : α) :
  ∀a b : α, tc₁ r a b → tc₁ r b c → tc₁ r a c :=
sorry

end LoVe


import .love10_denotational_semantics_demo

/- # LoVe Exercise 10: Denotational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Monotonicity

1.1. Prove the following lemma from the lecture. -/

lemma monotone_comp {α β : Type} [partial_order α] (f g : α → set (β × β))
    (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
sorry

/- 1.2. Prove its cousin. -/

lemma monotone_restrict {α β : Type} [partial_order α] (f : α → set (β × β))
    (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
sorry

/- ## Question 2: Regular Expressions

__Regular expressions__, or __regexes__, are a highly popular tool for software
development, to analyze textual inputs. Regexes are generated by the following
grammar:

    R ::= ∅
        | ε
        | a
        | R ⬝ R
        | R + R
        | R*

Informally, the semantics of regular expressions is as follows:

* `∅` accepts nothing;
* `ε` accepts the empty string;
* `a` accepts the atom `a`;
* `R ⬝ R` accepts the concatenation of two regexes;
* `R + R` accepts either of two regexes;
* `R*` accepts arbitrary many repetitions of a regex.

Notice the rough correspondence with a WHILE language:

    `∅` ~ diverging statement (e.g., `while true do skip`)
    `ε` ~ `skip`
    `a` ~ `:=`
    `⬝` ~ `;`
    `+` ~ `if then else`
    `*` ~ `while` loop -/

inductive regex (α : Type) : Type
| nothing {} : regex
| empty {}   : regex
| atom       : α → regex
| concat     : regex → regex → regex
| alt        : regex → regex → regex
| star       : regex → regex

/- In this exercise, we explore an alternative semantics of regular
expressions. Namely, we can imagine that the atoms represent binary relations,
instead of letters or symbols. Concatenation corresponds to composition of
relations, and alternation is union. Mathematically, regexes and binary
relations are both instances of Kleene algebras.

2.1. Complete the following translation of regular expressions to relations.

Hint: Exploit the correspondence with the WHILE language. -/

def rel_of_regex {α : Type} : regex (set (α × α)) → set (α × α)
| regex.nothing        := ∅
| regex.empty          := Id
| (regex.atom s)       := s
-- enter the missing cases here

/- 2.2. Prove the following recursive equation about your definition. -/

lemma rel_of_regex_star {α : Type} (r : regex (set (α × α))) :
  rel_of_regex (regex.star r) =
  rel_of_regex (regex.alt (regex.concat r (regex.star r)) regex.empty) :=
sorry

end LoVe


import data.nat.basic
open nat

-- 1
example : ∀ m n k : nat, m * (n + k) = m * n + m * k :=
assume m n k,
nat.rec_on k
    (show m*(n + 0) = m*n + m*0, from calc
    m*(n + 0) = m*n : by rw add_zero
          ... = m*n + 0 : by rw add_zero
          ... = m*n + m*0 : by rw mul_zero
    )
    (assume k,
    assume ih: m*(n + k) = m*n + m*k,
    show m*(n + succ k) = m*n + m*(succ k), from calc
    m*(n + succ k) = m*(succ(n + k)) : by rw add_succ
               ... = m*(n + k) + m : by rw mul_succ
               ... = m*n + m*k + m : by rw ih
               ... = m*n + (m*k + m) : by rw add_assoc
               ... = m*n + m*(succ k) : by rw mul_succ
    )

-- 2
example : ∀ n : nat, 0 * n = 0 :=
assume n,
nat.rec_on n
    (show 0*0 = 0, by rw mul_zero)
    (assume n,
    assume ih: 0*n = 0,
    show 0*(succ n) = 0, from calc
    0*(succ n) = 0*n + 0 : by rw mul_succ
         ...   = 0 + 0 : by rw ih
         ...   = 0 : by rw add_zero
    )

-- 3
example : ∀ n : nat, 1 * n = n :=
assume n,
nat.rec_on n
    (show 1*0 = 0, from mul_zero 1)
      (assume n,
    assume ih: 1*n = n,
    show 1*(succ n) = succ n, from calc
    1*(succ n) = 1*n + 1 : by rw mul_succ
           ... = n + 1 : by rw ih
           ... = succ n : by simp
      )

-- 4
example : ∀ m n k : nat, (m * n) * k = m * (n * k) :=
assume m n k,
nat.rec_on k
    (show (m*n)*0 = m*(n*0), by rw
    [mul_zero,mul_zero,mul_zero])
    (assume k,
    assume ih : (m * n) * k = m * (n * k),
    show (m * n) * (succ k) = m * (n * (succ k)), from calc
    (m * n) * (succ k) = (m*n)*k + (m*n) : by rw mul_succ
                   ... = m * (n * k) + m * n : by rw ih
                   ... = m * (n*k + n) : by rw left_distrib
                   ... = m * (n*(succ k)) : by rw mul_succ
                   ... = m * (n * succ k) : by simp
    )

-- 5
example : ∀ m n : nat, m * n = n * m :=
assume m n,
nat.rec_on n
    (show m*0 = 0*m, by rw [mul_zero,zero_mul])
    (assume n,
    assume ih : m*n = n*m,
    show m*(succ n) = (succ n)*m, from calc
    m*(succ n) = m*n + m : by rw mul_succ
           ... = n*m + m : by rw ih
           ... = n*m + 1*m : by rw one_mul
           ... = (n + 1)*m : by rw right_distrib
           ... = (succ n)*m : by simp
    )


/-
HOMEWORK #9
REESE ALLEN (rga2uz)
-/

/-
Prove the following. Note that you can read each of
the propositions to be proved as either a logical
statement or as simply a function definition. Use
what you already know about the latter to arrive
at a proof, and then understand the proof as one
that shows that the logical statement is true.
-/

theorem t1 {P Q : Prop} (p2q : P → Q) (p : P) : Q :=
  p2q p

theorem t2 {P Q R : Prop} (p2q : P → Q) (q2r : Q → R): P → R :=
  assume p : P,
  q2r (p2q p)

/-
Use "example" to state and prove the preceding two
theorems but using "cases" style notation rather
than C-style. Remember, "example" is a way to state
a proposition/type and give an example of a value.
Here's an example of the use of "example". Give
your answers following this example.
-/

example : ∀ (P Q : Prop), (P → Q) → P → Q :=
λ P Q p2q p, p2q p

example : ∀ ( P Q R: Prop), (P → Q) → (Q → R) → P → R :=
λ P Q R p2q q2r p, q2r (p2q p)

-- could also structure examples like this..
example : ∀ ( P Q : Prop), (P → Q) → P → Q
| P Q p2q p := p2q p

example : ∀ (P Q R : Prop), (P → Q) → (Q → R) → P → R
| P Q R p2q q2r p := q2r (p2q p)

/-
Now give English-language versions of your two proofs.

theorem t1:
If we want to prove for any two arbitrary propositions P and Q that if P implies
Q then, given P, we can derive a proof of Q (or P implies Q), we assume that we
are given a proof of P to Q and a proof of P. We apply the proof of P to Q to the
proof of P to get a proof of Q.

"If we assume that Jim's leg being broken means that he walks with a limp,
then if we know it is true that Jim's leg is broken, we can deduce that he
walks with a limp."

theorem t2:
If we want to prove for any propositions P, Q, and R that if P implies Q and
Q implies R then P implies R, we assume that we are given three arbitray propositions
and that we have a proof of P implies Q and a proof of Q implies R. Now to show that P
implies R, we assume P is true and that we have a proof of it. We apply the proof of
P to Q to the proof of P to get a proof of Q. Now that we have a proof of Q, we appply
the proof of Q to R to the proof of Q to finally arrive at a proof of R.

"If we assume that Jim's leg being broken means he walks with a limp and that Jim walking
with a limp means that he is in pain, then if we know Jim's leg is broken, we can deduce
that Jim is in pain"
-/

/-
Prove the following using case analysis on one
of the arguments (i.e., use match...with...end
at a key point in your proof). Use "cases" style
notation.
-/
theorem t3 : ∀ (P : Prop), false → P
| P f := match f with
        | f := false.elim f
        end

-- could also do this..
theorem t3' : ∀ (P : Prop), false → P
| P f := match f with end

-- or this..
theorem t3'' : ∀ (P : Prop), false → P
| P f := false.elim f

/-
Prove false → true by applying t3 to a proposition.
You have to figure out which one.
-/
theorem t4 : false → true := t3 true

/-
Define t5 to be the same as t3 but with P taken as
an implicit argument.
-/
theorem t5 : ∀ {P : Prop}, false → P
| P f := false.elim f

/-
Define t6 to be a proof of false → true by
applying t5 to the right argument(s).
-/
theorem t6 : false → true := λ (p : false), t5 p

/-
That is almost magic. In English, t3 proves
that false implies *any* proposition, so just
*apply* t3 to *true* in particular, but use t5
instead of t3.

What you see here is really important: Once
we've proved a general theorem (a ∀ proposition)
we can *apply the proof* to any *particular* case
to yield a proof for that specific case. This is
the elimination rule for ∀. It is also known as
universal instantiation (UI).
-/

/-
Next we see the idea that test cases are really
just equality propositions to be proved. Here,
for example, is a definition of the factorial
function.
-/

def fac : ℕ → ℕ
| 0 := 1
| (n' + 1) := (n' + 1) * fac n'

/-
Use "example" to write test cases for the
first ten natural number arguments to this
function.
-/

example : fac 0 = 1 := eq.refl 1
example : fac 1 = 1 := eq.refl _  -- Inferred
example : fac 2 = 2 := rfl        -- Shorthand
#check @rfl           -- infers type and value

example : fac 3 = 6 := rfl
example : fac 4 = 24 := rfl
example : fac 5 = 120 := rfl

/-
Insight: A test case is an equality proposition.
It is proved by "running" the program under test
to reduce the application of the function to input
arguments to produce an output that is then asserted
to be equal to an expected output.

In many cases, all we have to do is to simplify
the expressions on each side of the eq to see if
they reduce to exactly the same value. If so, we
can *apply* eq.refl (a universal generalization!)
to that value. Using rfl we can avoid even having
to type that value in cases where Lean can infer
it.
-/

/-
The next problem requires that you give a proof of
a bi-implication, a proposition whose connective is
↔. To prove a bi-implication requires that one prove
an implication in each direction.

Here you are asked to prove P ∧ Q ↔ Q ∧ P. What this
formula asserts is that ∧ is commutative. To construct
a proof of this proposition you will have to apply
iff.intro to two smaller proofs, one of P → Q and
and of Q → P.

Start by "assuming" that P and Q are arbitary but
specific propositions (∀ introduction), then apply
iff.intro to two "stubbed out" arguments (underscores).
We suggest that you put the underscores in parentheses
on different lines. Then recursively fill in each of
these stubs with the required types of proofs. Study
the context that Lean shows you in its Messages panel
to see what you have to work with at each point in
your proof constructions.
-/
theorem t7 : ∀ {P Q : Prop}, P ∧ Q ↔ Q ∧ P :=
λ (P Q : Prop),
iff.intro
(λ (pq : and P Q), and.intro (pq.right) (pq.left))
(λ (qp : and Q P), and.intro (qp.right) (qp.left))

/-
In English, when asked to prove P ↔ Q, one says, "it
will suffice to show P → Q and then to show Q → P." One
then goes on to give a proof of each implication. It
then follows from iff.intro that a proof of P ↔ Q can
be constructed, proving the bi-implication.
-/

/-
The trick here is to do case analysis on porq
(use match ... with ... end) and to show that
a proof of R can be constructed *in either case*.
-/
theorem t8 {P Q R : Prop} (p2r : P → R) (q2r : Q → R) (porq : P ∨ Q) : R :=
match porq with
|or.inl P := p2r P
|or.inr Q := q2r Q
end

theorem t8' {P Q R : Prop} (p2r : P → R) (q2r : Q → R) (porq : P ∨ Q) : R :=
or.elim porq p2r q2r

/-
We suggest that you use  "let ... in" to give
names to intermediate results that you then combine
in a final expression to finish the proof.
-/
-- if P implies Q, then it can't be that P is true and not Q is true
-- ¬ (P ∧ ¬ Q) means (P ∧ ¬ Q) → false

theorem t9 : ∀ (P Q: Prop), (P → Q) → ¬ (P ∧ ¬ Q) :=
λ P Q,
λ (p2q : P → Q),
λ (pnq),
let p := pnq.left in
let nq := pnq.right in
let q := p2q p in
nq q

theorem neg_elim' : ∀ (P : Prop), ¬ ¬ P → P :=
λ P,
λ nnp,
_           -- STUCK!!

theorem neg_elim : ∀ (P : Prop), (P ∨ ¬ P) → (¬ ¬ P → P):=
λ P,
    λ h : (P ∨ ¬ P),
        λ (nnp : ¬ ¬ P),
            match h with
            | or.inl p := p
            | or.inr np := false.elim (nnp np)
            end

theorem t10 : ∀ (P : Prop), P ∨ ¬ P :=
classical.em

theorem t11 : ∀ (P Q : Prop), ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
λ P Q,
    iff.intro
        (λ not_porq,
            match (classical.em P) with
            | or.inl p := false.elim (not_porq (or.inl p))
            | or.inr np := match (classical.em Q) with
                           | or.inl q := false.elim (not_porq (or.inr q))
                           | or.inr nq := and.intro np nq
                           end
            end
        )
        (
          λ npandnq,
            match npandnq with
            | and.intro np nq := λ (porq : P ∨ Q),
                          match porq with
                          | or.inl p := np p
                          | or.inr q := nq q
                          end
          end
        )

theorem t12 : ∀ (P Q : Prop), ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q :=
λ P Q,
iff.intro
(
λ not_pandq,
    match (classical.em P) with
    | or.inl p := match (classical.em Q) with
                  | or.inl q := false.elim (not_pandq (and.intro p q) )
                  | or.inr nq := or.inr nq
                  end
    | or.inr np := or.inl np
    end
)
(
λ npandnq,
λ porq,
  match npandnq with
  |or.inl np := let p := porq.left in
      np p
  |or.inr nq := let q := porq.right in
      nq q
  end
)

/-
For the following exercises, we assume that there is
a type called Person and a binary relation, Likes, on
pairs of people.
-/
axiom Person : Type
axiom Likes : Person → Person → Prop

theorem t13 :
  (∃ (p : Person), ∀ (q : Person), Likes q p) →
  (∀ (p : Person), ∃ (q : Person), Likes p q) :=
λ h,
    match h with
    | exists.intro p pf :=
        λ q,
            (exists.intro p (pf q))
    end


import data.matrix.basic
import linear_algebra.matrix
import linear_algebra.eigenspace

variables {γ : Type*} [fintype γ] [decidable_eq γ]
variables {μ : Type*} [fintype μ] [decidable_eq μ]
variables {R : Type*}

open_locale big_operators
open_locale matrix

namespace matrix

-- Properties of symmetric matrices.

def symmetric (M : matrix γ γ R) : Prop :=
∀ i j, M i j = M j i

lemma symmetric_diagonal [ring R] (D : γ → R)
: symmetric (diagonal D) :=
begin
  intros i j, unfold diagonal, by_cases (i = j),
  { split_ifs, { rw h, }, { exfalso, exact h_1 h.symm, }, },
  { split_ifs, { exfalso, exact h h_1.symm, }, { refl, }, },
end

lemma symmetric_sum
  [ring R]
  {A B : matrix γ γ R}
  (hA : symmetric A) (hB : symmetric B)
: symmetric (A + B) :=
begin
  intros i j, simp, rw [hA i j, hB i j],
end

lemma symmetric_LDLT
  [comm_ring R] (L : matrix γ γ R) (h : symmetric L) (D : γ → R)
: symmetric (Lᵀ ⬝ diagonal D ⬝ L) :=
begin
  intros i j, rw ←matrix.transpose_apply (Lᵀ ⬝ diagonal D ⬝ L) j i,
  rw [matrix.transpose_mul _ L, matrix.transpose_mul Lᵀ _],
  rw [matrix.diagonal_transpose, matrix.transpose_transpose],
  rw [matrix.mul_assoc],
end

-- Properties of the dot product.
-- TODO: to_mathlib

variable [linear_ordered_comm_ring R]

lemma dot_product_of_nonneg {v w : γ → R} (hv : 0 ≤ v) (hw : 0 ≤ w) : 0 ≤ dot_product v w :=
begin
  simp only [dot_product], apply finset.sum_nonneg, intros x hx,
  exact mul_nonneg (hv x) (hw x),
end

lemma vec_mul_self_nonneg (v : γ → R) : 0 ≤ v * v :=
λ i, mul_self_nonneg (v i)

lemma dot_product_diagonal_mul_vec_eq (d v w : γ → R) :
dot_product ((diagonal d).mul_vec v) w = dot_product d (v * w) :=
begin
  simp only [dot_product], congr, ext i,
  rw [mul_vec_diagonal, pi.mul_apply, mul_assoc],
end

lemma dot_product_self_nonneg (v : γ → R) : 0 ≤ dot_product v v :=
begin
  simp only [dot_product], apply finset.sum_nonneg, intros x hx,
  exact mul_self_nonneg (v x),
end

lemma dot_product_self_eq_zero_iff (v : γ → R) : dot_product v v = 0 ↔ v = 0 :=
begin
  have hsumz := finset.sum_eq_zero_iff_of_nonneg (λ x hx, mul_self_nonneg (v x)), split,
  { intros hdp, ext x,
    have hvx := (hsumz.1 hdp) x (finset.mem_univ x),
    exact (mul_self_eq_zero.1 hvx), },
  { intros hvz, erw hsumz, intros x hx, dsimp,
    erw [congr_fun hvz x], simp, }
end

lemma dot_product_self_pos_of_nonzero (v : γ → R) (hvnz : v ≠ 0) : dot_product v v > 0 :=
begin
  have h1 := dot_product_self_nonneg v,
  have h2 := ne_comm.1 ((not_iff_not_of_iff (dot_product_self_eq_zero_iff v)).2 hvnz),
  exact (lt_of_le_of_ne h1 h2),
end

lemma dot_product_transpose (v : γ → R) (K L : matrix μ γ R)
: dot_product v ((Kᵀ ⬝ L).mul_vec v) = dot_product (K.mul_vec v) (L.mul_vec v) :=
begin
  rw ←mul_vec_mul_vec, dsimp [mul_vec, dot_product],
  have : ∑ i, (v i) * (∑ j, K j i * ∑ k, L j k * v k) =
         ∑ i, (∑ j, (v i) * K j i * ∑ k, L j k * v k),
  { congr, ext i, rw [finset.mul_sum], congr, ext j, ring, },
  rw this,
  have : ∑ i j, v i * K j i * ∑ k, L j k * v k =
         ∑ i j k, v i * K j i * L j k * v k,
  { congr, ext i, congr, ext j, rw [finset.mul_sum], congr, ext k, ring, },
  rw this,
  have : ∑ i, (∑ j, K i j * v j) * ∑ k, L i k * v k =
         ∑ i, (∑ j, K i j * v j * ∑ k, L i k * v k),
  { congr, ext i, rw [finset.sum_mul], },
  rw this,
  have : ∑ i j, K i j * v j * ∑ k, L i k * v k =
         ∑ i j k, K i j * v j * L i k * v k,
  { congr, ext i, congr, ext j, rw [finset.mul_sum], congr, ext k, ring, },
  rw this,
  rw [finset.sum_comm],
  congr, ext i, congr, ext j, congr, ext k, ring,
end

end matrix


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Kenny Lau, Robert Y. Lewis
-/
import algebra.group.basic

/-!
# Eckmann-Hilton argument

The Eckmann-Hilton argument says that if a type carries two monoid structures that distribute
over one another, then they are equal, and in addition commutative.
The main application lies in proving that higher homotopy groups (`πₙ` for `n ≥ 2`) are commutative.

## Main declarations

* `eckmann_hilton.comm_monoid`: If a type carries a unital magma structure that distributes
  over a unital binary operation, then the magma is a commutative monoid.
* `eckmann_hilton.comm_group`: If a type carries a group structure that distributes
  over a unital binary operation, then the group is commutative.

-/

universe u

namespace eckmann_hilton
variables {X : Type u}

local notation a `<`m`>` b := m a b

/-- `is_unital m e` expresses that `e : X` is a left and right unit
for the binary operation `m : X → X → X`. -/
structure is_unital (m : X → X → X) (e : X) extends is_left_id _ m e, is_right_id _ m e : Prop.

@[to_additive eckmann_hilton.add_zero_class.is_unital]
lemma mul_one_class.is_unital [G : mul_one_class X] : is_unital (*) (1 : X) :=
is_unital.mk (by apply_instance) (by apply_instance)

variables {m₁ m₂ : X → X → X} {e₁ e₂ : X}
variables (h₁ : is_unital m₁ e₁) (h₂ : is_unital m₂ e₂)
variables (distrib : ∀ a b c d, ((a <m₂> b) <m₁> (c <m₂> d)) = ((a <m₁> c) <m₂> (b <m₁> d)))
include h₁ h₂ distrib

/-- If a type carries two unital binary operations that distribute over each other,
then they have the same unit elements.

In fact, the two operations are the same, and give a commutative monoid structure,
see `eckmann_hilton.comm_monoid`. -/
lemma one : e₁ = e₂ :=
by simpa only [h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id] using distrib e₂ e₁ e₁ e₂

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are equal.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
lemma mul : m₁ = m₂ :=
begin
  funext a b,
  calc m₁ a b = m₁ (m₂ a e₁) (m₂ e₁ b) :
    by simp only [one h₁ h₂ distrib, h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id]
          ... = m₂ a b :
    by simp only [distrib, h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id]
end

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are commutative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
lemma mul_comm : is_commutative _ m₂ :=
⟨λ a b, by simpa [mul h₁ h₂ distrib, h₂.left_id, h₂.right_id] using distrib e₂ a b e₂⟩

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are associative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
lemma mul_assoc : is_associative _ m₂ :=
⟨λ a b c, by simpa [mul h₁ h₂ distrib, h₂.left_id, h₂.right_id] using distrib a b e₂ c⟩

omit h₁ h₂ distrib

/-- If a type carries a unital magma structure that distributes over a unital binary
operations, then the magma structure is a commutative monoid. -/
@[to_additive "If a type carries a unital additive magma structure that distributes over a
unital binary operations, then the additive magma structure is a commutative additive monoid."]
def comm_monoid [h : mul_one_class X]
  (distrib : ∀ a b c d, ((a * b) <m₁> (c * d)) = ((a <m₁> c) * (b <m₁> d))) : comm_monoid X :=
{ mul := (*),
  one := 1,
  mul_comm := (mul_comm h₁ mul_one_class.is_unital distrib).comm,
  mul_assoc := (mul_assoc h₁ mul_one_class.is_unital distrib).assoc,
  ..h }

/-- If a type carries a group structure that distributes over a unital binary operation,
then the group is commutative. -/
@[to_additive "If a type carries an additive group structure that distributes
over a unital binary operation, then the additive group is commutative."]
def comm_group [G : group X]
  (distrib : ∀ a b c d, ((a * b) <m₁> (c * d)) = ((a <m₁> c) * (b <m₁> d))) : comm_group X :=
{ ..(eckmann_hilton.comm_monoid h₁ distrib),
  ..G }

end eckmann_hilton


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/
import number_theory.number_field.class_number
import tactic

/-

# Class groups

In Lean we don't talk about the class group of a number field, we talk about
the class group of its integer ring.

-/

variables (R : Type) [comm_ring R] [is_domain R]

example : Type := class_group R

noncomputable example : comm_group (class_group R) := infer_instance

/-

So what is this group?

A *fractional ideal* of `R` is an `R`-submodule `J` of the field of fractions of `R`
such that there exists a nonzero element `a` of `R` such that `a * J ⊆ R`.

-/

open_locale non_zero_divisors -- to get notation R⁰ for the submonoid of nonzero divisors of R
-- (of course in this case it's just R \ {0}).

-- the fractional ideals of R
example : Type := fractional_ideal (R⁰) (fraction_ring R)

-- Note that (0) is a fractional ideal with this definition. So fractional ideals aren't
-- a group under multiplication, only a monoid.

example : comm_monoid (fractional_ideal (R⁰) (fraction_ring R)) := infer_instance

-- However the invertible fractional ideals (for a number field this is the same as the
-- nonzero fractional ideals) are a group:

example : comm_group (fractional_ideal (R⁰) (fraction_ring R))ˣ := infer_instance

-- There's a group homomorphism from the units of `fraction_ring R` to the invertible
-- fractional ideals

noncomputable example :
  (fraction_ring R)ˣ →* (fractional_ideal (R⁰) (fraction_ring R))ˣ :=
to_principal_ideal R _

-- And the class group of `R` is defined to be the quotient of the invertible fractional
-- ideals by the image of this map.

example : class_group R =
  ((fractional_ideal R⁰ (fraction_ring R))ˣ ⧸ (to_principal_ideal R (fraction_ring R)).range) := rfl

-- For a general integral domain, the class group may be infinite. But the class group
-- of the integers of a number field is known by Lean to be finite.

open number_field

noncomputable example (K : Type) [field K] [number_field K] :
  fintype (class_group (ring_of_integers K)) :=
infer_instance

-- Proved in 2021 in Lean. See https://arxiv.org/abs/2102.02600 to see how it was done.
-- My PhD student Ashvni Narayanan was one of the people involved in the proof.