import ..lectures.love02_backward_proofs_demo

/-! # LoVe Exercise 2: Backward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Question 1: Connectives and Quantifiers

1.1. Carry out the following proofs using basic tactics.

Hint: Some strategies for carrying out such proofs are described at the end of
Section 2.3 in the Hitchhiker's Guide. -/

lemma I (a : Prop) :
  a → a :=
begin
  intro ha,
  exact ha
end

lemma K (a b : Prop) :
  a → b → b :=
begin
  intros ha hb,
  exact hb
end

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
begin
  intros hg hb ha,
  apply hg,
  exact ha,
  exact hb
end

lemma proj_1st (a : Prop) :
  a → a → a :=
begin
  intros ha ha',
  exact ha
end

/-! Please give a different answer than for `proj_1st`: -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
begin
  intros ha ha',
  exact ha'
end

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
begin
  intros hg ha hf hb,
  apply hg,
  exact ha,
  exact hb
end

/-! 1.2. Prove the contraposition rule using basic tactics. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
begin
  intros hab hnb ha,
  apply hnb,
  apply hab,
  apply ha
end

/-! 1.3. Prove the distributivity of `∀` over `∧` using basic tactics.

Hint: This exercise is tricky, especially the right-to-left direction. Some
forward reasoning, like in the proof of `and_swap₂` in the lecture, might be
necessary. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
begin
  apply iff.intro,
  { intro h,
    apply and.intro,
    { intro x,
      apply and.elim_left,
      apply h },
    { intro x,
      apply and.elim_right,
      apply h } },
  { intros h x,
    apply and.intro,
    { apply and.elim_left h },
    { apply and.elim_right h } }
end

/-! ## Question 2: Natural Numbers

2.1. Prove the following recursive equations on the first argument of the
`mul` operator defined in lecture 1. -/

#check mul

lemma mul_zero (n : ℕ) :
  mul 0 n = 0 :=
begin
  induction' n,
  { refl },
  { simp [add, mul, ih] }
end

lemma mul_succ (m n : ℕ) :
  mul (nat.succ m) n = add (mul m n) n :=
begin
  induction' n,
  { refl },
  { simp [add, add_succ, add_assoc, mul, ih] }
end

/-! 2.2. Prove commutativity and associativity of multiplication using the
`induction'` tactic. Choose the induction variable carefully. -/

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
begin
  induction' m,
  { simp [mul, mul_zero] },
  { simp [mul, mul_succ, ih],
    cc }
end

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
begin
  induction' n,
  { refl },
  { simp [mul, mul_add, ih] }
end

/-! 2.3. Prove the symmetric variant of `mul_add` using `rw`. To apply
commutativity at a specific position, instantiate the rule by passing some
arguments (e.g., `mul_comm _ l`). -/

lemma add_mul (l m n : ℕ) :
  mul (add l m) n = add (mul n l) (mul n m) :=
begin
  rw mul_comm _ n,
  rw mul_add
end

/-! ## Question 3 (**optional**): Intuitionistic Logic

Intuitionistic logic is extended to classical logic by assuming a classical
axiom. There are several possibilities for the choice of axiom. In this
question, we are concerned with the logical equivalence of three different
axioms: -/

def excluded_middle : Prop :=
∀a : Prop, a ∨ ¬ a

def peirce : Prop :=
∀a b : Prop, ((a → b) → a) → a

def double_negation : Prop :=
∀a : Prop, (¬¬ a) → a

/-! For the proofs below, please avoid using lemmas from Lean's `classical`
namespace, as this would defeat the purpose of the exercise.

3.1 (**optional**). Prove the following implication using tactics.

Hint: You will need `or.elim` and `false.elim`. You can use
`rw excluded_middle` to unfold the definition of `excluded_middle`,
and similarly for `peirce`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
begin
  rw excluded_middle,
  rw peirce,
  intro hem,
  intros a b haba,
  apply or.elim (hem a),
  { intro,
    assumption },
  { intro hna,
    apply haba,
    intro ha,
    apply false.elim,
    apply hna,
    assumption }
end

/-! 3.2 (**optional**). Prove the following implication using tactics. -/

lemma dn_of_peirce :
  peirce → double_negation :=
begin
  rw peirce,
  rw double_negation,
  intros hpeirce a hnna,
  apply hpeirce a false,
  intro hna,
  apply false.elim,
  apply hnna,
  exact hna
end

/-! We leave the remaining implication for the homework: -/

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end backward_proofs

end LoVe


-- begin header

import M40002.complete

namespace sequences
-- end header

/- Section
Chapter 3. Sequences
-/

/- Sub-section
Definitions
-/

/-
Let $a : ℕ → ℝ$ be a real valued sequence, then we define convergence of $a$ to some
real $l$ in the standard way.
-/

/- Definition
A real valued sequence $a_n : ℕ → ℝ$ is said to converge to $l ∈ ℝ$ if and only if for all
$ε > 0$, there exists $N ∈ ℕ$ such that for all $n ≥ N$, $\left| a_n - l \right| < ε$.
-/
def converges_to (a : ℕ → ℝ) (l : ℝ) :=  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, abs (a n - l) < ε
notation a ` ⇒ ` l := converges_to a l

/- Definition
We call $a_n : ℕ → ℝ$ convergent if there exists $l ∈ ℝ$, $a_n$ converges to $l$.
-/
def is_convergent (a : ℕ → ℝ) := ∃ l : ℝ, ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, abs (a n - l) < ε

/- Definition
We call $a_n : ℕ → ℝ$ bounede above if and only if there exists $R ∈ ℝ$ such that for all
$n ∈ ℕ$, $a_n ≤ R$.
-/
def seq_bounded_above (a : ℕ → ℝ) := ∃ R : ℝ, ∀ m : ℕ, a m ≤ R

/- Definition
We definte bounded below in a similar way.
-/
def seq_bounded_below (a : ℕ → ℝ) := ∃ R : ℝ, ∀ m : ℕ, R ≤ a m

/- Definition
We call $a_n : ℕ → ℝ$ bounded if and only if it is bounded above and below.
-/
def seq_bounded (a : ℕ → ℝ) := seq_bounded_above a ∧ seq_bounded_below a

def seq_in (a : ℕ → ℝ) (S : set ℝ) := ∀ n : ℕ, a n ∈ S
notation a ` ⊆ ` S := seq_in a S

example (n : ℕ) (hn : 0 < n) : 0 ≤ 1 / n := by exact bot_le

/- Example
Let $a_n : ℕ → ℝ : n ↦ 1 / n$, then $a_n$ converges to 0.
-/
example : (λ n : ℕ, 1 / n) ⇒ 0 :=
begin
  -- We first fix $ε > 0$.
  intros ε hε,
  -- Then by choosing some $N ∈ ℕ$ such that $N > 1 / ε$,
  cases (exists_nat_gt (1 / ε)) with N hN,
  -- we now need to show that for all $n ≥ N$, $\left| a_n - 0 \right| < ε$.
  refine ⟨N, λ n hn, _⟩,
  -- Now as $\left| a_n - 0 \right| = a_n = 1 / n$, it suffices to show that $1 / n < ε$.
  rw [sub_zero, abs_of_nonneg, (one_div_lt _ hε)],
    { refine lt_of_lt_of_le hN (by norm_cast; assumption) },
  -- But this follows from the transitivity of inequalities as $1 / n ≤ 1 / N ≤ ε$.
    { refine lt_trans (one_div_pos_of_pos hε) (lt_of_lt_of_le hN (by norm_cast; assumption)) },
    { simp [bot_le] }
end

/- Example
Let $a_n : ℕ → ℝ : n ↦ c$ for some $c ∈ ℝ$. Then $a_n$ converges to $c$
-/
theorem cons_conv {c : ℝ} : (λ n : ℕ, c) ⇒ c :=
begin
  -- Again we fix $ε > 0$
  intros ε hε,
  -- Then by simply choosing our $N = 0$,
  refine ⟨0, λ n hn, _⟩,
  -- it suffices to show that for all $n ∈ ℕ$, $\left| a_n - c \right| < ε$.
  -- But $\left| a_n - c \right|$ is simply zero, so we are done!
  simpa
end

/-
We will now prove a very useful lemma that will come up now an again.
-/

/- Lemma
If $x_0$ and $x_1$ are real numbers such that for all $ε > 0$, $\left| x₀ - x₁ \right| < ε$,
then $x_0 = x_1$.
-/
lemma dist_zero {x₀ x₁ : ℝ}
(h : ∀ (ε : ℝ) (hε : 0 < ε), abs (x₀ - x₁) < ε ) : x₀ = x₁ :=
begin
  -- We will attempt to prove by contradiction, so suppose $x₀ ≠ x₁$.
  apply classical.by_contradiction, intro hne,
  -- Then by trichotomy, either $x₀ < x₁$ or $x₁ < x₀$.
  cases lt_or_gt_of_ne hne with hlt hgt,
  -- If $x₀ < x₁$ then by letting $ε = x₁ - x₀$ we have $\left| x₀ - x₁ \right| < x₀ - x₁$.
    { refine not_le.2 (h (x₁ - x₀) (sub_pos.2 hlt)) _,
  -- But this is a contradiction as for all $r ∈ ℝ$, \left| r \right| ≥ r$.
      rw abs_sub, exact le_abs_self _ },
  -- It's a similar story if $x₁ < x₀$.
    { refine not_le.2 (h (x₀ - x₁) (sub_pos.2 hgt)) ( le_abs_self _) }
end

/-
With that, we will present a short proof that the limits of sequences are unique.
-/

/- Theorem
Let $a_n : ℕ → ℝ$ converge to $b$ and $c$ both of which are real. Then $b = c$.
-/
theorem unique_lim {a : ℕ → ℝ} {b c : ℝ} (hb : a ⇒ b) (hc : a ⇒ c) : b = c :=
begin
  -- By the previous lemma, it suffices to show that for all $ε > 0, \left| b - c \right| < ε$.
  apply dist_zero,
  -- So let us fix ε > 0.
  intros ε hε,
  -- Then as $a_n$ converges to $b$,
  -- there exists some $N₀ ∈ ℕ$ for all $n ≥ N₀, \left a_n - b \right < ε / 2$.
  cases hb (ε / 2) (half_pos hε) with N₀ hN₀,
  -- Similarly there must be some $N₁ ∈ ℕ$ for all $n ≥ N₁, \left a_n - c \right < ε / 2$.
  cases hc (ε / 2) (half_pos hε) with N₁ hN₁,
  -- So let's $N = \max \{N₀, N₁\}$.
  let N := max N₀ N₁,
  -- Then by the triangle inequality,
  -- we have $\left| b - c \right| ≤ \left| b - a_N \right| + \left| a_N - c \right| < ε / 2 + ε / 2 = ε$.
  apply lt_of_le_of_lt (abs_sub_le b (a N) c),
  linarith [show abs (b - a N) < ε / 2, by rw abs_sub; from hN₀ N (le_max_left _ _),
  hN₁ N (le_max_right _ _)]
end

#exit

