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

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

## Definition

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

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

noncomputable theory
open_locale classical polynomial

open polynomial finset

namespace polynomial

variables {R : Type*} [semiring R] {f : R[X]}

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

section erase_lead

lemma erase_lead_support (f : R[X]) :
  f.erase_lead.support = f.support.erase f.nat_degree :=
by simp only [erase_lead, support_erase]

lemma erase_lead_coeff (i : ℕ) :
  f.erase_lead.coeff i = if i = f.nat_degree then 0 else f.coeff i :=
by simp only [erase_lead, coeff_erase]

@[simp] lemma erase_lead_coeff_nat_degree : f.erase_lead.coeff f.nat_degree = 0 :=
by simp [erase_lead_coeff]

lemma erase_lead_coeff_of_ne (i : ℕ) (hi : i ≠ f.nat_degree) :
  f.erase_lead.coeff i = f.coeff i :=
by simp [erase_lead_coeff, hi]

@[simp] lemma erase_lead_zero : erase_lead (0 : R[X]) = 0 :=
by simp only [erase_lead, erase_zero]

@[simp] lemma erase_lead_add_monomial_nat_degree_leading_coeff (f : R[X]) :
  f.erase_lead + monomial f.nat_degree f.leading_coeff = f :=
begin
  ext i,
  simp only [erase_lead_coeff, coeff_monomial, coeff_add, @eq_comm _ _ i],
  split_ifs with h,
  { subst i, simp only [leading_coeff, zero_add] },
  { exact add_zero _ }
end

@[simp] lemma erase_lead_add_C_mul_X_pow (f : R[X]) :
  f.erase_lead + (C f.leading_coeff) * X ^ f.nat_degree = f :=
by rw [C_mul_X_pow_eq_monomial, erase_lead_add_monomial_nat_degree_leading_coeff]

@[simp] lemma self_sub_monomial_nat_degree_leading_coeff {R : Type*} [ring R] (f : R[X]) :
  f - monomial f.nat_degree f.leading_coeff = f.erase_lead :=
(eq_sub_iff_add_eq.mpr (erase_lead_add_monomial_nat_degree_leading_coeff f)).symm

@[simp] lemma self_sub_C_mul_X_pow {R : Type*} [ring R] (f : R[X]) :
  f - (C f.leading_coeff) * X ^ f.nat_degree = f.erase_lead :=
by rw [C_mul_X_pow_eq_monomial, self_sub_monomial_nat_degree_leading_coeff]

lemma erase_lead_ne_zero (f0 : 2 ≤ f.support.card) : erase_lead f ≠ 0 :=
begin
  rw [ne.def, ← card_support_eq_zero, erase_lead_support],
  exact (zero_lt_one.trans_le $ (tsub_le_tsub_right f0 1).trans
    finset.pred_card_le_card_erase).ne.symm
end

@[simp] lemma nat_degree_not_mem_erase_lead_support : f.nat_degree ∉ (erase_lead f).support :=
by simp [not_mem_support_iff]

lemma ne_nat_degree_of_mem_erase_lead_support {a : ℕ} (h : a ∈ (erase_lead f).support) :
  a ≠ f.nat_degree :=
by { rintro rfl, exact nat_degree_not_mem_erase_lead_support h }

lemma erase_lead_support_card_lt (h : f ≠ 0) : (erase_lead f).support.card < f.support.card :=
begin
  rw erase_lead_support,
  exact card_lt_card (erase_ssubset $ nat_degree_mem_support_of_nonzero h)
end

lemma erase_lead_card_support' {c : ℕ} (fc : f.support.card = c + 1) :
  f.erase_lead.support.card = c :=
erase_lead_card_support fc

@[simp] lemma erase_lead_monomial (i : ℕ) (r : R) :
  erase_lead (monomial i r) = 0 :=
begin
  by_cases hr : r = 0,
  { subst r, simp only [monomial_zero_right, erase_lead_zero] },
  { rw [erase_lead, nat_degree_monomial, if_neg hr, erase_monomial] }
end

@[simp] lemma erase_lead_C (r : R) : erase_lead (C r) = 0 :=
erase_lead_monomial _ _

@[simp] lemma erase_lead_X : erase_lead (X : R[X]) = 0 :=
erase_lead_monomial _ _

@[simp] lemma erase_lead_X_pow (n : ℕ) : erase_lead (X ^ n : R[X]) = 0 :=
by rw [X_pow_eq_monomial, erase_lead_monomial]

@[simp] lemma erase_lead_C_mul_X_pow (r : R) (n : ℕ) : erase_lead (C r * X ^ n) = 0 :=
by rw [C_mul_X_pow_eq_monomial, erase_lead_monomial]

lemma erase_lead_add_of_nat_degree_lt_left {p q : R[X]} (pq : q.nat_degree < p.nat_degree) :
  (p + q).erase_lead = p.erase_lead + q :=
begin
  ext n,
  by_cases nd : n = p.nat_degree,
  { rw [nd, erase_lead_coeff, if_pos (nat_degree_add_eq_left_of_nat_degree_lt pq).symm],
    simpa using (coeff_eq_zero_of_nat_degree_lt pq).symm },
  { rw [erase_lead_coeff, coeff_add, coeff_add, erase_lead_coeff, if_neg, if_neg nd],
    rintro rfl,
    exact nd (nat_degree_add_eq_left_of_nat_degree_lt pq) }
end

lemma erase_lead_add_of_nat_degree_lt_right {p q : R[X]} (pq : p.nat_degree < q.nat_degree) :
  (p + q).erase_lead = p + q.erase_lead :=
begin
  ext n,
  by_cases nd : n = q.nat_degree,
  { rw [nd, erase_lead_coeff, if_pos (nat_degree_add_eq_right_of_nat_degree_lt pq).symm],
    simpa using (coeff_eq_zero_of_nat_degree_lt pq).symm },
  { rw [erase_lead_coeff, coeff_add, coeff_add, erase_lead_coeff, if_neg, if_neg nd],
    rintro rfl,
    exact nd (nat_degree_add_eq_right_of_nat_degree_lt pq) }
end

lemma erase_lead_degree_le : (erase_lead f).degree ≤ f.degree :=
begin
  rw degree_le_iff_coeff_zero,
  intros i hi,
  rw erase_lead_coeff,
  split_ifs with h, { refl },
  apply coeff_eq_zero_of_degree_lt hi
end

lemma erase_lead_nat_degree_le_aux : (erase_lead f).nat_degree ≤ f.nat_degree :=
nat_degree_le_nat_degree erase_lead_degree_le

lemma erase_lead_nat_degree_lt (f0 : 2 ≤ f.support.card) :
  (erase_lead f).nat_degree < f.nat_degree :=
lt_of_le_of_ne erase_lead_nat_degree_le_aux $ ne_nat_degree_of_mem_erase_lead_support $
  nat_degree_mem_support_of_nonzero $ erase_lead_ne_zero f0

lemma erase_lead_nat_degree_lt_or_erase_lead_eq_zero (f : R[X]) :
  (erase_lead f).nat_degree < f.nat_degree ∨ f.erase_lead = 0 :=
begin
  by_cases h : f.support.card ≤ 1,
  { right,
    rw ← C_mul_X_pow_eq_self h,
    simp },
  { left,
    apply erase_lead_nat_degree_lt (lt_of_not_ge h) }
end

lemma erase_lead_nat_degree_le (f : R[X]) : (erase_lead f).nat_degree ≤ f.nat_degree - 1 :=
begin
  rcases f.erase_lead_nat_degree_lt_or_erase_lead_eq_zero with h | h,
  { exact nat.le_pred_of_lt h },
  { simp only [h, nat_degree_zero, zero_le] }
end

end erase_lead

/-- An induction lemma for polynomials. It takes a natural number `N` as a parameter, that is
required to be at least as big as the `nat_degree` of the polynomial.  This is useful to prove
results where you want to change each term in a polynomial to something else depending on the
`nat_degree` of the polynomial itself and not on the specific `nat_degree` of each term. -/
lemma induction_with_nat_degree_le (P : R[X] → Prop) (N : ℕ)
  (P_0 : P 0)
  (P_C_mul_pow : ∀ n : ℕ, ∀ r : R, r ≠ 0 → n ≤ N → P (C r * X ^ n))
  (P_C_add : ∀ f g : R[X], f.nat_degree < g.nat_degree →
    g.nat_degree ≤ N → P f → P g → P (f + g)) :
  ∀ f : R[X], f.nat_degree ≤ N → P f :=
begin
  intros f df,
  generalize' hd : card f.support = c,
  revert f,
  induction c with c hc,
  { assume f df f0,
    convert P_0,
    simpa only [support_eq_empty, card_eq_zero] using f0 },
  { intros f df f0,
    rw [← erase_lead_add_C_mul_X_pow f],
    cases c,
    { convert P_C_mul_pow f.nat_degree f.leading_coeff _ df,
      { convert zero_add _,
        rw [← card_support_eq_zero, erase_lead_card_support f0] },
      { rw [leading_coeff_ne_zero, ne.def, ← card_support_eq_zero, f0],
        exact zero_ne_one.symm } },
    refine P_C_add f.erase_lead _ _ _ _ _,
    { refine (erase_lead_nat_degree_lt _).trans_le (le_of_eq _),
      { exact (nat.succ_le_succ (nat.succ_le_succ (nat.zero_le _))).trans f0.ge },
      { rw [nat_degree_C_mul_X_pow _ _ (leading_coeff_ne_zero.mpr _)],
        rintro rfl,
        simpa using f0 } },
    { exact (nat_degree_C_mul_X_pow_le f.leading_coeff f.nat_degree).trans df },
    { exact hc _ (erase_lead_nat_degree_le_aux.trans df) (erase_lead_card_support f0) },
    { refine P_C_mul_pow _ _ _ df,
      rw [ne.def, leading_coeff_eq_zero, ← card_support_eq_zero, f0],
      exact nat.succ_ne_zero _ } }
end

/-- Let `φ : R[x] → S[x]` be an additive map, `k : ℕ` a bound, and `fu : ℕ → ℕ` a
"sufficiently monotone" map.  Assume also that
* `φ` maps to `0` all monomials of degree less than `k`,
* `φ` maps each monomial `m` in `R[x]` to a polynomial `φ m` of degree `fu (deg m)`.
Then, `φ` maps each polynomial `p` in `R[x]` to a polynomial of degree `fu (deg p)`. -/
lemma mono_map_nat_degree_eq {S F : Type*} [semiring S]
  [add_monoid_hom_class F R[X] S[X]] {φ : F}
  {p : R[X]} (k : ℕ)
  (fu : ℕ → ℕ) (fu0 : ∀ {n}, n ≤ k → fu n = 0) (fc : ∀ {n m}, k ≤ n → n < m → fu n < fu m)
  (φ_k : ∀ {f : R[X]}, f.nat_degree < k → φ f = 0)
  (φ_mon_nat : ∀ n c, c ≠ 0 → (φ (monomial n c)).nat_degree = fu n) :
  (φ p).nat_degree = fu p.nat_degree :=
