import tactic.norm_num data.nat.basic tactic.ring algebra.archimedean .limits data.nat.choose
section a
open real nat is_absolute_value finset
noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable

lemma pow_inv' {α : Type*} [discrete_field α] (a : α) (n : ℕ) : (a ^ n)⁻¹ = a⁻¹ ^ n :=
by induction n; simp [_root_.pow_succ, *, mul_inv', mul_comm]

lemma pow_incrs_of_gt_one {α : Type*}  [linear_ordered_semiring α] {x : α} {n m : ℕ}
  (h1x : 1 < x) (hnm : n < m) : x ^ n < x ^ m :=
begin
  rw [← nat.sub_add_cancel hnm, _root_.pow_add, _root_.pow_succ, ← mul_assoc],
  refine (lt_mul_iff_one_lt_left (pow_pos (lt_trans (by norm_num) h1x) _)).2 _,
  rw ← one_mul (1 : α),
  refine mul_lt_mul' (one_le_pow_of_one_le (le_of_lt h1x) _) h1x (by norm_num)
    (pow_pos (lt_trans (by norm_num) h1x) _)
end

lemma pow_dcrs_of_lt_one_of_pos {α : Type*} [discrete_linear_ordered_field α] {x : α} {n m : ℕ}
  (hx1 : x < 1) (h0x : 0 < x) (hnm : n < m) : x ^ m < x ^ n :=
begin
  refine (inv_lt_inv _ _).1 _,
  { exact pow_pos h0x _ },
  { exact pow_pos h0x _ },
  { rw [pow_inv', pow_inv'],
    refine pow_incrs_of_gt_one (one_lt_inv h0x hx1) hnm }
end

open finset

@[simp] lemma sum_range_zero {α : Type*} [add_comm_monoid α] (f : ℕ → α) :
  (range 0).sum f = 0 := rfl

lemma sum_range_succ {α : Type*} [add_comm_monoid α] (f : ℕ → α) (n : ℕ) :
  (range (succ n)).sum f = f n + (range n).sum f := by simp

lemma sum_range_succ' {α : Type*} [add_comm_monoid α] (f : ℕ → α) :
  ∀ n : ℕ, (range (nat.succ n)).sum f = (range n).sum (f ∘ nat.succ) + f 0
| 0       := by simp
| (n + 1) := by rw [sum_range_succ (λ m, f (nat.succ m)), add_assoc, ← sum_range_succ'];
  exact sum_range_succ _ _

/-- The binomial theorem -/
theorem add_pow {α : Type*} [comm_semiring α] (x y : α) : ∀ n : ℕ,
    (x + y) ^ n = (range (succ n)).sum (λ m, x ^ m * y ^ (n - m) * choose n m)
| 0        := by simp
| (succ n) :=
have h₁ : x * (x ^ n * y ^ (n - n) * choose n n) =
    x ^ succ n * y ^ (succ n - succ n) * choose (succ n) (succ n),
  by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
have  h₂ : y * (x^0 * y^(n - 0) * choose n 0) = x^0 * y^(succ n - 0) * choose (succ n) 0,
  by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
have h₃ : (range n).sum (λ m, x * (x ^ m * y ^ (n - m) * choose n m) + y *
    (x ^ succ m * y ^ (n - succ m) * choose n (succ m)))
    = (range n).sum (λ m, x ^ succ m * y ^ (succ n - succ m) * ↑(choose (succ n) (succ m))),
  from finset.sum_congr rfl $ λ m hm,
    begin
      simp only [mul_assoc, mul_left_comm y, mul_left_comm (y ^ (n - succ m)), mul_comm y],
      rw [← _root_.pow_succ', add_one, ← succ_sub (mem_range.1 hm)],
      simp [choose_succ_succ, mul_comm, mul_assoc, mul_left_comm, add_mul, mul_add, _root_.pow_succ]
    end,
by rw [_root_.pow_succ, add_pow, add_mul, finset.mul_sum, finset.mul_sum, sum_range_succ, sum_range_succ',
    sum_range_succ, sum_range_succ', add_assoc, ← add_assoc ((range n).sum _),
    ← finset.sum_add_distrib, h₁, h₂, h₃]

lemma geo_series_eq {α : Type*} [field α] {x : α} (n : ℕ) (hx1 : x ≠ 1) :
  (range n).sum (λ m, x ^ m) = (1 - x ^ n) / (1 - x) :=
have 1 - x ≠ 0 := mt sub_eq_zero_iff_eq.1 hx1.symm,
begin
  induction n with n ih,
  { simp },
  { rw [sum_range_succ, ← mul_div_cancel (x ^ n) this, ih, ← add_div, _root_.pow_succ],
    refine congr_fun (congr_arg _ _) _,
    ring }
end

variables {α : Type*} {β : Type*}
  [discrete_linear_ordered_field α] [archimedean α] {abv : β → α}

lemma forall_ge_le_of_forall_le_succ {α : Type*} [preorder α] (f : ℕ → α) {m : ℕ}
  (h : ∀ n ≥ m, f (succ n) ≤ f n) : ∀ l, ∀ k ≥ m, k ≤ l → f l ≤ f k :=
begin
  assume l k hkm hkl,
  generalize hp : l - k = p,
  have : l = k + p := add_comm p k ▸ (nat.sub_eq_iff_eq_add hkl).1 hp,
  subst this,
  clear hkl hp,
  induction p with p ih,
  { simp },
  { exact le_trans (h _ (le_trans hkm (nat.le_add_right _ _))) ih }
end

lemma is_cau_of_dcrs_bounded {α : Type*} [discrete_linear_ordered_field α]
  [archimedean α] (f : ℕ → α)
  {a : α} {m : ℕ} (ham : ∀ n ≥ m, abs (f n) ≤ a)
  (hnm : ∀ n ≥ m, f (succ n) ≤ f n) : is_cau_seq abs f :=
λ ε ε0,
let ⟨k, hk⟩ := archimedean.arch a ε0 in
have h : ∃ l, ∀ n ≥ m, a - add_monoid.smul l ε < f n :=
  ⟨k + k + 1, λ n hnm, lt_of_lt_of_le
    (show a - add_monoid.smul (k + (k + 1)) ε < -abs (f n),
      from lt_neg.1 $ lt_of_le_of_lt (ham n hnm) (begin
        rw [neg_sub, lt_sub_iff_add_lt, add_monoid.add_smul],
        exact add_lt_add_of_le_of_lt hk (lt_of_le_of_lt hk
          (lt_add_of_pos_left _ ε0)),
      end))
    (neg_le.2 $ (abs_neg (f n)) ▸ le_abs_self _)⟩,
let l := nat.find h in
have hl : ∀ (n : ℕ), n ≥ m → f n > a - add_monoid.smul l ε := nat.find_spec h,
have hl0 : l ≠ 0 := λ hl0, not_lt_of_ge (ham m (le_refl _))
  (lt_of_lt_of_le (by have := hl m (le_refl m); simpa [hl0] using this) (le_abs_self (f m))),
begin
  cases classical.not_forall.1
    (nat.find_min h (pred_lt hl0)) with i hi,
  rw [not_imp, not_lt] at hi,
  existsi i,
  assume j hj,
  have hfij : f j ≤ f i := forall_ge_le_of_forall_le_succ f hnm _ _ hi.1 hj,
  rw [abs_of_nonpos (sub_nonpos.2 hfij), neg_sub, sub_lt_iff_lt_add'],
  exact calc f i ≤ a - add_monoid.smul (pred l) ε : hi.2
    ... = a - add_monoid.smul l ε + ε :
      by conv {to_rhs, rw [← succ_pred_eq_of_pos (nat.pos_of_ne_zero hl0), succ_smul',
        sub_add, add_sub_cancel] }
    ... < f j + ε : add_lt_add_right (hl j (le_trans hi.1 hj)) _
end

lemma is_cau_of_incrs_bounded {α : Type*} [discrete_linear_ordered_field α]
  [archimedean α] (f : ℕ → α)
  {a : α} {m : ℕ} (ham : ∀ n ≥ m, abs (f n) ≤ a)
  (hnm : ∀ n ≥ m, f n ≤ f (succ n)) : is_cau_seq abs f :=
begin
  refine @eq.rec_on (ℕ → α) _ (is_cau_seq abs) _ _
    (-⟨_, @is_cau_of_dcrs_bounded _ _ _ (λ n, -f n) a m (by simpa) (by simpa)⟩ : cau_seq α abs).2,
  ext,
  exact neg_neg _
end

lemma series_cau_of_abv_le_cau {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β] {f : ℕ → β}
    {g : ℕ → α} {abv : β → α} [is_absolute_value abv] (n : ℕ) : (∀ m, n ≤ m → abv (f m) ≤ g m) →
    is_cau_seq abs (λ n, (range n).sum g) → is_cau_seq abv (λ n, (range n).sum f) := begin
  assume hm hg ε ε0,cases hg (ε / 2) (div_pos ε0 (by norm_num)) with i hi,
  existsi max n i,
  assume j ji,
  have hi₁ := hi j (le_trans (le_max_right n i) ji),
  have hi₂ := hi (max n i) (le_max_right n i),
  have sub_le := abs_sub_le ((range j).sum g) ((range i).sum g) ((range (max n i)).sum g),
  have := add_lt_add hi₁ hi₂,
  rw abs_sub ((range (max n i)).sum g) at this,
  rw add_halves ε at this,
  refine lt_of_le_of_lt (le_trans (le_trans _ (le_abs_self _)) sub_le) this,
  generalize hk : j - max n i = k,clear this hi₂ hi₁ hi ε0 ε hg sub_le,
  rw nat.sub_eq_iff_eq_add ji at hk,rw hk, clear hk ji j,
  induction k with k' hi,
  { simp [abv_zero abv] },
  { dsimp at *,
    rw [succ_add, sum_range_succ, sum_range_succ, add_assoc, add_assoc],
    refine le_trans (abv_add _ _ _) _,
    exact add_le_add (hm _ (le_add_of_nonneg_of_le (nat.zero_le _) (le_max_left _ _))) hi },
end

lemma pow_abv {α β : Type*} [discrete_linear_ordered_field α] [domain β] (abv : β → α) [is_absolute_value abv]
  (a : β) (n : ℕ) : abv (a ^ n) = abv a ^ n :=
by induction n; simp [abv_mul abv, _root_.pow_succ, abv_one abv, *]

lemma series_cau_of_abv_cau {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β] {abv : β → α} {f : ℕ → β}
    [is_absolute_value abv] : is_cau_seq abs (λ m, (range m).sum (λ n, abv (f n))) → is_cau_seq abv (λ m, (range m).sum f) :=
   λ h, series_cau_of_abv_le_cau 0 (λ n h, le_refl _) h

lemma geo_series_cau {α β : Type*} [discrete_linear_ordered_field α] [archimedean α] [field β]
  {abv : β → α} [is_absolute_value abv]
   (x : β) (hx1 : abv x < 1) : is_cau_seq abv (λ n, (range n).sum (λ m, x ^ m)) :=
have hx1' : abv x ≠ 1 := λ h, by simpa [h, lt_irrefl] using hx1,
series_cau_of_abv_cau
begin
  simp only [pow_abv abv, geo_series_eq _ hx1'] {eta := ff},
  refine @is_cau_of_incrs_bounded _ _ _ _ ((1 : α) / (1 - abv x)) 0 _ _,
  { assume n hn,
    rw abs_of_nonneg ,
    refine div_le_div_of_le_of_pos (sub_le_self _ (pow_abv abv x n ▸ abv_nonneg _ _))
      (sub_pos.2 hx1),
    refine div_nonneg (sub_nonneg.2 _) (sub_pos.2 hx1),
    clear hn,
    induction n with n ih,
    { simp },
    { rw [_root_.pow_succ, ← one_mul (1 : α)],
      refine mul_le_mul (le_of_lt hx1) ih (pow_abv abv x n ▸ abv_nonneg _ _) (by norm_num) } },
  { assume n hn,
    refine div_le_div_of_le_of_pos (sub_le_sub_left _ _) (sub_pos.2 hx1),
    rw [← one_mul (_ ^ n), _root_.pow_succ],
    exact mul_le_mul_of_nonneg_right (le_of_lt hx1) (pow_nonneg (abv_nonneg _ _) _) }
end

lemma geo_series_const_cau {α : Type*} [discrete_linear_ordered_field α] [archimedean α] (a x : α) :
  abs x < 1 → is_cau_seq abs (λ m, (range m).sum (λ n, a * x ^ n)) :=
λ hx1, begin
  have : is_cau_seq abs (λ m, a * (range m).sum (λ n, x ^ n)) := (cau_seq.const abs a * ⟨_, geo_series_cau x hx1⟩).2,
  simpa only [mul_sum] using this
end

-- The form of ratio test with  0 ≤ r < 1, and abv (f (succ m)) ≤ r * abv (f m) handled zero terms of series the best
lemma series_ratio_test {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β]
    [archimedean α] {abv : β → α} [is_absolute_value abv] {f : ℕ → β} (n : ℕ) (r : α) :
    0 ≤ r → r < 1 → (∀ m, n ≤ m → abv (f (succ m)) ≤ r * abv (f m)) → is_cau_seq abv (λ m, (range m).sum f)
  := begin
  assume r0 r1 h,
  refine series_cau_of_abv_le_cau (succ n) _ (geo_series_const_cau (abv (f (succ n)) * r⁻¹ ^ (succ n)) r _),
  assume m mn,
  generalize hk : m - (succ n) = k,rw nat.sub_eq_iff_eq_add mn at hk,
  cases classical.em (r = 0) with r_zero r_pos,have m_pos := lt_of_lt_of_le (succ_pos n) mn,
  have := pred_le_pred mn,simp at this,
  have := h (pred m) this,simp[r_zero,succ_pred_eq_of_pos m_pos] at this,
  refine le_trans this _,refine mul_nonneg _ _,
  refine mul_nonneg (abv_nonneg _ _) (pow_nonneg (inv_nonneg.mpr r0) _),exact pow_nonneg r0 _,
  replace r_pos : 0 < r,cases lt_or_eq_of_le r0 with h h,exact h,exact absurd h.symm r_pos,
  revert m n,
  induction k with k' hi,assume m n h mn hk,
  rw [hk,zero_add,mul_right_comm,←pow_inv',←div_eq_mul_inv,mul_div_cancel],
  exact (ne_of_lt (pow_pos r_pos _)).symm,
  assume m n h mn hk,rw [hk,succ_add],
  have kn : k' + (succ n) ≥ (succ n), rw ←zero_add (succ n),refine add_le_add _ _,exact zero_le _,simp,
  replace hi := hi (k' + (succ n)) n h kn rfl,
  rw [(by simp [_root_.pow_succ'] : r ^ (succ (k' + succ n)) = r ^ (k' + succ n) * r),←mul_assoc],
  replace h := h (k' + succ n) (le_of_succ_le kn),rw mul_comm at h,
  exact le_trans h (mul_le_mul_of_nonneg_right hi r0),
  rwa abs_of_nonneg r0,
end

lemma sum_range_diag_flip {α : Type*} [add_comm_monoid α] (n : ℕ) (f : ℕ → ℕ → α) :
    (range n).sum (λ m, (range (m + 1)).sum (λ k, f k (m - k))) =
    (range n).sum (λ m, (range (n - m)).sum (f m)) :=
have h₁ : ((range n).sigma (range ∘ succ)).sum
    (λ (a : Σ m, ℕ), f (a.2) (a.1 - a.2)) =
    (range n).sum (λ m, (range (m + 1)).sum
    (λ k, f k (m - k))) := sum_sigma,
have h₂ : ((range n).sigma (λ m, range (n - m))).sum (λ a : Σ (m : ℕ), ℕ, f (a.1) (a.2)) =
    (range n).sum (λ m, sum (range (n - m)) (f m)) := sum_sigma,
h₁ ▸ h₂ ▸ sum_bij
(λ a _, ⟨a.2, a.1 - a.2⟩)
(λ a ha, have h₁ : a.1 < n := mem_range.1 (mem_sigma.1 ha).1,
  have h₂ : a.2 < succ a.1 := mem_range.1 (mem_sigma.1 ha).2,
    mem_sigma.2 ⟨mem_range.2 (lt_of_lt_of_le h₂ h₁),
    mem_range.2 ((nat.sub_lt_sub_right_iff (le_of_lt_succ h₂)).2 h₁)⟩)
(λ _ _, rfl)
(λ ⟨a₁, a₂⟩ ⟨b₁, b₂⟩ ha hb h,
  have ha : a₁ < n ∧ a₂ ≤ a₁ :=
      ⟨mem_range.1 (mem_sigma.1 ha).1, le_of_lt_succ (mem_range.1 (mem_sigma.1 ha).2)⟩,
  have hb : b₁ < n ∧ b₂ ≤ b₁ :=
      ⟨mem_range.1 (mem_sigma.1 hb).1, le_of_lt_succ (mem_range.1 (mem_sigma.1 hb).2)⟩,
  have h : a₂ = b₂ ∧ _ := sigma.mk.inj h,
  have h' : a₁ = b₁ - b₂ + a₂ := (nat.sub_eq_iff_eq_add ha.2).1 (eq_of_heq h.2),
  sigma.mk.inj_iff.2
    ⟨nat.sub_add_cancel hb.2 ▸ h'.symm ▸ h.1 ▸ rfl,
    (heq_of_eq h.1)⟩)
(λ ⟨a₁, a₂⟩ ha,
  have ha : a₁ < n ∧ a₂ < n - a₁ :=
      ⟨mem_range.1 (mem_sigma.1 ha).1, (mem_range.1 (mem_sigma.1 ha).2)⟩,
  ⟨⟨a₂ + a₁, a₁⟩, ⟨mem_sigma.2 ⟨mem_range.2 ((nat.lt_sub_right_iff_add_lt
      (le_of_lt ha.1)).1 ha.2),
    mem_range.2 (lt_succ_of_le (le_add_left _ _))⟩,
  sigma.mk.inj_iff.2 ⟨rfl, heq_of_eq (nat.add_sub_cancel _ _).symm⟩⟩⟩)

lemma abv_sum_le_sum_abv {α β γ : Type*} [discrete_linear_ordered_field α] [ring β]
  (abv : β → α) [is_absolute_value abv] (f : γ → β) (s : finset γ) : abv (s.sum f) ≤ s.sum (abv ∘ f) :=
finset.induction_on s (by simp [abv_zero abv]) $ λ a s has ih,
by rw [sum_insert has, sum_insert has];
  exact le_trans (abv_add abv _ _) (add_le_add_left ih _)

lemma sum_nonneg {α β : Type*} [ordered_comm_monoid α] {f : β → α} {s : finset β} :
  (∀ x ∈ s, 0 ≤ f x) → 0 ≤ s.sum f :=
finset.induction_on s (by simp) $ λ a s has ih h, begin
  rw [sum_insert has],
  exact add_nonneg' (h a (by simp)) (ih (λx hx, by simp *)),
end

lemma neg_sum {α β : Type*} [add_comm_group α] {f : β → α} {s : finset β} :
  -s.sum f = s.sum (λ x, -f x) :=
finset.induction_on s (by simp) (by simp {contextual := tt})

@[simp] lemma filter_true {α : Type*} (s : finset α) : s.filter (λ _, true) = s :=
finset.ext.2 $ by simp

lemma sum_range_sub_sum_range {α : Type*} [add_comm_group α] {f : ℕ → α}
  {n m : ℕ} (hnm : n ≤ m) : (range m).sum f - (range n).sum f =
  ((range m).filter (λ k, n ≤ k)).sum f :=
begin
  rw [← sum_sdiff (@filter_subset _ (λ k, n ≤ k) _ (range m)),
    sub_eq_iff_eq_add, ← eq_sub_iff_add_eq, add_sub_cancel'],
  refine finset.sum_congr
    (finset.ext.2 $ λ a, ⟨λ h, by simp at *; finish,
    λ h, have ham : a < m := lt_of_lt_of_le (mem_range.1 h) hnm,
      by simp * at *⟩)
    (λ _ _, rfl),
end

lemma series_cauchy_prod {α β : Type*} [discrete_linear_ordered_field α] [ring β] {a b : ℕ → β}
  {abv : β → α} [is_absolute_value abv] : is_cau_seq abs (λ m, (range m).sum (λ n, abv (a n))) → is_cau_seq abv (λ m, (range m).sum b) →
  ∀ ε : α, 0 < ε → ∃ i : ℕ, ∀ j ≥ i, abv ((range j).sum a * (range j).sum b - (range j).sum (λ n,
  (range (n + 1)).sum (λ m, a m * b (n - m))) ) < ε :=
begin
-- slightly adapted version of theorem 9.4.7 from "The Real Numbers and Real Analysis", Ethan D. Bloch
  assume ha hb ε ε0,
  cases cau_seq.bounded ⟨_, hb⟩ with Q hQ,simp at hQ,
  cases cau_seq.bounded ⟨_, ha⟩ with P hP,simp at hP,
  have P0 : 0 < P,exact lt_of_le_of_lt (abs_nonneg _) (hP 0),
  have Pε0 := div_pos ε0 (mul_pos (show (2 : α) > 0, from by norm_num) P0),
  cases cau_seq.cauchy₂ ⟨_, hb⟩ Pε0 with N hN,simp at hN,
  have Qε0 := div_pos ε0 (mul_pos (show (4 : α) > 0, from by norm_num) (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0))),
  cases cau_seq.cauchy₂ ⟨_, ha⟩ Qε0 with M hM,simp at hM,
  existsi 2 * (max N M + 1),
  assume K hK,
  have := sum_range_diag_flip K (λ m n, a m * b n),
  dsimp at this,
  rw this,
  have : (λ (i : ℕ), (range (K - i)).sum (λ (k : ℕ), a i * b k)) = (λ (i : ℕ), a i * (range (K - i)).sum b),
    by simp [finset.mul_sum],
  rw this,clear this,
  have : (range K).sum (λ (i : ℕ), a i * (range (K - i)).sum b) =
    (range K).sum (λ (i : ℕ), a i * ((range (K - i)).sum b - (range K).sum b))
    + (range K).sum (λ i, a i * (range K).sum b),
    {rw ←sum_add_distrib,simp[(mul_add _ _ _).symm]},
  rw this, clear this,
  rw sum_mul, simp,
  rw abv_neg abv,
  refine lt_of_le_of_lt (abv_sum_le_sum_abv _ _ _) _,
  simp [abv_mul abv],
  suffices : (range (max N M + 1)).sum (λ (i : ℕ), abv (a i) * abv ((range (K - i)).sum b - (range K).sum b)) +
    ((range K).sum (λ (i : ℕ), abv (a i) * abv ((range (K - i)).sum b - (range K).sum b)) -(range (max N M + 1)).sum
     (λ (i : ℕ),
    abv (a i) * abv ((range (K - i)).sum b - (range K).sum b))) < ε / (2 * P) * P + ε / (4 * Q) * (2 * Q),
  { simp [(div_div_eq_div_mul _ _ _).symm] at this,
    rwa[div_mul_cancel _ (ne_of_lt P0).symm,(by norm_num : (4 : α) = 2 * 2),←div_div_eq_div_mul,mul_comm (2 : α),←_root_.mul_assoc,
    div_mul_cancel _ (ne_of_lt (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0))).symm,div_mul_cancel,add_halves] at this,
    norm_num},
  refine add_lt_add _ _,
  {have : (range (max N M + 1)).sum (λ (i : ℕ), abv (a i) *
    abv ((range (K - i)).sum b - (range K).sum b)) ≤ (range (max N M + 1)).sum
  (λ (i : ℕ), abv (a i) * (ε / (2 * P))) := by
    {refine sum_le_sum _,assume m mJ,refine mul_le_mul_of_nonneg_left _ _,
      {refine le_of_lt (hN (K - m) K _ _),{
      refine nat.le_sub_left_of_add_le (le_trans _ hK),
      rw[succ_mul,_root_.one_mul],
      exact add_le_add (le_of_lt (mem_range.1 mJ)) (le_trans (le_max_left _ _) (le_of_lt (lt_add_one _)))},
      {refine le_trans _ hK,rw ←_root_.one_mul N,
      refine mul_le_mul (by norm_num) (by rw _root_.one_mul;exact le_trans (le_max_left _ _)
      (le_of_lt (lt_add_one _))) (zero_le _) (zero_le _)}},
      exact abv_nonneg abv _},
  refine lt_of_le_of_lt this _,
  rw [← sum_mul, mul_comm],
  specialize hP (max N M + 1),rwa abs_of_nonneg at hP,
  exact (mul_lt_mul_left Pε0).mpr hP,
  exact sum_nonneg (λ x h, abv_nonneg abv _)},
  {have hNMK : max N M + 1 < K := by
    {refine lt_of_lt_of_le _ hK,
    rw [succ_mul,_root_.one_mul,←add_zero (max N M + 1)],
    refine add_lt_add_of_le_of_lt (le_refl _) _,rw add_zero,
    refine add_pos_of_nonneg_of_pos (zero_le _) (by norm_num)},
  rw sum_range_sub_sum_range (le_of_lt hNMK),
  exact calc sum (filter (λ (k : ℕ), max N M + 1 ≤ k) (range K))
      (λ (i : ℕ), abv (a i) * abv (sum (range (K - i)) b - sum (range K) b))
      ≤ sum (filter (λ (k : ℕ), max N M + 1 ≤ k) (range K)) (λ i, abv (a i) * (2 * Q)) :
    sum_le_sum (begin
      assume n hn,
      refine mul_le_mul_of_nonneg_left _ (abv_nonneg _ _),
      rw sub_eq_add_neg,
      refine le_trans (abv_add _ _ _) _,
      rw [two_mul, abv_neg abv],
      refine add_le_add (le_of_lt (hQ _)) (le_of_lt (hQ _)),
    end)
    ... < _ : begin
      rw [← sum_mul, ← sum_range_sub_sum_range (le_of_lt hNMK)],
      refine (mul_lt_mul_right _).2 _,
      rw two_mul,
      refine add_pos (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0))
        (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0)),
      refine lt_of_le_of_lt (le_abs_self _) _,
      refine hM _ _ (le_trans (le_succ_of_le (le_max_right _ _)) (le_of_lt hNMK))
        (le_succ_of_le (le_max_right _ _))
     end }
end

end a

open nat finset
lemma complex.exp_series_abs_cau (z : ℂ) : is_cau_seq abs (λ n, (range n).sum (λ m, complex.abs (z ^ m / fact m))) := begin
  cases exists_nat_gt (complex.abs z) with n hn,
  have n_pos : (0 : ℝ) < n := lt_of_le_of_lt (complex.abs_nonneg _) hn,
  refine series_ratio_test n (complex.abs z / n) _ _ _,exact div_nonneg_of_nonneg_of_pos (complex.abs_nonneg _) n_pos,rwa [div_lt_iff n_pos,one_mul],
  assume m mn,rw [abs_of_nonneg (complex.abs_nonneg _),abs_of_nonneg (complex.abs_nonneg _)],
  unfold fact,simp only [_root_.pow_succ, complex.abs_div,complex.abs_mul,div_eq_mul_inv,mul_inv',
    nat.cast_mul,complex.abs_inv],
  have : complex.abs z * complex.abs (z ^ m) * ((complex.abs ↑(fact m))⁻¹ * (complex.abs ↑(succ m))⁻¹) = complex.abs z *
    complex.abs (z ^ m) * (complex.abs ↑(fact m))⁻¹ * (complex.abs ↑(succ m))⁻¹,ring,rw this,
  have : complex.abs z * (↑n)⁻¹ * (complex.abs (z ^ m) * (complex.abs ↑(fact m))⁻¹) = complex.abs z * complex.abs (z ^ m) * (complex.abs ↑(fact m))⁻¹ * (↑n)⁻¹,ring,
  rw this,
  rw[(by simp : (succ m : ℂ) = ((succ m : ℝ) : ℂ)),complex.abs_of_nonneg],
  refine mul_le_mul_of_nonneg_left _ _,
  rw [inv_le_inv,nat.cast_le],exact le_succ_of_le mn,
  rw [←nat.cast_zero,nat.cast_lt],exact succ_pos _,exact n_pos,rw[←complex.abs_inv,←complex.abs_mul,←complex.abs_mul],
  exact complex.abs_nonneg _,rw[←nat.cast_zero,nat.cast_le],exact zero_le _,
end

lemma complex.exp_series_cau (z : ℂ) : is_cau_seq complex.abs (λ n, (range n).sum (λ m, z ^ m / fact m)) :=
  series_cau_of_abv_cau (complex.exp_series_abs_cau z)

def exp' (z : ℂ) : cau_seq ℂ complex.abs := ⟨_, complex.exp_series_cau z⟩

open complex
def exp (z : ℂ) : ℂ := complex.lim (exp' z)

def sin (z : ℂ) : ℂ := (exp (I * z) - exp (-I * z)) / (2 * I)

def cos (z : ℂ) : ℂ := (exp (I * z) + exp (-I * z)) / 2

def tan (z : ℂ) : ℂ := sin z / cos z

def sinh (z : ℂ) : ℂ := (exp z - exp (-z)) / 2

def cosh (z : ℂ) : ℂ := (exp z + exp (-z)) / 2

def tanh (z : ℂ) : ℂ := sinh z / cosh z

@[simp] lemma exp_zero : exp 0 = 1 := begin
  unfold exp exp',
  refine lim_eq_of_equiv_const _,
  assume ε ε0,
  existsi 1,
  assume j hj,
  dsimp [exp'],
  suffices : complex.abs (sum (range j) (λ (m : ℕ), 0 ^ m / ↑(fact m)) + -1) = 0,
    rwa this,
  cases j,
  { exact absurd hj (by norm_num) },
  { induction j,
    { simpa },
    { rw ← j_ih dec_trivial,
      simp only [sum_range_succ, _root_.pow_succ],
      simp } }
end

lemma exp_add (x y : ℂ) : exp (x + y) = exp x * exp y :=
show complex.lim (⟨_, complex.exp_series_cau (x + y)⟩ : cau_seq ℂ abs) =
  complex.lim ⇑(show cau_seq ℂ abs, from ⟨_, complex.exp_series_cau x⟩)
  * complex.lim (show cau_seq ℂ abs, from ⟨_, complex.exp_series_cau y⟩),
begin
 have hxa := complex.exp_series_abs_cau x,
 have hx := complex.exp_series_cau x,
 have hy := complex.exp_series_cau y,
 have hxy := complex.exp_series_cau (x + y),
   rw complex.lim_mul_lim,
 have hj : ∀ j : ℕ, (range j).sum (λ (m : ℕ),
    (x + y) ^ m / ↑(fact m)) = (range j).sum
    (λ i, (range (i + 1)).sum (λ k, x ^ k / fact k *
    (y ^ (i - k) / fact (i - k)))),
    { assume j,
      refine finset.sum_congr rfl (λ m hm, _),
      rw [add_pow, div_eq_mul_inv, sum_mul],
      refine finset.sum_congr rfl (λ i hi, _),
      have := choose_mul_fact_mul_fact (le_of_lt_succ $ finset.mem_range.1 hi),
      rw [← this, nat.cast_mul, nat.cast_mul, mul_inv', mul_inv'],
      simp only [mul_left_comm (choose m i : ℂ), mul_assoc, mul_left_comm (choose m i : ℂ)⁻¹,
        mul_comm (choose m i : ℂ)],
      have : (choose m i : ℂ) ≠ 0 := nat.cast_ne_zero.2 (λ h,
        by have := choose_pos (le_of_lt_succ (mem_range.1 hi)); simpa [h, lt_irrefl] using this),
      rw inv_mul_cancel this,
      simp [div_eq_mul_inv, mul_comm, mul_assoc, mul_left_comm] },
  have hf := funext hj, have hxy1 := hxy, rw hf at hxy1,
  have := series_cauchy_prod hxa hy,
  refine eq.symm (lim_eq_lim_of_equiv _),
  assume ε ε0,
  dsimp,
  simp only [hj],
  exact this ε ε0,
end


import data.real.basic

variables {x y : ℝ}

#check le_refl
#check le_refl y
#check @le_abs
#check @abs_le
#check neg_add
#check add_le_add

namespace my_abs

-- BEGIN
theorem le_abs_self : x ≤ abs x :=
begin
  rw le_abs,
  left,
  apply le_refl,
end

theorem neg_le_abs_self : -x ≤ abs x :=
begin
  rw le_abs,
  right,
  apply le_refl,
end

/- Alternatively -/

lemma neg_abs_le_self : - abs x ≤ x :=
begin
  nth_rewrite_rhs 0 ← neg_neg x,
  apply neg_le_neg,
  exact neg_le_abs_self,
end

theorem abs_add : abs (x + y) ≤ abs x + abs y :=
begin
  cases lt_or_le x 0 with hx hx;
  cases lt_or_le y 0 with hy hy;
  cases lt_or_le (x + y) 0 with hxy hxy;
  simp [abs_of_neg, abs_of_nonneg, hx, hy, hxy];
  linarith,
end

/- Essentially the same as the previous one, but we no longer need
the lemma `neg_abs_le_self`. -/
example : abs (x + y) ≤ abs x + abs y :=
begin
  rw abs_eq_max_neg,
  rw max_le_iff,
  split,
  { apply add_le_add,
    exact le_abs_self,
    exact le_abs_self, },
  { rw neg_add,
    apply add_le_add,
    exact neg_le_abs_self,
    exact neg_le_abs_self, },
end

-- END

#check @le_abs_self
#check @neg_le_abs_self
#check @abs_add

end my_abs


/-
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.degree.trailing_degree
! leanprover-community/mathlib commit 302eab4f46abb63de520828de78c04cb0f9b5836
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.ENat.Basic
import Mathlib.Data.Polynomial.Degree.Definitions

/-!
# Trailing degree of univariate polynomials

## Main definitions

* `trailingDegree p`: the multiplicity of `X` in the polynomial `p`
* `natTrailingDegree`: a variant of `trailingDegree` that takes values in the natural numbers
* `trailingCoeff`: the coefficient at index `natTrailingDegree p`

Converts most results about `degree`, `natDegree` and `leadingCoeff` to results about the bottom
end of a polynomial
-/

noncomputable section

open Function Polynomial Finsupp Finset

open BigOperators Classical Polynomial

namespace Polynomial

universe u v

variable {R : Type u} {S : Type v} {a b : R} {n m : ℕ}

section Semiring

variable [Semiring R] {p q r : R[X]}

/-- `trailingDegree p` is the multiplicity of `x` in the polynomial `p`, i.e. the smallest
`X`-exponent in `p`.
`trailingDegree p = some n` when `p ≠ 0` and `n` is the smallest power of `X` that appears
in `p`, otherwise
`trailingDegree 0 = ⊤`. -/
def trailingDegree (p : R[X]) : ℕ∞ :=
  p.support.min
#align polynomial.trailing_degree Polynomial.trailingDegree

theorem trailingDegree_lt_wf : WellFounded fun p q : R[X] => trailingDegree p < trailingDegree q :=
  InvImage.wf trailingDegree (WithTop.wellFounded_lt Nat.lt_wfRel.2)
#align polynomial.trailing_degree_lt_wf Polynomial.trailingDegree_lt_wf

/-- `natTrailingDegree p` forces `trailingDegree p` to `ℕ`, by defining
`natTrailingDegree ⊤ = 0`. -/
def natTrailingDegree (p : R[X]) : ℕ :=
  (trailingDegree p).getD 0
#align polynomial.nat_trailing_degree Polynomial.natTrailingDegree

/-- `trailingCoeff p` gives the coefficient of the smallest power of `X` in `p`-/
def trailingCoeff (p : R[X]) : R :=
  coeff p (natTrailingDegree p)
#align polynomial.trailing_coeff Polynomial.trailingCoeff

/-- a polynomial is `monic_at` if its trailing coefficient is 1 -/
def TrailingMonic (p : R[X]) :=
  trailingCoeff p = (1 : R)
#align polynomial.trailing_monic Polynomial.TrailingMonic

theorem TrailingMonic.def : TrailingMonic p ↔ trailingCoeff p = 1 :=
  Iff.rfl
#align polynomial.trailing_monic.def Polynomial.TrailingMonic.def

-- Porting note: Removed unused argument `[DecidableEq R]`?
instance TrailingMonic.decidable: Decidable (TrailingMonic p) := inferInstance
#align polynomial.trailing_monic.decidable Polynomial.TrailingMonic.decidable

@[simp]
theorem TrailingMonic.trailingCoeff {p : R[X]} (hp : p.TrailingMonic) : trailingCoeff p = 1 :=
  hp
#align polynomial.trailing_monic.trailing_coeff Polynomial.TrailingMonic.trailingCoeff

@[simp]
theorem trailingDegree_zero : trailingDegree (0 : R[X]) = ⊤ :=
  rfl
#align polynomial.trailing_degree_zero Polynomial.trailingDegree_zero

@[simp]
theorem trailingCoeff_zero : trailingCoeff (0 : R[X]) = 0 :=
  rfl
#align polynomial.trailing_coeff_zero Polynomial.trailingCoeff_zero

@[simp]
theorem natTrailingDegree_zero : natTrailingDegree (0 : R[X]) = 0 :=
  rfl
#align polynomial.nat_trailing_degree_zero Polynomial.natTrailingDegree_zero

theorem trailingDegree_eq_top : trailingDegree p = ⊤ ↔ p = 0 :=
  ⟨fun h => support_eq_empty.1 (Finset.min_eq_top.1 h), fun h => by simp [h]⟩
#align polynomial.trailing_degree_eq_top Polynomial.trailingDegree_eq_top

theorem trailingDegree_eq_natTrailingDegree (hp : p ≠ 0) :
    trailingDegree p = (natTrailingDegree p : ℕ∞) := by
  let ⟨n, hn⟩ :=
    not_forall.1 (mt Option.eq_none_iff_forall_not_mem.2 (mt trailingDegree_eq_top.1 hp))
  have hn : trailingDegree p = n := Classical.not_not.1 hn
  rw [natTrailingDegree, hn]
  rfl
#align polynomial.trailing_degree_eq_nat_trailing_degree Polynomial.trailingDegree_eq_natTrailingDegree

theorem trailingDegree_eq_iff_natTrailingDegree_eq {p : R[X]} {n : ℕ} (hp : p ≠ 0) :
    p.trailingDegree = n ↔ p.natTrailingDegree = n := by
  rw [trailingDegree_eq_natTrailingDegree hp]
  exact WithTop.coe_eq_coe
#align polynomial.trailing_degree_eq_iff_nat_trailing_degree_eq Polynomial.trailingDegree_eq_iff_natTrailingDegree_eq

theorem trailingDegree_eq_iff_natTrailingDegree_eq_of_pos {p : R[X]} {n : ℕ} (hn : 0 < n) :
    p.trailingDegree = n ↔ p.natTrailingDegree = n := by
  constructor
  · intro H
    rwa [← trailingDegree_eq_iff_natTrailingDegree_eq]
    rintro rfl
    rw [trailingDegree_zero] at H
    exact Option.noConfusion H
  · intro H
    rwa [trailingDegree_eq_iff_natTrailingDegree_eq]
    rintro rfl
    rw [natTrailingDegree_zero] at H
    rw [H] at hn
    exact lt_irrefl _ hn
#align polynomial.trailing_degree_eq_iff_nat_trailing_degree_eq_of_pos Polynomial.trailingDegree_eq_iff_natTrailingDegree_eq_of_pos

theorem natTrailingDegree_eq_of_trailingDegree_eq_some {p : R[X]} {n : ℕ}
    (h : trailingDegree p = n) : natTrailingDegree p = n :=
  have hp0 : p ≠ 0 := fun hp0 => by rw [hp0] at h; exact Option.noConfusion h
  Option.some_inj.1 <|
    show (natTrailingDegree p : ℕ∞) = n by rwa [← trailingDegree_eq_natTrailingDegree hp0]
#align polynomial.nat_trailing_degree_eq_of_trailing_degree_eq_some Polynomial.natTrailingDegree_eq_of_trailingDegree_eq_some

@[simp]
theorem natTrailingDegree_le_trailingDegree : ↑(natTrailingDegree p) ≤ trailingDegree p := by
  by_cases hp : p = 0;
  · rw [hp, trailingDegree_zero]
    exact le_top
  rw [trailingDegree_eq_natTrailingDegree hp]
#align polynomial.nat_trailing_degree_le_trailing_degree Polynomial.natTrailingDegree_le_trailingDegree

theorem natTrailingDegree_eq_of_trailingDegree_eq [Semiring S] {q : S[X]}
    (h : trailingDegree p = trailingDegree q) : natTrailingDegree p = natTrailingDegree q := by
  unfold natTrailingDegree
  rw [h]
#align polynomial.nat_trailing_degree_eq_of_trailing_degree_eq Polynomial.natTrailingDegree_eq_of_trailingDegree_eq

theorem le_trailingDegree_of_ne_zero (h : coeff p n ≠ 0) : trailingDegree p ≤ n :=
  show @LE.le ℕ∞ _ p.support.min n from min_le (mem_support_iff.2 h)
#align polynomial.le_trailing_degree_of_ne_zero Polynomial.le_trailingDegree_of_ne_zero

theorem natTrailingDegree_le_of_ne_zero (h : coeff p n ≠ 0) : natTrailingDegree p ≤ n := by
  have : WithTop.some (natTrailingDegree p) = Nat.cast (natTrailingDegree p) := rfl
  rw [← WithTop.coe_le_coe, this, ← trailingDegree_eq_natTrailingDegree]
  · exact le_trailingDegree_of_ne_zero h
  · intro h
    subst h
    exact h rfl
#align polynomial.nat_trailing_degree_le_of_ne_zero Polynomial.natTrailingDegree_le_of_ne_zero

theorem trailingDegree_le_trailingDegree (h : coeff q (natTrailingDegree p) ≠ 0) :
    trailingDegree q ≤ trailingDegree p := by
  by_cases hp : p = 0
  · rw [hp]
    exact le_top
  · rw [trailingDegree_eq_natTrailingDegree hp]
    exact le_trailingDegree_of_ne_zero h
#align polynomial.trailing_degree_le_trailing_degree Polynomial.trailingDegree_le_trailingDegree

theorem trailingDegree_ne_of_natTrailingDegree_ne {n : ℕ} :
    p.natTrailingDegree ≠ n → trailingDegree p ≠ n := by
  -- Porting note: Needed to account for different coercion behaviour & add the lemma below
  have : Nat.cast n = WithTop.some n := rfl
  exact mt fun h => by rw [natTrailingDegree, h, this, ←WithTop.some_eq_coe, Option.getD_coe]
#align polynomial.trailing_degree_ne_of_nat_trailing_degree_ne Polynomial.trailingDegree_ne_of_natTrailingDegree_ne

theorem natTrailingDegree_le_of_trailingDegree_le {n : ℕ} {hp : p ≠ 0}
    (H : (n : ℕ∞) ≤ trailingDegree p) : n ≤ natTrailingDegree p := by
  rw [trailingDegree_eq_natTrailingDegree hp] at H
  exact WithTop.coe_le_coe.mp H
#align polynomial.nat_trailing_degree_le_of_trailing_degree_le Polynomial.natTrailingDegree_le_of_trailingDegree_le

theorem natTrailingDegree_le_natTrailingDegree {hq : q ≠ 0}
    (hpq : p.trailingDegree ≤ q.trailingDegree) : p.natTrailingDegree ≤ q.natTrailingDegree := by
  by_cases hp : p = 0;
  · rw [hp, natTrailingDegree_zero]
    exact zero_le _
  rw [trailingDegree_eq_natTrailingDegree hp, trailingDegree_eq_natTrailingDegree hq] at hpq
  exact WithTop.coe_le_coe.1 hpq
#align polynomial.nat_trailing_degree_le_nat_trailing_degree Polynomial.natTrailingDegree_le_natTrailingDegree

@[simp]
theorem trailingDegree_monomial (ha : a ≠ 0) : trailingDegree (monomial n a) = n := by
  rw [trailingDegree, support_monomial n ha, min_singleton]
  rfl
#align polynomial.trailing_degree_monomial Polynomial.trailingDegree_monomial

theorem natTrailingDegree_monomial (ha : a ≠ 0) : natTrailingDegree (monomial n a) = n := by
  rw [natTrailingDegree, trailingDegree_monomial ha]
  rfl
#align polynomial.nat_trailing_degree_monomial Polynomial.natTrailingDegree_monomial

theorem natTrailingDegree_monomial_le : natTrailingDegree (monomial n a) ≤ n :=
  if ha : a = 0 then by simp [ha] else (natTrailingDegree_monomial ha).le
#align polynomial.nat_trailing_degree_monomial_le Polynomial.natTrailingDegree_monomial_le

theorem le_trailingDegree_monomial : ↑n ≤ trailingDegree (monomial n a) :=
  if ha : a = 0 then by simp [ha] else (trailingDegree_monomial ha).ge
#align polynomial.le_trailing_degree_monomial Polynomial.le_trailingDegree_monomial

@[simp]
theorem trailingDegree_C (ha : a ≠ 0) : trailingDegree (C a) = (0 : ℕ∞) :=
  trailingDegree_monomial ha
set_option linter.uppercaseLean3 false in
#align polynomial.trailing_degree_C Polynomial.trailingDegree_C

theorem le_trailingDegree_C : (0 : ℕ∞) ≤ trailingDegree (C a) :=
  le_trailingDegree_monomial
set_option linter.uppercaseLean3 false in
#align polynomial.le_trailing_degree_C Polynomial.le_trailingDegree_C

@[simp]
theorem natTrailingDegree_C (a : R) : natTrailingDegree (C a) = 0 :=
  nonpos_iff_eq_zero.1 natTrailingDegree_monomial_le
set_option linter.uppercaseLean3 false in
#align polynomial.nat_trailing_degree_C Polynomial.natTrailingDegree_C

@[simp]
theorem natTrailingDegree_one : natTrailingDegree (1 : R[X]) = 0 :=
  natTrailingDegree_C 1
#align polynomial.nat_trailing_degree_one Polynomial.natTrailingDegree_one

@[simp]
theorem natTrailingDegree_nat_cast (n : ℕ) : natTrailingDegree (n : R[X]) = 0 := by
  simp only [← C_eq_nat_cast, natTrailingDegree_C]
#align polynomial.nat_trailing_degree_nat_cast Polynomial.natTrailingDegree_nat_cast

@[simp]
theorem trailingDegree_C_mul_X_pow (n : ℕ) (ha : a ≠ 0) : trailingDegree (C a * X ^ n) = n := by
  rw [C_mul_X_pow_eq_monomial, trailingDegree_monomial ha]
set_option linter.uppercaseLean3 false in
#align polynomial.trailing_degree_C_mul_X_pow Polynomial.trailingDegree_C_mul_X_pow

theorem le_trailingDegree_C_mul_X_pow (n : ℕ) (a : R) : (n : ℕ∞) ≤ trailingDegree (C a * X ^ n) :=
  by
  rw [C_mul_X_pow_eq_monomial]
  exact le_trailingDegree_monomial
set_option linter.uppercaseLean3 false in
#align polynomial.le_trailing_degree_C_mul_X_pow Polynomial.le_trailingDegree_C_mul_X_pow

theorem coeff_eq_zero_of_trailingDegree_lt (h : (n : ℕ∞) < trailingDegree p) : coeff p n = 0 :=
  Classical.not_not.1 (mt le_trailingDegree_of_ne_zero (not_le_of_gt h))
#align polynomial.coeff_eq_zero_of_trailing_degree_lt Polynomial.coeff_eq_zero_of_trailingDegree_lt

theorem coeff_eq_zero_of_lt_natTrailingDegree {p : R[X]} {n : ℕ} (h : n < p.natTrailingDegree) :
    p.coeff n = 0 := by
  apply coeff_eq_zero_of_trailingDegree_lt
  by_cases hp : p = 0
  · rw [hp, trailingDegree_zero]
    exact WithTop.coe_lt_top n
  · rw [trailingDegree_eq_natTrailingDegree hp]
    exact WithTop.coe_lt_coe.2 h
#align polynomial.coeff_eq_zero_of_lt_nat_trailing_degree Polynomial.coeff_eq_zero_of_lt_natTrailingDegree

@[simp]
theorem coeff_natTrailingDegree_pred_eq_zero {p : R[X]} {hp : (0 : ℕ∞) < natTrailingDegree p} :
    p.coeff (p.natTrailingDegree - 1) = 0 :=
  coeff_eq_zero_of_lt_natTrailingDegree <|
    Nat.sub_lt ((WithTop.zero_lt_coe (natTrailingDegree p)).mp hp) Nat.one_pos
#align polynomial.coeff_nat_trailing_degree_pred_eq_zero Polynomial.coeff_natTrailingDegree_pred_eq_zero

theorem le_trailingDegree_X_pow (n : ℕ) : (n : ℕ∞) ≤ trailingDegree (X ^ n : R[X]) := by
  simpa only [C_1, one_mul] using le_trailingDegree_C_mul_X_pow n (1 : R)
set_option linter.uppercaseLean3 false in
#align polynomial.le_trailing_degree_X_pow Polynomial.le_trailingDegree_X_pow

theorem le_trailingDegree_X : (1 : ℕ∞) ≤ trailingDegree (X : R[X]) :=
  le_trailingDegree_monomial
set_option linter.uppercaseLean3 false in
#align polynomial.le_trailing_degree_X Polynomial.le_trailingDegree_X

theorem natTrailingDegree_X_le : (X : R[X]).natTrailingDegree ≤ 1 :=
  natTrailingDegree_monomial_le
set_option linter.uppercaseLean3 false in
#align polynomial.nat_trailing_degree_X_le Polynomial.natTrailingDegree_X_le

@[simp]
theorem trailingCoeff_eq_zero : trailingCoeff p = 0 ↔ p = 0 :=
  ⟨fun h =>
    _root_.by_contradiction fun hp =>
      mt mem_support_iff.1 (Classical.not_not.2 h)
        (mem_of_min (trailingDegree_eq_natTrailingDegree hp)),
    fun h => h.symm ▸ leadingCoeff_zero⟩
#align polynomial.trailing_coeff_eq_zero Polynomial.trailingCoeff_eq_zero

theorem trailingCoeff_nonzero_iff_nonzero : trailingCoeff p ≠ 0 ↔ p ≠ 0 :=
  not_congr trailingCoeff_eq_zero
#align polynomial.trailing_coeff_nonzero_iff_nonzero Polynomial.trailingCoeff_nonzero_iff_nonzero

theorem natTrailingDegree_mem_support_of_nonzero : p ≠ 0 → natTrailingDegree p ∈ p.support :=
  mem_support_iff.mpr ∘ trailingCoeff_nonzero_iff_nonzero.mpr
#align polynomial.nat_trailing_degree_mem_support_of_nonzero Polynomial.natTrailingDegree_mem_support_of_nonzero

theorem natTrailingDegree_le_of_mem_supp (a : ℕ) : a ∈ p.support → natTrailingDegree p ≤ a :=
  natTrailingDegree_le_of_ne_zero ∘ mem_support_iff.mp
#align polynomial.nat_trailing_degree_le_of_mem_supp Polynomial.natTrailingDegree_le_of_mem_supp

theorem natTrailingDegree_eq_support_min' (h : p ≠ 0) :
    natTrailingDegree p = p.support.min' (nonempty_support_iff.mpr h) := by
  apply le_antisymm
  · apply le_min'
    intro y hy
    exact natTrailingDegree_le_of_mem_supp y hy
  · apply Finset.min'_le
    exact mem_support_iff.mpr (trailingCoeff_nonzero_iff_nonzero.mpr h)
#align polynomial.nat_trailing_degree_eq_support_min' Polynomial.natTrailingDegree_eq_support_min'

theorem le_natTrailingDegree (hp : p ≠ 0) (hn : ∀ m < n, p.coeff m = 0) : n ≤ p.natTrailingDegree :=
  by
  rw [natTrailingDegree_eq_support_min' hp]
  exact Finset.le_min' _ _ _ fun m hm => not_lt.1 fun hmn => mem_support_iff.1 hm <| hn _ hmn
#align polynomial.le_nat_trailing_degree Polynomial.le_natTrailingDegree

theorem natTrailingDegree_le_natDegree (p : R[X]) : p.natTrailingDegree ≤ p.natDegree := by
  by_cases hp : p = 0
  · rw [hp, natDegree_zero, natTrailingDegree_zero]
  · exact le_natDegree_of_ne_zero (mt trailingCoeff_eq_zero.mp hp)
#align polynomial.nat_trailing_degree_le_nat_degree Polynomial.natTrailingDegree_le_natDegree

theorem natTrailingDegree_mul_X_pow {p : R[X]} (hp : p ≠ 0) (n : ℕ) :
    (p * X ^ n).natTrailingDegree = p.natTrailingDegree + n := by
  apply le_antisymm
  · refine' natTrailingDegree_le_of_ne_zero fun h => mt trailingCoeff_eq_zero.mp hp _
    rwa [trailingCoeff, ← coeff_mul_X_pow]
  · rw [natTrailingDegree_eq_support_min' fun h => hp (mul_X_pow_eq_zero h), Finset.le_min'_iff]
    intro y hy
    have key : n ≤ y := by
      rw [mem_support_iff, coeff_mul_X_pow'] at hy
      exact by_contra fun h => hy (if_neg h)
    rw [mem_support_iff, coeff_mul_X_pow', if_pos key] at hy
    exact (le_tsub_iff_right key).mp (natTrailingDegree_le_of_ne_zero hy)
set_option linter.uppercaseLean3 false in
#align polynomial.nat_trailing_degree_mul_X_pow Polynomial.natTrailingDegree_mul_X_pow

theorem le_trailingDegree_mul : p.trailingDegree + q.trailingDegree ≤ (p * q).trailingDegree := by
  refine' Finset.le_min fun n hn => _
  rw [mem_support_iff, coeff_mul] at hn
  obtain ⟨⟨i, j⟩, hij, hpq⟩ := exists_ne_zero_of_sum_ne_zero hn
  refine'
    (add_le_add (min_le (mem_support_iff.mpr (left_ne_zero_of_mul hpq)))
          (min_le (mem_support_iff.mpr (right_ne_zero_of_mul hpq)))).trans
      (le_of_eq _)
  rwa [← WithTop.coe_add, WithTop.coe_eq_coe, ← Nat.mem_antidiagonal]
#align polynomial.le_trailing_degree_mul Polynomial.le_trailingDegree_mul

theorem le_natTrailingDegree_mul (h : p * q ≠ 0) :
    p.natTrailingDegree + q.natTrailingDegree ≤ (p * q).natTrailingDegree := by
  have hp : p ≠ 0 := fun hp => h (by rw [hp, zero_mul])
  have hq : q ≠ 0 := fun hq => h (by rw [hq, mul_zero])
  -- Porting note: Needed to account for different coercion behaviour & add the lemma below
  have : ∀ (p : R[X]), WithTop.some (natTrailingDegree p) = Nat.cast (natTrailingDegree p) :=
    fun p ↦ rfl
  rw [← WithTop.coe_le_coe, WithTop.coe_add, this p, this q, this (p * q),
    ← trailingDegree_eq_natTrailingDegree hp, ← trailingDegree_eq_natTrailingDegree hq,
    ← trailingDegree_eq_natTrailingDegree h]
  exact le_trailingDegree_mul
#align polynomial.le_nat_trailing_degree_mul Polynomial.le_natTrailingDegree_mul

theorem coeff_mul_natTrailingDegree_add_natTrailingDegree :
    (p * q).coeff (p.natTrailingDegree + q.natTrailingDegree) = p.trailingCoeff * q.trailingCoeff :=
  by
  rw [coeff_mul]
  refine'
    Finset.sum_eq_single (p.natTrailingDegree, q.natTrailingDegree) _ fun h =>
      (h (Nat.mem_antidiagonal.mpr rfl)).elim
  rintro ⟨i, j⟩ h₁ h₂
  rw [Nat.mem_antidiagonal] at h₁
  by_cases hi : i < p.natTrailingDegree
  · rw [coeff_eq_zero_of_lt_natTrailingDegree hi, zero_mul]
  by_cases hj : j < q.natTrailingDegree
  · rw [coeff_eq_zero_of_lt_natTrailingDegree hj, mul_zero]
  rw [not_lt] at hi hj
  refine' (h₂ (Prod.ext_iff.mpr _).symm).elim
  exact (add_eq_add_iff_eq_and_eq hi hj).mp h₁.symm
#align polynomial.coeff_mul_nat_trailing_degree_add_nat_trailing_degree Polynomial.coeff_mul_natTrailingDegree_add_natTrailingDegree

theorem trailingDegree_mul' (h : p.trailingCoeff * q.trailingCoeff ≠ 0) :
    (p * q).trailingDegree = p.trailingDegree + q.trailingDegree := by
  have hp : p ≠ 0 := fun hp => h (by rw [hp, trailingCoeff_zero, zero_mul])
  have hq : q ≠ 0 := fun hq => h (by rw [hq, trailingCoeff_zero, mul_zero])
  refine' le_antisymm _ le_trailingDegree_mul
  rw [trailingDegree_eq_natTrailingDegree hp, trailingDegree_eq_natTrailingDegree hq, ←
    ENat.coe_add]
  apply le_trailingDegree_of_ne_zero
  rwa [coeff_mul_natTrailingDegree_add_natTrailingDegree]
#align polynomial.trailing_degree_mul' Polynomial.trailingDegree_mul'

theorem natTrailingDegree_mul' (h : p.trailingCoeff * q.trailingCoeff ≠ 0) :
    (p * q).natTrailingDegree = p.natTrailingDegree + q.natTrailingDegree := by
  have hp : p ≠ 0 := fun hp => h (by rw [hp, trailingCoeff_zero, zero_mul])
  have hq : q ≠ 0 := fun hq => h (by rw [hq, trailingCoeff_zero, mul_zero])
  -- Porting note: Needed to account for different coercion behaviour & add the lemmas below
  have aux1 : ∀ n, Nat.cast n = WithTop.some (n) := fun n ↦ rfl
  have aux2 : ∀ (p : R[X]), WithTop.some (natTrailingDegree p) = Nat.cast (natTrailingDegree p) :=
    fun p ↦ rfl
  apply natTrailingDegree_eq_of_trailingDegree_eq_some
  rw [trailingDegree_mul' h, aux1 (natTrailingDegree p + natTrailingDegree q),
    WithTop.coe_add, aux2 p, aux2 q, ← trailingDegree_eq_natTrailingDegree hp, ←
    trailingDegree_eq_natTrailingDegree hq]
#align polynomial.nat_trailing_degree_mul' Polynomial.natTrailingDegree_mul'

theorem natTrailingDegree_mul [NoZeroDivisors R] (hp : p ≠ 0) (hq : q ≠ 0) :
    (p * q).natTrailingDegree = p.natTrailingDegree + q.natTrailingDegree :=
  natTrailingDegree_mul'
    (mul_ne_zero (mt trailingCoeff_eq_zero.mp hp) (mt trailingCoeff_eq_zero.mp hq))
#align polynomial.nat_trailing_degree_mul Polynomial.natTrailingDegree_mul

end Semiring

section NonzeroSemiring

variable [Semiring R] [Nontrivial R] {p q : R[X]}

@[simp]
theorem trailingDegree_one : trailingDegree (1 : R[X]) = (0 : ℕ∞) :=
  trailingDegree_C one_ne_zero
#align polynomial.trailing_degree_one Polynomial.trailingDegree_one

@[simp]
theorem trailingDegree_X : trailingDegree (X : R[X]) = 1 :=
  trailingDegree_monomial one_ne_zero
set_option linter.uppercaseLean3 false in
#align polynomial.trailing_degree_X Polynomial.trailingDegree_X

@[simp]
theorem natTrailingDegree_X : (X : R[X]).natTrailingDegree = 1 :=
  natTrailingDegree_monomial one_ne_zero
set_option linter.uppercaseLean3 false in
#align polynomial.nat_trailing_degree_X Polynomial.natTrailingDegree_X

end NonzeroSemiring

section Ring

variable [Ring R]

@[simp]
theorem trailingDegree_neg (p : R[X]) : trailingDegree (-p) = trailingDegree p := by
  unfold trailingDegree
  rw [support_neg]
#align polynomial.trailing_degree_neg Polynomial.trailingDegree_neg

@[simp]
theorem natTrailingDegree_neg (p : R[X]) : natTrailingDegree (-p) = natTrailingDegree p := by
  simp [natTrailingDegree]
#align polynomial.nat_trailing_degree_neg Polynomial.natTrailingDegree_neg

@[simp]
theorem natTrailingDegree_int_cast (n : ℤ) : natTrailingDegree (n : R[X]) = 0 := by
  simp only [← C_eq_int_cast, natTrailingDegree_C]
#align polynomial.nat_trailing_degree_int_cast Polynomial.natTrailingDegree_int_cast

end Ring

section Semiring

variable [Semiring R]

/-- The second-lowest coefficient, or 0 for constants -/
def nextCoeffUp (p : R[X]) : R :=
  if p.natTrailingDegree = 0 then 0 else p.coeff (p.natTrailingDegree + 1)
#align polynomial.next_coeff_up Polynomial.nextCoeffUp

@[simp]
theorem nextCoeffUp_C_eq_zero (c : R) : nextCoeffUp (C c) = 0 := by
  rw [nextCoeffUp]
  simp
set_option linter.uppercaseLean3 false in
#align polynomial.next_coeff_up_C_eq_zero Polynomial.nextCoeffUp_C_eq_zero

theorem nextCoeffUp_of_pos_natTrailingDegree (p : R[X]) (hp : 0 < p.natTrailingDegree) :
    nextCoeffUp p = p.coeff (p.natTrailingDegree + 1) := by
  rw [nextCoeffUp, if_neg]
  contrapose! hp
  simpa
#align polynomial.next_coeff_up_of_pos_nat_trailing_degree Polynomial.nextCoeffUp_of_pos_natTrailingDegree

end Semiring

section Semiring

variable [Semiring R] {p q : R[X]} {ι : Type _}

theorem coeff_natTrailingDegree_eq_zero_of_trailingDegree_lt
    (h : trailingDegree p < trailingDegree q) : coeff q (natTrailingDegree p) = 0 :=
  coeff_eq_zero_of_trailingDegree_lt <| natTrailingDegree_le_trailingDegree.trans_lt h
#align polynomial.coeff_nat_trailing_degree_eq_zero_of_trailing_degree_lt Polynomial.coeff_natTrailingDegree_eq_zero_of_trailingDegree_lt

theorem ne_zero_of_trailingDegree_lt {n : ℕ∞} (h : trailingDegree p < n) : p ≠ 0 := fun h₀ =>
  h.not_le (by simp [h₀])
#align polynomial.ne_zero_of_trailing_degree_lt Polynomial.ne_zero_of_trailingDegree_lt

end Semiring

end Polynomial


import data.int.basic data.nat.gcd

namespace int

lemma dvd_mod_iff {k m n : ℤ} (h : k ∣ n) : k ∣ m % n ↔ k ∣ m :=
let t := @dvd_add_iff_left _ _ _ (m % n) _ (dvd_trans h (dvd_mul_right n (m / n))) in
by rwa mod_add_div at t

@[simp] lemma gcd_zero_left (a : ℤ) : gcd 0 a = a.nat_abs := nat.gcd_zero_left _

@[simp] lemma gcd_one_left (a : ℤ) : gcd 1 a = 1 := nat.gcd_one_left _

@[simp] lemma gcd_one_right (a : ℤ) : gcd a 1 = 1 := nat.gcd_one_right _

lemma gcd_comm (a b : ℤ) : gcd a b = gcd b a := nat.gcd_comm _ _

lemma gcd_mul_left (a b c : ℤ) : gcd (a * b) (a * c) = a.nat_abs * gcd b c :=
by unfold gcd;
  rw [nat_abs_mul, nat_abs_mul, nat.gcd_mul_left]

lemma gcd_mul_right (a b c : ℤ) : gcd (b * a) (c * a) = gcd b c * a.nat_abs :=
by rw [mul_comm b, mul_comm c, gcd_mul_left, mul_comm (gcd b c)]

lemma gcd_pos_of_ne_zero_left {a : ℤ} (b : ℤ) (hb : b ≠ 0) : 0 < gcd a b :=
by unfold gcd; exact nat.gcd_pos_of_pos_right _ (nat_abs_pos_of_ne_zero hb)

@[simp] lemma gcd_neg (a b : ℤ) : gcd (-a) b = gcd a b :=
by unfold gcd; rw nat_abs_neg

@[simp] lemma gcd_neg' (a b : ℤ) : gcd a (-b) = gcd a b :=
by unfold gcd; rw nat_abs_neg

lemma gcd_dvd_left (a b : ℤ) : (gcd a b : ℤ) ∣ a :=
dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ nat.gcd_dvd_left _ _

lemma gcd_dvd_right (a b : ℤ) : (gcd a b : ℤ) ∣ b :=
dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ nat.gcd_dvd_right _ _

lemma dvd_gcd {a b c : ℤ} (hb : a ∣ b) (hc : a ∣ c) : a ∣ gcd b c :=
nat_abs_dvd.1 $ int.coe_nat_dvd.2 (begin
  rw [← nat_abs_dvd, ← dvd_nat_abs, int.coe_nat_dvd] at hb hc,
  exact nat.dvd_gcd hb hc
end)

lemma gcd_mod (a b : ℤ) : gcd (b % a) a = gcd a b:=
nat.dvd_antisymm
  (int.coe_nat_dvd.1 (dvd_gcd (gcd_dvd_right (b % a) a)
    ((dvd_mod_iff (gcd_dvd_right (b % a) a)).1 (gcd_dvd_left (b % a) a))))
  (int.coe_nat_dvd.1 (dvd_gcd ((dvd_mod_iff (gcd_dvd_left a b)).2
    (gcd_dvd_right a b)) (gcd_dvd_left a b)))

lemma gcd_assoc (a b c : ℤ) : gcd (gcd a b) c = gcd a (gcd b c) := nat.gcd_assoc _ _ _

end int


import MyNat.Definition
namespace MyNat
open MyNat
/-!

# Advanced proposition world.

## Level 5: `iff_trans` easter eggs.

Let's try `iff_trans` again. Try proving it in other ways.

### A trick.

Instead of using `cases` on `h : P ↔ Q` you can just access the proofs of `P → Q` and `Q → P`
directly with `h.mp` and `h.mpr`.

## Lemma
If `P`, `Q` and `R` are true/false statements, then `P ↔ Q` and `Q ↔ R` together imply `P ↔ R`.
-/
lemma iff_trans₂ (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) := by
  intros hpq hqr
  constructor
  intro p
  apply hqr.mp
  apply hpq.mp
  assumption
  intro r
  apply hpq.mpr
  apply hqr.mpr
  assumption

/-!

### Another trick

Instead of using `cases` on `h : P ↔ Q`, you can just `rw [h]`, and this will change all `P`s to `Q`s
in the goal. You can use this to create a much shorter proof. Note that
this is an argument for *not* running the `cases` tactic on an iff statement;
you cannot rewrite one-way implications, but you can rewrite two-way implications.

-/
lemma iff_trans₃ (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) := by
  intros hpq hqr
  rw [hpq]
  rw [hqr]

/-!

Next up [Level 6](./Level6.lean.md)
-/


open classical

variables p q r s : Prop

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

example : p ∨ q ↔ q ∨ p :=
iff.intro
    (assume hpq : p ∨ q,
    or.elim hpq
        (assume hp : p, show q ∨ p, from or.intro_right q hp)
        (assume hq : q, show q ∨ p, from or.intro_left p hq)
    )
    (assume hqp : q ∨ p,
    or.elim hqp
        (assume hq : q, show p ∨ q, from or.intro_right p hq)
        (assume hp : p, show p ∨ q, from or.intro_left q hp)
    )

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

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
iff.intro
    (assume h : (p ∨ q) ∨ r,
    show p ∨ (q ∨ r),
    from or.elim h
        (λ hpq : p ∨ q, or.elim hpq
            (λ hp : p, or.intro_left (q ∨ r) hp)
            (λ hq : q, or.intro_right p (or.intro_left r hq)))
        (λ hr : r, or.intro_right p (or.intro_right q hr)))
    (assume h : p ∨ (q ∨ r),
    show (p ∨ q) ∨ r,
    from or.elim h
        (λ hp : p, or.intro_left r (or.intro_left q hp))
        (λ hqr : q ∨ r, or.elim hqr
            (λ hq : q, or.intro_left r (or.intro_right p hq))
            (λ hr : r, or.intro_right (p ∨ q) hr)))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
    (λ h : p ∧ (q ∨ r), or.elim h.right
        (λ hq: q, or.intro_left (p ∧ r) (and.intro h.left hq))
        (λ hr: r, or.intro_right (p ∧ q) (and.intro h.left hr)))
    (λ h : (p ∧ q) ∨ (p ∧ r), or.elim h
        (λ hpq: p ∧ q, and.intro hpq.left (or.intro_left r hpq.right))
        (λ hpr: p ∧ r, and.intro hpr.left (or.intro_right q hpr.right)))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
iff.intro
    (λ h : p ∨ (q ∧ r), or.elim h
        (λ hp: p, and.intro (or.intro_left q hp) (or.intro_left r hp))
        (λ hqr: q ∧ r, and.intro (or.intro_right p hqr.left) (or.intro_right p hqr.right)))
    (λ h : (p ∨ q) ∧ (p ∨ r), or.elim h.left
        (λ hp: p, or.intro_left (q ∧ r) hp)
        (λ hq: q, or.elim h.right
            (λ hp: p, or.intro_left (q ∧ r) hp)
            (λ hr: r, or.intro_right p (and.intro hq hr))))

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
iff.intro
    (assume h: p → (q → r),
    assume hpq: p ∧ q,
    have hqr: q → r, from h hpq.left,
    show r, from hqr hpq.right)
    (assume h: p ∧ q → r,
    assume hp: p,
    assume hq: q,
    show r, from h (and.intro hp hq))

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
iff.intro
    (assume h : (p ∨ q) → r, and.intro
        (assume hp: p, show r, from h (or.intro_left q hp))
        (assume hq: q, show r, from h (or.intro_right p hq)))
    (assume h : (p → r) ∧ (q → r),
    assume hpq: p ∨ q, or.elim hpq
        (assume hp: p, show r, from h.left hp)
        (assume hq: q, show r, from h.right hq))

example : ¬(p ∨ q) → ¬p :=
    assume h : ¬(p ∨ q),
    show ¬p, from (
        assume hp: p,
        have hpq: p ∨ q, from or.intro_left q hp,
        show false, from absurd hpq h)

-- changed to lemma for later use
lemma not_or_and_not : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
iff.intro
    (assume h : ¬(p ∨ q), and.intro
        (assume hp: p,
        have hpq: p ∨ q, from or.intro_left q hp,
        show false, from absurd hpq h)
        (assume hq: q,
        have hpq: p ∨ q, from or.intro_right p hq,
        show false, from absurd hpq h))
    (assume npq: ¬p ∧ ¬q,
    assume hpq: p ∨ q,
    have np: ¬p, from npq.left,
    have nq: ¬q, from npq.right,
    show false, from or.elim hpq
        (assume hp: p, absurd hp np)
        (assume hq: q, absurd hq nq))

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
    assume npq: ¬p ∨ ¬q,
    assume hpq: p ∧ q,
    have hp: p, from hpq.left,
    have hq: q, from hpq.right,
    show false, from or.elim npq
        (assume np: ¬p, absurd hp np)
        (assume nq: ¬q, absurd hq nq)

example : ¬(p ∧ ¬p) :=
    assume h : p ∧ ¬p,
    have hp: p, from h.left,
    have np: ¬p, from h.right,
    show false, from absurd hp np

example : p ∧ ¬q → ¬(p → q) :=
    assume hpnq: p ∧ ¬q,
    assume hpq: p → q,
    have hp: p, from hpnq.left,
    have nq: ¬q, from hpnq.right,
    have hq: q, from hpq hp,
    show false, from absurd hq nq

example : ¬p → (p → q) :=
    assume np: ¬p,
    assume hp: p,
    show q, from absurd hp np

example : (¬p ∨ q) → (p → q) :=
    assume h: ¬p ∨ q,
    assume hp: p,
    show q, from or.elim h
        (assume np: ¬p, absurd hp np)
        (assume hq: q, hq)

example : p ∨ false ↔ p :=
iff.intro
    (assume h : p ∨ false, or.elim h
        (assume hp: p, hp)
        (assume f: false, false.elim f))
    (assume hp: p, or.intro_left false hp)

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

/-
Exercise 2. Prove ¬(p ↔ ¬p) without using classical logic.
-/
lemma implies_to_double_not_and : (p → q) → ¬¬(¬p ∨ q):=
    assume h: p → q,
    assume h₂ : ¬(¬p ∨ q),
    have h₃ : ¬¬p ∧ ¬q, from iff.elim_left (not_or_and_not (¬p) q) h₂,
    have nnp: ¬¬p, from h₃.left,
    have nq: ¬q, from h₃.right,
    have np: ¬p, from (
        assume hp: p,
        have hq: q, from h hp,
        show false, from absurd hq nq),
    show false, from absurd np nnp
lemma iff_to_not_iff : (p ↔ q) → (¬p ↔ ¬q) :=
    assume h : p ↔ q, iff.intro
        (assume np : ¬p,
        assume hq : q,
        have hp: p, from iff.elim_right h hq,
        show false, from absurd hp np)
        (assume nq : ¬q,
        assume hp : p,
        have hq: q, from iff.elim_left h hp,
        show false, from absurd hq nq)
lemma not_and_same : ¬(p ∧ p) → ¬p :=
    assume h: ¬(p ∧ p),
    assume hp: p,
    have hpp: p ∧ p, from and.intro hp hp,
    show false, from absurd hpp h
example : ¬(p ↔ ¬p) :=
    -- enumerate negations
    assume h₀: p ↔ ¬p,
    have h₁ : ¬p ↔ ¬¬p, from iff_to_not_iff p (¬p) h₀,
    have h₂ : ¬¬p ↔ ¬¬¬p, from iff_to_not_iff (¬p) (¬¬p) h₁,
    -- get negated p
    have hnnnp : ¬(¬¬p ∧ ¬¬p), from (
        -- (p → ¬p) → ¬(¬¬p ∧ ¬¬p)
        have h₁ : ¬¬(¬p ∨ ¬p), from implies_to_double_not_and p (¬p) (iff.elim_left h₀),
        have h₂ : ¬¬(¬p ∨ ¬p) ↔ ¬(¬¬p ∧ ¬¬p), from iff_to_not_iff (¬(¬p ∨ ¬p)) (¬¬p ∧ ¬¬p) (not_or_and_not (¬p) (¬p)),
        show ¬(¬¬p ∧ ¬¬p), from (iff.elim_left h₂) h₁),
    --implies_to_andish p (¬p) (iff.elim_left h₀),
    have nnnp : ¬¬¬p, from not_and_same (¬¬p) hnnnp,
    -- eliminate negations
    have nnp : ¬¬p, from iff.elim_right h₂ nnnp,
    show false, from absurd nnp nnnp

-- changed to lemma for later use
lemma reverse_imp : (p → q) → (¬q → ¬p) :=
    assume hpq: p → q,
    assume nq: ¬q,
    assume hp: p,
    have hq: q, from hpq hp,
    show false, from absurd hq nq

-- these require classical reasoning

lemma notnot : ¬¬p ↔ p :=
    iff.intro
        (assume h: ¬¬p,
        by_contradiction (assume h1 : ¬p, show false, from h h1))
        (assume h: p,
        by_cases
            (assume h1 : ¬p, absurd h h1)
            (assume h1 : ¬¬p, h1))

lemma imp_substitue_frst : ((p → q) ∧ (p ↔ r)) → (r → q) :=
    assume h: (p → q) ∧ (p ↔ r),
    assume hr: r,
    have hp: p, from iff.elim_right (and.elim_right h) hr,
    show q, from and.elim_left h hp

lemma imp_substitue_scnd : ((p → q) ∧ (q ↔ r)) → (p → r) :=
    assume h: (p → q) ∧ (q ↔ r),
    assume hp: p,
    have hq: q, from and.elim_left h hp,
    show r, from iff.elim_left (and.elim_right h) hq

lemma not_and_to_imp : ¬(p ∧ ¬q) → (p → q) :=
    assume h : ¬(p ∧ ¬q),
    assume hp : p,
    show q, from
    or.elim (em q)
        (assume hq : q, hq)
        (assume hnq : ¬q, absurd (and.intro hp hnq) h)

lemma not_iff : ¬(p → q) → p ∧ ¬q :=
    assume h : ¬(p → q),
    by_contradiction
        (assume n₀ : ¬(p ∧ ¬q),
        have n₁ : p → q, from not_and_to_imp  p q n₀,
        show false, from absurd n₁ h)

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
    assume h : p → r ∨ s,
    by_contradiction
        (assume n₀ : ¬((p → r) ∨ (p → s)),
        have n₁ : ¬(p → r) ∧ ¬(p → s), from iff.elim_left (not_or_and_not (p → r) (p → s)) n₀,
        have n₂ : p ∧ ¬r, from not_iff p r (and.elim_left n₁),
        have n₃ : p ∧ ¬s, from not_iff p s (and.elim_right n₁),
        have hrs: r ∨ s, from h (and.elim_left n₂),
        have nrs: ¬(r ∨ s), from iff.elim_right (not_or_and_not r s) (and.intro n₂.right n₃.right),
        show false, from absurd hrs nrs)

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
    assume h : ¬(p ∧ q),
    by_cases
        (assume hp: p,
        have nq: ¬q, from by_contradiction(
            assume nnq: ¬¬q,
            have hq: q, from iff.elim_left (notnot q) nnq,
            have n : p ∧ q, from and.intro hp hq,
            show false, from absurd n h),
        show ¬p ∨ ¬q, from or.intro_right (¬p) nq)
        (assume np: ¬p, show ¬p ∨ ¬q, from or.intro_left (¬q) np)

-- changed to lemma for later use
lemma implies_as_or : (p → q) → (¬p ∨ q) :=
assume h : p → q,
by_cases
    (assume hp : p,
    have hq: q, from h hp,
    show ¬p ∨ q, from or.intro_right (¬p) hq)
    (assume np : ¬p, show ¬p ∨ q, from or.intro_left (q) np)

example : (¬q → ¬p) → (p → q) :=
    assume h : ¬q → ¬p,
    assume hp : p,
    by_contradiction (
        assume nq: ¬q,
        have np : ¬p, from h nq,
        show false, from absurd hp np)

example : p ∨ ¬p := em p

example : (((p → q) → p) → p) :=
    by_contradiction
        (assume n : ¬ (((p → q) → p) → p),
        have h₀ : ((p → q) → p) ∧ ¬p, from not_iff ((p → q) → p) p n,
        have h₁ : ¬(p → q), from (reverse_imp (p → q) p h₀.left) h₀.right,
        have h₂ : p ∧ ¬q, from not_iff p q h₁,
        show false, from absurd h₂.left h₀.right)


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import linear_algebra.determinant
import topology.algebra.ring

/-!
# Topological properties of matrices

This file is a place to collect topological results about matrices.

## Main definitions:

 * `continuous_det`: the determinant is continuous over a topological ring.
-/

open matrix

variables {ι k : Type*} [topological_space k]

instance : topological_space (matrix ι ι k) := Pi.topological_space

variables [fintype ι] [decidable_eq ι] [comm_ring k] [topological_ring k]

lemma continuous_det : continuous (det : matrix ι ι k → k) :=
begin
  suffices : ∀ (n : ℕ), continuous (λ A : matrix (fin n) (fin n) k, matrix.det A),
  { have h : (det : matrix ι ι k → k) = det ∘ reindex (fintype.equiv_fin ι) (fintype.equiv_fin ι),
    { ext, simp, },
    rw h,
    apply (this (fintype.card ι)).comp,
    exact continuous_pi (λ i, continuous_pi (λ j, continuous_apply_apply _ _)), },
  intros n,
  induction n with n ih,
  { simp_rw coe_det_is_empty,
    exact continuous_const, },
  simp_rw det_succ_column_zero,
  refine continuous_finset_sum _ (λ l _, _),
  refine (continuous_const.mul (continuous_apply_apply _ _)).mul (ih.comp _),
  exact continuous_pi (λ i, continuous_pi (λ j, continuous_apply_apply _ _)),
end


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

/-!
# Left and right continuity

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

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

## Tags

left continuous, right continuous
-/

open set filter
open_locale topological_space

section partial_order

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

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

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

end partial_order

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

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

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

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

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

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


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

import data.nat.basic

/-! # A recursion principle based on even and odd numbers.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.-/

namespace nat

/-- Recursion principle on even and odd numbers: if we have `P 0`, and for all `i : ℕ` we can
extend from `P i` to both `P (2 * i)` and `P (2 * i + 1)`, then we have `P n` for all `n : ℕ`.
This is nothing more than a wrapper around `nat.binary_rec`, to avoid having to switch to
dealing with `bit0` and `bit1`. -/
@[elab_as_eliminator]
def even_odd_rec {P : ℕ → Sort*} (h0 : P 0)
  (h_even : ∀ n (ih : P n), P (2 * n))
  (h_odd : ∀ n (ih : P n), P (2 * n + 1)) (n : ℕ) : P n :=
begin
  refine @binary_rec P h0 (λ b i hi, _) n,
  cases b,
  { simpa [bit, bit0_val i] using h_even i hi },
  { simpa [bit, bit1_val i] using h_odd i hi },
end

@[simp] lemma even_odd_rec_zero (P : ℕ → Sort*) (h0 : P 0)
  (h_even : ∀ i, P i → P (2 * i)) (h_odd : ∀ i, P i → P (2 * i + 1)) :
  @even_odd_rec _ h0 h_even h_odd 0 = h0 := binary_rec_zero _ _

@[simp] lemma even_odd_rec_even (n : ℕ) (P : ℕ → Sort*) (h0 : P 0)
  (h_even : ∀ i, P i → P (2 * i)) (h_odd : ∀ i, P i → P (2 * i + 1))
  (H : h_even 0 h0 = h0) :
  @even_odd_rec _ h0 h_even h_odd (2 * n) = h_even n (even_odd_rec h0 h_even h_odd n) :=
begin
  convert binary_rec_eq _ ff n,
  { exact (bit0_eq_two_mul _).symm },
  { exact (bit0_eq_two_mul _).symm },
  { apply heq_of_cast_eq, refl },
  { exact H }
end

@[simp] lemma even_odd_rec_odd (n : ℕ) (P : ℕ → Sort*) (h0 : P 0)
  (h_even : ∀ i, P i → P (2 * i)) (h_odd : ∀ i, P i → P (2 * i + 1))
  (H : h_even 0 h0 = h0) :
  @even_odd_rec _ h0 h_even h_odd (2 * n + 1) = h_odd n (even_odd_rec h0 h_even h_odd n) :=
begin
  convert binary_rec_eq _ tt n,
  { exact (bit0_eq_two_mul _).symm },
  { exact (bit0_eq_two_mul _).symm },
  { apply heq_of_cast_eq, refl },
  { exact H }
end

end nat


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.convex.star
import topology.homotopy.contractible

/-!
# A convex set is contractible

In this file we prove that a (star) convex set in a real topological vector space is a contractible
topological space.
-/

variables {E : Type*} [add_comm_group E] [module ℝ E] [topological_space E]
  [has_continuous_add E] [has_continuous_smul ℝ E] {s : set E} {x : E}

/-- A non-empty star convex set is a contractible space. -/
protected lemma star_convex.contractible_space (h : star_convex ℝ x s) (hne : s.nonempty) :
  contractible_space s :=
begin
  refine (contractible_iff_id_nullhomotopic _).2 ⟨⟨x, h.mem hne⟩,
    ⟨⟨⟨λ p, ⟨p.1.1 • x + (1 - p.1.1) • p.2, _⟩, _⟩, λ x, _, λ x, _⟩⟩⟩,
  { exact h p.2.2 p.1.2.1 (sub_nonneg.2 p.1.2.2) (add_sub_cancel'_right _ _) },
  { exact ((continuous_subtype_val.fst'.smul continuous_const).add
      ((continuous_const.sub continuous_subtype_val.fst').smul
        continuous_subtype_val.snd')).subtype_mk _ },
  { ext1, simp },
  { ext1, simp }
end

/-- A non-empty convex set is a contractible space. -/
protected lemma convex.contractible_space (hs : convex ℝ s) (hne : s.nonempty) :
  contractible_space s :=
let ⟨x, hx⟩ := hne in (hs.star_convex hx).contractible_space hne

@[priority 100] instance real_topological_vector_space.contractible_space : contractible_space E :=
(homeomorph.set.univ E).contractible_space_iff.mp $ convex_univ.contractible_space set.univ_nonempty


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intros h1 h2,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  by_cases hipo : P,
    intro h1,
    apply hipo,

    intro h1,
    have newhipo := h1 hipo,
    contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  have primeiraHipo := doubleneg_elim P,
    apply primeiraHipo,
  have segundaHipo := doubleneg_intro P,
    apply segundaHipo,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro h1,
  cases h1,
  right,
    apply h1,
  left,
    apply h1,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h1,
  cases h1 with part1 part2,
  split,
  apply part2,
  apply part1,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intros h1 h2,
  cases h1,
  contradiction,
  apply h1,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intros h1 h2,
  cases h1,
  contradiction,
  apply h1,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intros h1 h2 h3,
  have newhipo : Q := h1 h3,
    contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros h1 h2,
  by_cases q: Q,
    assumption,
    have newhipo := h1 q,
      contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  have primeiraHipo := impl_as_contrapositive P Q,
    apply primeiraHipo,
  have segundaHipo := impl_as_contrapositive_converse P Q,
    apply segundaHipo,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intros h1,
  have leiTercEscolh : P ∨ ¬P,
    right,
    intro h2,
    have leiTercEscolhOutraParte : P ∨ ¬P,
      left,
      apply h2,
      contradiction,
  contradiction,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intros h1 h2,
  have newhipo : P → Q,
    intro h2,
    contradiction,
  have obterP := h1 newhipo,
    contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intros h1 h2,
  cases h2 with hp hq,
  cases  h1,
    contradiction,
    contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intros h1 h2,
  cases h1 with hp hq,
  cases h2,
    contradiction,
    contradiction,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro h1,
  split,
    intro hp,
    have newhipo : (P∨Q),
    left,
      apply hp,
      contradiction,
    intro hq,
    have newhipo : (P∨Q),
      right,
      apply hq,
      contradiction,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intros h1 h2,
  cases h1 with naop naoq,
    cases h2,
    contradiction,
    contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro h1,
  by_cases P,
  left,
  by_contradiction q,
  have newhipo : P∧Q,
    split,
    repeat {assumption},
  contradiction,
  right,
  assumption,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intros h1 h2,
  cases h2 with hp hq,
    cases h1 with naoq naop,
    contradiction,
    contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  have primeiraHipo := demorgan_conj P Q,
    apply primeiraHipo,
  have segundaHipo := demorgan_conj_converse P Q,
    apply segundaHipo,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  have primeiraHipo := demorgan_disj P Q,
    apply primeiraHipo,
  have segundaHipo := demorgan_disj_converse P Q,
    apply segundaHipo,
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro h1,
  cases h1 with hp hqr,
  cases hqr,
  left,
    split,
      assumption,
      assumption,
  right,
    split,
      assumption,
      assumption,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h1,
  split,
  cases h1,
    cases h1 with hq hpr,
    assumption,
      cases h1 with p q,
      assumption,
      cases h1,
        cases h1 with hp hq,
        left,
          assumption,
        cases h1 with hp hpr,
        right,
        assumption,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro h1,
  cases h1,
    split,
    left,
      assumption,
      left,
        assumption,
    cases h1 with hq hr,
    split,
    right,
      assumption,
    right,
      assumption,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h1,
  cases h1 with pq pr,
  cases pq with p q,
    left,
      assumption,
    cases pr with p r,
      left,
        assumption,
      right,
        split,
          repeat {assumption},
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intros h1 h2 h3,
  have newhipo : (P∧Q),
  split,
    assumption,
    assumption,
  apply h1 newhipo,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intros h1 h2,
  cases h2 with hp hq,
  apply h1 hp hq,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro h1,
  assumption,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro h1,
  left, --escolhe lado esquerdo do alvo
  assumption,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro h1,
  right, --escolhe lado direito do alvo
  assumption,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro h1,
  cases h1 with hp hq,
    assumption,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro h1,
  cases h1 with hp hq,
    assumption,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro h1,
  cases h1,
    assumption,
  intro h2,
    split,
      assumption,
      assumption,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro h1,
  cases h1,
    assumption,
    assumption,
  intro h2,
    right, --ou esquerda, tanto faz
      assumption,
end

end propositional

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

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intros nEa a pA,
  apply nEa,
  existsi a,
  assumption,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intros pTdA eA,
  cases eA with a,
  have newhipo := pTdA a,
  contradiction,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  apply impl_as_contrapositive_converse (¬(∀x, P x)) (∃x, ¬P x),
  intros nEa,
  apply doubleneg_intro (∀x, P x),
  intro a,
  by_contra nPa,
  have newhipo : (∃x, ¬P x),
    existsi a,
    assumption,
  contradiction,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intros eA pTdA,
  cases eA with a,
  have newhipo := pTdA a,
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  have primeiraHipo := demorgan_forall U P,
    apply primeiraHipo,
  have segundaHipo := demorgan_forall_converse U P,
    apply segundaHipo,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  have primeiraHipo := demorgan_exists U P,
    apply primeiraHipo,
  have segundaHipo := demorgan_exists_converse U P,
    apply segundaHipo,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intros eA nPtdA,
  cases eA with u pU,
  have newhipo := nPtdA u,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intros pTdA eA,
  cases eA with a nPa,
  have newhipo := pTdA a,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intros nEnPa a,
  by_contra nPa,
  have newhipo : ∃x, ¬P x,
    existsi a,
    apply nPa,
  contradiction,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro npTdA,
  by_contra nEa,
  have newhipo : (∀x, ¬P x),
    intros a Pa,
    have otherhipo : ∃x, P x,
      existsi a,
      assumption,
    contradiction,
  contradiction,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  have primeiraHipo := forall_as_neg_exists U P,
    apply primeiraHipo,
  have segundaHipo := forall_as_neg_exists_converse U P,
    apply segundaHipo,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  have primeiraHipo := exists_as_neg_forall U P,
    apply primeiraHipo,
  have segundaHipo := exists_as_neg_forall_converse U P,
    apply segundaHipo,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro ePa,
  cases ePa with a pq,
    cases pq with pa qa,
      split,
        existsi a,
        assumption,
        existsi a,
        assumption,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro ePa,
  cases ePa with a pq,
    cases pq with pa qa,
      left,
        existsi a,
        assumption,
      right,
        existsi a,
        assumption,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro ePaOUeQa,
  cases ePaOUeQa with ePa eQa,
    cases ePa with a Pa,
      existsi a,
      left,
        assumption,
    cases eQa with a Qa,
      existsi a,
      right,
        assumption,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro pTdaPaEQa,
  split,
    intro a,
    have newhipo := pTdaPaEQa a,
    cases newhipo with pq qa,
    assumption,

    intro a,
    have otherhipo := pTdaPaEQa a,
    cases otherhipo with pq qa,
    assumption,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intros pTdaPaEpTdaQa a,
  cases pTdaPaEpTdaQa with pTdaPa pTdaQa,
    split,
      have newhipo := pTdaPa a,
        assumption,
      have newhipo := pTdaQa a,
        assumption,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intros pTdaPaOUpTdaQa a,
  cases pTdaPaOUpTdaQa with pTdaPa pTdaQa,
    left,
      have newhipo := pTdaPa a,
        assumption,
    right,
      have newhipo := pTdaQa a,
        assumption,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


-- Monotonía de la suma por la derecha en Lean
-- ===========================================

-- Demostrar que si a, b y c son números reales
-- tales que a ≤ b, entonces a + c ≤ b + c.

import data.real.basic

variables {a b c : ℝ}

-- 1ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  have h : (b + c) - (a + c) = b - a,
  { ring, },
  { rw h,
    rw sub_nonneg,
    exact hab, },
end

-- 2ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  calc
    0   ≤ b - a
            : by exact sub_nonneg.mpr hab
    ... = b + c - (a + c)
            : by exact (add_sub_add_right_eq_sub b a c).symm,
end

-- 3ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  calc
    0   ≤ b - a
            : sub_nonneg.mpr hab
    ... = b + c - (a + c)
            : (add_sub_add_right_eq_sub b a c).symm,
end

-- 4ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  calc 0   ≤ b - a           : sub_nonneg.mpr hab
       ... = b + c - (a + c) : by ring,
end

-- 5ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  simp,
  exact hab,
end

-- 6ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  simp [hab],
end

-- 7ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  simp [hab],
end

-- 8ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
by simp [hab]

-- 9ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
add_le_add_right hab c

-- 10ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
by linarith

-- 11ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
by finish

-- 12ª demostración
example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw add_comm a c,
  rw add_comm b c,
  exact add_le_add_left hab c,
end


import tactic
import data.nat.gcd.basic

-- Rather than reinventing the wheel now we want to explore how to use mathlib

-- this gives us access to most results of the form `nat.blah` in their short form `blah`

open nat
variables {a b c d k m n : ℕ} -- these will now be available when needed in our examples below

/- TODO Ask Richard what he thinks we need to do on this topic -/
/- Integer dvd -/
example : d ∣ n ↔ ∃ k, n = d*k :=
begin
  refl,
end

example : a ∣ b →  b ∣ c →  a ∣ c:=
begin
  sorry,
end

example : a ∣ b → b ∣ a →  a = b:=
begin
  sorry,
end

example : 0 ∣ a → a = 0:=
begin
  sorry,
end

example : 1 ∣ a :=
begin
  sorry,
end

example : 2 ∣ a ↔ even a :=
begin
  sorry,
end

example : 2 ∣ a →  3 ∣ a →  6 ∣ a:=
begin
  sorry,
end

/-  k % m the remainder of k after division by m`
  while k/m is the quotient so: -/
example : m*(k/m) + (k%m) = k:=
begin
  sorry,
end

example : a % m = b % m → b % m = c % m → a % m = c % m:=
begin
  sorry,
end

#check nat.gcd


-- https://leanprover.github.io/theorem_proving_in_lean/propositions_and_proofs.html#exercises

variables p q r : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  ⟨ assume h: p ∧ q, ⟨h.right, h.left⟩, assume h: q ∧ p, ⟨h.right, h.left⟩ ⟩

example : p ∨ q ↔ q ∨ p :=
  ⟨
    assume h: p ∨ q,
    show q ∨ p, from h.elim (λ hp: p, or.inr hp) (λ hq: q, or.inl hq),

    assume h: q ∨ p,
    show p ∨ q, from h.elim (λ hq: q, or.inr hq) (λ hp: p, or.inl hp),
  ⟩

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  ⟨
    assume h: (p ∧ q) ∧ r,
    show p ∧ (q ∧ r), from ⟨h.left.left, ⟨h.left.right, h.right⟩⟩,

    assume h: p ∧ (q ∧ r),
    show (p ∧ q) ∧ r, from ⟨⟨h.left, h.right.left⟩, h.right.right⟩,
  ⟩

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := ⟨
  let goal := p ∨ (q ∨ r) in
  assume h: (p ∨ q) ∨ r,
  show goal, from h.elim (
    assume hpq: p ∨ q, show goal, from hpq.elim
      (assume hp: p, show goal, from or.inl hp)
      (assume hq: q, show goal, from or.inr (or.inl hq))
  ) (
    assume hr: r, show goal, from or.inr (or.inr hr)
  ),

  let goal := (p ∨ q) ∨ r in
  assume h: p ∨ (q ∨ r),
  show goal, from h.elim (
    assume hp: p, show goal, from or.inl (or.inl hp)
  ) (
    assume hqr: q ∨ r, show goal, from hqr.elim
      (assume hq: q, show goal, from or.inl (or.inr hq))
      (assume hr: r, show goal, from or.inr hr)
  )
⟩

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := ⟨
  assume h: p ∧ (q ∨ r),
  show (p ∧ q) ∨ (p ∧ r), from (
    have hp: p, from h.left,
    have hqr: q ∨ r, from h.right,
    or.elim hqr (
      assume hq: q, or.inl ⟨hp, hq⟩
    ) (
      assume hr: r, or.inr ⟨hp, hr⟩
    )
  ),

  assume h: (p ∧ q) ∨ (p ∧ r),
  show p ∧ (q ∨ r), from (
    or.elim h (
      assume hpq: p ∧ q,
      ⟨hpq.left, or.inl hpq.right⟩
    ) (
      assume hpr: p ∧ r,
      ⟨hpr.left, or.inr hpr.right⟩
    )
  ),
⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
let left := p ∨ (q ∧ r) in
let right := (p ∨ q) ∧ (p ∨ r) in ⟨
  assume h: left,
  show right, from or.elim h
    (λ hp: p, show right, from ⟨or.inl hp, or.inl hp⟩)
    (λ hqr: q ∧ r, show right, from ⟨or.inr hqr.left, or.inr hqr.right⟩),

  assume h: right,
  have hpq: p ∨ q, from h.left,
  show left, from or.elim hpq (
    λ hp: p, or.inl hp
  ) (
    λ hq: q,
      have hqr: p ∨ r, from h.right,
      show left, from or.elim hqr (
        λ hp: p, or.inl hp
      ) (
        λ hr: r, or.inr ⟨hq, hr⟩
      )
  )
⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
let left := p → (q → r) in
let right := (p ∧ q → r) in
⟨
  assume h: left,
  show right, from
    (λ hpq: p ∧ q, h hpq.left hpq.right),

  assume h: right,
  show left, from (λ (hp: p) (hq: q), h ⟨hp, hq⟩)
⟩

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
let left := (p ∨ q) → r, right := (p → r) ∧ (q → r) in
⟨
  assume h: left,
  show right, from ⟨λ hp: p, h $ or.inl hp,  λ hq: q, h $ or.inr hq⟩,

  assume h: right,
  show left, from λ hpq: p ∨ q, hpq.elim
    (λ hp: p, h.left hp)
    (λ hq: q, h.right hq)
⟩

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
let left := ¬(p ∨ q), right := ¬ p ∧ ¬ q in ⟨
  assume h: left, show right, from
  let hnp :=
    show ¬ p, from
    assume hp: p,
    have hpq: (p ∨ q), from or.inl hp,
    show false, from h hpq in
  let hnq :=
    show ¬ q, from
    assume hq: q,
    have hpq: (p ∨ q), from or.inr hq,
    show false, from h hpq in
  ⟨hnp, hnq⟩,

  assume h: right, show left, from
  let hnp := h.left, hnq := h.right in
  assume hpq: p ∨ q,
  show false, from hpq.elim (λ hp: p, hnp hp) (λ hq: q, hnq hq)
⟩

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
assume h: ¬ p ∨ ¬ q, assume hpq: p ∧ q, show false, from
  h.elim (λ hnp: ¬ p, hnp hpq.left) (λ hnq: ¬ q, hnq hpq.right)

example : ¬(p ∧ ¬p) :=
assume h: p ∧ ¬ p, show false, from h.right h.left

example : p ∧ ¬q → ¬(p → q) :=
assume h: p ∧ ¬q,
have hp: p, from h.left, have hnq: q -> false, from h.right,
assume hpq: p -> q, show false, from hnq $ hpq hp

example : ¬p → (p → q) :=
assume hnp: ¬ p, assume hp: p, show q, from absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
assume h: ¬ p ∨ q, h.elim
  (λ hnp: ¬ p, λ hp: p, absurd hp hnp)
  (λ hq: q, λ hp: p, hq)

example : p ∨ false ↔ p := ⟨
  assume h: p ∨ false,
  show p, from h.elim (λ x, x) false.elim,

  λ h: p, or.inl h
⟩

example : p ∧ false ↔ false := ⟨
  λ h: p ∧ false, h.right,
  λ h: false, ⟨h.elim, h⟩
⟩

example : ¬(p ↔ ¬p) :=
  assume h: (p ↔ ¬p),
  have hl: p -> p -> false, from h.mp,
  have hnp: p -> false, from λ hp, hl hp hp,
  have hr: (p -> false) -> p, from h.mpr,
  have hp: p, from hr hnp,
  absurd hp hnp

example : (p → q) → (¬q → ¬p) :=
assume (h: p -> q) (hnq: ¬ q),
show ¬ p, from
  assume hp: p,
  absurd (h hp) hnq


import tools.auto.finish
import _target.deps.mini_crush.src.mini_crush

namespace arith
-- *Artihmetic Expressions Over Natural Numbers
-- **Source Language

-- binary operation syntax
inductive binop : Type
| Plus
| Times

-- arithmetic expression syntax
inductive exp : Type
| Const : ℕ → exp
| Binop : binop → exp → exp → exp

-- binop denotational semantics
def binopDenote : binop → ℕ → ℕ → ℕ
| binop.Plus  := nat.add
| binop.Times := nat.mul

-- exp denotational semantics
def expDenote : exp → ℕ
| (exp.Const n)       := n
| (exp.Binop b e1 e2) := (binopDenote b) (expDenote e1) (expDenote e2)

-- tests using both #reduce and #eval
#reduce (decidable.to_bool(expDenote (exp.Const 42) = 42))
#eval   (decidable.to_bool(expDenote (exp.Const 42) = 42))

#reduce (decidable.to_bool(expDenote (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2)) = 4))
#eval   (decidable.to_bool(expDenote (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2)) = 4))

#reduce (decidable.to_bool(expDenote (exp.Binop binop.Times (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2)) (exp.Const 7)) = 28))
#eval   (decidable.to_bool(expDenote (exp.Binop binop.Times (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2)) (exp.Const 7)) = 28))

-- **Target Language

-- instruction syntax
inductive instr : Type
| iConst : ℕ → instr
| iBinop : binop → instr

-- program and stack syntax
-- mark as reducible so lean can unfold the definitions during typechecking
@[reducible] def prog : Type := list instr
@[reducible] def stack : Type := list ℕ

-- instr denotational semantics
def instrDenote (i : instr) (s : stack) : option stack :=
    match i with
    | (instr.iConst n) := some (n :: s)
    | (instr.iBinop b) :=
        match s with
        | arg1 :: arg2 :: s' := some ((binopDenote b) arg1 arg2 :: s')
        | _ := none
        end
    end

-- prog denotational semantics
def progDenote : prog → stack → option stack
| [] s := some s
| (i :: p') s :=
    match instrDenote i s with
    | none    := none
    | some s' := progDenote p' s'
    end

-- **Translation

def compile : exp → prog
| (exp.Const n)       := instr.iConst n :: []
| (exp.Binop b e1 e2) := compile e2 ++ compile e1 ++ instr.iBinop b :: []

-- compilation examples
#reduce compile (exp.Const 42)
#reduce compile (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2))
#reduce compile (exp.Binop binop.Times (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2))(exp.Const 7))

-- compilation-evaluation examples
#reduce progDenote (compile (exp.Const 42)) []
#reduce progDenote (compile (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2))) []
#reduce progDenote (compile (exp.Binop binop.Times (exp.Binop binop.Plus (exp.Const 2) (exp.Const 2))(exp.Const 7))) []

-- **Translation Correctness

lemma compile_correct' (e : exp) : ∀ p s, progDenote (compile e ++ p) s = progDenote p (expDenote e :: s) :=
begin
induction e; intros,
case exp.Const {
    unfold compile,
    unfold expDenote,
    simp,
    unfold progDenote,
    unfold instrDenote,
    simp,
    unfold instrDenote._match_1,
    unfold progDenote._match_1,
    refl
},
case exp.Binop {
    unfold compile,
    unfold expDenote,
    simp,    /- can replace these lines with simph -/
    rw ih_2, /- -/
    rw ih_1, /- -/
    unfold progDenote,
    unfold instrDenote,
    simp,
    unfold instrDenote._match_1,
    unfold instrDenote._match_2,
    unfold progDenote._match_1,
    refl
}
end

lemma compile_correct'_lean (e : exp) : ∀ p s, progDenote (compile e ++ p) s = progDenote p (expDenote e :: s) :=
begin
induction e; intros,
case exp.Const {refl},
case exp.Binop {
    unfold compile expDenote,
    simph,
    refl
}
end

@[simp] lemma compile_correct'_crush (e : exp) : ∀ p s, progDenote (compile e ++ p) s = progDenote p (expDenote e :: s) :=
by mini_crush

lemma app_nil_end {A : Type} (l : list A) : l = l ++ list.nil := by induction l; simph

theorem compile_correct (e : exp) : progDenote (compile e) [] = some (expDenote e :: []) :=
begin
rw app_nil_end (compile e),
rw compile_correct',
refl
end

-- TODO: excessive memory consumption
theorem compile_correct_crush (e : exp) : progDenote (compile e) [] = some (expDenote e :: []) :=
by mini_crush

end arith

namespace typed
-- *Typed Expressions
-- **Source Language

-- atomic types
inductive type : Type
| Nat
| Bool
open type

-- binop types
inductive tbinop : type → type → type → Type
| TPlus  : tbinop Nat Nat Nat
| TTimes : tbinop Nat Nat Nat
| TEq    : ∀ t, tbinop t t Bool
| TLt    : tbinop Nat Nat Bool
open tbinop

-- expression types
inductive texp : type → Type
| TNConst : ℕ → texp Nat
| TBConst : bool → texp Bool
| TBinop : ∀ {t1 t2 t}, tbinop t1 t2 t → texp t1 → texp t2 → texp t
open texp

-- type denotational semantics
def typeDenote : type → Type
| Nat := ℕ
| Bool := bool

-- tbinop denotational semantics
def tbinopDenote : ∀ {arg1 arg2 res} (b : tbinop arg1 arg2 res),
    typeDenote arg1 → typeDenote arg2 → typeDenote res
| ._ ._ ._ TPlus      := nat.add
| ._ ._ ._ TTimes     := nat.mul
| ._ ._ ._ (TEq Nat)  := (λ x y, decidable.to_bool $ x = y)
| ._ ._ ._ (TEq Bool) := (λ x y, decidable.to_bool $ x = y)
| ._ ._ ._ TLt        := (λ x y, decidable.to_bool $ nat.le x y)

-- texp denotational semantics
def texpDenote : ∀ {t}, texp t → typeDenote t
| ._ (TNConst n) := n
| ._ (TBConst b) := b
| ._ (@TBinop _ _ _ b e1 e2) := (tbinopDenote b) (texpDenote e1) (texpDenote e2)

#reduce texpDenote (TNConst 42)
#reduce texpDenote (TBConst true)
-- TODO: is there a way to remove need for _'s?
#reduce texpDenote (TBinop TTimes (TBinop TPlus (TNConst 2) (TNConst 2)) (TNConst 7))
#reduce texpDenote (TBinop (TEq Nat) (TBinop TPlus (TNConst 2) (TNConst 2)) (TNConst 7))
#reduce texpDenote (TBinop TLt (TBinop TPlus (TNConst 2) (TNConst 2)) (TNConst 7))

-- **Target Language

-- stack type to describe how expressions affect the stack
@[reducible] def tstack := list type

inductive tinstr : tstack → tstack → Type
| TiNConst : ∀ s, ℕ → tinstr s (Nat :: s)
| TiBConst : ∀ s, bool → tinstr s (Bool :: s)
| TiBinop  : ∀ arg1 arg2 res s,
    tbinop arg1 arg2 res
    → tinstr (arg1 :: arg2 :: s) (res :: s)
open tinstr

inductive tprog : tstack → tstack → Type
| TNil  : ∀ s, tprog s s
| TCons : ∀ s1 s2 s3,
    tinstr s1 s2
    → tprog s2 s3
    → tprog s1 s3
open tprog

def vstack : tstack → Type
| []      := unit
| (t :: ts) := typeDenote t × vstack ts

def tinstrDenote : ∀ {ts} {ts'}, tinstr ts ts' → vstack ts → vstack ts'
| ._ ._ (TiNConst _ n)      := (λ s, (n, s))
| ._ ._ (TiBConst _ b)      := (λ s, (b, s))
| ._ ._ (TiBinop _ _ _ _ b) := (λ s,
    let (arg1, (arg2, s')) := s in
        ((tbinopDenote b) arg1 arg2, s'))

def tprogDenote : ∀ {ts} {ts'}, tprog ts ts' → vstack ts → vstack ts'
| ._ ._ (TNil _) := (λ s, s)
| ._ ._ (TCons _ _ _ i p) := (λ s, tprogDenote p (tinstrDenote i s))

-- **Translation

def tconcat : ∀ {ts} {ts'} {ts''}, tprog ts ts' → tprog ts' ts'' → tprog ts ts''
| ._ ._ ts'' (TNil _) := (λ p, p)
| ._ ._ ts'' (TCons _ _ _ i p1) := (λ p, TCons _ _ _ i (tconcat p1 p))

def tcompile : ∀ {t} (e : texp t) (ts : tstack), tprog ts (t :: ts)
| ._ (TNConst n) _ := TCons _ _ _ (TiNConst _ n) (TNil _)
| ._ (TBConst b) _ := TCons _ _ _ (TiBConst _ b) (TNil _)
| ._ (@TBinop _ _ _ b e1 e2) _ := tconcat (tcompile e2 _)
    (tconcat (tcompile e1 _) (TCons _ _ _ (TiBinop _ _ _ _ b) (TNil _)))

#reduce tprogDenote (tcompile (TNConst 42) []) ()
#reduce tprogDenote (tcompile (TBConst true) []) ()
#reduce tprogDenote (tcompile (TBinop TTimes (TBinop TPlus (TNConst 2)
    (TNConst 2)) (TNConst 7)) []) ()
#reduce tprogDenote (tcompile (TBinop (TEq Nat) (TBinop TPlus (TNConst 2)
    (TNConst 2)) (TNConst 7)) []) ()
#reduce  tprogDenote (tcompile (TBinop TLt (TBinop TPlus (TNConst 2) (TNConst 2))
    (TNConst 7)) []) ()

-- **Translation Correctness

@[simp] lemma tconcat_correct : ∀ ts ts' ts'' (p : tprog ts ts') (p' : tprog ts' ts'') (s : vstack ts),
    tprogDenote (tconcat p p') s = tprogDenote p' (tprogDenote p s) :=
by mini_crush

@[simp] lemma tcompile_correct' : ∀ t (e : texp t) ts (s : vstack ts),
    tprogDenote (tcompile e ts) s = (texpDenote e, s) :=
by mini_crush

theorem tcompile_correct : ∀ t (e : texp t),
    tprogDenote (tcompile e []) () = (texpDenote e, ()) := by mini_crush

end typed