-- If (a n) is convergent then its bounded
lemma converge_is_bdd_abv (b : ℕ → ℝ) : is_convergent b → seq_bounded_above b :=
begin
  rintro ⟨l, hl⟩,
  cases (hl 1 _) with N hN,
  swap, linarith,
  let U := finset.image b (finset.range (N + 1)) ∪ {l + 1},
  have : b 0 ∈ U := by simp,
  cases finset.max_of_mem this with R hR,
  use R, intro m,
  cases le_or_lt m N,
    {have : b m ∈ U :=
      by{simp, left, use m, from ⟨(nat_le_imp_lt_succ N m).mp h, rfl⟩},
    from finset.le_max_of_mem this hR
    },
    {have : l + 1 ∈ U := by {simp},
    replace this : l + 1 ≤ R :=
      by {from finset.le_max_of_mem this hR},
    apply le_trans _ this,
    replace this : abs (b m - l) < 1 := hN m (le_of_lt h),
    rw abs_lt at this,
    from le_of_lt (sub_lt_iff_lt_add'.mp this.right)
    }
end

lemma converge_is_bdd_blw (b : ℕ → ℝ) : is_convergent b → seq_bounded_below b :=
begin
  rintro ⟨l, hl⟩,
  cases (hl 1 _) with N hN,
  swap, linarith,
  let U := finset.image b (finset.range (N + 1)) ∪ {l + -1},
  have : b 0 ∈ U := by simp,
  cases finset.min_of_mem this with R hR,
  use R, intro m,
  cases le_or_lt m N,
    {have : b m ∈ U :=
      by{simp, left, use m, from ⟨(nat_le_imp_lt_succ N m).mp h, rfl⟩},
    from finset.min_le_of_mem this hR
    },
    {have : l + -1 ∈ U := by {simp},
    replace this : R ≤ l + -1 :=
      by {from finset.min_le_of_mem this hR},
    apply le_trans this,
    replace this : abs (b m - l) < 1 := hN m (le_of_lt h),
    rw abs_lt at this,
    from le_of_lt (lt_sub_iff_add_lt'.mp this.left)
    }
end

theorem converge_is_bdd (b : ℕ → ℝ) : is_convergent b → seq_bounded b := λ h, ⟨converge_is_bdd_abv b h, converge_is_bdd_blw b h⟩

-- Defining addition for sequences
def seq_add_seq (a : ℕ → ℝ) (b : ℕ → ℝ) := λ n : ℕ, a n + b n
notation a ` + ` b := seq_add_seq a b

def seq_add_real (a : ℕ → ℝ) (b : ℝ) := λ n : ℕ, a n + b
notation a ` + ` b := seq_add_real a b

-- Algebra of limits
theorem add_lim_conv (a b : ℕ → ℝ) (l m : ℝ) : a ⇒ l ∧ b ⇒ m → (a + b) ⇒ (l + m) :=
begin
  rintros ⟨ha, hb⟩ ε hε,
  have : ε / 2 > 0 := half_pos hε,
  cases ha (ε / 2) this with N₁ hN₁,
  cases hb (ε / 2) this with N₂ hN₂,
  let N : ℕ := max N₁ N₂,
  use N,
  intros n hn,
  have hrw : a n + b n - (l + m) = (a n - l) + (b n - m) := by {linarith},
  unfold seq_add_seq,
  rw hrw,
  have hmax : N ≥ N₁ ∧ N ≥ N₂ :=
    by {split,
      all_goals {rwa [ge_iff_le, le_max_iff], tauto}},
  suffices h : abs (a n - l) + abs (b n - m) < ε,
    from lt_of_le_of_lt (abs_add (a n - l) (b n - m)) h,
  have h : abs (a n - l) + abs (b n - m) < ε / 2 + ε / 2 :=
    by {from add_lt_add (hN₁ n (ge_trans hn hmax.left)) (hN₂ n (ge_trans hn hmax.right))},
  rwa add_halves' ε at h
end

lemma diff_seq_is_zero (a b : ℕ → ℝ) (l : ℝ) (h : a ⇒ l) : a = b + l → b ⇒ 0 :=
begin
  unfold seq_add_real, unfold converges_to,
  unfold converges_to at h,
  intro ha,
  rw ha at h, simp at h,
  suffices : ∀ (ε : ℝ), 0 < ε → (∃ (N : ℕ), ∀ (n : ℕ), N ≤ n → abs (b n) < ε),
    simpa,
  assumption
end

-- Defining multiplication of sequences
def seq_mul_seq (a : ℕ → ℝ) (b : ℕ → ℝ) := λ n : ℕ, a n * b n
notation a ` × ` b := seq_mul_seq a b

def seq_mul_real (a : ℕ → ℝ) (b : ℝ) := λ n : ℕ, a n * b
notation a ` × ` b := seq_mul_real a b

theorem mul_lim_conv (a b : ℕ → ℝ) (l m : ℝ) (ha : a ⇒ l) (hb : b ⇒ m) : (a × b) ⇒ l * m :=
begin
  sorry
end

-- Defining division of sequences
noncomputable def seq_div_seq (a : ℕ → ℝ) (b : ℕ → ℝ) := λ n : ℕ, (a n) / (b n)
noncomputable instance : has_div (ℕ → ℝ) := ⟨seq_div_seq⟩

theorem div_lim_conv (a b : ℕ → ℝ) (l m : ℝ) (ha : a ⇒ l) (hb : b ⇒ m) (hc : m ≠ 0) : (a / b) ⇒ l / m :=
begin
  sorry
end

-- Defining monotone increasing and decreasing sequences
def mono_increasing (a : ℕ → ℝ) := ∀ n : ℕ, a n ≤ a (n + 1)
notation a ` ↑ ` := mono_increasing a

def mono_increasing_conv (a : ℕ → ℝ) (l : ℝ) := mono_increasing a ∧ a ⇒ l
notation a ` ↑ ` l := mono_increasing a l

def mono_decreasing (a : ℕ → ℝ) := ∀ n : ℕ, a (n + 1) ≤ a n
notation a ` ↓ ` := mono_decreasing a

def mono_decreasing_conv (a : ℕ → ℝ) (l : ℝ) := mono_decreasing a ∧ a ⇒ l
notation a ` ↓ ` l := mono_decreasing a l

lemma le_chain (N : ℕ) (b : ℕ → ℝ) (h : mono_increasing b) : ∀ n : ℕ, N ≤ n → b N ≤ b n :=
begin
  intros n hn,
  have ha : ∀ k : ℕ, b N ≤ b (N + k) :=
    by {intro k,
    induction k with k hk,
      {refl},
      {from le_trans hk (h (N + k))}
    },
  have : ∃ k : ℕ, N + k = n := nat.le.dest hn,
  cases this with k hk,
  rw ←hk,
  from ha k
end

lemma ge_chain (N : ℕ) (b : ℕ → ℝ) (h : mono_decreasing b) : ∀ n : ℕ, N ≤ n → b n ≤ b N :=
begin
  intros n hn,
  have ha : ∀ k : ℕ, b (N + k) ≤ b N :=
    by {intro k,
    induction k with k hk,
      {refl},
      {from le_trans (h (N + k)) hk}
    },
  have : ∃ k : ℕ, N + k = n := nat.le.dest hn,
  cases this with k hk,
  rw ←hk,
  from ha k
end

-- Monotone increasing and bounded means convergent (to the supremum)
lemma mono_increasing_means_conv_sup (b : ℕ → ℝ) (M : ℝ) (h₁ : mono_increasing b) (h₂ : seq_bounded b) (h₃ : sup {t : ℝ | ∃ n : ℕ, t = b n} M) : b ⇒ M :=
begin
  rcases h₂ with ⟨⟨N, habv⟩, hblw⟩,
  intros ε hε,
  clear habv N,
  have : ∃ N : ℕ, M - ε < b N :=
    by {cases h₃ with hubd hnubd,
    unfold upper_bound at hnubd,
    push_neg at hnubd,
    have : M - ε < M :=
      by {rw gt_iff_lt at hε,
      from sub_lt_self M hε},
    rcases hnubd (M - ε) this with ⟨s, ⟨hs₁, hs₂⟩⟩,
    rw set.mem_set_of_eq at hs₁,
    cases hs₁ with n hn,
    use n, rwa ←hn
    },
  cases this with N hN,
  use N, intros n hn,
  rw abs_of_nonpos,
    {have : ∀ n : ℕ, N ≤ n → b N ≤ b n := le_chain N b h₁,
    suffices : M - ε < b n,
      simp, from sub_lt.mp this,
    from lt_of_lt_of_le hN (this n (iff.rfl.mp hn))
    },
    cases h₃,
    have : b n ≤ M := by {apply h₃_left, rwa set.mem_set_of_eq, use n},
    from sub_nonpos_of_le this
end

theorem mono_increasing_means_conv (b : ℕ → ℝ) (h₁ : mono_increasing b) (h₂ : seq_bounded b) : is_convergent b :=
begin
  let α : set ℝ := {t : ℝ | ∃ n : ℕ, t = b n},
  have : ∃ M : ℝ, sup α M :=
    by {rcases h₂ with ⟨⟨R, habv⟩, hblw⟩,
      apply completeness α,
      {use R, rintros s ⟨n, hs⟩,
      suffices : b n ≤ R, rwa ←hs at this,
      from habv n
      },
      {suffices : b 0 ∈ α,
        apply set.not_eq_empty_iff_exists.mpr,
        use b 0, assumption,
      rw set.mem_set_of_eq,
      use 0
      }
    },
  cases this with M hM,
  use M,
  from mono_increasing_means_conv_sup b M h₁ h₂ hM
end

-- Monotone decreasing and bounded means convergent (to the infimum)
lemma mono_decreasing_means_conv_inf (b : ℕ → ℝ) (M : ℝ) (h₁ : mono_decreasing b) (h₂ : seq_bounded b) (h₃ : inf {t : ℝ | ∃ n : ℕ, t = b n} M) : b ⇒ M :=
begin
  intros ε hε,
  have : ∃ N : ℕ, b N < M + ε :=
    by {cases h₃ with hlbd hnlbd,
    unfold lower_bound at hnlbd,
    push_neg at hnlbd,
    have : M < M + ε := by {linarith},
    rcases hnlbd (M + ε) this with ⟨s, ⟨hs₁, hs₂⟩⟩,
    rw set.mem_set_of_eq at hs₁,
    cases hs₁ with n hn,
    use n, rwa ←hn
    },
  cases this with N hN,
  use N, intros n hn,
  rw abs_lt, split,
    {suffices : M - ε < b n, linarith,
    have : M ≤ b n := by {apply h₃.left (b n), rw set.mem_set_of_eq, use n},
    have hα : M - ε < M := by {linarith},
    from lt_of_lt_of_le hα this
    },
    {suffices : b n < M + ε, linarith,
    from lt_of_le_of_lt (ge_chain N b h₁ n (iff.rfl.mp hn)) hN
    }
end

theorem mono_decreasing_means_conv (b : ℕ → ℝ) (h₁ : mono_decreasing b) (h₂ : seq_bounded b) : is_convergent b :=
begin
  let α : set ℝ := {t : ℝ | ∃ n : ℕ, t = b n},
  have : ∃ M : ℝ, inf α M :=
    by {rcases h₂ with ⟨habv, ⟨R, hblw⟩⟩,
      apply completeness_below α,
      {use R, rintros s ⟨n, hs⟩,
      rw hs,
      from hblw n
      },
      {suffices : b 0 ∈ α,
        apply set.not_eq_empty_iff_exists.mpr,
        use b 0, assumption,
      rw set.mem_set_of_eq,
      use 0
      }
    },
  cases this with M hM,
  use M,
  from mono_decreasing_means_conv_inf b M h₁ h₂ hM
end

-- Defining order on sequences (is this necessary?)
def le_seq (a b : ℕ → ℝ) := ∀ n : ℕ, a n ≤ b n
notation a ` ≤* ` b := le_seq a b

def lt_seq (a b : ℕ → ℝ) := ∀ n : ℕ, a n < b n
notation a ` <* ` b := lt_seq a b

def ge_seq (a b : ℕ → ℝ) := ∀ n : ℕ, a n ≥ b n
notation a ` ≥* ` b := ge_seq a b

def gt_seq (a b : ℕ → ℝ) := ∀ n : ℕ, a n > b n
notation a ` >* ` b := gt_seq a b

-- Comparison of sequences
theorem le_lim (a b : ℕ → ℝ) (l m : ℝ) (ha : a ⇒ l) (hb : b ⇒ m) : (a ≤* b) → l ≤ m :=
begin
  rw ←not_lt,
  intros h hlt,
  have hδ : (l - m) / 2 > 0 := half_pos (sub_pos.mpr hlt),
  cases ha ((l - m) / 2) hδ with N₁ hN₁,
  cases hb ((l - m) / 2) hδ with N₂ hN₂,
  let N := max N₁ N₂,
  have hmax : N ≥ N₁ ∧ N ≥ N₂ :=
    by {split,
      all_goals {rwa [ge_iff_le, le_max_iff], tauto}},
  replace hN₁ : abs (a N - l) < (l - m) / 2 := hN₁ N hmax.left,
  replace hN₂ : abs (b N - m) < (l - m) / 2 := hN₂ N hmax.right,
  have hα : (l + m) / 2 < a N :=
    by {rw abs_lt at hN₁,
    cases hN₁ with hl hr,
    linarith
    },
  have hβ : b N < (l + m) / 2 :=
    by {rw abs_lt at hN₂,
    cases hN₂ with hl hr,
    linarith
    },
  have : b N < a N := lt_trans hβ hα,
  rw ←not_le at this,
  from this (h N)
end

-- Sandwich Theorem. Suppose that an ≤ bn ≤ cn ∀n and that an → a and cn → a, Then bn → a.
theorem sandwich {a b c : ℕ → ℝ} {l : ℝ} (h₀ : a ⇒ l) (h₁ : c ⇒ l) : (a ≤* b) ∧ (b ≤* c) → b ⇒ l :=
begin
  rintro ⟨ha, hb⟩,
  intros ε hε,
  cases (h₀ ε hε) with N₀ hN₀,
  cases (h₁ ε hε) with N₁ hN₁,
  let N := max N₀ N₁,
  have hN : N₀ ≤ N ∧ N₁ ≤ N := by {finish},
  use N,
  intros n hn,
  cases lt_or_ge (b n) l with hlt hge,
    {rw [abs_sub, abs_of_pos (sub_pos.mpr hlt)],
    apply lt_of_le_of_lt _ (hN₀ n (le_trans hN.left hn)),
    apply le_trans ((sub_le_sub_iff_left l).mpr (ha n)) _,
    rw abs_sub,
    from le_abs_self (l - a n)
    },
    {rw abs_of_nonneg (sub_nonneg.mpr hge),
    apply lt_of_le_of_lt _ (hN₁ n (le_trans hN.right hn)),
    apply le_trans (add_le_add_right' (hb n)) _,
    from le_abs_self (c n - l)
    }
end

-- Cauchy Sequences
def cauchy (a : ℕ → ℝ) := ∀ ε > 0, ∃ N : ℕ, ∀ n m : ℕ, N ≤ n ∧ N ≤ m → abs (a n - a m) < ε

-- Convergent implies Cauchy
lemma conv_to_cauchy (a : ℕ → ℝ) (h : is_convergent a) : cauchy a :=
begin
  cases h with l hl,
  intros ε hε,
  cases hl (ε / 2) (half_pos hε) with N hN,
  use N, intros n m hnm,
  suffices : abs (a n - l) + abs (a m - l) < ε,
    {rw abs_sub (a m) l at this,
    have h : abs (a n - l + (l - a m)) < ε :=
      lt_of_le_of_lt (abs_add_le_abs_add_abs (a n - l) (l - a m)) this,
    rwa sub_add_sub_cancel (a n) l (a m) at h
    },
  have h : abs (a n - l) + abs (a m - l) < ε / 2 + ε / 2 :=
    add_lt_add (hN n hnm.left) (hN m hnm.right),
  linarith
end

-- We will prove that Cauchy implies bounded after subsequences!

-- Subsequences
def is_subseq (a b : ℕ → ℝ) := ∃ n : ℕ → ℕ, (strict_mono n ∧ ∀ i : ℕ, b i = a (n i))

-- b n = 1 is a subsequence of a n = (-1)^ n
example (a b : ℕ → ℝ) (h₁ : a = λ i, (- 1)^ i) (h₂ : b = λ i, 1) : is_subseq a b :=
begin
  let n := λ i, 2 * i,
  unfold is_subseq,
  use n, split,
    {intros a b, finish},
    {intro i,
    have : n = λ (i : ℕ), 2 * i, refl,
    rwa [h₁, h₂, this], simp,
    rw pow_mul,
    finish
    }
end

-- Every sequence has atleast one subsequence
theorem has_subseq (a : ℕ → ℝ) : ∃ b : ℕ → ℝ, is_subseq a b :=
begin
  use a,
  unfold is_subseq,
  let n : ℕ → ℕ := λ i, i,
  have : n = λ i, i := rfl,
  use n, split,
    {intros a b hab,
    rw this, simpa
    },
    {intro i,
    rwa this,
    }
end

-- n(i) ≥ i ∀ i ∈ ℕ
lemma subseq_ge_id {n : ℕ → ℕ} (h : strict_mono n) : ∀ i : ℕ, i ≤ n i :=
begin
  intro i,
  induction i with i hi,
    {from zero_le (n 0)},
    {have : (n i) + 1 ≤ n (nat.succ i) :=
      by {rw nat.succ_le_iff,
      from h (lt_add_one i)
      },
    from le_trans (nat.pred_le_iff.mp hi) this
    }
end

-- Bolzano-Weierstrass : Every bounded sequence has a convergent subsequence
theorem bolzano_weierstrass {a : ℕ → ℝ} (h₁ : seq_bounded a) : ∃ b : ℕ → ℝ, is_subseq a b ∧ is_convergent b :=
begin
  sorry
end

-- a → l iff. all subsequences of a also converges to l
theorem conv_subseq {a : ℕ → ℝ} {l : ℝ} : a ⇒ l ↔ (∀ b : ℕ → ℝ, is_subseq a b → b ⇒ l) :=
begin
  split,
    {rintros h b ⟨n, ⟨hn₁, hn₂⟩⟩ ε hε,
    cases (h ε hε) with N hN,
    use N, intros i hi,
    rw hn₂ i,
    have : n i ≥ N := ge_trans (subseq_ge_id hn₁ i) hi,
    from hN (n i) this
    },
    {intro h,
    let n : ℕ → ℕ := λ i, i,
    let b : ℕ → ℝ := a,
    have : is_subseq a b :=
      by {use n, split,
      have : n = λ i, i := rfl,
        {intros a b hab,
        rw this, simpa},
        {simp},
      },
    have ha : a = b := rfl,
    rw ha, from h b this
    }
end

-- Cauchy implies bounded
lemma cauchy_bounded_abv (b : ℕ → ℝ) : cauchy b → seq_bounded_above b :=
begin
  intro hb,
  cases (hb 1 _) with N hN,
  swap, linarith,
  let U := finset.image b (finset.range (N + 1)) ∪ {b N + 1},
  have : b 0 ∈ U := by simp,
  cases finset.max_of_mem this with R hR,
  use R, intro m,
  cases le_or_lt m N,
    {have : b m ∈ U :=
      by{simp, left, use m, from ⟨(nat_le_imp_lt_succ N m).mp h, rfl⟩},
    from finset.le_max_of_mem this hR
    },
    {have : b N + 1 ∈ U := by {simp},
    replace this : b N + 1 ≤ R :=
      by {from finset.le_max_of_mem this hR},
    apply le_trans _ this,
    replace this : abs (b m - b N) < 1 := hN m N ⟨le_of_lt h, le_refl N⟩,
    rw abs_lt at this,
    from le_of_lt (sub_lt_iff_lt_add'.mp this.right)
    }
end

lemma cauchy_bounded_blw (b : ℕ → ℝ) : cauchy b → seq_bounded_below b :=
begin
  intro hb,
  cases (hb 1 _) with N hN,
  swap, linarith,
  let U := finset.image b (finset.range (N + 1)) ∪ {b N + -1},
  have : b 0 ∈ U := by simp,
  cases finset.min_of_mem this with R hR,
  use R, intro m,
  cases le_or_lt m N,
    {have : b m ∈ U :=
      by{simp, left, use m, from ⟨(nat_le_imp_lt_succ N m).mp h, rfl⟩},
    from finset.min_le_of_mem this hR
    },
    {have : b N + -1 ∈ U := by {simp},
    replace this : R ≤ b N + -1 :=
      by {from finset.min_le_of_mem this hR},
    apply le_trans this,
    replace this : abs (b m - b N) < 1 := hN m N ⟨le_of_lt h, le_refl N⟩,
    rw abs_lt at this,
    from le_of_lt (lt_sub_iff_add_lt'.mp this.left)
    }
end

lemma cauchy_bounded (a : ℕ → ℝ) : cauchy a → seq_bounded a := λ h, ⟨cauchy_bounded_abv a h, cauchy_bounded_blw a h⟩

-- Cauchy implies convergent
lemma cauchy_to_conv (a : ℕ → ℝ) (h : cauchy a) : is_convergent a :=
begin
  rcases bolzano_weierstrass (cauchy_bounded a h) with ⟨b, ⟨⟨n, ⟨hb₁, hb₂⟩⟩, ⟨l, hl⟩⟩⟩,
  use l, intros ε hε,
  cases h (ε / 2) (half_pos hε) with N₁ hN₁,
  cases hl (ε / 2) (half_pos hε) with N₂ hN₂,
  let N := n (max N₁ N₂),
  use N, intros i hi,
  suffices : abs (a i - a N) + abs (a N - l) < ε,
    apply lt_of_le_of_lt _ this,
    have hβ: a i - a N + (a N - l) = a i - l := by {linarith},
    rw ←hβ,
    from abs_add (a i - a N) (a N - l),
  have hα : abs (a i - a N) + abs (a N - l) < ε / 2 + ε / 2 :=
    by {have : N = n (max N₁ N₂) := rfl,
      apply add_lt_add,
      {have hβ : N₁ ≤ N :=
        by {rw this, from le_trans (le_max_left N₁ N₂) (subseq_ge_id hb₁ (max N₁ N₂))},
      have hγ : N₁ ≤ i := by {from le_trans hβ hi},
      from hN₁ i N ⟨hγ, hβ⟩
      },
      {have hβ : N₂ ≤ N :=
        by {rw this, from le_trans (le_max_right N₁ N₂) (subseq_ge_id hb₁ (max N₁ N₂))},
      apply lt_of_le_of_lt _ (hN₂ (max N₁ N₂) (le_max_right N₁ N₂)),
      rwa hb₂ (max N₁ N₂)
      }
    },
  linarith
end

-- Cauchy iff. convergent
theorem cauchy_iff_conv {a : ℕ → ℝ} : cauchy a ↔ is_convergent a :=
begin
  split,
    {intro h, from cauchy_to_conv a h},
    {intro h, from conv_to_cauchy a h}
end

end sequences


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

import tactic
import number_theory.divisors -- added to make Bhavik's proof work

/-

# Find all integers x ≠ 3 such that x - 3 divides x^3 - 3

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

My solution: x - 3 divides x^3-27, and hence if it divides x^3-3
then it also divides the difference, which is 24. Conversely,
if x-3 divides 24 then because it divides x^3-27 it also divides x^3-3.
But getting Lean to find all the integers divisors of 24 is a nightmare!
Bhavik (last year) managed to figure out how to do this.

-/

-- This isn't so hard
lemma lemma1 (x : ℤ) : x - 3 ∣ x^3 - 3 ↔ x - 3 ∣ 24 :=
begin
  have h : x - 3 ∣ x ^ 3 - 27,
  { use x ^ 2 + 3 * x + 9,
    ring, },
  split,
  { intro h1,
    have h2 := dvd_sub h1 h,
    convert h2,
    ring },
  { intro h1,
    convert dvd_add h h1,
    ring },
end

lemma int_dvd_iff (x : ℤ) (n : ℤ) (hn : n ≠ 0) :
  x ∣ n ↔ x.nat_abs ∈ n.nat_abs.divisors :=
by simp [hn]

-- Thanks to Bhavik Mehta for showing me how to prove this in Lean 3 without timing out!
lemma lemma2 (x : ℤ) : x ∣ 24 ↔ x ∈ ({-24,-12,-8,-6,-4,-3,-2,-1,1,2,3,4,6,8,12,24} : set ℤ) :=
begin
  suffices : x ∣ 24 ↔ x.nat_abs ∈ ({1,2,3,4,6,8,12,24} : finset ℕ),
  { simp only [this, int.nat_abs_eq_iff, set.mem_insert_iff, set.mem_singleton_iff,
      finset.mem_insert, finset.mem_singleton],
    norm_cast,
    rw ←eq_iff_iff,
    ac_refl },
  exact int_dvd_iff _ 24 (by norm_num),
end

-- This seems much harder :-) (it's really a computer science question, not a maths question,
-- feel free to skip)
example (x : ℤ) : x - 3 ∣ x^3 - 3 ↔ x ∈ ({-21, -9, -5, -3, -1, 0, 1, 2, 4, 5, 6, 7, 9, 11, 15, 27} : set ℤ)  :=
begin
  rw lemma1,
  rw lemma2,
  simp only [set.mem_insert_iff, sub_eq_neg_self, set.mem_singleton_iff],
  repeat {apply or_congr },
  all_goals { omega },
end


import data.set
open set
/-
NOTE: The final exam is comprehensive, but this practice
exam is not. In addition to working through this practice
exam, you should revisit the exam1 and exam2 practice
exams.
-/

/- SETS -/
namespace sets

/-
1.

Prove that 1 is in the set {1, 2, 3, 4, 5}.
-/

example: 1 ∈ ({1, 2, 3, 4, 5}: set ℕ) :=
begin
  _
end

/-
2.

Prove that 1 is not in the set {2, 3, 4}.
-/

example: 1 ∉ ({2, 3, 4}: set ℕ) :=
begin
  _
end

/-
3.

Prove that there does not exist any natural number that is
a member of the empty set of natural numbers.
-/

example: ¬(∃ n:ℕ, n ∈ (∅: set ℕ)) :=
begin
  _
end

/-
4.

Prove that the intersection of the sets of natural numbers
{1, 2} and {3, 4} is empty by showing that for all natural
numbers, they are not in the intersection of {1, 2} and
{3, 4}.
-/

#reduce 2 ∈ ({3, 4}: set ℕ)

example: ∀n: ℕ, n ∉ ({1, 2}: set ℕ) ∩ ({3, 4}: set ℕ) :=
begin
  _
end

/-
5.

Prove that 1 is in the difference between {1, 2, 3} and {3, 4}
-/

example: 1 ∈ ({1, 2, 3}: set ℕ) \ ({3, 4}: set ℕ) :=
begin
  _
end

/-
6.

Prove that {2, 3} is a subset of the union of {1, 2} and {3, 4}
Note: use ⊆ not ⊂
-/

example: ({2, 3}: set ℕ) ⊆ ({1, 2}: set ℕ) ∪ ({3, 4}: set ℕ) :=
begin
  _
end

/-
7.

Prove that {2, 3} is an element of the powerset of {1, 2, 3, 4}
-/

#reduce {2, 3} ∈ 𝒫({1, 2, 3, 4}: set ℕ)
-- ∀ ⦃a : ℕ⦄, a = 3 ∨ a = 2 ∨ false → a = 4 ∨ a = 3 ∨ a = 2 ∨ a = 1 ∨ false

example: {2, 3} ∈ 𝒫({1, 2, 3, 4}: set ℕ) :=
begin
  _
end

end sets

/- RELATIONS -/
namespace relations

/-
The following problems on relations use definitions
of properties of relations from the Lean library that
are identical to those we studied in class.
-/

/-
1.

Prove that disjunction has the symmetric property
-/

example: symmetric or :=
begin
  _
end

/-
2.

Prove that conjunction is a subrelation of disjunction
-/

example: subrelation and or :=
begin
  _
end

/-
3.

What is the transitive closure of the relation on
ℕ represented by the set { (1,2), (2, 3) }? Write
your answer as a related set in a comment below.
-/

/-
Your answer here:
-/

end relations

/-
===================================================
Inductive types, functions, properties, and proofs.
====================================================
-/

/-
1.

Define a function, sub_mynat : mynat → mynat → mynat,
that implements subtraction of the second argument, m,
from the first, n. If m >= n, the result should be 0,
otherwise it should be n - m. Hint: Think about cases
where one of the arguments is zero, and otherwise note
the following pattern: 3 - 2 = 2 - 1 = 1 - 0 = 1.
-/

namespace mynat

inductive mynat : Type
| zero : mynat
| succ : mynat → mynat

-- def sub_mynat: mynat → mynat → mynat

/-
2.

Prove that ∀ n, sub_mynat n n = 0.
-/

/-
3.

We give you a copy of the add_mynat function
below. Show that our definition of add_mynat
is associative.
-/

def add_mynat: mynat → mynat → mynat
| mynat.zero m := m
| (mynat.succ n') m :=
    mynat.succ (add_mynat n' m)

example: ∀(a b c: mynat),
  add_mynat a (add_mynat b c) = add_mynat (add_mynat a b) c :=
begin
  _
end

end mynat

/-
Simple inductive types.
-----------------------
-/

/-
3.

Define a new type called day having
these seven constant constructors:
sunday, monday, tuesday, wednesday,
thursday, friday, saturday. We will
interpret these constructors as
representing the actual days of the
week. Write your code below here now.
-/

inductive day : Type
-- finish this definition here

-- We suggest you open the day namespace

open day

/-
4.

Define a function, nextday : day → day,
that, when given a value, d : day, returns
the day value that represents the next day
of the week. Hint: either write a function
using a "match d with ... end", or, if you
prefer, use a tactic script (to write code!).
If you use a tactic script, use "cases d"
and for each possible case of d, specify
the exact day to be returned in that case.
For extra credit do it both ways and write
a single sentence to describe how these two
representations correspond.
-/

def nextday (d : day) : day :=
begin
  _
end

/-
5.

Formalize and prove the proposition that
for any day, d, if you apply nextday to d
seven times, the result is that very same
d. Write both the proposition to be proved
and its proof using "example".
-/

-- Your answer here

/-
Recursive (nested) inductive types.
-----------------------------------
-/

/-
6.

Give an inductive type definition for nat_list,
so that values of this type represent lists of
values of type ℕ.

While there's an infinity of such lists, we can
cleverly define the set inductively with just two
rules.

First, there is an empty list of natural numbers.
We will represent it with the constant constructor,
nil_nat. Make it one of the nat_list constructors.

Second, if we are given a nat_list value, l, and
a ℕ value, e : ℕ, we can always construct a list
that is one longer than by prepending e to l. To
do this, define a constructor called nat_cons. It
take arguments, e : ℕ and l : ₤st_nat, and yield a
nat_list.
-/

inductive nat_list : Type
-- finish the definition here

-- we suggest you open the nat_list namespace

open nat_list

/-
7.

Define X to be the nat_list value that we
interpret as representing the empty list of
natural numbers, []; Y to be the nat_list
value that represents the list, [1]; and
finally Z to represent the list, [2, 1].
-/

def X : nat_list := _
def Y : nat_list := _
def Z : nat_list := _

/-
8.

Define a function (it will be recursive)
that takes any nat_list value and that
returns its length (a natural number that
indicates how many values are in the list).
Call the function, length.

The challenge is to see the recursion in
the definition of the length of a list.
Hint questions: What is the length of the
empty list? What is the length of a list
that is not empty, and that thus must be
of the form (nat_cons h t), where h is the
value at the head of the list and t is the
rest of the list.
-/

/-
Uncomment the following line
and finish the definition
-/

--def length : nat_list → ℕ

/-
The stuff that follows is challenging
Get solid on the more basic stuff before
going here.
-/

/-
9.

Define a function, app (short for "append"),
that takes two nat_list values, let's call them
l1 and l2, and that returns the nat_list with
the elements of the first list followed by the
elements of the second list. For example,
(app Y Z) should return the list [1, 2, 1].

Hint: Consider the possible forms of l1. It
can only be either nat_nil or (nat_cons h t),
where, once again, h is is first element in
l1, and t is the rest of the list. Write the
function recursively accordingly.
-/

def app : nat_list → nat_list → nat_list
_

/-
10.

Prove the following

∀ l1 l2 : nat_list,
(length l1 + length l2) = length (append l1 l2)

Hint: use proof by induction on l1. There will be
two cases. In the first, l1 will be nat_nil, and
its length will reduce directly to 0. In the second
case, you will show that if the property is true for
some list l1', it is true for  next bigger list: one
in the form of (nat_cons h l1').
-/

example : ∀ l1 l2 : nat_list,
(length l1 + length l2) =
length (app l1 l2) :=
begin
  _
end

/- Formal Languages -/

namespace formal
/-
1.

Extend the following formal language to incorporate "or"
in a manner similar to "and"
-/

inductive pVar : Type
| mk : ℕ → pVar

inductive pExp : Type
| mk_lit_pexp : bool → pExp
| mk_var_pexp : pVar → pExp
| mk_not_pexp : pExp → pExp
| mk_and_pexp : pExp → pExp → pExp

open pExp

def pInterp := pVar → bool

def pEval : pExp → pInterp → bool
-- how to evaluate literal expression
| (mk_lit_pexp b) i := b
-- how to evaluate variable expression
| (mk_var_pexp v) i := i v
-- how to evaluate a "not" expression
| (mk_not_pexp e) i := bnot (pEval e i)
-- how to evaluate an "and" expression
| (mk_and_pexp e1 e2) i :=
    band (pEval e1 i) (pEval e2 i)

end formal


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

import Mathlib.Init.Algebra.Order

universe u

section

variable {α : Type u} [LinearOrder α]

lemma min_le_left (a b : α) : min a b ≤ a :=
if h : a ≤ b
then by simp[min, if_pos h, le_refl]
else by simp[min, if_neg h]
        exact le_of_not_le h

lemma min_le_right (a b : α) : min a b ≤ b :=
if h : a ≤ b
then by simp[min, if_pos h]; exact h
else by simp[min, if_neg h, le_refl]

lemma le_min {a b c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) : c ≤ min a b :=
if h : a ≤ b
then by simp[min, if_pos h]; exact h₁
else by simp[min, if_neg h]; exact h₂

lemma le_max_left (a b : α) : a ≤ max a b :=
if h : b < a
then by simp[max, if_pos h, le_refl]
else by simp[max, if_neg h]
        exact le_of_not_lt h

lemma le_max_right (a b : α) : b ≤ max a b :=
if h : b < a
then by simp[max, if_pos h]; exact le_of_lt h
else by simp[max, if_neg h, le_refl]

lemma max_le {a b c : α} (h₁ : a ≤ c) (h₂ : b ≤ c) : max a b ≤ c :=
if h : b < a
then by simp[max, if_pos h]; exact h₁
else by simp[max, if_neg h]; exact h₂

lemma eq_min {a b c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) (h₃ : ∀{d}, d ≤ a → d ≤ b → d ≤ c) :
  c = min a b :=
le_antisymm (le_min h₁ h₂) (h₃ (min_le_left a b) (min_le_right a b))

lemma min_comm (a b : α) : min a b = min b a :=
eq_min (min_le_right a b) (min_le_left a b) (λ {c} h₁ h₂ => le_min h₂ h₁)

lemma min_assoc (a b c : α) : min (min a b) c = min a (min b c) :=
by apply eq_min
   . apply le_trans; apply min_le_left; apply min_le_left
   . apply le_min; apply le_trans; apply min_le_left; apply min_le_right; apply min_le_right
   . intros d h₁ h₂; apply le_min; apply le_min h₁; apply le_trans h₂; apply min_le_left;
     apply le_trans h₂; apply min_le_right

lemma min_left_comm : @left_commutative α α min :=
left_comm min (@min_comm α _) (@min_assoc α _)

@[simp]
lemma min_self (a : α) : min a a = a := by simp[min]

lemma min_eq_left {a b : α} (h : a ≤ b) : min a b = a :=
by apply Eq.symm; apply eq_min (le_refl _) h; intros; assumption

lemma min_eq_right {a b : α} (h : b ≤ a) : min a b = b :=
by rw [min_comm]
   exact min_eq_left h

lemma eq_max {a b c : α} (h₁ : a ≤ c) (h₂ : b ≤ c) (h₃ : ∀{d}, a ≤ d → b ≤ d → c ≤ d) : c = max a b :=
le_antisymm (h₃ (le_max_left a b) (le_max_right a b)) (max_le h₁ h₂)

lemma max_comm (a b : α) : max a b = max b a :=
eq_max (le_max_right a b) (le_max_left a b) (λ {c} h₁ h₂ => max_le h₂ h₁)

lemma max_assoc (a b c : α) : max (max a b) c = max a (max b c) := by
  apply eq_max
  · apply le_trans; apply le_max_left a b; apply le_max_left
  · apply max_le; apply le_trans; apply le_max_right a b; apply le_max_left; apply le_max_right
  · intros d h₁ h₂; apply max_le; apply max_le h₁; apply le_trans (le_max_left _ _) h₂;
    apply le_trans (le_max_right _ _) h₂

lemma max_left_comm : ∀ (a b c : α), max a (max b c) = max b (max a c) :=
left_comm max (@max_comm α _) (@max_assoc α _)

@[simp]
lemma max_self (a : α) : max a a = a := by simp[max]

lemma max_eq_left {a b : α} (h : b ≤ a) : max a b = a :=
by apply Eq.symm; apply eq_max (le_refl _) h; intros; assumption

lemma max_eq_right {a b : α} (h : a ≤ b) : max a b = b :=
by rw [←max_comm b a]; exact max_eq_left h

/- these rely on lt_of_lt -/

lemma min_eq_left_of_lt {a b : α} (h : a < b) : min a b = a :=
min_eq_left (le_of_lt h)

lemma min_eq_right_of_lt {a b : α} (h : b < a) : min a b = b :=
min_eq_right (le_of_lt h)

lemma max_eq_left_of_lt {a b : α} (h : b < a) : max a b = a :=
max_eq_left (le_of_lt h)

lemma max_eq_right_of_lt {a b : α} (h : a < b) : max a b = b :=
max_eq_right (le_of_lt h)

/- these use the fact that it is a linear ordering -/

lemma lt_min {a b c : α} (h₁ : a < b) (h₂ : a < c) : a < min b c :=
Or.elim (le_or_gt b c)
  (λ h : b ≤ c => by rwa [min_eq_left h])
  (λ h : b > c => by rwa [min_eq_right_of_lt h])

lemma max_lt {a b c : α} (h₁ : a < c) (h₂ : b < c) : max a b < c :=
Or.elim (le_or_gt a b)
  (λ h : a ≤ b => by rwa [max_eq_right h])
  (λ h : a > b => by rwa [max_eq_left_of_lt h])

end


------------------
-- Random Notes --

--
-- 7.1. Enumerated Types
--
namespace s71
  inductive weekday : Type
    | sunday : weekday
    | monday : weekday
    | tuesday : weekday
    | wednesday : weekday
    | thursday : weekday
    | friday : weekday
    | saturday : weekday

  namespace weekday
    def next (d : weekday) : weekday :=
      weekday.cases_on d
        monday
        tuesday
        wednesday
        thursday
        friday
        saturday
        sunday

    def previous (d : weekday) : weekday :=
      weekday.cases_on d
        saturday
        sunday
        monday
        tuesday
        wednesday
        thursday
        friday

    theorem next_previous (d : weekday) : next (previous d) = d :=
    begin
      apply weekday.cases_on d;
      refl,
    end

    theorem previous_next (d : weekday) : previous (next d) = d :=
    begin
      apply weekday.cases_on d;
      refl,
    end
  end weekday
end s71

--
-- 7.2. Constructors with Arguments
--
namespace s72
  universes u v

  inductive prod (α : Type u) (β : Type v)
    | mk : α → β → prod

  namespace prod
    def fst {α : Type u} {β : Type v} (p : prod α β) : α :=
      prod.rec_on p (λa b, a)

    def snd {α : Type u} {β : Type v} (p : prod α β) : β :=
      prod.rec_on p (λa b, b)

    section
      variables (α : Type u) (β : Type v) (p : prod α β)
      variables (a : α) (b : β)

      #reduce mk a b
      #reduce fst (mk a b)
      #reduce snd (mk a b)
    end
  end prod

  -- Defining the necessary conditions for a group as a structure.
  --
  -- Now how would one actually use this definition?
  universe t

  structure Group :=
    (carrier : Type t)
    (ident : carrier)

    (inverse : carrier → carrier)
    (mul : carrier → carrier → carrier)

    (ident_mul_eq : ∀ a : carrier, mul ident a = a)
    (mul_ident_eq : ∀ a : carrier, mul a ident = a)

    (inverse_mul_eq_ident : ∀ a : carrier, mul (inverse a) a = ident)
    (mul_inverse_eq_ident : ∀ a : carrier, mul a (inverse a) = ident)

    (mul_assoc : ∀ a b c : carrier, mul (mul a b) c = mul a (mul b c))
end s72

---------------
-- Exercises --

-- Exercise 1
--
-- Try defining other operations on the natural numbers, such as multiplication,
-- the predecessor function (with pred 0 = 0), truncated subtraction (with
-- n - m = 0 when m is greater than or equal to n), and exponentiation. Then try
-- proving some of their basic properties, building on the theorems we have
-- already proved.
--
-- Since many of these are already defined in Lean’s core library, you should
-- work within a namespace named hide, or something like that, in order to avoid
-- name clashes.
namespace hidden
  variables (x y : ℕ)

  -- Defining our operations
  def add (x y : ℕ) : ℕ :=
    nat.rec_on
      x
      y
      (λ _ add_x_y, nat.succ add_x_y)

  def mul (x y : ℕ) : ℕ :=
    nat.rec_on
      x
      0
      (λ _ mul_x_y, add mul_x_y y)

  def pred (n : ℕ) : ℕ :=
    nat.rec_on
      n
      0
      (λ n pred_n, n)

  def sub (x y : ℕ) : ℕ :=
    nat.rec_on
      y
      x
      (λ n sub_x_y, pred sub_x_y)

  -- TODO: Define infix operators

  -- Defining some theorems. Skipping most of them because I did them in NN Game
  theorem add_sub_inverse : ∀ (x y : ℕ), x + y - y = x :=
    begin
      intros x y,

      induction y with d hd,

      {
        rw add_zero,
        -- rw sub_zero,
        sorry,
      },

      {
        sorry,
      },
    end
end hidden

-- TODO

-- Exericse 2
--
-- Define some operations on lists, like a length function or the reverse
-- function. Prove some properties, such as the following:
--
-- length (s ++ t) = length s + length t
--
-- length (reverse t) = length t
--
-- reverse (reverse t) = t

-- TODO

-- Exericse 3
--
-- Define an inductive data type consisting of terms built up from the following
-- constructors:
--
-- const n, a constant denoting the natural number n
--
-- var n, a variable, numbered n
--
-- plus s t, denoting the sum of s and t
--
-- times s t, denoting the product of s and t
--
-- Recursively define a function that evaluates any such term with respect to an
-- assignment of values to the variables.

-- Exercise 4
--
-- Similarly, define the type of propositional formulas, as well as functions on
-- the type of such formulas: an evaluation function, functions that measure the
-- complexity of a formula, and a function that substitutes another formula for
-- a given variable.

-- TODO

-- Exercise 5
--
-- Simulate the mutual inductive definition of even and odd described in Section 7.9 with an ordinary inductive type, using an index to encode the choice between them in the target type.

-- TODO


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# `equiv`

Let `X` and `Y` be types. Here's the definition of `X ≃ Y`
(which is notation for `equiv X Y`):

```

structure equiv (X : Type) (Y : Type) :=
(to_fun    : X → Y)
(inv_fun   : Y → X)
(left_inv  : ∀ x : X, inv_fun (to_fun x) = x)
(right_inv : ∀ y : Y, to_fun (inv_fun y) = y)

-- notation
infix ` ≃ `:25 := equiv

```

Here's an example: the identity bijection
between a type and itself:
-/

-- this is called `equiv.refl` in `mathlib`
example (X : Type) : X ≃ X :=
{ to_fun := λ x, x, -- x ↦ x
  inv_fun := λ y, y,-- y ↦ y
  left_inv := begin
    -- got to check that `∀ x, inv_fun (to_fun x) = x`
    intro x,
    dsimp, -- if you want to check the goal is definitionally `x = x`
    refl,
  end,
  right_inv := begin
    -- goal is definitionally `∀ y, to_fun (inv_fun y) = y`.
    intro y,
    refl,
  end }

-- now let's see you define `equiv.symm` and `equiv.trans`.
-- Let's start with `equiv.symm`.
-- Note that if `e : X ≃ Y` then `e.to_fun : X → Y`
-- and `e.left_inv` is a proof of `∀ x : X, e.inv_fun (e.to_fun x) = x` etc

example (X Y : Type) (e : X ≃ Y) : Y ≃ X :=
{ to_fun := e.inv_fun, -- you could write `λ x, e.inv_fun x` instead
  inv_fun := sorry, -- this is data -- don't use tactic mode
  left_inv := begin
    sorry -- this is a proof so tactic mode is fine
  end,
  right_inv := begin
    sorry -- this is a proof
  end }

-- can you build `equiv.trans` yourself?
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
{ to_fun := sorry, -- this is data; stay away from tactic mode.
  inv_fun := sorry, -- ditto
  left_inv := begin
    sorry -- this is a proof
  end,
  right_inv := begin
    sorry
  end }

-- here's the library's version
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
equiv.trans eXY eYZ

-- here it is again using dot notation
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
eXY.trans eYZ

-- See if you can make the following bijection using dot notation
example (A B C X : Type) (eAX : A ≃ X) (eBX : B ≃ X) : A ≃ B :=
sorry -- don't use tactic mode, see if you can find a one-liner
-- using `equiv.symm` and `equiv.trans`

-- We already have `equiv.refl ℚ : ℚ ≃ ℚ`, the identity bijection
-- between `ℚ` and itself. See if you can finish making a different one:

example : ℚ ≃ ℚ :=
{ to_fun := λ x, 3 * x + 4,
  inv_fun := λ y, sorry, -- fill in the inverse function
  left_inv := begin
    sorry,
  end,
  right_inv := begin
    sorry,
  end }

/-

Note that `equiv` is *data* -- `X ≃ Y` doesn't say "`X` bijects with `Y`";
that statement is a true-false statement. A term of type `X ≃ Y`
is *explicit functions* `X → Y` and `Y → X`, together with proofs
that they're inverse bijections.

Clearly there's an equivalence relation going on *somewhere* though:
here it is.

If `X : Type` then `∃ x : X, true` is just the statement that `X`
is nonempty. It's a proposition. So this works:

-/

-- Two types `X` and `Y` satisfy `R X Y` iff there *exists*
-- a bijection `X ≃ Y`.
def R (X Y : Type) : Prop := ∃ e : X ≃ Y, true

example : equivalence R :=
begin
  sorry
end

-- Remark: the equivalence classes of `R` are called *cardinals*.


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

! This file was ported from Lean 3 source module data.polynomial.erase_lead
! leanprover-community/mathlib commit fa256f00ce018e7b40e1dc756e403c86680bf448
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Fin
import Mathlib.Data.Polynomial.Degree.Definitions

/-!
# Erase the leading term of a univariate polynomial

## Definition

* `eraseLead f`: the polynomial `f - leading term of f`

`eraseLead` serves as reduction step in an induction, shaving off one monomial from a polynomial.
The definition is set up so that it does not mention subtraction in the definition,
and thus works for polynomials over semirings as well as rings.
-/

noncomputable section

open Classical Polynomial

open Polynomial Finset

namespace Polynomial

variable {R : Type _} [Semiring R] {f : R[X]}

/-- `eraseLead f` for a polynomial `f` is the polynomial obtained by
subtracting from `f` the leading term of `f`. -/
def eraseLead (f : R[X]) : R[X] :=
  Polynomial.erase f.natDegree f
#align polynomial.erase_lead Polynomial.eraseLead

section EraseLead

theorem eraseLead_support (f : R[X]) : f.eraseLead.support = f.support.erase f.natDegree := by
  simp only [eraseLead, support_erase]
#align polynomial.erase_lead_support Polynomial.eraseLead_support

theorem eraseLead_coeff (i : ℕ) : f.eraseLead.coeff i = if i = f.natDegree then 0 else f.coeff i :=
  by simp only [eraseLead, coeff_erase]
#align polynomial.erase_lead_coeff Polynomial.eraseLead_coeff

@[simp]
theorem eraseLead_coeff_natDegree : f.eraseLead.coeff f.natDegree = 0 := by simp [eraseLead_coeff]
#align polynomial.erase_lead_coeff_nat_degree Polynomial.eraseLead_coeff_natDegree

theorem eraseLead_coeff_of_ne (i : ℕ) (hi : i ≠ f.natDegree) : f.eraseLead.coeff i = f.coeff i := by
  simp [eraseLead_coeff, hi]
#align polynomial.erase_lead_coeff_of_ne Polynomial.eraseLead_coeff_of_ne

@[simp]
theorem eraseLead_zero : eraseLead (0 : R[X]) = 0 := by simp only [eraseLead, erase_zero]
#align polynomial.erase_lead_zero Polynomial.eraseLead_zero

@[simp]
theorem eraseLead_add_monomial_natDegree_leadingCoeff (f : R[X]) :
    f.eraseLead + monomial f.natDegree f.leadingCoeff = f :=
  (add_comm _ _).trans (f.monomial_add_erase _)
#align polynomial.erase_lead_add_monomial_nat_degree_leading_coeff Polynomial.eraseLead_add_monomial_natDegree_leadingCoeff

@[simp]
theorem eraseLead_add_C_mul_X_pow (f : R[X]) :
    f.eraseLead + C f.leadingCoeff * X ^ f.natDegree = f := by
  rw [C_mul_X_pow_eq_monomial, eraseLead_add_monomial_natDegree_leadingCoeff]
set_option linter.uppercaseLean3 false in
#align polynomial.erase_lead_add_C_mul_X_pow Polynomial.eraseLead_add_C_mul_X_pow

@[simp]
theorem self_sub_monomial_natDegree_leadingCoeff {R : Type _} [Ring R] (f : R[X]) :
    f - monomial f.natDegree f.leadingCoeff = f.eraseLead :=
  (eq_sub_iff_add_eq.mpr (eraseLead_add_monomial_natDegree_leadingCoeff f)).symm
#align polynomial.self_sub_monomial_nat_degree_leading_coeff Polynomial.self_sub_monomial_natDegree_leadingCoeff

@[simp]
theorem self_sub_C_mul_X_pow {R : Type _} [Ring R] (f : R[X]) :
    f - C f.leadingCoeff * X ^ f.natDegree = f.eraseLead := by
  rw [C_mul_X_pow_eq_monomial, self_sub_monomial_natDegree_leadingCoeff]
set_option linter.uppercaseLean3 false in
#align polynomial.self_sub_C_mul_X_pow Polynomial.self_sub_C_mul_X_pow

theorem lt_natDegree_of_mem_eraseLead_support {a : ℕ} (h : a ∈ (eraseLead f).support) :
    a < f.natDegree := by
  rw [eraseLead_support, mem_erase] at h
  exact (le_natDegree_of_mem_supp a h.2).lt_of_ne h.1
#align polynomial.lt_nat_degree_of_mem_erase_lead_support Polynomial.lt_natDegree_of_mem_eraseLead_support

theorem ne_natDegree_of_mem_eraseLead_support {a : ℕ} (h : a ∈ (eraseLead f).support) :
    a ≠ f.natDegree :=
  (lt_natDegree_of_mem_eraseLead_support h).ne
#align polynomial.ne_nat_degree_of_mem_erase_lead_support Polynomial.ne_natDegree_of_mem_eraseLead_support

theorem natDegree_not_mem_eraseLead_support : f.natDegree ∉ (eraseLead f).support := fun h =>
  ne_natDegree_of_mem_eraseLead_support h rfl
#align polynomial.nat_degree_not_mem_erase_lead_support Polynomial.natDegree_not_mem_eraseLead_support

theorem eraseLead_support_card_lt (h : f ≠ 0) : (eraseLead f).support.card < f.support.card := by
  rw [eraseLead_support]
  exact card_lt_card (erase_ssubset <| natDegree_mem_support_of_nonzero h)
#align polynomial.erase_lead_support_card_lt Polynomial.eraseLead_support_card_lt

theorem eraseLead_card_support {c : ℕ} (fc : f.support.card = c) :
    f.eraseLead.support.card = c - 1 := by
  by_cases f0 : f = 0
  · rw [← fc, f0, eraseLead_zero, support_zero, card_empty]
  · rw [eraseLead_support, card_erase_of_mem (natDegree_mem_support_of_nonzero f0), fc]
#align polynomial.erase_lead_card_support Polynomial.eraseLead_card_support

theorem eraseLead_card_support' {c : ℕ} (fc : f.support.card = c + 1) :
    f.eraseLead.support.card = c :=
  eraseLead_card_support fc
#align polynomial.erase_lead_card_support' Polynomial.eraseLead_card_support'

@[simp]
theorem eraseLead_monomial (i : ℕ) (r : R) : eraseLead (monomial i r) = 0 := by
  by_cases hr : r = 0
  · subst r
    simp only [monomial_zero_right, eraseLead_zero]
  · rw [eraseLead, natDegree_monomial, if_neg hr, erase_monomial]
#align polynomial.erase_lead_monomial Polynomial.eraseLead_monomial

@[simp]
theorem eraseLead_C (r : R) : eraseLead (C r) = 0 :=
  eraseLead_monomial _ _
set_option linter.uppercaseLean3 false in
#align polynomial.erase_lead_C Polynomial.eraseLead_C

@[simp]
theorem eraseLead_X : eraseLead (X : R[X]) = 0 :=
  eraseLead_monomial _ _
set_option linter.uppercaseLean3 false in
#align polynomial.erase_lead_X Polynomial.eraseLead_X

@[simp]
theorem eraseLead_X_pow (n : ℕ) : eraseLead (X ^ n : R[X]) = 0 := by
  rw [X_pow_eq_monomial, eraseLead_monomial]
set_option linter.uppercaseLean3 false in
#align polynomial.erase_lead_X_pow Polynomial.eraseLead_X_pow

@[simp]
theorem eraseLead_C_mul_X_pow (r : R) (n : ℕ) : eraseLead (C r * X ^ n) = 0 := by
  rw [C_mul_X_pow_eq_monomial, eraseLead_monomial]
set_option linter.uppercaseLean3 false in
#align polynomial.erase_lead_C_mul_X_pow Polynomial.eraseLead_C_mul_X_pow

theorem eraseLead_add_of_natDegree_lt_left {p q : R[X]} (pq : q.natDegree < p.natDegree) :
    (p + q).eraseLead = p.eraseLead + q := by
  ext n
  by_cases nd : n = p.natDegree
  · rw [nd, eraseLead_coeff, if_pos (natDegree_add_eq_left_of_natDegree_lt pq).symm]
    simpa using (coeff_eq_zero_of_natDegree_lt pq).symm
  · rw [eraseLead_coeff, coeff_add, coeff_add, eraseLead_coeff, if_neg, if_neg nd]
    rintro rfl
    exact nd (natDegree_add_eq_left_of_natDegree_lt pq)
#align polynomial.erase_lead_add_of_nat_degree_lt_left Polynomial.eraseLead_add_of_natDegree_lt_left

theorem eraseLead_add_of_natDegree_lt_right {p q : R[X]} (pq : p.natDegree < q.natDegree) :
    (p + q).eraseLead = p + q.eraseLead := by
  ext n
  by_cases nd : n = q.natDegree
  · rw [nd, eraseLead_coeff, if_pos (natDegree_add_eq_right_of_natDegree_lt pq).symm]
    simpa using (coeff_eq_zero_of_natDegree_lt pq).symm
  · rw [eraseLead_coeff, coeff_add, coeff_add, eraseLead_coeff, if_neg, if_neg nd]
    rintro rfl
    exact nd (natDegree_add_eq_right_of_natDegree_lt pq)
#align polynomial.erase_lead_add_of_nat_degree_lt_right Polynomial.eraseLead_add_of_natDegree_lt_right

theorem eraseLead_degree_le : (eraseLead f).degree ≤ f.degree :=
  f.degree_erase_le _
#align polynomial.erase_lead_degree_le Polynomial.eraseLead_degree_le

theorem eraseLead_natDegree_le_aux : (eraseLead f).natDegree ≤ f.natDegree :=
  natDegree_le_natDegree eraseLead_degree_le
#align polynomial.erase_lead_nat_degree_le_aux Polynomial.eraseLead_natDegree_le_aux

theorem eraseLead_natDegree_lt (f0 : 2 ≤ f.support.card) : (eraseLead f).natDegree < f.natDegree :=
  lt_of_le_of_ne eraseLead_natDegree_le_aux <|
    ne_natDegree_of_mem_eraseLead_support <|
      natDegree_mem_support_of_nonzero <| eraseLead_ne_zero f0
#align polynomial.erase_lead_nat_degree_lt Polynomial.eraseLead_natDegree_lt

theorem eraseLead_natDegree_lt_or_eraseLead_eq_zero (f : R[X]) :
    (eraseLead f).natDegree < f.natDegree ∨ f.eraseLead = 0 := by
  by_cases h : f.support.card ≤ 1
  · right
    rw [← C_mul_X_pow_eq_self h]
    simp
  · left
    apply eraseLead_natDegree_lt (lt_of_not_ge h)
#align polynomial.erase_lead_nat_degree_lt_or_erase_lead_eq_zero Polynomial.eraseLead_natDegree_lt_or_eraseLead_eq_zero

theorem eraseLead_natDegree_le (f : R[X]) : (eraseLead f).natDegree ≤ f.natDegree - 1 := by
  rcases f.eraseLead_natDegree_lt_or_eraseLead_eq_zero with (h | h)
  · exact Nat.le_pred_of_lt h
  · simp only [h, natDegree_zero, zero_le]
#align polynomial.erase_lead_nat_degree_le Polynomial.eraseLead_natDegree_le

end EraseLead

/-- An induction lemma for polynomials. It takes a natural number `N` as a parameter, that is
required to be at least as big as the `nat_degree` of the polynomial.  This is useful to prove
results where you want to change each term in a polynomial to something else depending on the
`nat_degree` of the polynomial itself and not on the specific `nat_degree` of each term. -/
theorem induction_with_natDegree_le (P : R[X] → Prop) (N : ℕ) (P_0 : P 0)
    (P_C_mul_pow : ∀ n : ℕ, ∀ r : R, r ≠ 0 → n ≤ N → P (C r * X ^ n))
    (P_C_add : ∀ f g : R[X], f.natDegree < g.natDegree → g.natDegree ≤ N → P f → P g → P (f + g)) :
    ∀ f : R[X], f.natDegree ≤ N → P f := by
  intro f df
  generalize hd : card f.support = c
  revert f
  induction' c with c hc
  · intro f _ f0
    convert P_0
    simpa [support_eq_empty, card_eq_zero] using f0
  · intro f df f0
    rw [← eraseLead_add_C_mul_X_pow f]
    cases c
    · convert P_C_mul_pow f.natDegree f.leadingCoeff ?_ df using 1
      · convert zero_add (C (leadingCoeff f) * X ^ f.natDegree)
        rw [← card_support_eq_zero, eraseLead_card_support f0]
      · rw [leadingCoeff_ne_zero, Ne.def, ← card_support_eq_zero, f0]
        exact zero_ne_one.symm
    refine' P_C_add f.eraseLead _ _ _ _ _
    · refine' (eraseLead_natDegree_lt _).trans_le (le_of_eq _)
      · exact (Nat.succ_le_succ (Nat.succ_le_succ (Nat.zero_le _))).trans f0.ge
      · rw [natDegree_C_mul_X_pow _ _ (leadingCoeff_ne_zero.mpr _)]
        rintro rfl
        simp at f0
    · exact (natDegree_C_mul_X_pow_le f.leadingCoeff f.natDegree).trans df
    · exact hc _ (eraseLead_natDegree_le_aux.trans df) (eraseLead_card_support f0)
    · refine' P_C_mul_pow _ _ _ df
      rw [Ne.def, leadingCoeff_eq_zero, ← card_support_eq_zero, f0]
      exact Nat.succ_ne_zero _
#align polynomial.induction_with_nat_degree_le Polynomial.induction_with_natDegree_le

/-- Let `φ : R[x] → S[x]` be an additive map, `k : ℕ` a bound, and `fu : ℕ → ℕ` a
"sufficiently monotone" map.  Assume also that
* `φ` maps to `0` all monomials of degree less than `k`,
* `φ` maps each monomial `m` in `R[x]` to a polynomial `φ m` of degree `fu (deg m)`.
Then, `φ` maps each polynomial `p` in `R[x]` to a polynomial of degree `fu (deg p)`. -/
theorem mono_map_natDegree_eq {S F : Type _} [Semiring S] [AddMonoidHomClass F R[X] S[X]] {φ : F}
    {p : R[X]} (k : ℕ) (fu : ℕ → ℕ) (fu0 : ∀ {n}, n ≤ k → fu n = 0)
    (fc : ∀ {n m}, k ≤ n → n < m → fu n < fu m) (φ_k : ∀ {f : R[X]}, f.natDegree < k → φ f = 0)
    (φ_mon_nat : ∀ n c, c ≠ 0 → (φ (monomial n c)).natDegree = fu n) :
    (φ p).natDegree = fu p.natDegree := by
  refine' induction_with_natDegree_le (fun p => (φ p).natDegree = fu p.natDegree)
    p.natDegree (by simp [fu0]) _ _ _ rfl.le
  · intro n r r0 _
    rw [natDegree_C_mul_X_pow _ _ r0, C_mul_X_pow_eq_monomial, φ_mon_nat _ _ r0]
  · intro f g fg _ fk gk
    rw [natDegree_add_eq_right_of_natDegree_lt fg, _root_.map_add]
    by_cases FG : k ≤ f.natDegree
    · rw [natDegree_add_eq_right_of_natDegree_lt, gk]
      rw [fk, gk]
      exact fc FG fg
    · cases k
      · exact (FG (Nat.zero_le _)).elim
      · rwa [φ_k (not_le.mp FG), zero_add]
#align polynomial.mono_map_nat_degree_eq Polynomial.mono_map_natDegree_eq

theorem map_natDegree_eq_sub {S F : Type _} [Semiring S] [AddMonoidHomClass F R[X] S[X]] {φ : F}
    {p : R[X]} {k : ℕ} (φ_k : ∀ f : R[X], f.natDegree < k → φ f = 0)
    (φ_mon : ∀ n c, c ≠ 0 → (φ (monomial n c)).natDegree = n - k) :
    (φ p).natDegree = p.natDegree - k :=
  mono_map_natDegree_eq k (fun j => j - k) (by simp)
    (@fun m n h => (tsub_lt_tsub_iff_right h).mpr)
    (φ_k _) φ_mon
#align polynomial.map_nat_degree_eq_sub Polynomial.map_natDegree_eq_sub

theorem map_natDegree_eq_natDegree {S F : Type _} [Semiring S] [AddMonoidHomClass F R[X] S[X]]
    {φ : F} (p) (φ_mon_nat : ∀ n c, c ≠ 0 → (φ (monomial n c)).natDegree = n) :
    (φ p).natDegree = p.natDegree :=
  (map_natDegree_eq_sub (fun f h => (Nat.not_lt_zero _ h).elim) (by simpa)).trans
    p.natDegree.sub_zero
#align polynomial.map_nat_degree_eq_nat_degree Polynomial.map_natDegree_eq_natDegree

open BigOperators

theorem card_support_eq' {n : ℕ} (k : Fin n → ℕ) (x : Fin n → R) (hk : Function.Injective k)
    (hx : ∀ i, x i ≠ 0) : (∑ i, C (x i) * X ^ k i).support.card = n := by
  suffices (∑ i, C (x i) * X ^ k i).support = image k univ by
    rw [this, univ.card_image_of_injective hk, card_fin]
  simp_rw [Finset.ext_iff, mem_support_iff, finset_sum_coeff, coeff_C_mul_X_pow, mem_image,
    mem_univ, exists_true_left, true_and]
  refine' fun i => ⟨fun h => _, _⟩
  · obtain ⟨j, _, h⟩ := exists_ne_zero_of_sum_ne_zero h
    exact ⟨j, (ite_ne_right_iff.mp h).1.symm⟩
  · rintro ⟨j, _, rfl⟩
    rw [sum_eq_single_of_mem j (mem_univ j), if_pos rfl]
    · exact hx j
    · exact fun m _ hmj => if_neg fun h => hmj.symm (hk h)
#align polynomial.card_support_eq' Polynomial.card_support_eq'

theorem card_support_eq {n : ℕ} :
    f.support.card = n ↔
      ∃ (k : Fin n → ℕ)(x : Fin n → R)(hk : StrictMono k)(hx : ∀ i, x i ≠ 0),
        f = ∑ i, C (x i) * X ^ k i := by
  refine' ⟨_, fun ⟨k, x, hk, hx, hf⟩ => hf.symm ▸ card_support_eq' k x hk.injective hx⟩
  induction' n with n hn generalizing f
  · exact fun hf => ⟨0, 0, fun x => x.elim0, fun x => x.elim0, card_support_eq_zero.mp hf⟩
  · intro h
    obtain ⟨k, x, hk, hx, hf⟩ := hn (eraseLead_card_support' h)
    have H : ¬∃ k : Fin n, Fin.castSucc k = Fin.last n :=
      by
      rintro ⟨i, hi⟩
      exact i.castSucc_lt_last.ne hi
    refine'
      ⟨Function.extend Fin.castSucc k fun _ => f.natDegree,
        Function.extend Fin.castSucc x fun _ => f.leadingCoeff, _, _, _⟩
    · intro i j hij
      have hi : i ∈ Set.range (Fin.castSucc : Fin n ↪o Fin (n + 1)) :=
        by
        rw [Fin.range_castSucc, Set.mem_def]
        exact lt_of_lt_of_le hij (Nat.lt_succ_iff.mp j.2)
      obtain ⟨i, rfl⟩ := hi
      rw [Fin.castSucc.injective.extend_apply]
      by_cases hj : ∃ j₀, Fin.castSucc j₀ = j
      · obtain ⟨j, rfl⟩ := hj
        rwa [Fin.castSucc.injective.extend_apply, hk.lt_iff_lt, ← Fin.castSucc_lt_castSucc_iff]
      · rw [Function.extend_apply' _ _ _ hj]
        apply lt_natDegree_of_mem_eraseLead_support
        rw [mem_support_iff, hf, finset_sum_coeff]
        rw [sum_eq_single, coeff_C_mul, coeff_X_pow_self, mul_one]
        · exact hx i
        · intro j _ hji
          rw [coeff_C_mul, coeff_X_pow, if_neg (hk.injective.ne hji.symm), mul_zero]
        · exact fun hi => (hi (mem_univ i)).elim
    · intro i
      by_cases hi : ∃ i₀, Fin.castSucc i₀ = i
      · obtain ⟨i, rfl⟩ := hi
        rw [Fin.castSucc.injective.extend_apply]
        exact hx i
      · rw [Function.extend_apply' _ _ _ hi, Ne, leadingCoeff_eq_zero, ← card_support_eq_zero, h]
        exact n.succ_ne_zero
    · rw [Fin.sum_univ_castSucc]
      simp only [Fin.castSucc.injective.extend_apply]
      rw [← hf, Function.extend_apply', Function.extend_apply', eraseLead_add_C_mul_X_pow]
      all_goals exact H
#align polynomial.card_support_eq Polynomial.card_support_eq

theorem card_support_eq_one : f.support.card = 1 ↔ ∃ (k : ℕ)(x : R)(hx : x ≠ 0), f = C x * X ^ k :=
  by
  refine' ⟨fun h => _, _⟩
  · obtain ⟨k, x, _, hx, rfl⟩ := card_support_eq.mp h
    exact ⟨k 0, x 0, hx 0, Fin.sum_univ_one _⟩
  · rintro ⟨k, x, hx, rfl⟩
    rw [support_C_mul_X_pow k hx, card_singleton]
#align polynomial.card_support_eq_one Polynomial.card_support_eq_one

theorem card_support_eq_two :
    f.support.card = 2 ↔
      ∃ (k m : ℕ)(hkm : k < m)(x y : R)(hx : x ≠ 0)(hy : y ≠ 0), f = C x * X ^ k + C y * X ^ m := by
  refine' ⟨fun h => _, _⟩
  · obtain ⟨k, x, hk, hx, rfl⟩ := card_support_eq.mp h
    refine' ⟨k 0, k 1, hk Nat.zero_lt_one, x 0, x 1, hx 0, hx 1, _⟩
    rw [Fin.sum_univ_castSucc, Fin.sum_univ_one]
    rfl
  · rintro ⟨k, m, hkm, x, y, hx, hy, rfl⟩
    exact card_support_binomial hkm.ne hx hy
#align polynomial.card_support_eq_two Polynomial.card_support_eq_two

theorem card_support_eq_three :
    f.support.card = 3 ↔
      ∃ (k m n : ℕ)(hkm : k < m)(hmn : m < n)(x y z : R)(hx : x ≠ 0)(hy : y ≠ 0)(hz : z ≠ 0),
        f = C x * X ^ k + C y * X ^ m + C z * X ^ n := by
  refine' ⟨fun h => _, _⟩
  · obtain ⟨k, x, hk, hx, rfl⟩ := card_support_eq.mp h
    refine'
      ⟨k 0, k 1, k 2, hk Nat.zero_lt_one, hk (Nat.lt_succ_self 1), x 0, x 1, x 2, hx 0, hx 1, hx 2,
        _⟩
    rw [Fin.sum_univ_castSucc, Fin.sum_univ_castSucc, Fin.sum_univ_one]
    rfl
  · rintro ⟨k, m, n, hkm, hmn, x, y, z, hx, hy, hz, rfl⟩
    exact card_support_trinomial hkm hmn hx hy hz
#align polynomial.card_support_eq_three Polynomial.card_support_eq_three

end Polynomial


import data.nat.order.basic

-- Utility library for three maxes of ℕ

/-- maximum of three natural numbers. -/
def max3 (a b c : ℕ) : ℕ := max (max a b) c

theorem max3_mul_left (a b c d : ℕ) :
  max3 (a * b) (a * c) (a * d) = a * max3 b c d :=
begin
  -- This is hard: should I use `max_mul_of_nonneg`
  -- or `max_mul_mul_left`?
  rw nat.mul_comm a (max3 b c d),
  simp_rw max3,
  rw max_mul_of_nonneg _ _ (zero_le a),
  rw max_mul_of_nonneg _ _ (zero_le a),
  repeat {rw nat.mul_comm a _},
end

theorem le_max3_first (a b c : ℕ) : a ≤ max3 a b c :=
  le_max_of_le_left (le_max_left _ _)

theorem le_max3_second (a b c : ℕ) : b ≤ max3 a b c :=
  le_max_of_le_left (le_max_right _ _)

theorem le_max3_third (a b c : ℕ) : c ≤ max3 a b c :=
  le_max_right _ _

theorem max3_lt_iff {a b c d : ℕ} :
  max3 a b c < d ↔ a < d ∧ b < d ∧ c < d :=
begin
  rw max3, simp only [max_lt_iff], tauto,
end

theorem add3_le_three_mul_max3 (a b c : ℕ) :
  a + b + c ≤ 3 * max3 a b c :=
begin
  rw (show 3 = 2 + 1, by exact rfl),
  rw [nat.succ_mul, two_mul],
  apply nat.add_le_add _ (le_max3_third _ _ _),
  apply nat.add_le_add _ (le_max3_second _ _ _),
  exact le_max3_first _ _ _,
end

theorem weighted_average_le_max3 {p q r a b c: ℕ} :
  p*a + q*b + r*c ≤ (p+q+r)*(max3 a b c) :=
begin
  simp_rw add_mul,
  apply nat.add_le_add,
  apply nat.add_le_add,
  exact nat.mul_le_mul (le_refl _) (le_max3_first _ _ _),
  exact nat.mul_le_mul (le_refl _) (le_max3_second _ _ _),
  exact nat.mul_le_mul (le_refl _) (le_max3_third _ _ _),
end


import BrownCs22.Library.Tactics

namespace Lecture04

/-

Recall from lecture:
* A *proof state* is a sequence of goals,
  each with an associated list of hypotheses.
* We can manipulate a proof state by applying *proof rules*.
  Proof rules change the goals and/or hypotheses.
* The objective of proving is to apply proof rules
  until there are no remaining goals.

* *introduction rules* tell us how to show goals of certain shapes.
* *elimination rules* tell us how to use hypotheses of certain shapes.

-/

-- let `p, q, r` be propositions.
variable (p q r : Prop)

/-

To start a proof, we write `example :` or `theorem theorem_name :`,
followed by the proposition we are trying to prove,
followed by `:= by`.

What follows after that is a list of proof rules ("tactics").
If we put the cursor at the end of any line, we see the current proof state
after applying that rule.

The lines above the `⊢` symbol are our *context*, i.e. our hypotheses.
The line after the `⊢` is our current goal.

-/

example : p → p := by
  intro hp
  assumption

/-
Here are some useful tactics, corresponding to the intro rules we've seen.

* and introduction: `split_goal`
* or introduction: `left`, `right`
* implication intro: `intro h` (you get to name the new hypothesis)
* iff intro: `split_goal`
* atom: `assumption` (if your goal matches a hypothesis)

* `sorry` proves the goal automatically, no matter what it is.
  This is cheating! :)
-/

example : p → q → p ∧ q := by
  intro hp
  intro hq
  split_goal
  { assumption } -- when we have multiple goals, we sometimes put each subproof in {...}
  { assumption }  -- but this is mainly for style!

example : p → p ∨ q := by
  intro hp
  left
  assumption

-- try it yourself:

example : q → p ∨ q := by
  intro hq
  right
  assumption

example : (p ∧ q) → (p ↔ q) := by
  intro h
  split_goal
  {
    {intro hq}
    {sorry}
    }

/-
*Elimination rules* tell us how we can use hypotheses. To start:

* and elimination: `eliminate h with h1 h2`,
  when `h : p ∧ q` is in the context. Creates new hypotheses
  `h1 : p` and `h2 : q`.
* or elimination: `eliminate h with h1 h2`,
  when `h : p ∨ q` is in the context. Creates new goals,
  one with `h1 : p` in the context and one with `h2 : q` in the context.

-/

example : p ∧ q → q ∧ p := by
  intro hpq
  eliminate hpq with hp hq
  split_goal
  . assumption
  . assumption

example : (p ∨ q) → (p ∨ r) ∨ (q ∨ r) := by
  intro hpq
  eliminate hpq with hp hq
  { left
    left
    assumption }
  { right
    left
    assumption }

/-

Using an iff is easy: `eliminate` will turn it into two "imply"s.

-/

example : (p ↔ q) → (p → q) := by
  intro h_iff
  eliminate h_iff with hpq hqp
  assumption

/-

Using an "imply" is a little trickier:
if we know `hpq : p → q`, and our goal is to prove `q`,
then `apply hpq` will change the goal to `p`.

-/

example : p → (p → q) → q := by
  intro hp
  intro hpq
  apply hpq
  assumption

/-

Alternatively, if we know `hpq : p → q` and `hp : p`,
we can "reason forward" by writing `have hq : q := hpq hp`.
This adds a new hypothesis `hq : q` without changing the goal.
This syntax is a little clunky, but we'll use it in a more general setting later.

-/

example : p → (p → q) → q ∧ p := by
  intro hp
  intro hpq
  have hq : q := hpq hp
  split_goal
  { assumption }
  { assumption }

/- Here's a little logic puzzle.

(h1) Alan likes acorns, and either Betty likes begonias or Carl likes cacti.

(h2) If Betty likes begonias, then Alan doesn’t like acorns.

(h3) If Carl likes cacti, then Betty likes begonias.

Show that these hypotheses are contradictory.

-/

variable (al_ac : Prop) -- the proposition "Alan likes acorns"
variable (betty_beg : Prop) -- the proposition "Betty likes begonias"
variable (carl_cac : Prop) -- the proposition "Carl likes cacti"

theorem these_are_contradictory
    (h1 : al_ac ∧ (betty_beg ∨ carl_cac))
    (h2 : betty_beg → ¬ al_ac)
    (h3 : carl_cac → betty_beg) :
    False := by
  eliminate h1 with h4 h5      -- from h1, we know
                               -- (h4) Alan likes acorns and
                               -- (h5) either Betty likes begonias or Carl likes cacti.
  eliminate h5 with h6 h7      -- let's reason by cases on h5.

  { have h8 : ¬ al_ac := h2 h6 -- First, suppose Betty likes begonias.
                               -- Then, by modus ponens with h2, Alan does not like acorns.
    contradiction }            -- This contradicts h4!

  { have h9 : betty_beg := h3 h7 -- Now suppose Carl likes cacti.
                                 -- By modus ponens with h3, Betty likes begonias.
    have h10 : ¬ al_ac := h2 h9  -- But now again by modus ponens with h2, Alan does not like acorns.
    contradiction }              -- Another contradiction!
                                 -- We've finished all our goals.

/-

You've just seen the missing connective.
We skipped rules for negation introduction and elimination before.

This example just showed how to *use* a negation:
if we have hypotheses `hp : p` and `hnp : ¬ p`, then
`contradiction` will prove any goal.

How to introduce a negation? This uses a technique called
"proof by contradiction", which we'll motivate in class soon.

-/

end Lecture04


open classical

variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
iff.intro
  (assume H : p ∧ q,
    and.intro (and.right H) (and.left H))
  (assume H : q ∧ p,
    and.intro (and.right H) (and.left H))

example : p ∨ q ↔ q ∨ p :=
iff.intro
  (assume H : p ∨ q,
    or.elim H or.inr or.inl)
  (assume H : q ∨ p,
    or.elim H or.inr or.inl)

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
iff.intro
  (assume H : (p ∧ q) ∧ r,
    and.intro (and.left (and.left H))
      (and.intro (and.right (and.left H))
        (and.right H)))
  (assume H : p ∧ (q ∧ r),
    and.intro
      (and.intro (and.left H)
        (and.left (and.right H)))
      (and.right (and.right H)))

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
iff.intro
  (assume H : (p ∨ q) ∨ r,
    or.elim H
      (assume Hpq : p ∨ q,
        or.elim Hpq or.inl
          (assume Hq : q, or.inr (or.inl Hq)))
      (assume Hr : r, or.inr (or.inr Hr)))
  (assume H : p ∨ (q ∨ r),
    or.elim H
      (assume Hp : p, or.inl (or.inl Hp))
      (assume Hqr : q ∨ r,
        or.elim Hqr
          (assume Hq : q, or.inl (or.inr Hq))
          or.inr))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
  (assume H : p ∧ (q ∨ r),
    have Hp : p, from and.left H,
    have Hqr : q ∨ r, from and.right H,
    or.elim Hqr
      (λ Hq, or.inl (and.intro Hp Hq))
      (λ Hr, or.inr (and.intro Hp Hr)))
  (assume H : (p ∧ q) ∨ (p ∧ r),
    or.elim H
      (assume Hpq : p ∧ q,
        and.intro (and.left Hpq)
          (or.inl (and.right Hpq)))
      (assume Hpr : p ∧ r,
        and.intro (and.left Hpr)
          (or.inr (and.right Hpr))))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
iff.intro
  (assume H : p ∨ (q ∧ r),
    or.elim H
      (λ Hp, and.intro (or.inl Hp) (or.inl Hp))
      (assume Hqr,
        and.intro
          (or.inr (and.left Hqr))
          (or.inr (and.right Hqr))))
  (assume H : (p ∨ q) ∧ (p ∨ r),
    have Hpq : p ∨ q, from and.left H,
    have Hpr : p ∨ r, from and.right H,
    or.elim Hpq or.inl
      (assume Hq : q,
        or.elim Hpr or.inl
          (assume Hr : r,
            or.inr (and.intro Hq Hr))))

-- other properties
example : (p → q → r) ↔ (p ∧ q → r) :=
iff.intro
  (assume H : p → q → r,
    (assume Hpq : p ∧ q,
      H (and.left Hpq) (and.right Hpq)))
  (assume H : p ∧ q → r,
    λ Hp, λ Hq, H (and.intro Hp Hq))

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
iff.intro
  (assume H : (p ∨ q) → r,
    and.intro (λ Hp, H (or.inl Hp))
              (λ Hq, H (or.inr Hq)))
  (assume H : (p → r) ∧ (q → r),
    (assume Hpq : p ∨ q,
      or.elim Hpq (and.left H) (and.right H)))

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
iff.intro
  (assume Hpq : ¬(p ∨ q),
    show ¬p ∧ ¬q, from
    and.intro
      (assume Hp : p,
        Hpq (or.inl Hp))
      (assume Hq : q,
        Hpq (or.inr Hq)))
  (assume H : ¬p ∧ ¬q,
    have Hnp : ¬p, from and.left H,
    have Hnq : ¬q, from and.right H,
    not.intro
      (assume Hpq : p ∨ q,
        or.elim Hpq Hnp Hnq))

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  (assume H : ¬p ∨ ¬q,
    not.intro
      (assume Hpq : p ∧ q,
        have Hp : p, from and.left Hpq,
        have Hq : q, from and.right Hpq,
        show false, from
          or.elim H
            (assume Hnp : ¬p, Hnp Hp)
            (assume Hnq : ¬q, Hnq Hq)))

example : ¬(p ∧ ¬ p) :=
not.intro
  (assume H : p ∧ ¬p,
    have Hp : p, from and.left H,
    have Hn : ¬p, from and.right H,
    show false, from Hn Hp)

example : p ∧ ¬q → ¬(p → q) :=
  (assume H : p ∧ ¬q,
    have Hp : p, from and.left H,
    have Hnq : ¬q, from and.right H,
    not.intro
      (assume Hpq : p → q,
        show false, from Hnq (Hpq Hp)))

example : ¬p → (p → q) :=
  (assume Hn : ¬p, (assume Hp : p, absurd Hp Hn))

example : (¬p ∨ q) → (p → q) :=
  (assume H : ¬p ∨ q,
    or.elim H
      (assume Hn : ¬p, (assume Hp : p, absurd Hp Hn))
      (assume Hq : q, (assume Hp : p, Hq)))

example : p ∨ false ↔ p :=
iff.intro
  (assume H : p ∨ false,
    or.elim H id false.elim)
  or.inl

example : p ∧ false ↔ false :=
iff.intro
  and.right
  (assume H : false, and.intro (false.elim H) H)

example : ¬(p ↔ ¬p) :=
not.intro
  (assume H : p ↔ ¬p,
    have Hnp: ¬p, from not.intro (λ Hp, iff.mp H Hp Hp),
    have Hp: p, from iff.mpr H Hnp,
    show false, from not.intro Hnp Hp)

example : (p → q) → (¬q → ¬p) :=
(assume H : p → q,
  (assume Hnq : ¬q,
    not.intro
      (assume Hp : p,
        Hnq (H Hp))))

-- these require classical reasoning
open classical

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  (assume H : p → r ∨ s,
  by_cases
    (assume Hp : p,
      or.elim (H Hp)
        (assume Hr : r,
          or.inl (λ Hpp : p, Hr))
        (assume Hs : s,
          or.inr (λ Hpp : p, Hs)))
    (assume Hnp : ¬p, or.inl (λ Hp : p, absurd Hp Hnp)))

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  (assume H : ¬(p ∧ q),
  by_cases
    (assume Hp : p,
    by_cases
      (assume Hq : q, absurd (and.intro Hp Hq) H)
      (assume Hnq : ¬q, or.inr Hnq))
    (assume Hnp : ¬p, or.inl Hnp))

theorem impl_or : (p → q) → ¬p ∨ q :=
  (assume H : p → q,
    by_cases
      or.inr
      (assume Hnq : ¬q,
        by_cases
          (assume Hp : p, absurd (H Hp) Hnq)
          or.inl))

theorem or_impl : ¬p ∨ q → (p → q) :=
  (assume H : ¬p ∨ q,
    (assume Hp : p,
      or.elim H
        (λ Hnp : ¬p, absurd Hp Hnp)
        id))

theorem nimpl_and : ¬(p → q) → p ∧ ¬q :=
  (assume H : ¬(p → q),
    have Hnq : ¬q, from
      by_cases
        (assume Hq : q, absurd (λ Hp, Hq) H)
        id,
    have Hp : p, from
      by_cases
        id
        (assume Hnp : ¬p, sorry),
    and.intro Hp Hnq)

example : (p → q) → (¬p ∨ q) :=
  (assume H : p → q,
    by_cases
      (assume Hp : p, or.inr (H Hp))
      (assume Hnp : ¬p, or.inl Hnp))

theorem contrapositive : (¬q → ¬p) → (p → q) :=
  (assume H : ¬q → ¬p,
    (assume Hp : p,
      or.elim (em q)
        id
        (λ Hnq : ¬q, absurd Hp (H Hnq))))

example : p ∨ ¬p :=
  em p

example : (((p → q) → p) → p) :=
  (assume Hpqp : (p → q) → p,
    by_cases
      (assume Hp : p, Hp)
      (assume Hnp : ¬p,
        have Hnpq : ¬(p → q), from sorry,
        and.left (nimpl_and p q Hnpq)))


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

import tactic.ring
import data.nat.prime

/-!
# IMO 1959 Q1

Prove that the fraction `(21n+4)/(14n+3)` is irreducible for every natural number `n`.

Since Lean doesn't have a concept of "irreducible fractions" per se, we just formalize this
as saying the numerator and denominator are relatively prime.
-/

open nat

lemma calculation (n k : ℕ) (h1 : k ∣ 21 * n + 4) (h2 : k ∣ 14 * n + 3) : k ∣ 1 :=
have h3 : k ∣ 2 * (21 * n + 4), from h1.mul_left 2,
have h4 : k ∣ 3 * (14 * n + 3), from h2.mul_left 3,
have h5 : 3 * (14 * n + 3) = 2 * (21 * n + 4) + 1, by ring,
(nat.dvd_add_right h3).mp (h5 ▸ h4)

theorem imo1959_q1 : ∀ n : ℕ, coprime (21 * n + 4) (14 * n + 3) :=
assume n, coprime_of_dvd' $ λ k hp h1 h2, calculation n k h1 h2


import Mathlib.Data.Nat.Basic
import Mathlib.Tactic.Cases
import Notes4.IndTypes
/-
Induction with Inductive Types

Let's see a bit how how induction is called inductive types.
For each inductive type, recursors are automatically instantiated.
-/

#check Nat.rec
#check List.rec

example (a b c: ℕ) : exp (a*b) c = (exp a c) * exp b c := by
  apply @Nat.rec (fun c => exp (a*b) c = ((exp a c) * exp b c))
  · simp [exp]
  · intro n ih
    simp [exp]
    rw [ih]
    ac_rfl

/-

Using the recusors directly is not as ergnomic as some built in tactics
of which there are few.

First, we have already seen that `match` can be used to argue via
induction.

Let's prove that our exponentiation function on ℕ is multiplicative in
the base.
-/

theorem mul_of_mul_base_exp (a b c : ℕ) : exp (a*b) c = (exp a c) * exp b c := by
  match c with
  | 0 => simp only [exp]
  | z+1 =>
    simp only [exp,Nat.add]
    rw [mul_of_mul_base_exp a b z]
    ac_rfl

/-

In `mul_of_mul_base_exp`, we used induction at the step `rw [mul_of_mul_base_exp a b c]`
since this presumes a proof of `mul_of_mul_base_exp a b c`.

Consider the following version using an anonymous `example`.

example (a b c: ℕ) : exp (a*b) c = (exp a c) * exp b c := by
  match c with
  | 0 => simp only [exp]
  | c+1 =>
    simp only [exp,Nat.add]
    -- how do we call the inductive step without a name?
    sorry

In this case, we can use `induction` or `induction'`.

-/

variable {α : Type}

open List

def iterateAppend : ℕ → List α → List α
  | 0, _ => []
  | n+1, l => l ++ iterateAppend n l

-- Using `induction`
example (n : ℕ) (l : List α) : n*(l.length) = (iterateAppend n l).length := by
  induction n with
  | zero =>
    simp only [iterateAppend,length]
    rw [Nat.zero_mul]
  | succ n' inductionHyp =>
    simp [iterateAppend,length]
    rw [Nat.succ_mul]
    rw [inductionHyp]
    ac_rfl

-- Using `induction'`
example (n : ℕ) (l : List α) : n*(l.length) = (iterateAppend n l).length := by
  induction' n with m indhyp
  · simp only [iterateAppend,length]
    rw [Nat.zero_mul]
  · simp [iterateAppend,length]
    rw [Nat.succ_mul]
    rw [indhyp]
    ac_rfl

#check Nat.mul

open Nat

def times : ℕ → ℕ → ℕ
  | _, 0 => 0
  | a , b+1 => times a b + a

example (n m : ℕ) : times n m = times m n := by
  induction m with
  | zero =>
    induction n with
      | zero => rfl
      | succ n' ih =>
        simp [times] at *
        exact ih
  | succ m' ih =>
    induction n with
      | zero =>
        simp [times] at *
        exact ih
      | succ n' ih' =>
        simp [times] at *
        rw [ih]
        sorry
@[simp]
theorem zero_times { n: ℕ } : times 0 n = 0 := by
  match n with
  | 0 => simp
  | n'+1 =>
    simp [times]
    exact zero_times

@[simp]
theorem succ_times { n m : ℕ } : times (n+1) m = times n m + m := by
  match m with
  | 0 =>
    simp [times]
  | m'+1 =>
    simp [times]
    rw [@succ_times n m']
    ac_rfl

theorem times_comm (n m : ℕ) : times n m = times m n := by
  match n,m with
  | n, 0 =>
    simp [times]
    -- rw [zero_times]
  | n, m'+1 =>
    simp [times]
    -- rw [succ_times]
    rw [times_comm n m']

example (a n m : ℕ) : times a (m + n) = times a m + times a n := by
  induction a with
  | zero => simp
  | succ b ih =>
    simp only [succ_times]
    rw [ih]
    ac_rfl


import tactic

namespace notes

universe u
variables {X Y Z : Type u}

--------------------------------------------------------------------------------
-- # Functions

section
  example (f : X → Y) (g : X → Y) :
-- Proposition. (Extensionality of Functions)
    f = g ↔ (∀ x : X, f x = g x)
-- Note that in Lean it follows from an axiom (`funext`).
-- Proof.
    :=
  begin
    split,
    { intros h, rw h, exact (λ x, rfl), },
    { intros h, funext, exact h x, },
  end
-- ∎
end

section
-- Definitions.
  def injective (f : X → Y) : Prop :=
    ∀ (a b : X), f a = f b → a = b
  def surjective (f : X → Y) : Prop :=
    ∀ y : Y, ∃ x : X, f x = y
  def bijective (f : X → Y) : Prop :=
    injective f ∧ surjective f
end

section
  variables {f : X → Y} {g : Y → Z}

  theorem composition_inj_of_inj :
-- Theorem.
    injective f → injective g → injective (g ∘ f)
-- Proof.
  :=
  begin
    unfold injective at *,
    intros hf hg a b h,
    unfold function.comp at *,
    apply hf,
    apply (hg (f a) (f b)),
    exact h,
  end
-- ∎

  theorem composition_surj_of_surj :
-- Theorem.
    surjective f → surjective g → surjective (g ∘ f)
-- Proof.
  :=
  begin
    unfold surjective at *,
    intros hf hg z,
    unfold function.comp at *,
    cases (hg z) with y hy,
    cases (hf y) with x hx,
    use x,
    rw [hx, hy],
  end
-- ∎

  theorem composition_bij_of_bij :
-- Theorem.
    bijective f → bijective g → bijective (g ∘ f)
-- Proof.
  :=
  begin
    unfold bijective at *,
    rintros ⟨hf_inj, hf_surj⟩ ⟨hg_inj, hg_surj⟩,
    exact ⟨composition_inj_of_inj hf_inj hg_inj, composition_surj_of_surj hf_surj hg_surj⟩,
  end
-- ∎

  theorem inj_of_composition_inj :
-- Theorem.
    injective (g ∘ f) → injective f
-- Proof.
  :=
  begin
    unfold injective at *,
    intros h_inj a b h,
    apply h_inj,
    unfold function.comp,
    rw h,
  end
-- ∎

  theorem surj_of_composition_surj :
-- Theorem.
    surjective (g ∘ f) → surjective g
-- Proof.
  :=
  begin
    unfold surjective at *,
    intros h z,
    cases (h z) with x hx,
    use (f x),
    exact hx,
  end
-- ∎
end

section
-- Definition.
  def are_inverse (f : X → Y) (g : Y → X) : Prop :=
    (∀ x : X, g (f x) = x) ∧ (∀ y : Y, f (g y) = y)

  lemma are_inverse.symm (f : X → Y) (g : Y → X) :
-- Corollary.
    are_inverse f g ↔ are_inverse g f
-- Proof.
  :=
  begin
    unfold are_inverse,
    split,
    { rintros ⟨hgf, hfg⟩, exact ⟨hfg, hgf⟩, },
    { rintros ⟨hfg, hgf⟩, exact ⟨hgf, hfg⟩, },
  end
-- ∎
end

section
  open classical

  theorem has_inverse_iff_bij (f : X → Y) :
-- Theorem.
    bijective f ↔ (∃ g : Y → X, are_inverse f g)
-- Proof.
  :=
  begin
    split,
    { rintros ⟨hf_inj, hf_surj⟩,
      let g : Y → X := (λ y, some (hf_surj y)),
      use g,
      split,
      { intros x,
        have hgy := some_spec (hf_surj (f x)),
        have hgy' := hf_inj _ _ hgy,
        exact hgy', },
      { intros y,
        have hgy := some_spec (hf_surj y),
        exact hgy, } },
    { rintros ⟨g, ⟨hgf, hfg⟩⟩,
      split,
      { intros a b h,
        rw [← hgf a, h, hgf b], },
      { intros y,
        use (g y),
        exact (hfg y), } },
  end
-- ∎
end

--------------------------------------------------------------------------------
-- # Relations

section
  variable r : X → X → Prop
-- Definitions.
  def reflexive : Prop :=
    ∀ (a : X), r a a
  def symmetric : Prop :=
    ∀ {a b : X}, r a b → r b a
  def antisymmetric : Prop :=
    ∀ {a b : X}, r a b → r b a → a = b
  def transitive : Prop :=
    ∀ {a b c : X}, r a b → r b c → r a c
  def total : Prop :=
    ∀ (a b : X), r a b ∨ r b a
end

section
  variable r : X → X → Prop
-- Definitions.
  def is_partial_order : Prop :=
    reflexive r ∧ antisymmetric r ∧ transitive r
  def is_total_order : Prop :=
    reflexive r ∧ antisymmetric r ∧ transitive r ∧ total r
  def is_equivalence_relation : Prop :=
    reflexive r ∧ symmetric r ∧ transitive r
end

section
  variables (r : X → X → Prop)
-- Definition.
  def cl (hr : is_equivalence_relation r) (s : X) : set X :=
    (λ x, r s x)
end

section
  variables (r : X → X → Prop) (hr : is_equivalence_relation r)
  local notation `cl` := cl r hr

  lemma cl.eq_of_equiv {a b : X} :
-- Lemma.
    r a b → cl a = cl b
-- Proof.
  :=
  begin
    rcases hr with ⟨hrefl, hsymm, htrans⟩,
    unfold «cl»,
    intros hr,
    ext, split,
    { intros hax, exact (htrans (hsymm hr) hax), },
    { intros hbx, exact (htrans hr hbx), },
  end
-- ∎

  lemma cl.disjoint_of_not_equiv {a b : X} :
-- Lemma.
    ¬(r a b) → cl a ∩ cl b = ∅
-- Proof.
  :=
  begin
    rcases hr with ⟨hrefl, hsymm, htrans⟩,
    unfold «cl» at *,
    intros h,
    ext, split,
    { rintros ⟨hax, hbx⟩, exact h (htrans hax (hsymm hbx)), },
    { intros hf, exfalso, exact hf, },
  end
end
-- ∎

section
-- Definition.
  def is_partition (A : set (set X)) : Prop :=
    ∀ x : X, ∃! a, a ∈ A ∧ x ∈ a
end

section
  variables (r : X → X → Prop) (hr : is_equivalence_relation r)
  local notation `cl` := cl r hr

  theorem partition_from_equiv :
-- Theorem.
    is_partition (λ s, ∃ x : X, s = cl x)
-- Proof.
  :=
  begin
    have hr' := hr,
    rcases hr' with ⟨hrefl, hsymm, htrans⟩,
    intros x,
    use (cl x), split,                 -- Claim: `x` is only in `cl x`
    { exact ⟨⟨x, rfl⟩, hrefl x⟩, },    -- By definition, `x` is in `cl x`
    { unfold «cl»,
      rintros a ⟨⟨z, ha⟩, hx : (a x)⟩,
      ext y, split,                    -- Assume that `x` is also in `y`
      { intros hy,
        rw ha at *,
        exact htrans (hsymm hx) hy, }, -- Then anything in `y` must be in `cl x`
      { intros hxy,
        rw ha at *,
        exact htrans hx hxy, } },      -- And anything in `cl x` must be in `y`
  end
-- ∎

  private theorem partition_equiv_eq_self {f : X → set X} {rf : X → X → Prop}
-- Theorem.
    (hf : ∀ a : X, f a = cl a) (hrf : ∀ a b : X, rf a b ↔ f a = f b) :
    rf = r
-- Proof.
  :=
  begin
    rcases hr with ⟨hrefl, hsymm, htrans⟩,
    unfold «cl» at *,
    ext x y, split,
    { intros hxy,
      have h := (hrf x y).mp hxy,
      rw [hf, hf] at h,
      have h' : r y y → r x y,
      { change (λ (x : X), r y x) y → r x y,
        rw ← h,
        exact id, },
      exact h' (hrefl y), },
    { intros hxy,
      have h : f x = f y,
      { rw [hf, hf],
        ext, split,
        { intros h, exact htrans (hsymm hxy) h, },
        { intros h, exact htrans hxy h, }, },
      exact (hrf x y).mpr h, },
  end
-- ∎
end

--------------------------------------------------------------------------------

end notes


import BrownCs22.Library.Tactics

/-

In this file, we'll prove some of the identities from
https://brown-cs22.github.io/resources/math-resources/logic.pdf

Note that these identities are stated with the symbol `≡`,
meaning "the formula on the left is equivalent to the formula on the right."
In Lean, we can use iff (bi-implication, `↔`) to mean the same thing.

Remember the tactics we learned in Lecture 4.
We'll see a bit of new Lean syntax along the way.

Also remember that it doesn't matter what we name our hypotheses.
In our examples, we use patterns like `hp` for the hypothesis `p`,
`hnpq` for the hypothesis `¬ p ∧ q` (hnpq for "hypothesis not p q"), etc.
But this is just a custom. You can choose any names you want.
As they say, the hardest problem in computer science is naming variables.

Your task: fill in all the `sorry`s with proofs!

-/

variable (p q r : Prop)

-- ## Commutative Laws

-- We'll do the first for you, as an example.
-- Notice two things.
-- One, must of these problems will start with `split_goal`,
-- to turn the `iff` goal into two `implies` goals.
-- Two, we structure our proof by putting each *subproof* in `{...}`.
-- This isn't necessary but it helps with organization!
example : p ∧ q ↔ q ∧ p := by
  split_goal
  { intro hpq
    eliminate hpq with hp hq
    split_goal
    assumption
    assumption }
  { intro hqp
    eliminate hqp with hq hp
    split_goal
    assumption
    assumption }

example : p ∨ q ↔ q ∨ p := by
  split_goal
  { intro hpq
    eliminate hpq with hp hq
    { right
      assumption }
    { left
      assumption } }
  { intro hqp
    eliminate hqp with hq hp
    { right
      assumption }
    { left
      assumption } }

-- ## Associative laws

-- Notice that Lean doesn't print parentheses unless it needs to.
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by
  split_goal
  { intro hpqr
    eliminate hpqr with hpq hr
    eliminate hpq with hp hq
    split_goal
    assumption
    split_goal
    assumption
    assumption }
  { intro hpqr
    eliminate hpqr with hp hqr
    eliminate hqr with hq hr
    split_goal
    split_goal
    assumption
    assumption
    assumption }

-- This is getting a little repetitive.
-- To mix it up, we'll only do one direction of the iff this time.
-- You won't start with `split_goal`, but instead, ... what?
example : (p ∨ q) ∨ r → p ∨ (q ∨ r) := by
  intro hpqr
  eliminate hpqr with hpq hr
  { eliminate hpq with hp hq
    { left
      assumption }
    { right
      left
      assumption } }
  { right
    right
    assumption }

-- ## Distributive laws

-- warning, this one is kind of long!
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  split_goal
  { intro hpqr
    eliminate hpqr with hp hqr
    eliminate hqr with hq hr
    { left
      split_goal
      assumption
      assumption }
    { right
      split_goal
      assumption
      assumption } }
  { intro hpqpr
    eliminate hpqpr with hpq hpr
    { eliminate hpq with hp hq
      split_goal
      assumption
      left
      assumption }
    { eliminate hpr with hp hr
      split_goal
      assumption
      right
      assumption } }

-- Again, let's just do one direction.
-- When we're proving an implication `→`, we'll always start with `intro`.
-- This is such a common pattern that Lean gives us special syntax for it:
-- we can do the intro "in advance," before we start the proof,
-- by naming the hypothesis to the left of the `:`.
-- Notice that at the beginning of our proof, we already have the
-- hypothesis `hpqr` in our context.
example (hpqr : p ∨ (q ∧ r)) : (p ∨ q) ∧ (p ∨ r) := by
  eliminate hpqr with hp hqr
  { split_goal
    { left
      assumption }
    { left
      assumption } }
  { eliminate hqr with hq hr
    split_goal
    { right
      assumption }
    { right
      assumption } }

-- ## Identity laws

/-

We'll do a few more together.

Let's sneak a new tactic in.
To prove a goal `True`, you can use the tactic `trivial`.
This is a sensible proof rule: trivially, you can always show `True` is true!
-/

example : p ∧ True ↔ p := by
  split_goal
  { intro hpT
    eliminate hpT
    assumption }
  { intro hpT
    split_goal
    assumption
    trivial }

-- Before, we saw `contradiction` would work if we had hypotheses
-- `p` and `¬ p` at the same time.
-- It also works if we have a hypothesis `False`!
example : p ∨ False ↔ p := by
  split_goal
  { intro hpF
    eliminate hpF with hp hF
    assumption
    contradiction }
  { intro hp
    left
    assumption }

/-

## Negation laws

If you're following along with the list of identities, you'll see that
we've come to some laws like `(p ∨ ¬ p) ↔ True`.

Unfortunately, we don't have the tools to prove these in Lean yet.

But, you can do the **Idempotent laws** and **Universal bound laws**.
Try stating and proving these yourself!

-/

/-

## De Morgan's Laws

These can be a bit of a challenge! Like the negation laws,
a few of the implications here will require some new tools.
But try out these directions.

Remember that to prove a negation `¬ X`, you can use a *proof by contradiction*:
add a hypothesis `h : X` using `intro h`, and then show a contradiction.

-/

example (hnpnq : ¬ p ∨ ¬ q) : ¬(p ∧ q) := by
  intro hpq
  eliminate hpq with hp hq
  eliminate hnpnq with hnp hnq
  contradiction
  contradiction

example (hnpnq : ¬ p ∧ ¬ q) : ¬ (p ∨ q) := by
  intro hpq
  eliminate hnpnq with hnp hnq
  eliminate hpq with hp hq
  contradiction
  contradiction

/-

That's it for the moment!
Try the **Absorption laws** and **Negation of True and False**
on your own, if you want to. Skip the definition laws for now.

-/


import data.real.basic

/-!
# IMO 2011 Q3

Let f : ℝ → ℝ be a function that satisfies

   f(x + y) ≤ y * f(x) + f(f(x))

for all x and y. Prove that f(x) = 0 for all x ≤ 0.

# Solution

Direct translation of the solution found in https://www.imo-official.org/problems/IMO2011SL.pdf
-/

theorem imo2011_q3 (f : ℝ → ℝ) (hf : ∀ x y, f (x + y) ≤ y * f x + f (f x)) :
  ∀ x ≤ 0, f x = 0 :=
begin
  -- reparameterize
  have hxt : ∀ x t, f t ≤ t * f x - x * f x + f (f x),
  { intros x t,
    calc f t = f (x + (t - x))             : by rw (add_eq_of_eq_sub' rfl)
         ... ≤ (t - x) * f x + f (f x)     : hf x (t - x)
         ... = t * f x - x * f x + f (f x) : by rw sub_mul },

  have h_ab_combined : ∀ a b, a * f a + b * f b ≤ 2 * f a * f b,
  { intros a b,
    linarith [hxt b (f a), hxt a (f b)] },

  have h_f_nonneg_of_pos : ∀ a < 0, 0 ≤ f a,
  { intros a han,
    suffices : a * f a ≤ 0, from nonneg_of_mul_nonpos_right this han,
    exact add_le_iff_nonpos_left.mp (h_ab_combined a (2 * f a)) },

  have h_f_nonpos : ∀ x, f x ≤ 0,
  { intros x,
    by_contra h_suppose_not,
    -- If we choose a small enough argument for f, then we get a contradiction.
    let s := (x * f x - f (f x)) / (f x),
    have hm : min 0 s - 1 < s := (sub_one_lt _).trans_le (min_le_right 0 s),
    have hml : min 0 s - 1 < 0 := (sub_one_lt _).trans_le (min_le_left 0 s),

    suffices : f (min 0 s - 1) < 0, from not_le.mpr this (h_f_nonneg_of_pos (min 0 s - 1) hml),

    have hp : 0 < f x := not_le.mp h_suppose_not,
    calc f (min 0 s - 1)
           ≤ (min 0 s - 1) * f x - x * f x + f (f x) : hxt x (min 0 s - 1)
      ...  < s * f x - x * f x + f (f x) : by linarith [(mul_lt_mul_right hp).mpr hm]
      ...  = 0 : by { rw [(eq_div_iff hp.ne.symm).mp rfl], linarith } },

  have h_fx_zero_of_neg : ∀ x < 0, f x = 0,
  { intros x hxz,
    exact (h_f_nonpos x).antisymm (h_f_nonneg_of_pos x hxz) },

  intros x hx,
  obtain (h_x_neg : x < 0) | (rfl : x = 0) := hx.lt_or_eq,
  { exact h_fx_zero_of_neg _ h_x_neg },
  { suffices : 0 ≤ f 0, from (h_f_nonpos 0).antisymm this,
    have hno : f (-1) = 0 := h_fx_zero_of_neg (-1) neg_one_lt_zero,
    have hp := hxt (-1) (-1),
    rw hno at hp,
    linarith },
end


theorem mem_singleton_iff {t: Type} {a b: t}:
  a ∈ ({b} : set t) ↔ a = b :=
begin
  split,
  intro h,
  cases h,
  exact h,
  exfalso,
  exact h,
  intro h,
  rw h,
  simp [singleton],
  simp [has_insert.insert],
  simp [set.insert],
  simp [has_emptyc.emptyc],
  simp [has_mem.mem],
  simp [set.mem],
  simp [set_of],
end

theorem mem_pred {t: Type} {s: set t} {p: t -> Prop} {x: t}:
  x ∈ { y ∈ s | p y} ->
  x ∈ s :=
begin
  intro h,
  cases h,
  exact h_left,
end

theorem set_ext {t: Type} {a b: set t}: (∀ x, x ∈ a ↔ x ∈ b) -> a = b :=
begin
  intro h,
  exact funext (fun x, propext (h x)),
end

theorem pred_distr_union {t: Type} {a b: set t} {p: t -> Prop}:
  { x ∈ (a ∪ b) | p x } = { x ∈ a | p x } ∪ { x ∈ b | p x } :=
set_ext begin
  intro x,
  split,
  intro h,
  cases h,
  cases h_left,
  left,
  split,
  exact h_left,
  simp,
  exact h_right,
  right,
  split,
  exact h_left,
  simp,
  exact h_right,
  intro h,
  cases h,
  cases h,
  split,
  left,
  exact h_left,
  simp,
  exact h_right,
  cases h,
  split,
  right,
  exact h_left,
  simp,
  exact h_right,
end

theorem singleton_not_pred {t: Type} {x: t} {p: t -> Prop} (npx: ¬ (p x)):
  { y ∈ {x} | p y } = (∅: set t) :=
set_ext begin
  intro y,
  split,
  intro h,
  cases h,
  let hm := iff.elim_left mem_singleton_iff h_left,
  rw hm at h_right,
  exfalso,
  exact npx h_right,
  intro h,
  exfalso,
  exact h,
end

theorem union_emp {t: Type} {a: set t}: ∅ ∪ a = a :=
set_ext begin
  intro x,
  split,
  intro h,
  cases h,
  exfalso,
  exact h,
  exact h,
  intro h,
  right,
  exact h,
end

theorem double_pred {t: Type} {s: set t} {p: t -> Prop}:
  { x ∈ { y ∈ s | p y } | p x } = { x ∈ s | p x } :=
set_ext begin
  intro x,
  split,
  intro h,
  cases h,
  cases h_left,
  split,
  exact h_left_left,
  simp,
  exact h_right,
  intro h,
  cases h,
  split,
  split,
  exact h_left,
  simp,
  exact h_right,
  simp,
  exact h_right,
end