begin
  refine induction_with_nat_degree_le (λ p, _ = fu _) p.nat_degree (by simp [fu0]) _ _ _ rfl.le,
  { intros n r r0 np,
    rw [nat_degree_C_mul_X_pow _ _ r0, ← monomial_eq_C_mul_X, φ_mon_nat _ _ r0] },
  { intros f g fg gp fk gk,
    rw [nat_degree_add_eq_right_of_nat_degree_lt fg, _root_.map_add],
    by_cases FG : k ≤ f.nat_degree,
    { rw [nat_degree_add_eq_right_of_nat_degree_lt, gk],
      rw [fk, gk],
      exact fc FG fg },
    { cases k,
      { exact (FG (nat.zero_le _)).elim },
      { rwa [φ_k (not_le.mp FG), zero_add] } } }
end

lemma map_nat_degree_eq_sub {S F : Type*} [semiring S]
  [add_monoid_hom_class F R[X] S[X]] {φ : F}
  {p : R[X]} {k : ℕ}
  (φ_k : ∀ f : R[X], f.nat_degree < k → φ f = 0)
  (φ_mon : ∀ n c, c ≠ 0 → (φ (monomial n c)).nat_degree = n - k) :
  (φ p).nat_degree = p.nat_degree - k :=
mono_map_nat_degree_eq k (λ j, j - k) (by simp) (λ m n h, (tsub_lt_tsub_iff_right h).mpr) φ_k φ_mon

lemma map_nat_degree_eq_nat_degree {S F : Type*} [semiring S]
  [add_monoid_hom_class F R[X] S[X]] {φ : F} (p)
  (φ_mon_nat : ∀ n c, c ≠ 0 → (φ (monomial n c)).nat_degree = n) :
  (φ p).nat_degree = p.nat_degree :=
(map_nat_degree_eq_sub (λ f h, (nat.not_lt_zero _ h).elim) (by simpa)).trans p.nat_degree.sub_zero

end polynomial


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro p,
  intro f,
  exact f(p),
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro h,
  by_cases p : P,
  exact p,
  have h1 : false := h p,
  exfalso,
  exact h1,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  intro h,
  by_cases p : P,
  exact p,
  have h1 : false := h p,
  exfalso,
  exact h1,

  intro p,
  intro f,
  exact f(p),
end

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

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro hpq,
  cases hpq with hp hq,
  right,
  exact hp,
  left,
  exact hq,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro hpq,
  cases hpq with hp hq,
  split,
  exact hq,
  exact hp,
end

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

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  cases h with hp hq,
  intro p,
  exfalso,
  apply hp,
  exact p,
  intro p,
  exact hq,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro h,
  intro p,
  cases h with hp hq,
  exfalso,
  apply p,
  exact hp,
  exact hq,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro hpq,
  intro q,
  intro p,
  have hq : Q := hpq p,
  apply q,
  exact hq,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros hqp p,
  by_cases hq : Q,
  exact hq,
  exfalso,
  have hboom := hqp hq,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intros hpq q,
  intro p,
  have hq : Q := hpq p,
  contradiction,

  intros hqp p,
  by_cases hq : Q,
  exact hq,
  have hboom := hqp hq,
  exfalso,
  contradiction,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro hp,
  apply hp,
  right,
  intro p,

  have hpp : P ∨ ¬P,
  left,
  exact p,
  contradiction,
end

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

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intros hp p,
  have p : P,
  apply hp,
  intro p,
  contradiction,
  contradiction,
end

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intros p q,
  cases p with hp hq,
  cases q with nhp nhq,
  apply nhq,
  contradiction,
  cases q with nhp nhq,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intros p q,
  cases p with hp hq,
  cases q with nhp nhq,
  contradiction,
  contradiction,
end

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

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro npq,
  split,
  intro p,
  have hpq : P ∨ Q,
  left,
  exact p,
  apply npq,
  exact hpq,

  intro q,
  have hpq : P ∨ Q,
  right,
  exact q,
  contradiction,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intros npq p,
  cases npq with np nq,
  cases p with hp hq,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro hpq,
  by_contra nqp,
  apply hpq,
  split,
  by_contra np,
  apply nqp,
  right,
  exact np,
  by_contra nq,
  apply nqp,
  left,
  exact nq,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intros nqp,
  intro hpq,
  cases nqp with nq np,
  cases hpq with hp hq,
  contradiction,
  cases hpq with hp hq,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  exact demorgan_conj P Q,
  exact demorgan_conj_converse P Q,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  exact demorgan_disj P Q,
  exact demorgan_disj_converse P Q,
end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro hpqr,
  cases hpqr with hp hqr,
  cases hqr with hq hr,
  left,
  split,
  exact hp,
  exact hq,
  right,
  split,
  exact hp,
  exact hr,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro hpqr,
  cases hpqr with hpq hpr,
  cases hpq with hp hq,
  split,
  exact hp,
  left,
  exact hq,
  split,
  cases hpr with hp hr,
  exact hp,
  cases hpr with hp hr,
  right,
  exact hr,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro hpqr,
  cases hpqr with hp hqr,
  split,
  left,
  exact hp,
  left,
  exact hp,
  cases hqr with hq hr,
  split,
  right,
  exact hq,
  right,
  exact hr,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro hpqr,
  cases hpqr with hpq hpr,
  cases hpr with hp hr,
  left,
  exact hp,
  cases hpq with hp hq,
  left,
  exact hp,
  right,
  split,
  exact hq,
  exact hr,
end

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intros hpqr hp hq,
  apply hpqr,
  split,
  exact hp,
  exact hq,
end

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

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

theorem impl_refl :
  P → P  :=
begin
  intro hp,
  exact hp,
end

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

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro hp,
  left,
  exact hp,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro hq,
  right,
  exact hq,
end

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

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

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro hp,
  cases hp with p,
  exact p,
  intro p,
  split,
  exact p,
  exact p,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro hpp,
  cases hpp with p hp,
  exact p,
  exact hp,
  intro p,
  left,
  exact p,
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 hpx u pu,
  apply hpx,
  existsi u,
  exact pu,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intros npx hpx,
  cases hpx with u pu,
  apply npx,
  exact pu,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro hpx,
  by_contra npx,
  apply hpx,
  intro u,
  by_contra npu,
  apply npx,
  existsi u,
  exact npu,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intros hpx px,
  cases hpx with u pu,
  have hx := px u,
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  exact demorgan_forall U P,
  exact demorgan_forall_converse U P,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  exact demorgan_exists U P,
  exact demorgan_exists_converse U P,
end

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intros hpx px,
  cases hpx with u hpu,
  have hx := px u,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intros px hpx,
  cases hpx with u hpu,
  have hx := px u,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intros hpx u,
  by_contra npu,
  apply hpx,
  existsi u,
  exact npu,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro hpx,
  by_contra npu,
  apply hpx,
  intro u,
  intro pu,
  apply npu,
  existsi u,
  exact pu,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  exact forall_as_neg_exists U P,
  exact forall_as_neg_exists_converse U P,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  exact exists_as_neg_forall U P,
  exact exists_as_neg_forall_converse U P,
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 h,
  cases h with u hpq,
  cases hpq with p q,
  split,
  existsi u,
  exact p,
  existsi u,
  exact q,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro h,
  cases h with u hpq,
  cases hpq with p q,
  left,
  existsi u,
  exact p,
  right,
  existsi u,
  exact q,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro h,
  cases h with hpx hqx,
  cases hpx with u hpu,
  split,
  left,
  exact hpu,
  cases hqx with u hqu,
  split,
  right,
  exact hqu,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro h,
  split,
  intro u,
  have hu := h u,
  cases hu with p q,
  exact p,
  intro u,
  have hu := h u,
  cases hu with p q,
  exact q,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro h,
  intro u,
  split,
  cases h with px qx,
  have pu := px u,
  exact pu,
  cases h with px qx,
  have hu := qx u,
  exact hu,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro h,
  intro u,
  cases h with px qx,
  have pu := px u,
  left,
  exact pu,
  have hu := qx u,
  right,
  exact hu,
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


/- Homework 2 -/

/- Part I: tactic proofs -/

/- Do five propositional logic proofs and three quantifier proofs, following the
   same constraints as on the last assignment, but this time using tactics.
   (You can prove the same theorems as on the last assignment!)
-/

section
  open classical

  variables p q r s : Prop

  -- commutativity of ∧ and ∨
  example : p ∧ q ↔ q ∧ p :=
  begin
    apply iff.intro,
    intro h,
      apply and.intro,
        exact (and.elim_right h),
        exact (and.elim_left h),
    intro h,
      apply and.intro,
        exact (and.elim_right h),
        exact (and.elim_left h),
  end

  example : p ∨ q ↔ q ∨ p :=
  begin
    apply iff.intro,
    intro h,
      apply or.elim h,
        intro hp,
        exact or.inr hp,
        intro hq,
        exact or.inl hq,
    intro h,
      apply or.elim h,
        intro hp,
        exact or.inr hp,
        intro hq,
        exact or.inl hq,
  end

  -- associativity of ∧ and ∨
  example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
   begin
    apply iff.intro,
    intro h,
      apply and.intro,
        exact (and.elim_left (and.elim_left h)),
        apply and.intro,
          exact (and.elim_right (and.elim_left h)),
          exact (and.elim_right h),
    intro h,
      apply and.intro,
        apply and.intro,
          exact and.elim_left h,
          exact and.elim_left (and.elim_right h),
        exact and.elim_right (and.elim_right h)
  end

  example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  begin
    apply iff.intro,
    intro h,
      apply or.elim h,
        intro hpq,
        apply or.elim hpq,
          intro hp,
            exact or.inl hp,
          intro hq,
            exact or.inr (or.inl hq),
        intro hr,
          exact or.inr (or.inr hr),
    intro h,
      apply or.elim h,
        intro hp,
          exact or.inl (or.inl hp),
        intro hqr,
        apply or.elim hqr,
          intro hq,
            exact or.inl (or.inr hq),
          intro hr,
            exact or.inr hr
  end

  -- distributivity
  -- this next one is in *Theorem Proving in Lean*
  -- example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := sorry
  example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  begin
    apply iff.intro,
      intro h,
        apply or.elim h,
        intro hp,
          exact and.intro (or.inl hp) (or.inl hp),
        intro hqr,
          exact and.intro (or.inr (and.elim_left hqr))
                          (or.inr (and.elim_right hqr)),
      intro h,
        apply or.elim (and.elim_left h),
        intro hp,
          exact or.inl hp,
        intro hq,
          apply or.elim (and.elim_right h),
          intro hp,
            exact or.inl hp,
          intro hr,
            exact or.inr (and.intro hq hr)
  end

  example : (p → q) → (¬p ∨ q) :=
  begin
    intro h,
    apply or.elim (em p),
    intro hp,
      apply or.inr,
      exact h hp,
    intro hnp,
      apply or.inl,
      exact hnp
  end

  example : ¬(p ↔ ¬p) :=
  begin
    intro h,
    apply false.elim,
      apply iff.elim_left,
        apply iff_false_intro,
        exact (assume K: p, have K1: ¬p, from (iff.elim_left h) K, show false, from K1 K),
      exact (iff.elim_right h) (assume K: p, have K1: ¬p, from (iff.elim_left h) K, show false, from K1 K)
  end

end

section

  open classical

  variable  α : Type
  variables (p q : α → Prop) (r : Prop)
  variable  a : α

  example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  begin
    apply iff.intro,
    intro h,
      apply and.intro,
      intro x,
        exact (and.elim_left (h x)),
      intro x,
        exact (and.elim_right (h x)),
    intro h,
      intro x,
      apply and.intro,
      exact ((and.elim_left h) x),
      exact ((and.elim_right h) x)
  end

  example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  begin
    intro h,
    intro h2,
    intro x,
    exact ((h x) (h2 x))
  end

  example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  begin
    intro h,
    intro x,
      apply or.elim h,
      intro hp,
        exact or.inl (hp x),
      intro hq,
        exact or.inr (hq x),
  end

  example : (∃ x : α, r) → r :=
  begin
    intro h,
    cases h with x r,
    exact r
  end

  example (c : α) : r → (∃ {x : α}, r) :=
  begin
    intro h,
    apply exists.intro,
      exact c,    -- I don't understand why a wouldn't work here
      exact h
  end

  example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  begin
    apply iff.intro,
    intro h,
      cases h with x px,
      apply and.intro,
        constructor, exact (and.elim_left px),
        exact (and.elim_right px),
    intro h,
      cases h with px r,
        cases px with x p_x,
        constructor, exact (and.intro p_x r)
  end

  example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  begin
    apply iff.intro,
    intro h,
      apply by_contradiction,
      intro hnp,
      exact (h (take z,
                  show p z, from
                  by_contradiction
                  (assume H₂: ¬ p z,
                  have H₃: ∃ x, ¬ p x, from exists.intro z H₂,
                  show false, from hnp H₃))),
    intro h,
    cases h with x npx,
      intro h_to_contradict,
      exact npx (h_to_contradict x)
  end

  end

/- Part II: calculations -/

/- The Lean 3 library does not yet have the real numbers. We can fake it with the declarations
   below. -/
section
  variables (real : Type) [ordered_ring real]
  variables (log exp : real → real)
  premise   log_exp_eq : ∀ x, log (exp x) = x
  premise   exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
  premise   exp_pos    : ∀ x, exp x > 0
  premise   exp_add    : ∀ x y, exp (x + y) = exp x * exp y

  -- this ensures the assumptions are available in tactic proofs
  include log_exp_eq exp_log_eq exp_pos exp_add

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

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

  /- Prove the folowing theorem, using the facts above. -/
  --theorem
  theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) : log (x * y) = log x + log y :=
  have H1: exp (log (x * y)) = exp (log x + log y), from
  (calc
      exp (log (x * y)) = x * y                      : by rw exp_log_eq (mul_pos hx hy)
      ...               = exp (log x) * y            : by rw exp_log_eq (hx)
      ...               = exp (log x) * exp (log y)  : by rw exp_log_eq hy
      ...               = exp (log x + log y)        : by rw exp_add),
  show log (x * y) = log x + log y, from
  (calc
      log (x * y) = log (exp (log(x * y)))           : by rw log_exp_eq
      ...         = log (exp (log x + log y))        : by rw H1
      ...         = log x + log y                    : by rw log_exp_eq
  )
end

/- The following command lets you see the ring axioms in Lean. (We will discuss this when
   we talk about structures.) -/

print fields ring

/- Note that the properties left_distrib and right_distrib are also called mul_add and add_mul,
   respectively. Since x - y is defined to be x + -y, the library proves "sub_self" as follows.
-/

namespace hide

theorem sub_self {α : Type} [ring α] (x : α) : x - x = 0 := add_right_neg x

end hide

/- Similarly, we have mul_sub and sub_mul. The following is a consequence of the ring axioms,
   and can be proved using only a short calculation, using sub_self and mul_sub. Do it!
   Hint: consider x * (1 - 1). -/

example {α : Type} [ring α] (x : α) (h1: 0 = 1 - 1) : x * 0 = 0 :=
calc
  x * 0 = x * (1 - 1)       : by rw [sub_self]
  ...   = (x * 1) - (x * 1) : by rw mul_sub
  ...   = x - x             : by rw mul_one
  ...   = 0                 : by rw (sub_self x)

/- Part III: inductive definitions -/

open list
variable {α : Type}

/- In the Lean 3 library, the function "concat", which appends an element to the end of a list,
   is defined as follows. -/

namespace hide

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

end hide

/- For the next exercise, we will use the following "home-grown" version. Make sure you
   understand how it works. -/

def conc (l : list α) (a : α) : list α :=
list.rec_on l
  [a]
  (λ b l recval, b :: recval)

theorem conc_nil  (a : α) : conc nil a = [a] := rfl
theorem conc_cons (b : α) (l : list α) (a : α) : conc (b :: l) a = b :: conc l a := rfl

vm_eval conc [1, 2, 3] 4

/- We will also use the length function. -/

check conc_cons

check length_nil
check length_cons

example : length [1, 2, 3] = 3 := by refl
example (a : α) (l : list α) : length (a :: l) = length l + 1 := rfl

vm_eval length [1, 2, 3, 4, 5]

/- The following is an example of a proof by induction using these two notions. -/

theorem length_conc (a : α) (l : list α) : length (conc l a) = length l + 1 :=
list.induction_on l
  rfl
  (take b l',
    assume ih : length (conc l' a) = length l' + 1,
    show length (conc (b::l') a) = length (b::l') + 1, from
      calc
        length (conc (b::l') a) = length (b :: (conc l' a)) : rfl
                            ... = length (conc l' a) + 1     : rfl
                            ... = length l' + 1 + 1          : by rw ih
                            ... = length (b::l') + 1         : rfl)

/- Here is a shorter proof. -/

theorem length_conc' (a : α) (l : list α) : length (conc l a) = length l + 1 :=
list.induction_on l rfl (λ b l' ih, by simp [length, conc_cons, ih])

/- Let us define a "list reverse" function and check that it works. -/

def rev (l : list α) : list α :=
list.rec_on l
  []
  (λ b l recval, conc recval b)

theorem rev_nil : rev ([] : list α) = [] := rfl
theorem rev_cons (a : α) (l : list α) : rev (a :: l) = conc (rev l) a := rfl

vm_eval rev [1, 2, 3, 4, 5]

/- Prove the following. -/

theorem length_rev (l : list α) : length (rev l) = length l :=
list.induction_on l
  rfl
  (take b l',
   assume ih: length (rev l') = length l',
   show length (rev (b::l')) = length (b::l'), from
    calc
      length (rev (b::l')) = length (conc (rev (l')) b) : rfl
      ...                  = length (rev l') + 1    : by rw length_conc
      ...                  = length l' + 1          : by rw ih
      ...                  = length (b::l')         : rfl
  )


import topology.basic data.set.intervals analysis.exponential
open real set

-- * Objective 1: prove that 1/x is continuous on R∗ (defined using sets)

-- It's easy to define the underlying set, and a restricted version of the function
def punctured_line := (Iio (0:ℝ)) ∪ (Ioi (0:ℝ))
noncomputable def punctured_inv := function.restrict (λ (x:ℝ), 1/x) punctured_line

lemma punctured_reals_are_nonzero : ∀ (a : subtype punctured_line), a.val ≠ 0 :=
begin
intro,
-- we can decompose the property using cases
cases a.2 with l r,
have h : a.val < 0, from mem_Iio.mp l,
have h1 : a.val ≠ 0, from ne_of_lt h,
exact  h1,
have k : a.val > 0, from mem_Ioi.mp r,
have k1 : a.val ≠ 0, from (ne_of_lt k).symm,
exact  k1,
end

-- ... we mainly need to know that all of the possible arguments are nonzero
lemma cont_punctured_inv : continuous punctured_inv :=
begin
  unfold punctured_inv function.restrict,
  simp only [one_div_eq_inv],
  exact continuous_inv punctured_reals_are_nonzero continuous_subtype_val,
end

-- Here is a similar result that is closer to the mathlib proof
theorem continuous_1_over_x'' : continuous (λ (x : {r : ℝ | r ≠ 0} ), 1/(x:ℝ)) :=
begin
simp only [one_div_eq_inv],
refine real.continuous_inv _ _,
exact subtype.property,
apply continuous_subtype_val,
end

-- * Objective 2:  prove that tan(x) is continuous where cos(x) is nonzero

def cos_nonzero_set := {x : ℝ | cos x ≠ 0}

-- minor change from the mathlib version
lemma continuous_tan' : continuous (λ x : cos_nonzero_set, tan x) :=
by simp only [tan_eq_sin_div_cos]; exact
continuous_mul
  (continuous_subtype_val.comp continuous_sin)
  (continuous_inv subtype.property
    (continuous_subtype_val.comp continuous_cos))

-- * Objective 3: Instantiate [0,2] as a subtype and prove that x is continuous on this interval

def two_interval_set := (Icc (0:ℝ) 2)

theorem continuous_id_on_tworeal' : continuous (λ (x : ↥two_interval_set), x) :=
begin
exact continuous_id,
end


import .love03_forward_proofs_demo

/-! # LoVe Exercise 4: Functional Programming -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Reverse of a List

We define a new accumulator-based version of `reverse`. The first argument,
`as`, serves as the accumulator. This definition is __tail-recursive__, meaning
that compilers and interpreters can easily optimize the recursion away,
resulting in more efficient code. -/

def accurev {α : Type} : list α → list α → list α
| as []        := as
| as (x :: xs) := accurev (x :: as) xs

/-! 1.1. Our intention is that `accurev [] xs` should be equal to `reverse xs`.
But if we start an induction, we quickly see that the induction hypothesis is
not strong enough. Start by proving the following generalization (using the
`induction` tactic or pattern matching): -/

lemma accurev_eq_reverse_append {α : Type} :
  ∀ xs as : list α, accurev as xs = reverse xs ++ as :=
begin
  intros,
  induction xs generalizing as,
  simp [accurev,reverse],
  simp [accurev,reverse, xs_ih],
end

/-! 1.2. Derive the desired equation. -/

#check accurev_eq_reverse_append

lemma append_nil {α : Type} (xs : list α) :
  reverse xs = reverse xs ++ [] :=
begin
  simp [refl]
end

lemma accurev_eq_reverse {α : Type} (xs : list α) :
  accurev [] xs = reverse xs :=
begin
  rw append_nil xs,
  apply accurev_eq_reverse_append xs [],
end

/-! 1.3. Prove the following property.

Hint: A one-line inductionless proof is possible. -/

lemma accurev_accurev {α : Type} (xs : list α) :
  accurev [] (accurev [] xs) = xs :=
begin
  simp [accurev_eq_reverse, reverse_reverse],
end

/-! 1.4. Prove the following lemma by structural induction, as a "paper" proof.
This is a good exercise to develop a deeper understanding of how structural
induction works (and is good practice for the final exam).

    lemma accurev_eq_reverse_append {α : Type} :
      ∀as xs : list α, accurev as xs = reverse xs ++ as

Guidelines for paper proofs:

We expect detailed, rigorous, mathematical proofs. You are welcome to use
standard mathematical notation or Lean structured commands (e.g., `assume`,
`have`, `show`, `calc`). You can also use tactical proofs (e.g., `intro`,
`apply`), but then please indicate some of the intermediate goals, so that we
can follow the chain of reasoning.

Major proof steps, including applications of induction and invocation of the
induction hypothesis, must be stated explicitly. For each case of a proof by
induction, you must list the inductive hypotheses assumed (if any) and the goal
to be proved. Minor proof steps corresponding to `refl`, `simp`, or `cc` need
not be justified if you think they are obvious (to humans), but you should say
which key lemmas they depend on. You should be explicit whenever you use a
function definition or an introduction rule for an inductive predicate. -/

-- enter your paper proof here

/-! ## Question 2: Drop and Take

The `drop` function removes the first `n` elements from the front of a list. -/

def drop {α : Type} : ℕ → list α → list α
| 0       xs        := xs
| (_ + 1) []        := []
| (m + 1) (x :: xs) := drop m xs

/-! Its relative `take` returns a list consisting of the the first `n` elements
at the front of a list.

2.1. Define `take`.

To avoid unpleasant surprises in the proofs, we recommend that you follow the
same recursion pattern as for `drop` above. -/

def take {α : Type} : ℕ → list α → list α
| 0       xs        := []
| (_ + 1) []        := []
| (m + 1) (x :: xs) := x :: take m xs

#eval take 0 [3, 7, 11]   -- expected: []
#eval take 1 [3, 7, 11]   -- expected: [3]
#eval take 2 [3, 7, 11]   -- expected: [3, 7]
#eval take 3 [3, 7, 11]   -- expected: [3, 7, 11]
#eval take 4 [3, 7, 11]   -- expected: [3, 7, 11]

#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/-! 2.2. Prove the following lemmas, using `induction` or pattern matching.
Notice that they are registered as simplification rules thanks to the `@[simp]`
attribute. -/

@[simp] lemma drop_nil {α : Type} :
  ∀n : ℕ, drop n ([] : list α) = [] :=
begin
  intros n,
  induction n,
  {
    simp [drop],
  },
  {
    simp [drop],
  }
end

@[simp] lemma take_nil {α : Type} :
  ∀n : ℕ, take n ([] : list α) = [] :=
begin
  intros n,
  induction n,
  {
    simp [take],
  },
  {
    simp [take],
  }
end

/-! 2.3. Follow the recursion pattern of `drop` and `take` to prove the
following lemmas. In other words, for each lemma, there should be three cases,
and the third case will need to invoke the induction hypothesis.

The first case is shown for `drop_drop`. Beware of the fact that there are three
variables in the `drop_drop` lemma (but only two arguments to `drop`).

Hint: The `refl` tactic might be useful in the third case of `drop_drop`. -/

lemma drop_drop {α : Type} :
  ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0         n xs        := by refl
| m         0 xs        := by simp [drop]
| (m+1)     n xs        := by
begin
    cases xs,
    {
      simp [drop],
    },
    {
      simp [drop, drop_drop],
      calc drop (n + (m + 1)) (xs_hd :: xs_tl)
      = drop (n + m + 1) (xs_hd :: xs_tl): by refl,
    }
end
-- supply the two missing cases here

lemma take_take {α : Type} :
  ∀ (m : ℕ) (xs : list α), take m (take m xs) = take m xs
  | 0 xs := by simp [take]
  | m [] := by simp [take]
  | (n + 1) (x :: xs) := by simp [take, take_take]

lemma take_drop {α : Type} :
  ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs
  | 0 xs := by simp [take, drop]
  | m [] := by simp [take]
  | (m + 1) (x :: xs) := by simp [take, drop, take_drop]

/-! ## Question 3: A Type of λ-Terms

3.1. Define an inductive type corresponding to the untyped λ-terms, as given
by the following context-free grammar:

    term ::= 'var' string        -- variable (e.g., `x`)
           | 'lam' string term   -- λ-expression (e.g., `λx, t`)
           | 'app' term term     -- application (e.g., `t u`) -/

-- enter your definition here

inductive term : Type
  | var (x: string) : term
  | lam (x: string) (t: term): term
  | app (t: term) (u: term): term

/-! 3.2. Register a textual representation of the type `term` as an instance of
the `has_repr` type class. Make sure to supply enough parentheses to guarantee
that the output is unambiguous. -/

def term.repr : term → string
  | (term.var x) := x
  | (term.lam x t) := "λ" ++ x ++ ",(" ++ (term.repr t) ++ ")"
  | (term.app t u) := "(" ++ (term.repr t) ++ " " ++(term.repr u) ++ ")"

@[instance] def term.has_repr : has_repr term :=
{ repr := term.repr }

/-! 3.3. Test your textual representation: -/

#eval (term.lam "x" (term.app (term.app (term.var "y") (term.var "x"))
    (term.var "x")))
  -- should print something like `(λx, ((y x) x))`

end LoVe


/-
COMP2009-ACE

Exercise 02 (Propositional logic)

   We play the game of logic poker :-)

    You have to classify the propositions into
    a) provable intuitionistically (i.e. in plain lean)
    b) provable classically (using em : P ∨ ¬ P or raa : ¬¬ P → P).
    c) not provable classically.
    and then you have to prove the propositions in a) and b) accordingly.

    Here is how you score:
    We start with 10 points :-)
    For any proposition which you didn't classify correctly (or not at all)
    you loose 1 point. :-(
    For any proposition which is provable but you didn't prove you loose
    1 point. :-(
    We stop subtracting points at 0. :-)

    Write the classification as a comment using -- after the proposition.

    You are only allowed to use the tactics introduced in the lecture
    (i.e. assume, exact, apply, constructor, cases, left, right, have, trivial)

    Please only use the tactics in the way indicated in the script,
    otherwise you may lose upto 2 style points.

    For propositions classified into c) just keep "sorry," as the proof.
-/

variables P Q R : Prop

open classical

theorem raa : ¬ ¬ P → P :=
begin
  assume nnp,
  cases (em P) with p np,
    exact p,
    have f : false,
      apply nnp,
      exact np,
    cases f,
end

theorem e01 : (P → Q) → (R → P) → (R → Q) :=
---a)  provable intuitionistically
begin
  assume pq rp r,
  apply pq,
  apply rp,
  exact r,
end

theorem e02 : (P → Q) → (P → R) → (Q → R) :=
---c) not provable classically
begin
  sorry,
end

theorem e03 : (P → Q) → (Q → R) → (P → R) :=
--a) provable intuitionistically
begin
  assume pq qr pr,
  apply qr,
  apply pq,
  exact pr,
end

theorem e04 : P → (P → Q) → P ∧ Q :=
--a) provable intuitionistically
begin
  assume p pq,
  constructor,
  exact p,
  apply pq,
  exact p,
end

theorem e05 : P ∨ Q → (P → Q) → Q :=
--a) provable intuitionistically
begin
  assume pq,
  assume p2q,
  cases pq with p q,
  apply p2q,
  exact p,
  exact q,
end

theorem e06 : (P → Q) → ¬ P ∨ Q :=
--b) provable classically
begin
  assume pq,
  cases (em P) with p np,
  right,
  apply pq,
  exact p,
  left,
  exact np,
end

theorem e07 : (¬ P ∨ Q) → P → Q :=
--a) provable intuitionistically
begin
  assume npq p,
  cases npq with np q,
  have h: P ∨ Q,
  left,
  exact p,
  have h: false,
  apply np,
  exact p,
  cases h,
  exact q,
end

theorem e08 : ¬ (P ↔ ¬ P) :=
--b) provable classically
begin
  assume pnp,
  cases pnp with pnp npp,
  cases (em P) with p np,
  cases (em ¬ P) with np1 p1,
  apply np1,
  exact p,
  apply p1,
  apply pnp,
  exact p,
  apply np,
  apply npp,
  exact np,
end

theorem e09 : ¬ P ↔ ¬ ¬ ¬ P :=
---a) provable intuitionistically
begin
  constructor,
  assume np,
  assume nnp,
  apply nnp,
  exact np,
  assume nnnp,
  assume p,
  apply nnnp,
  assume np2,
  apply np2,
  exact p,
end

theorem e10 : ((P → Q) → P) → P :=
--b) provable classically
begin
  assume pqp,
  apply raa,
  assume np,
  apply np,
  apply pqp,
  assume p,
  apply raa,
  assume nq,
  apply np,
  exact p,
end


-- Prueba mediante encadenamiento de ecuaciones
-- ============================================

-- Sean a, b y c números reales. Demostrar que
--    (a * b) * c = b * (a * c)

import data.real.basic

variables (a b c : ℝ)

-- 1ª demostración
example : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc,
end

-- 2ª demostración
example : (a * b) * c = b * (a * c) :=
begin
  calc (a * b) * c = (b * a) * c : by rw mul_comm a b
              ...  = b * (a * c) : by rw mul_assoc,
end

-- 3ª demostración
example : (a * b) * c = b * (a * c) :=
by linarith

-- 4ª demostración
example : (a * b) * c = b * (a * c) :=
by finish

-- 5ª demostración
example : (a * b) * c = b * (a * c) :=
by ring


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro p,
  by_contra,
  have i := h p,
  exact i,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro p,
  by_contra,
  have i := p h,
  exact i,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  intro p,
  by_contra,
  exact p h,
  intro p,
  by_contra,
  exact h p,
end

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

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

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro p,
  cases p with q r,
  split,
  exact r,
  exact q,
end

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

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intros p q,
  cases p,
  by_contra,
  exact p q,
  exact p,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intros p q,
  cases p,
  by_contra,
  exact q p,
  exact p,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intros p q r,
  have i := p r,
  exact q i,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros p q,
  by_contra,
  have i := p h,
  exact i q,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intros p q r,
  have i := p r,
  exact q i,
  intros p q,
  by_contra,
  have i := p h,
  exact i q,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro p,
  apply p,
  right,
  by_contra,
  have q : P ∨ ¬P,
  left,
  exact h,
  have i := p q,
  exact i,
end

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

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intros p q,
  have r : P,
  apply p,
  intro s,
  exfalso,
  exact q s,
  exact q r,
end

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intros p q,
  cases q with r s,
  cases p,
  exact r p,
  exact s p,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intros p q,
  cases p with r s,
  cases q with t u,
  exact t r,
  exact u s,
end

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

theorem demorgan_ndisj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro p,
  split,
  by_contra,
  have q : P ∨ Q,
  left,
  exact h,
  exact p q,
  by_contra,
  have q : P ∨ Q,
  right,
  exact h,
  exact p q,
end

theorem demorgan_ndisj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intros p q,
  cases p with r s,
  cases q with j k,
  exact r j,
  exact s k,
end

theorem demorgan_nconj_converse :
   (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intros p q,
  cases p with r s,
  cases q with j k,
  exact r k,
  cases q with x z,
  exact s x,
end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro p,
  cases p with q r,
  cases r with s t,
  left,
  split,
  exact q,
  exact s,
  right,
  split,
  exact q,
  exact t,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro p,
  cases p with q r,
  split,
  cases q with s t,
  exact s,
  cases q with u v,
  left,
  exact v,
  cases r with w x,
  split,
  exact w,
  right,
  exact x,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro p,
  split,
  cases p with q r s,
  left,
  exact q,
  cases r with t u,
  right,
  exact t,
  cases p with v w,
  left,
  exact v,
  cases w with x y,
  right,
  exact y,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro p,
  cases p with q r,
  cases q,
  left,
  exact q,
  cases r,
  left,
  exact r,
  right,
  split,
  exact q,
  exact r,
end

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intros p q r,
  apply p,
  split,
  exact q,
  exact r,
end
theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intros p q,
  apply p,
  cases q with r s,
  exact r,
  cases q with r s,
  exact s,
end

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

theorem impl_refl :
  P → P  :=
begin
  intro p,
  exact p,
end

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

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro p,
  left,
  exact p,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro p,
  right,
  exact p,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro p,
  cases p with q r,
  exact q,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro p,
  cases p with q r,
  exact r,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro p,
  cases p with q r,
  exact q,
  intro p,
  split,
  exact p,
  exact p,
end

theorem disj_idemp :
  (P∨P) ↔ P  :=
begin
  split,
  intro p,
  cases p,
  exact p,
  exact p,
  intro p,
  left,
  exact p,
end

end propositional

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

section predicate

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

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

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intros p,
  cases p with q r,
  intro s,
  have i := s q,
  exact r i,
end

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intros p q r,
  apply p,
  existsi q,
  exact r,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intros p q,
  cases q with r s,
  have i := p r,
  exact i s,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro p,
  by_contra r,
  apply p,
  intro q,
  by_contra,
  apply r,
  existsi q,
  exact h,
end

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

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

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intros p q,
  cases p with r s,
  have i := q r,
  exact i s,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intros p q,
  cases q with r s,
  have i := p r,
  exact s i,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intros p q,
  by_contra,
  apply p,
  existsi q,
  exact h,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro p,
  by_contra,
  apply p,
  intros q r,
  apply h,
  existsi q,
  exact r,
end

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

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  apply exists_as_neg_forall,
  apply exists_as_neg_forall_converse,
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 p,
  cases p with q r,
  cases r with s t,
  split,
  existsi q,
  exact s,
  existsi q,
  exact t,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro p,
  cases p with q r,
  cases r with s t,
  left,
  existsi q,
  exact s,
  right,
  existsi q,
  exact t,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro p,
  cases p with q r,
  cases q with s t,
  existsi s,
  left,
  exact t,
  cases r with s t,
  existsi s,
  right,
  exact t,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro p,
  split,
  intro q,
  by_contra,
  have i := p q,
  cases i with j k,
  exact h j,
  intro s,
  have i := p s,
  cases i with j k,
  by_contra,
  exact h k,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intros p q,
  split,
  cases p with r s,
  have i := r q,
  by_contra,
  exact h i,
  cases p with r s,
  by_contra,
  have i := s q,
  exact h i,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intros p q,
  cases p with r s,
  have i := r q,
  left,
  by_contra,
  exact h i,
  have i := s q,
  right,
  by_contra,
  exact h i,
end

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

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
  intro p,
  right,
  intro q,
  have i := p q,
  cases i,
  --teorema inválido
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
  intro p,
  cases p with q r,
  cases q with s t,
  cases r with u v,
  existsi u,
  split,
  --teorema inválido
end

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

end predicate


-- ---------------------------------------------------------------------
-- Ejercicio . Demostrar que, para todo númeo real a,
--    0 ≤ a^2
-- ----------------------------------------------------------------------

import data.real.basic
import tactic

example (a : ℝ) : 0 ≤ a^2 :=
begin
  -- library_search,
  exact pow_two_nonneg a,
end

-- Notas:
-- + Nota 1: Al colocar el cursor sobre library_search (después de descomentar
--   la línea) escribe el mensaje
--      Try this: exact pow_two_nonneg a
-- + Nota 2: Para usar library_search hay que importar tactic.


import tutorial_world.incidenceplane --hide
open IncidencePlane --hide

/- Axiom :
line_through_left (P Q : Ω) : P ∈ (line_through P Q)
-/
/- Axiom :
line_through_right (P Q : Ω) : Q ∈ (line_through P Q)
-/

/-
# Tutorial World

## Level 5: the `theorem statements`.

To solve this level, we need to introduce a new section that appears on the left side of the screen, which is called
**Theorem statements**.  Click on the top left menu where it says **"Theorem statements"** and display the **"Tutorial
World"** box to discover what we are talking about. As you can see, two new statements have been added to the list.

* line_through_left (P Q : Ω) : P ∈ (line_through P Q)

* line_through_right (P Q : Ω) : Q ∈ (line_through P Q)

**Note the name of the two statements**. Mathematicians sometimes call them "Lemma 2.1" or "Hypothesis P6" or something. But
computer scientists call them `line_through_left` and `line_through_right` because they are easier to use and remember. From now on,
all the statements that appear on this list will be remembered by the computer. In this way, we won't have to provide their proofs again.
Instead of this, we will use them straightforwardly in case they are handy for solving the following levels.

Just after the name of the statements, two parentheses appear. Inside them, there are the exact number of variables that are needed to
put out that statements. Then, the colon **:** symbol introduces the statement as such. In this case, they are very similar to each other.
What they come to mean is that we can draw a line that passes through two distinct points (P and Q) that lie in a plane (Ω). They symbol **∈**
is read as **"is an element of"**. Then, P and Q are elements of the line that passes through the points P and Q. Seems obvious, right? Now, let's
try to solve this level!

Delete the `sorry` and watch the goal appear as `⊢ B ∈ line_through A B`. Presumably, the goal shows the same structure as
the statement `line_through_right (P Q : Point) : Q ∈ (line_through P Q)`. Then, we just have to write that statement in a different way!
-- How do we change the points P and Q for the points A and B? -- Follow the same structure of the statement we need to use. Do you remember that the `exact`
tactic solved the goal by using a hypothesis of the same structure? Then, because the computer already knows what
`line_through_right (P Q : Point) : Q ∈ (line_through P Q)` means, why don't we type `exact line_through_right A B,`? Type that and see
how it finishes the proof! [**Don't forget to write the variables A and B. They are needed to use the statement**.]

-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma :  no-side-bar
A point lies in the line that passes through it.
-/
lemma point_on_line {A B : Ω} {r : Line Ω} :
B ∈ line_through A B :=
begin

  exact line_through_right A B,

end


theorem easy (P Q: Prop) (HP : P) (HPQ: P → Q) : Q :=
    begin
        apply HPQ, -- now i just have to prove p -> Q
        exact HP -- i know HP of P
    end

theorem prove_P_implies_Q (P Q : Prop)(HQ: Q): P → Q :=
    begin
        intro HP, -- assume HP of  P
        exact HQ,
    end

theorem P_implies_P (P: Prop) : P → P :=
    begin -- assume HP of P
        intro HP,
        apply HP
    end

theorem needs_intros (P Q R : Prop)(HR : R): P → Q → R :=
    begin
        intro HP,
        -- we have a proof of HP of P
        intro HQ,
        -- we have a proof of HQ of Q
        exact HR
    end

theorem very_easy : true :=
begin
    exact trivial,
end

theorem very_hard : false :=
begin
    sorry,
end

theorem false_implies_false: false → false :=
    begin
        intro Hfalse,
        exact Hfalse,
    end

theorem not_not (P: Prop): P → ¬ (¬ P) :=
                            -- ¬ P → ¬r P
begin
    intro HP,
    intro HnP,
    apply HnP,
    exact HP,
end

theorem contrapositive
  (P Q : Prop) (HPQ : P → Q) : ¬ Q → ¬ P :=
begin
    intro HnQ,
    intro HP,
    apply HnQ,
    apply HPQ,
    exact HP
end
#print contrapositive

theorem P_imples_P_or_Q (P Q: Prop) (HP: P) : P ∨ Q :=
begin
    left,
    exact HP,
end
#print P_imples_P_or_Q

theorem Q_imples_P_or_Q (P Q: Prop) (HQ: Q): P ∨ Q :=
begin
    right,
    exact HQ,
end
#print Q_imples_P_or_Q

theorem or_symmetry (P Q: Prop): P ∨ Q → Q ∨ P :=
begin
    intro HPQ,
    cases HPQ with HP HQ,
    { right,
      exact HP,
    },
    { left,
      exact HQ,
    },
end
#print or_symmetry

theorem or_associative (P Q R: Prop):
P ∨ (Q ∨ R) → (P ∨ Q) ∨ R :=
begin
    intro HPQR,
    cases HPQR with HP HQR,
    {
        left,
      {
          left,
          exact HP,
      }
    },
    cases HQR with HQ' HR',
    {
        left,
        {
            right,
            exact HQ',
        }
    },
    {
        right,
        exact HR',
    }
end
#print or_associative

theorem and_definition (P Q: Prop)(HP : P)(HQ: Q): P ∧ Q :=
begin
    split,
        {exact HP,}
        {exact HQ,}
end
#print and_definition

theorem and_symmetric(P Q: Prop): P ∧ Q → Q ∧ P :=
begin
    intro HPQ,
    cases HPQ with HP HQ,
    split,
        {exact HQ,},
        {exact HP,},
end
#print and_symmetric

theorem and_transitive(P Q R: Prop):
(P ∧ Q) ∧ (Q ∧ R) → (P ∧ R) :=
begin
    intro HPQandHQR,
    cases HPQandHQR with HPQ HQR,
        cases HPQ with HP HQ,
            split,
                {exact HP,},
        cases HQR with HQ' HR,
            exact HR,
end
#print and_transitive


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

import tactic

/-

# `finset X` is a lattice

Recall that a lattice is just a partially ordered set where every pair {a,b} of elements has
an inf `a ⊓ b` and a sup `a ⊔ b`. The type of finite subsets of `X`, ordered by inclusion,
has this property (because the union or intersection of two finite sets is finite).
This lattice structure is inbuilt in Lean.

-/

-- Let X be a type
variables (X : Type)

-- Assume the law of the excluded middle
open_locale classical

-- Don't worry about whether functions are computable
noncomputable theory

-- Then, finally, the type of finite subsets of X has a lattice structure
example : lattice (finset X) := infer_instance -- the square bracket system knows this

example (a b : finset X) : finset X := a ⊔ b -- sups (and infs) make sense

-- The lattice also has a `⊥`, the smallest finite subset of `X`, namely the empty set.

example : finset X := ⊥

-- But for general `X` it does not have a `⊤`, because if `X` is infinite then it doesn't
-- have a largest finite subset

-- example : finset X := ⊤ -- error

-- If `Y` is another type, then you can push finsets forward along maps from X to Y
variables (Y : Type) (f : X → Y)

example (S : finset X) : finset Y := finset.image f S

-- See if you can prove these. You'll have to figure out the basic API
-- for `finset.image`.

example (S : finset X) (y : Y) : y ∈ S.image f ↔ ∃ x ∈ S, f x = y :=
begin
  sorry,
end

example (S : finset X) (x : X) (hx : x ∈ S) : f x ∈ S.image f :=
begin
  sorry,
end


import algebra.group_power tactic.norm_num algebra.big_operators

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

theorem Q4 (n : ℕ) (H : n > 0) : factorial n < 3^n ↔ n ≤ 6 :=
begin
cases n with m,
  revert H,
  exact dec_trivial,
clear H,

cases m with m,split;exact dec_trivial,
cases m with m,split;exact dec_trivial,
cases m with m,split;exact dec_trivial,

cases m with m,split;intros,exact dec_trivial,
repeat {unfold factorial monoid.pow},{norm_num},

cases m with m,split;intros,exact dec_trivial,
repeat {unfold factorial monoid.pow},{norm_num},

cases m with m,split;exact dec_trivial,

split,
  tactic.swap,
  intro H,
  exfalso,
  revert H,
  exact dec_trivial,

intro this,exfalso,revert this,
apply not_lt_of_ge,
induction m with d Hd,
repeat {unfold factorial monoid.pow},{norm_num},

let e := nat.succ (nat.succ (nat.succ (nat.succ (nat.succ (nat.succ (nat.succ d)))))),
change nat.succ (nat.succ (nat.succ (nat.succ (nat.succ (nat.succ (nat.succ d)))))) with e,
change nat.succ (nat.succ (nat.succ (nat.succ (nat.succ (nat.succ (nat.succ d)))))) with e at Hd,

have He_ge_3 : nat.succ e ≥ 3 := by exact dec_trivial,
exact calc
factorial (nat.succ e) = factorial e * (nat.succ e) : by unfold factorial
... ≥ factorial e * 3 : nat.mul_le_mul_left _ He_ge_3
... ≥ 3^e*3 : nat.mul_le_mul_right 3 Hd
... = 3*3^e : by rw mul_comm
... = 3^nat.succ e : rfl,
end


/-
Copyright (c) 2020 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens, Yury Kudryashov

! This file was ported from Lean 3 source module number_theory.primorial
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Associated
import Mathlib.Data.Nat.Choose.Sum
import Mathlib.Data.Nat.Choose.Dvd
import Mathlib.Data.Nat.Parity
import Mathlib.Data.Nat.Prime

/-!
# Primorial

This file defines the primorial function (the product of primes less than or equal to some bound),
and proves that `primorial n ≤ 4 ^ n`.

## Notations

We use the local notation `n#` for the primorial of `n`: that is, the product of the primes less
than or equal to `n`.
-/

open Finset

open Nat

open BigOperators Nat

/-- The primorial `n#` of `n` is the product of the primes less than or equal to `n`.
-/
def primorial (n : ℕ) : ℕ :=
  ∏ p in filter Nat.Prime (range (n + 1)), p
#align primorial primorial

-- mathport name: «expr #»
local notation x "#" => primorial x

theorem primorial_pos (n : ℕ) : 0 < n# :=
  prod_pos fun _p hp ↦ (mem_filter.1 hp).2.pos
#align primorial_pos primorial_pos

theorem primorial_succ {n : ℕ} (hn1 : n ≠ 1) (hn : Odd n) : (n + 1)# = n# := by
  refine prod_congr ?_ fun _ _ ↦ rfl
  rw [range_succ, filter_insert, if_neg fun h ↦ odd_iff_not_even.mp hn _]
  exact fun h ↦ h.even_sub_one <| mt succ.inj hn1
#align primorial_succ primorial_succ

theorem primorial_add (m n : ℕ) :
    (m + n)# = m# * ∏ p in filter Nat.Prime (Ico (m + 1) (m + n + 1)), p := by
  rw [primorial, primorial, ← Ico_zero_eq_range, ← prod_union, ← filter_union, Ico_union_Ico_eq_Ico]
  exacts [Nat.zero_le _, add_le_add_right (Nat.le_add_right _ _) _,
    disjoint_filter_filter <| Ico_disjoint_Ico_consecutive _ _ _]
#align primorial_add primorial_add

theorem primorial_add_dvd {m n : ℕ} (h : n ≤ m) : (m + n)# ∣ m# * choose (m + n) m :=
  calc
    (m + n)# = m# * ∏ p in filter Nat.Prime (Ico (m + 1) (m + n + 1)), p := primorial_add _ _
    _ ∣ m# * choose (m + n) m :=
      mul_dvd_mul_left _ <|
        prod_primes_dvd _ (fun k hk ↦ (mem_filter.1 hk).2.prime) fun p hp ↦ by
          rw [mem_filter, mem_Ico] at hp
          exact hp.2.dvd_choose_add hp.1.1 (h.trans_lt (m.lt_succ_self.trans_le hp.1.1))
              (Nat.lt_succ_iff.1 hp.1.2)
#align primorial_add_dvd primorial_add_dvd

theorem primorial_add_le {m n : ℕ} (h : n ≤ m) : (m + n)# ≤ m# * choose (m + n) m :=
  le_of_dvd (mul_pos (primorial_pos _) (choose_pos <| Nat.le_add_right _ _)) (primorial_add_dvd h)
#align primorial_add_le primorial_add_le

theorem primorial_le_4_pow (n : ℕ) : n# ≤ 4 ^ n := by
  induction' n using Nat.strong_induction_on with n ihn
  cases' n with n; · rfl
  rcases n.even_or_odd with (⟨m, rfl⟩ | ho)
  · rcases m.eq_zero_or_pos with (rfl | hm)
    · decide
    calc
      (m + m + 1)# = (m + 1 + m)# := by rw [add_right_comm]
      _ ≤ (m + 1)# * choose (m + 1 + m) (m + 1) := primorial_add_le m.le_succ
      _ = (m + 1)# * choose (2 * m + 1) m := by rw [choose_symm_add, two_mul, add_right_comm]
      _ ≤ 4 ^ (m + 1) * 4 ^ m :=
        mul_le_mul' (ihn _ <| succ_lt_succ <| (lt_add_iff_pos_left _).2 hm) (choose_middle_le_pow _)
      _ ≤ 4 ^ (m + m + 1) := by rw [← pow_add, add_right_comm]
  · rcases Decidable.eq_or_ne n 1 with (rfl | hn)
    · decide
    · calc
        (n + 1)# = n# := primorial_succ hn ho
        _ ≤ 4 ^ n := ihn n n.lt_succ_self
        _ ≤ 4 ^ (n + 1) := pow_le_pow_of_le_right four_pos n.le_succ
#align primorial_le_4_pow primorial_le_4_pow


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

import data.polynomial.derivative
import logic.function.iterate
import data.finset.intervals
import tactic.ring
import tactic.linarith

/-!
# Theory of iterated derivative
We define and prove some lemmas about iterated (formal) derivative for polynomials over a semiring.
-/

noncomputable theory

open finset nat polynomial
open_locale big_operators

namespace polynomial
universes u
variable {R : Type u}

section semiring

variables [semiring R] (r : R) (f p q : polynomial R) (n k : ℕ)

/-- `iterated_deriv f n` is the `n`-th formal derivative of the polynomial `f` -/
def iterated_deriv : polynomial R := derivative ^[n] f

@[simp] lemma iterated_deriv_zero_right : iterated_deriv f 0 = f := rfl

lemma iterated_deriv_succ : iterated_deriv f (n + 1) = (iterated_deriv f n).derivative :=
by rw [iterated_deriv, iterated_deriv, function.iterate_succ']

@[simp] lemma iterated_deriv_zero_left : iterated_deriv (0 : polynomial R) n = 0 :=
begin
  induction n with n hn,
  { exact iterated_deriv_zero_right _ },
  { rw [iterated_deriv_succ, hn, derivative_zero] },
end

@[simp] lemma iterated_deriv_add :
  iterated_deriv (p + q) n = iterated_deriv p n + iterated_deriv q n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right], },
  { simp only [iterated_deriv_succ, ih, derivative_add] }
end

@[simp] lemma iterated_deriv_smul : iterated_deriv (r • p) n = r • iterated_deriv p n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right] },
  { simp only [iterated_deriv_succ, ih, derivative_smul] }
end

@[simp] lemma iterated_deriv_X_zero : iterated_deriv (X : polynomial R) 0 = X :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_X_one : iterated_deriv (X : polynomial R) 1 = 1 :=
by simp only [iterated_deriv, derivative_X, function.iterate_one]

@[simp] lemma iterated_deriv_X (h : 1 < n) : iterated_deriv (X : polynomial R) n = 0 :=
begin
  induction n with n ih,
  { exfalso, exact not_lt_zero 1 h},
  { simp only [iterated_deriv_succ],
    by_cases H : n = 1,
    { rw H, simp only [iterated_deriv_X_one, derivative_one] },
    { replace h : 1 < n := array.push_back_idx h (ne.symm H),
      rw ih h, simp only [derivative_zero] } }
end

@[simp] lemma iterated_deriv_C_zero : iterated_deriv (C r) 0 = C r :=
  by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_C (h : 0 < n) : iterated_deriv (C r) n = 0 :=
begin
  induction n with n ih,
  { exfalso, exact nat.lt_asymm h h },
  { by_cases H : n = 0,
    { rw [iterated_deriv_succ, H], simp only [iterated_deriv_C_zero, derivative_C]},
    { replace h : 0 < n := nat.pos_of_ne_zero H,
      rw [iterated_deriv_succ, ih h], simp only [derivative_zero] } }
end

@[simp] lemma iterated_deriv_one_zero : iterated_deriv (1 : polynomial R) 0 = 1 :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_one : 0 < n → iterated_deriv (1 : polynomial R) n = 0 := λ h,
begin
  have eq1 : (1 : polynomial R) = C 1 := by simp only [ring_hom.map_one],
  rw eq1, exact iterated_deriv_C _ _ h,
end

end semiring

section ring
variables [ring R] (p q : polynomial R) (n : ℕ)

@[simp] lemma iterated_deriv_neg : iterated_deriv (-p) n = - iterated_deriv p n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right] },
  { simp only [iterated_deriv_succ, ih, derivative_neg] }
end

@[simp] lemma iterated_deriv_sub :
  iterated_deriv (p - q) n = iterated_deriv p n - iterated_deriv q n :=
by rw [sub_eq_add_neg, iterated_deriv_add, iterated_deriv_neg, ←sub_eq_add_neg]

end ring

section comm_semiring
variable [comm_semiring R]
variables (f p q : polynomial R) (n k : ℕ)

lemma coeff_iterated_deriv_as_prod_Ico :
  ∀ m : ℕ, (iterated_deriv f k).coeff m = (∏ i in Ico m.succ (m + k.succ), i) * (f.coeff (m+k)) :=
begin
  induction k with k ih,
  { simp only [add_zero, forall_const, one_mul, Ico.self_eq_empty, eq_self_iff_true,
      iterated_deriv_zero_right, prod_empty] },
  { intro m, rw [iterated_deriv_succ, coeff_derivative, ih (m+1), mul_right_comm],
    apply congr_arg2,
    { have set_eq : (Ico m.succ (m + k.succ.succ)) = (Ico (m + 1).succ (m + 1 + k.succ)) ∪ {m+1},
      { rw [union_comm, ←insert_eq, Ico.insert_succ_bot, add_succ, add_succ, add_succ _ k,
            ←succ_eq_add_one, succ_add],
        rw succ_eq_add_one,
        linarith },
      rw [set_eq, prod_union],
      apply congr_arg2,
      { refl },
      { simp only [prod_singleton], norm_cast },
      { simp only [succ_pos', disjoint_singleton, and_true, lt_add_iff_pos_right, not_le, Ico.mem],
        exact lt_add_one (m + 1) } },
    { exact congr_arg _ (succ_add m k) } },
end

lemma coeff_iterated_deriv_as_prod_range :
  ∀ m : ℕ, (iterated_deriv f k).coeff m = f.coeff (m + k) * (∏ i in range k, ↑(m + k - i)) :=
begin
  induction k with k ih,
  { simp },
  intro m,
  calc (f.iterated_deriv k.succ).coeff m
      = f.coeff (m + k.succ) * (∏ i in range k, ↑(m + k.succ - i)) * (m + 1) :
    by rw [iterated_deriv_succ, coeff_derivative, ih m.succ, succ_add, add_succ]
  ... = f.coeff (m + k.succ) * (∏ i in range k, ↑(m + k.succ - i)) * ↑(m + 1) :
    by push_cast
  ... = f.coeff (m + k.succ) * (∏ i in range k.succ, ↑(m + k.succ - i)) :
    by rw [prod_range_succ, nat.add_sub_assoc k.le_succ, succ_sub le_rfl, nat.sub_self, mul_assoc]
end

lemma iterated_deriv_eq_zero_of_nat_degree_lt (h : f.nat_degree < n) : iterated_deriv f n = 0 :=
begin
  ext m,
  rw [coeff_iterated_deriv_as_prod_range, coeff_zero, coeff_eq_zero_of_nat_degree_lt, zero_mul],
  linarith
end

lemma iterated_deriv_mul :
  iterated_deriv (p * q) n =
  ∑ k in range n.succ,
    (C (n.choose k : R)) * iterated_deriv p (n - k) * iterated_deriv q k :=
begin
  induction n with n IH,
  { simp },

  calc (p * q).iterated_deriv n.succ
      = (∑ (k : ℕ) in range n.succ,
           C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv k).derivative :
    by rw [iterated_deriv_succ, IH]
  ... = ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k + 1) * q.iterated_deriv k +
        ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) :
    by simp_rw [derivative_sum, derivative_mul, derivative_C, zero_mul, zero_add,
                iterated_deriv_succ, sum_add_distrib]
  ... = (∑ (k : ℕ) in range n.succ,
            C ↑(n.choose k.succ) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) +
          C ↑1 * p.iterated_deriv n.succ * q.iterated_deriv 0) +
        ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) : _
  ... = ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) +
        ∑ (k : ℕ) in range n.succ,
            C ↑(n.choose k.succ) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) +
        C ↑1 * p.iterated_deriv n.succ * q.iterated_deriv 0 :
    by ring
  ... = ∑ (i : ℕ) in range n.succ,
          C ↑((n+1).choose (i+1)) * p.iterated_deriv (n + 1 - (i+1)) * q.iterated_deriv (i+1) +
        C ↑1 * p.iterated_deriv n.succ * q.iterated_deriv 0 :
    by simp_rw [choose_succ_succ, succ_sub_succ, cast_add, C.map_add, add_mul, sum_add_distrib]
  ... = ∑ (k : ℕ) in range n.succ.succ,
          C ↑(n.succ.choose k) * p.iterated_deriv (n.succ - k) * q.iterated_deriv k :
    by rw [sum_range_succ' _ n.succ, choose_zero_right, nat.sub_zero],

  congr,
  refine (sum_range_succ' _ _).trans (congr_arg2 (+) _ _),
  { rw [sum_range_succ, nat.choose_succ_self, cast_zero, C.map_zero, zero_mul, zero_mul, add_zero],
    refine sum_congr rfl (λ k hk, _),
    rw mem_range at hk,
    congr,
    rw [← nat.sub_add_comm (nat.succ_le_of_lt hk), nat.succ_sub_succ] },
  { rw [choose_zero_right, nat.sub_zero] },
end

end comm_semiring

end polynomial


import data.real.basic

open_locale classical

/-
Theoretical negations.

This file is for people interested in logic who want to fully understand
negations.

Here we don't use `contrapose` or `push_neg`. The goal is to prove lemmas
that are used by those tactics. Of course we can use
`exfalso`, `by_contradiction` and `by_cases`.

If this doesn't sound like fun then skip ahead to the next file.
-/

section negation_prop

variables P Q : Prop

-- 0055
example : (P → Q) ↔ (¬ Q → ¬ P) :=
begin
  split, intro h, intro j, by_contradiction hyp, exact j (h hyp),
  intro h, intro p, by_contradiction qn, exact h qn p,
end

-- 0056
lemma non_imp (P Q : Prop) : ¬ (P → Q) ↔ P ∧ ¬ Q :=
begin
  split, intro h, split, by_contradiction np,
  have k : P → Q, intro p, exfalso, exact np p, exact h k,
  intro q, have k : P → Q, intro p, exact q, exact h k,
  intro h, cases h with p qn, intro j, exact qn (j p),
end

-- In the next one, let's use the axiom
-- propext {P Q : Prop} : (P ↔ Q) → P = Q

-- 0057
example (P : Prop) : ¬ P ↔ P = false :=
begin
  split, intro h, apply propext, split, intro j, exact h j, intro p, exfalso, exact p,
  intro h, intro j, rw h at j, exact j,
end

end negation_prop

section negation_quantifiers
variables (X : Type) (P : X → Prop)

-- 0058
example : ¬ (∀ x, P x) ↔ ∃ x, ¬ P x :=
begin
  split, intro h, by_contradiction hyp, apply h, intro x, by_contradiction j, exact hyp ⟨x,j⟩,
  intro h, intro hyp, cases h with x hx, exact hx (hyp x),
end

-- 0059
example : ¬ (∃ x, P x) ↔ ∀ x, ¬ P x :=
begin
  split, intros h x hx, exact h ⟨x, hx⟩,
  intros h j, cases j with x hx, exact h x hx,
end

-- 0060
example (P : ℝ → Prop) : ¬ (∃ ε > 0, P ε) ↔ ∀ ε > 0, ¬ P ε :=
begin
  split, intros h ε ε_pos hε, apply h, use [ε,ε_pos,hε],
  intros h j, rcases j with ⟨ε,ε_pos,hε⟩, exact h ε ε_pos hε,
end

-- 0061
example (P : ℝ → Prop) : ¬ (∀ x > 0, P x) ↔ ∃ x > 0, ¬ P x :=
begin
  split, intro h, by_contradiction hyp, apply h, intros x x_pos, by_contradiction hp,
  apply hyp, use [x,x_pos,hp],
  intros h j, rcases h with ⟨x,hx,px⟩, exact px (j x hx),
end

end negation_quantifiers


/-***************-/
/- ** BASICS ** --/
/-***************-/

/-
#

Write a defintion of x as a value of
type nat having the specific value 0.
Be sure it type-checks.
-/

def x : nat := 0

def x' := 0

/-
#

Write a definition of f as a function
of type ℕ → ℕ that returns the square of
the value to which it is applied (i.e.,
that it is given as an argument)
-/

def square' (n : nat) : nat := n^2

#check square'

def square : ℕ → ℕ := λ n : nat, n^2

/-
#

Write a definition of a function, nt, that
takes any proposition, P, and that returns
the proposition, P → false.
-/

def nt (P : Prop) : Prop := P → false

#check nt

def isZero (n : nat) : Prop := 0 = n

#reduce isZero 3

/-
#

What is the type of this function? Hint:
Use #check to check it.
-/

/-****************************************-/
/- ** PROOFS OF EQUALITY PROPOSITIONS ** --/
/-****************************************-/

/-
#1

Write a function, teqt, that takes any type,
T : Type, and any value, t : T, and that
returns a proof of t = t.
-/

def teqt (T : Type) (t: T) := eq.refl t

def teqt' : ∀ (T : Type), ∀ (t : T), (t = t) :=
    λ X x, eq.refl x

def teqt'' (T : Type) := λ t : T, t = t

#check teqt''

#check teqt

/-
#2a

Write a function that takes any type, T; three values,
a, b, and c, of type T; a proof of a = b; and a proof
of b = c; and that returns a proof of c = a. We give
you most of the answer. Replace the sorry with your
answer.
-/

def aBbCCa : ∀ (T : Type), ∀ (a b c: T),
    (a = b) -> (b = c) → (c = a) :=
        λ X a b c ab bc,
            eq.symm (eq.trans ab bc)

-- This is equivalent
def aBbCCa''
    { T : Type }
    (a b c : T)
    (ab : a = b)
    (bc: b = c) :
    (c = a)
    :=
begin
have ac := eq.trans ab bc,
show c = a,
from eq.symm ac
end

/-
#2b.

Define aBbCCa' to be the same function, but specify
its type using ∀ and → connectives, and then provide
the function value using a lambda expression (λ). So
you will start with "def", then the name, then a :,
then the proposition, starting with ∀ and ending with
→ (c = a), followed by :=, and finally follwed by a
lambda expression.
-/

def aBbCCa' :
    ∀ T : Type, ∀ a b c : T, (a = b) → (b = c) → (c = a) :=
        λ T a b c ab bc,
            eq.symm (eq.trans ab bc)

/-*******************************-/
/- ** PROOFS OF CONJUNCTIONS ** --/
/-*******************************-/

/-
We assume P Q and R are propositions using the
following "variables" declaration. That means that
we can use P, Q, R, and S in the following theorems
without having to use ∀ P Q R S : Prop to introduce
them again for each individual proposition.
-/

variables P Q R S : Prop

/-
Prove the following propositions by completing
the definitions (replace sorrys with your answers).
-/

theorem t1 : P → Q → R → P :=
  λ p q r, p

#check t1

theorem t2 : Q → (Q ∧ Q) :=
    λ (q : Q), and.intro q q

theorem t3 : (P ∧ Q) ∧ (Q ∧ R) → (P ∧ R) :=
begin
assume pqqr : (P ∧ Q) ∧ (Q ∧ R),
have pq : P ∧ Q := pqqr.left,
have qr := pqqr.right,
have p := pq.left,
have r := qr.right,
apply and.intro p r
end

/- This is a shorter version!
   λ pqqr : ((P ∧ Q) ∧ (Q ∧ R)),
        and.intro (pqqr.left.left) pqqr.right.right
-/

/-*******************************-/
/- ** PROOFS OF IMPLICATIONS ** --/
/-*******************************-/

/-
Prove the following theorem. It claims that
implication is transitive (which it is).
-/

theorem t4 : ((P → Q) ∧ P) → Q :=
λ pqp, pqp.left pqp.right

theorem t5 :
    (P → Q) → (Q → R) → (R → S) → (P → S) :=
        λ pq qr rs,
            λ p, rs (qr (pq p))

/-******************-/
/- ** Functions ** --/
/-******************-/

/-
Complete the following definition
with a value that makes the definition
type-check. You can answer with a
lambda expression. You can also
use a tactic script if you prefer.
-/
def n2n : ℕ → ℕ :=
    λ n, 0

/-
Define a function called double
that takes any natural number, n,
and returns two times n.
-/

def double : ℕ → ℕ := λ n, 2 * n

/-
Write a test case for double
in the form of a theorem called
d15is30, that asserts that the
double of 15 is 30, and prove it.
-/

theorem d15is30 : double 15 = 30 := rfl

/-
Write a function, sum3, that takes three
natural numbers, a, b, c, and that returns
the sum of a, b, and c. Use a λ expression
to express the function.
-/

def sum' :=
    λ (a b c : nat), a + b + c
-- Your answer here

/-*****************-/
/- ** NEGATION ** --/
/-*****************-/

/-
You already know that double
negation elimination requires
classical reasoning (using the
law of the excluded middle).
Give a proof of the following
proposition, which asserts that
it's valid to introduce double
negatations. Note: You do not
need the law of the excluded
middle to prove it.
-/

def t6 : P → ¬ ¬ P :=
    λ p np, np p

/-
You've learned a few important
proof strategies. Explain in a
few words when might a proof
by negation be attempted, and
how one proceeds to use it.

Know the answer to the same
question about a proof by
contradiction.
-/

/-
Explain precisely why using a
proof by contradiction relies
on classical reasoning using
the law of the excluded middle.
-/

/-
EXTRA CREDIT: Write a function
that takes a function, f, of type
ℕ → ℕ, and that returns a function
that, for any value, n, returns
one more that what f returns.
-/

/-
That's the end of the practice test.
Here's a partial inventory of inference
rules we've covered. and related concepts.
This is not enough material for a complete
review. Reread all the notes and work any
problems that you're not yet sure you know
how to solve.
-/

/-
Partial inventory of inference rules.

* Equality
-- eq.refl : given a type T and a value t : T, derives a proof of t = t
-- eq.symm : given a type T, values a b : T, and a proof of a = b, derives a proof of b = a
-- eq.trans : given a type T, values a b c : T, and proofs of a = b and b = c, derives a proof of a = c

* Conjunction
-- and.intro : given propositions, P Q : Prop, a proof P : P, and a proof q : Q, derives a proof of P ∧ Q
-- and.elim_right : given propositions, P Q : Prop and a proof pq : P ∧ Q, derives a proof of P
-- and.elim_right : given propositions, P Q : Prop and a proof pq : P ∧ Q, derives a proof of Q

* Implication
-- → introduction: given P Q : Prop and a derivation of a proof Q from a proof of P, conclude P → Q
-- note : a derivation of a proof of Q from a proof of P is given as a function of type P → Q
-- → elimination: given propositions, P and Q, a proof of P → Q, and a proof of P, derive a proof of Q
-- note that → elimination is both a formal version of Aristotle's modus ponens rule and function application

* Negation
-- introduction : given a proposition P and a proof of P → false, conclude ¬ P
-- elimination
---- in constructive logic, showing that a proposition, ¬ P, is false proves only ¬ ¬ P, not that P is true
---- try to derive a proof of P from the assumption of a proof for ¬ ¬ P and you will see the problem
---- you can read ¬ ¬ P as "there's no proof of ¬ P," or as "¬ P is false,"
---- classical logic adds the axiom of the excluded middle (AEM), stating that ∀ P : Prop, P ∨ ¬ P
---- if you accept this axiom and you know that ¬ P is false, then P must be true
---- the AEM enables ¬ elimination
---- given a proposition P and a proof of ¬ P → false (of ¬ ¬ P), derive a proof of P

* Forall
-- introduction : to prove ∀ p : P, Q, where P is a type and Q is a proposition that can involve be written in terms of p, show that Q holds for an any arbitrarily assumed value, p, of type P
-- elimination : given a proof of ∀ p : P, Q, and a specific value x : P, conclude Q
-/


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si a, b, c y d son números reales, entonces
--    (a + b) * (c + d) = a * c + a * d + b * c + b * d
-- ---------------------------------------------------------------------

import data.real.basic

variables a b c d : ℝ

-- 1ª demostración
-- ===============

example
  : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
calc
  (a + b) * (c + d)
      = a * (c + d) + b * (c + d)       : by rw add_mul
  ... = a * c + a * d + b * (c + d)     : by rw mul_add
  ... = a * c + a * d + (b * c + b * d) : by rw mul_add
  ... = a * c + a * d + b * c + b * d   : by rw ←add_assoc

-- 2ª demostración
-- ===============

example
  : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
calc
  (a + b) * (c + d)
      = a * (c + d) + b * (c + d)       : by ring
  ... = a * c + a * d + b * (c + d)     : by ring
  ... = a * c + a * d + (b * c + b * d) : by ring
  ... = a * c + a * d + b * c + b * d   : by ring

-- 3ª demostración
-- ===============

example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
by ring

-- 4ª demostración
-- ===============

example
  : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
begin
   rw add_mul,
   rw mul_add,
   rw mul_add,
   rw ← add_assoc,
end

-- El desarrollo de la prueba es
--
--    a b c d : ℝ
--    ⊢ (a + b) * (c + d) = a * c + a * d + b * c + b * d
-- rw add_mul,
--    ⊢ a * (c + d) + b * (c + d) = a * c + a * d + b * c + b * d
-- rw mul_add,
--    ⊢ a * c + a * d + b * (c + d) = a * c + a * d + b * c + b * d
-- rw mul_add,
--    ⊢ a * c + a * d + (b * c + b * d) = a * c + a * d + b * c + b * d
-- rw ← add_assoc,
--    no goals

-- 5ª demostración
-- ===============

example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
by rw [add_mul, mul_add, mul_add, ←add_assoc]


import .love10_denotational_semantics_demo

/-! # LoVe Exercise 10: Denotational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Monotonicity

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

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

/-! 1.2. Prove its cousin. -/

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

/-! ## Question 2: Regular Expressions

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

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

Informally, the semantics of regular expressions is as follows:

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

Notice the rough correspondence with a WHILE language:

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

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

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

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

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

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

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

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

end LoVe


-- Monotonía de la multiplicación por no positivo
-- ==============================================

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

import data.real.basic

variables {a b c : ℝ}

-- 1ª demostración
example
  (hc : c ≤ 0)
  (hab : a ≤ b)
  : b * c ≤ a * c :=
begin
  rw ← sub_nonneg,
  have h : a * c - b * c = (a - b) * c,
  { ring, },
  { rw h,
    apply mul_nonneg_of_nonpos_of_nonpos,
    { rwa sub_nonpos, },
    { exact hc, }},
end

-- 2ª demostración
example
  (hc : c ≤ 0)
  (hab : a ≤ b)
  : b * c ≤ a * c :=
begin
  have hab' : a - b ≤ 0,
  { rwa ← sub_nonpos at hab, },
  have h1 : 0 ≤ (a - b) * c,
  { exact mul_nonneg_of_nonpos_of_nonpos hab' hc, },
  have h2 : (a - b) * c = a * c - b * c,
  { ring, },
  have h3 : 0 ≤ a * c - b * c,
  { rwa h2 at h1, },
  rwa sub_nonneg at h3,
end

-- 3ª demostración
example
  (hc : c ≤ 0)
  (hab : a ≤ b)
  : b * c ≤ a * c :=
begin
  rw ← sub_nonneg,
  have hab' : a - b ≤ 0,
  { rwa sub_nonpos, },
  calc 0 ≤ (a - b)*c
              : mul_nonneg_of_nonpos_of_nonpos hab' hc
     ... =  a*c - b*c
              : by ring,
end

-- 4ª demostración
example
  (hc : c ≤ 0)
  (hab : a ≤ b)
  : b * c ≤ a * c :=
mul_mono_nonpos hc hab

-- 5ª demostración
example
  (hc : c ≤ 0)
  (hab : a ≤ b)
  : b * c ≤ a * c :=
by nlinarith


-- Basic definition of a group (G, ⬝).
class group (G : Type*) :=
  (mul : G → G → G)
  (mul_assoc : ∀ a b c : G, (mul a (mul b c)) = (mul (mul a b) c))
  (id : G)
  (id_mul : ∀ a : G, (mul id a) = a)
  (mul_id : ∀ a : G, (mul a id) = a)
  (inv : G → G)
  (mul_inv : ∀ a : G, (mul a (inv a)) = id)
  (inv_mul : ∀ a : G, (mul (inv a) a) = id)

infix ` ⬝ `:65 := group.mul

-- The following theorems are simple rewrites that are just needed
-- because I don't know how to make the infix operator `⬝` work...

theorem int.my_add_assoc : ∀ a b c : ℤ, (a + (b + c)) = ((a + b) + c) := begin
  intros,
  rw int.add_assoc,
end

theorem int.my_zero_add : ∀ a : ℤ, (0 + a) = a := begin
  intros,
  rw int.zero_add,
end

theorem int.my_add_zero : ∀ a : ℤ, (a + 0) = a := begin
  intros,
  rw int.add_zero,
end

-- Basically, a proof that ℤ forms a group under addition, with
-- 0 as the identity element and (-a) as the inverse of a.
instance : group ℤ := {
  mul := int.add,
  mul_assoc := int.my_add_assoc,
  id := int.zero,
  id_mul := int.my_zero_add,
  mul_id := int.my_add_zero,
  inv := λ a : ℤ, -a,
  mul_inv := int.add_right_neg,
  inv_mul := int.add_left_neg,
}


open nat

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

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

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

--1.d.
example : ∀ m n k : nat, (m * n) * k = m * (n * k) :=
    assume m n k,
        nat.rec_on k
            (show (m * n) * 0 = m * (n * 0), from
                calc
                    (m * n) * 0 = 0 : by rw mul_zero
                            ... = m * 0 : by rw mul_zero
                            ... = 0 * m : by rw mul_comm
                            ... = (n * 0) * m : by rw mul_zero
                            ... = m * (n * 0) : by rw mul_comm)
            (assume i (ih : (m * n) * i = m * (n * i)),
            show (m * n) * succ i = m * (n * succ i), from
                begin
                    rw mul_succ,
                    rw ih,
                    rw ← left_distrib,
                    rw mul_succ
                end)

--1.e.
example : ∀ m n : nat, m * n = n * m :=
    assume m n,
        nat.rec_on n
            (begin
                rw mul_zero,
                apply eq.symm,
                rw zero_mul
            end)
            (begin
                intros k ih,
                rw mul_succ,
                rw ih,
                rw succ_mul
            end)

github-repos/lean/lucasresck-Discrete-Mathematics/Discrete-Mathematics-0a08081c5f393e5765259d3f1253c3a6dd043dac/Exercises/18. The Natural Numbers and Induction in Lean.lean


import data.real.basic

--OUTPUT 1
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  -- $\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$
  have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [arithmetic_mean_harmonic_mean],
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [h1],
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Nesbitt's inequality
Let $a$, $b$ and $c$ be positive real numbers.

Then:
:$\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$

`proof`
{{begin-eqn}}
{{eqn | l = \frac a {b + c} + \frac b {a + c} + \frac c {a + b}
      | o = \ge
      | r = \dfrac 3 2
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac 9 2
      | c = by adding $3$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac {9 \paren {a + b + c} } {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = as $\dfrac {a + b + c} {\paren {b + c} + \paren {a + c} + \paren {a + b} } = \dfrac 1 2$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {\frac 1 {b + c} + \frac 1 {a + c} + \frac 1 {a + b} } 3
      | o = \ge
      | r = \frac 3 {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = dividing by $3 \paren {a + b + c}$
}}
{{end-eqn}}
These are the arithmetic mean and the harmonic mean of $\dfrac 1 {b + c}$, $\dfrac 1 {a + c}$ and $\dfrac 1 {a + b}$.

From Arithmetic Mean is Never Less than Harmonic Mean the last inequality is true.

Thus Nesbitt's Inequality holds.
{{qed}}

-/
theorem  nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
FEW SHOT PROMPTS TO CODEX(END)-/