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

import easy_mode.sheet01

/-! Two-by-two matrices

This file defines two-by-two matrices and shows that they form a vector space.
-/

/- Here is one way to define a 2x2 matrix, via specifying its two rows. In hard mode you could try to take a
  different approach (either as its two columns or as its four entries and see what gets easier and what gets
  harder). -/
structure two_matrix : Type :=
(fst_row : ℝ²)
(snd_row : ℝ²)

namespace two_matrix

notation `Mat₂` := two_matrix

/-- Two matrices are equal if and only if their first and second rows coincide. -/
@[ext] theorem ext {A B : Mat₂}
  (h_first_row : A.fst_row = B.fst_row )
  (h_second_row : A.snd_row = B.snd_row ) :
  A = B :=
begin
  sorry
end

/- Again we want to be able to write `A + B` if `A` and `B` are matrices without too complicated notation. -/
instance : has_add Mat₂ := ⟨λ A B, ⟨A.fst_row + B.fst_row, A.snd_row + B.snd_row⟩⟩

@[simp] lemma add_fst_row (A B : Mat₂) : (A + B).fst_row = A.fst_row + B.fst_row := sorry
@[simp] lemma add_snd_row (A B : Mat₂) : (A + B).snd_row = A.snd_row + B.snd_row := sorry

lemma add_assoc (A B C : Mat₂) : A + B + C = A + (B + C) :=
begin
  sorry
end

lemma add_comm (A B : Mat₂) : A + B = B + A :=
begin
  sorry
end

def zero_matrix : Mat₂ := ⟨0,0⟩

/- We even want to be able to write `0` for the zero matrix.-/
instance : has_zero Mat₂ := ⟨zero_matrix⟩

/- The following lemmas have each two zeros in them, see which is which. -/
@[simp] lemma zero_fst_row : (0 : Mat₂).fst_row = 0 := sorry
@[simp] lemma zero_snd_row : (0 : Mat₂).snd_row = 0 := sorry

@[simp] lemma add_zero (A : Mat₂) : A + 0 = A :=
begin
  sorry
end

@[simp] lemma zero_add (A : Mat₂) : 0 + A = A :=
begin
  sorry
end

/- We want to define the negation of a matrix. -/
instance : has_neg Mat₂ := ⟨λ A, ⟨-A.fst_row, -A.snd_row⟩⟩

@[simp] lemma neg_fst_row (A : Mat₂) : (-A).fst_row = -A.fst_row := sorry
@[simp] lemma neg_snd_row (A : Mat₂) : (-A).snd_row = -A.snd_row := sorry

@[simp] lemma add_neg_self (A : Mat₂) : A + -A = 0 :=
begin
  sorry
end

@[simp] lemma neg_add_self (A : Mat₂) : -A + A = 0 :=
begin
  sorry
end

/- Finally we set up subtraction and scalar multiplication of matrices. -/
instance : has_sub Mat₂ := ⟨λ A B, A + (-B)⟩

instance : has_scalar ℝ Mat₂ := ⟨λ a A, ⟨a • A.fst_row, a • A.snd_row⟩⟩

@[simp] lemma smul_fst_row (a : ℝ) (A : Mat₂) : (a • A).fst_row = a • A.fst_row := sorry
@[simp] lemma smul_snd_row (a : ℝ) (A : Mat₂) : (a • A).snd_row = a • A.snd_row := sorry

lemma smul_assoc (a b : ℝ) (A : Mat₂) : (a * b) • A = a • (b • A) :=
begin
  sorry
end

@[simp] lemma one_smul (A : Mat₂) : (1 : ℝ) • A = A :=
begin
  sorry
end

@[simp] lemma smul_add (a : ℝ) (A B : Mat₂) : a • (A + B) = a • A + a • B :=
begin
  sorry
end

@[simp] lemma add_smul (a b : ℝ) (A : Mat₂) : (a + b) • A = a • A + b • A :=
begin
  sorry
end

end two_matrix


-- Ref: The conversion tactic mode https://bit.ly/3kqif1T

import tactic

example (a b c : ℕ) : a * (b * c) = a * (c * b) :=
begin
  conv
  begin          -- | a * (b * c) = a * (c * b)
    to_lhs,      -- | a * (b * c)
    congr,       -- 2 goals : | a and | b * c
    skip,        -- | b * c
    rw mul_comm, -- | c * b
  end
end

example (a b c : ℕ) : a * (b * c) = a * (c * b) :=
begin
  conv in (b*c)
  begin          -- | b * c
    rw mul_comm, -- | c * b
  end,
end

example (a b c : ℕ) : a * (b * c) = a * (c * b) :=
by conv in (b*c) { rw mul_comm }

example (a b c : ℕ) : a + (b * c) = a + (c * b) :=
by conv in (_ * c) { rw mul_comm }

example (a b c : ℕ) : (b * c) * (b * c) * (b * c) = (b * c) * (c * b)  * (c * b):=
by conv { for (b * c) [2, 3] { rw mul_comm } }

example : (λ x : ℕ, 0 + x) = (λ x, x) :=
begin
  conv
  begin           -- | (λ (x : ℕ), 0 + x) = λ (x : ℕ), x
    to_lhs,       -- | λ (x : ℕ), 0 + x
    funext,       -- | 0 + x
    rw zero_add,  -- | x
  end
end

example : (λ x : ℕ, 0+x) = (λ x, x) :=
by funext ; rw zero_add


namespace chapter3

open nat
open classical
open set

-- Since sets are not exactly straightforward in type theory,
-- there will be some leniency with regards to the textbook
-- in order to define them type theoretically and
-- Lean's standard library will be employed
-- to express the properties of sets.
variable {α : Type}

-- "set" will be used instead
def d3_1_1 := α → Prop

-- sets are objects
theorem ax3_1 (A : set α) (B : set (set α)) : Prop := A ∈ B

-- should be the axiom of extensionality
def d3_1_4 {A B : set α} : A = B ↔ (∀ x : α, x ∈ A ↔ x ∈ B) :=
begin
    constructor,
    intro h,
        intro x,
        rw h,
    intro h,
        have : ∀ x, (x ∈ A) = (x ∈ B),
            intro x,
            exact iff.to_eq (h x),
        exact funext this
end

theorem ax3_2 {A : set α} : (∀ x : α, x ∉ A) → A = ∅ :=
begin
    intro h,
    apply iff.mpr d3_1_4,
    intro x,
    constructor,
    intro xa,
    have : x ∉ A, exact h x,
    contradiction,
    intro xe,
    exact false.elim xe
end

lemma l3_1_6 {A : set α} (h : A ≠ ∅) : ∃ x, x ∈ A :=
begin
    apply by_contradiction,
    intro nh,
    have : ∀ x, x ∉ A, from forall_not_of_not_exists nh,
    have : A = ∅, from ax3_2 this,
    contradiction
end

-- singleton set
theorem ax3_3a {y : α} {a : α} : y ∈ (singleton a : set α) ↔ y = a :=
begin
    constructor,
    intro ye,
        apply or.elim ye,
        exact id,
        assume (h : set.mem y ∅),
        exact false.elim h,
    intro ye,
        exact or.inl ye
end

-- pair set
theorem ax3_3b {y : α} {a : α} {b : α} : y ∈ (insert b (singleton a) : set α) ↔ y = a ∨ y = b :=
begin
    constructor,
    intro ye,
        apply or.elim ye,
        exact or.inr,
        intro ya,
        exact or.inl (ax3_3a.mp ya),
    intro ye,
        apply or.elim ye,
        intro ya,
        exact or.inr (ax3_3a.mpr ya),
        intro yb,
        exact or.inl yb
end

theorem ax3_4 {A B : set α} : ∀ x : α, x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B :=
begin
    intro x,
    constructor,
    exact id,
    exact id,
end

example : {1, 2} ∪ {2, 3} = ({1, 2, 3} : set ℕ) :=
--calc
--    {1, 2} ∪ {2, 3} = {x | x ∈ {1, 2} ∨ x ∈ {2, 3}} : rfl
--    ...             =

end chapter3


namespace hidden
inductive Natural
 | zero : Natural
 | succ : Natural -> Natural

open Natural

instance : has_zero Natural :=
{ zero := zero}

instance : has_one Natural :=
 { one := succ zero}

def add : Natural -> Natural -> Natural
 | a zero := a
 | a (succ b) := succ (add a b).

instance : has_add Natural :=
{ add := add }

def times : Natural -> Natural -> Natural
 | a zero := zero
 | a (succ b) := add (times a b) a

instance : has_mul Natural :=
{ mul := times}

def pow : Natural -> Natural -> Natural
 | a zero := (succ zero)
 | a (succ b) := times (pow a b) a

instance : has_pow Natural Natural :=
 { pow := pow}

theorem add_associativity (a b c : Natural) : (a + b) + c = a + (b + c) :=
Natural.rec_on c
(show (a + b) + 0 = a + (b + 0), from calc
      (a + b) + 0 = a + b : rfl
              ... = a + (b + 0) : rfl
)
(assume c, assume ih : (a + b) + c = a + (b + c),
 show (a + b) + (c + 1) = a + (b + (c + 1)), from calc
      (a + b) + (c + 1) = ((a + b) + c) + 1 : rfl
                    ... = (a + (b + c)) + 1 : by rw ih
                    ... = a + ((b + c) + 1) : rfl
                    ... = a + (b + (c + 1)) : rfl
)

lemma zero_commutativity (a : Natural) : a + 0 = 0 + a :=
Natural.rec_on a
(show zero + 0 = 0 + zero, from rfl
)
(assume a, assume ih : a + 0 = 0 + a,
 show (a + 1) + 0 = 0 + (a + 1), from calc
      (a + 1) + 0 = a + 1 : rfl
              ... = (a + 0) +1 : rfl
              ... = (0 + a) + 1 : by rw ih
              ... = 0 + (a + 1) : rfl
)

lemma one_commutativity (a : Natural) : a + 1 = 1 + a :=
Natural.rec_on a
(show (0 + 1 : Natural) = 1 + 0, by rw zero_commutativity)
(assume a, assume ih : a + 1 = 1 + a,
 show (a + 1) + 1 = 1 + (a + 1), from calc
      (a + 1) + 1 = (1 + a) + 1 : by rw ih
              ... = 1 + (a + 1) : rfl
)

theorem add_commutativity (a b : Natural) : a + b = b + a :=
Natural.rec_on b
(show (a + 0 : Natural) = 0 + a, by rw zero_commutativity)
(assume b, assume ih : a + b = b + a,
 show a + (b + 1) = (b + 1) + a, from calc
      a + (b + 1) = (a + b) + 1 : by rw add_associativity
              ... = (b + a) + 1 : by rw ih
              ... = b + (a + 1) : by rw add_associativity
              ... = b + (1 + a) : by rw one_commutativity
              ... = (b + 1) + a : by rw add_associativity
)

-- Question 1a
theorem left_distributivity (a b c : Natural) : a * (b + c) = a * b + a * c :=
Natural.rec_on c
(show a * (b + 0) = a * b + a * 0, from calc
      a * (b + 0) = a * b : rfl
              ... = a * b + 0 : rfl
              ... = a * b + a * 0 : rfl
)
(assume c, assume ih : a * (b + c) = a * b + a * c,
 show a * (b + (c + 1)) = a * b + a * (c + 1), from calc
      a * (b + (c + 1)) = a * ((b + c) + 1) : by rw add_associativity
                    ... = a * (b + c) + a : rfl
                    ... = (a * b + a * c) + a : by rw ih
                    ... = a * b + (a * c + a) : by rw add_associativity
                    ... = a * b + a * (c + 1) : rfl
)

lemma times_zero (a : Natural) : 0 * a = 0 :=
Natural.rec_on a
(show (0 * 0 : Natural) = 0, by refl)
(assume a, assume ih : 0 * a = 0,
 show 0 * (a + 1) = 0, from calc
      0 * (a + 1) = 0 * a + 0 * 1 : by rw left_distributivity
              ... = 0 + 0 * 1 : by rw ih
              ... = 0 + 0 : rfl
              ... = 0 : rfl
)

theorem right_distributivity (a b c : Natural) : (a + b) * c = a * c + b * c :=
Natural.rec_on c
(show (a + b) * 0 = a * 0 + b * 0, by refl)
(assume c, assume ih : (a + b) * c = a * c + b * c,
 show (a + b) * (c + 1) = a * (c + 1) + b * (c + 1), from calc
      (a + b) * (c + 1) = ((a + b) * c) + (a + b) : rfl
                    ... = (a * c + b * c) + (a + b) : by rw ih
                    ... = ((a * c + b * c) + a) + b : by rw ← add_associativity
                    ... = (a * c + (b * c + a)) + b : by rw ← add_associativity
                    ... = (a * c + (a + b * c)) + b : by rw add_commutativity (b * c)
                    ... = ((a * c + a) + b * c) + b : by rw ← add_associativity
                    ... = (a * c + a) + (b * c + b) : by rw ← add_associativity
                    ... = a * (c + 1) + b * (c + 1) : by refl
)

lemma right_times_one (a : Natural) : a * 1 = a :=
(show a * 1 = a, from calc
      a * 1 = a * 0 + a : rfl
        ... = 0 + a : rfl
        ... = a + 0 : by rw add_commutativity
        ... = a : rfl
)

lemma left_times_one (a : Natural) : 1 * a = a :=
Natural.rec_on a
(show (1 * 0 : Natural) = 0, by refl)
(assume a, assume ih : 1 * a = a,
 show 1 * (a + 1) = a + 1, from calc
      1 * (a + 1) = 1 * a + 1 : rfl
             ...  = a + 1 : by rw ih
)

-- Question 1b
theorem times_commutativity (a b : Natural) : a * b = b * a :=
Natural.rec_on b
(show a * 0 = 0 * a, from calc
      a * 0 = 0 : rfl
        ... = 0 * a : by rw times_zero
)
(assume b, assume ih : a * b = b * a,
 show a * (b + 1) = (b + 1) * a, from calc
      a * (b + 1) = a * b + a : rfl
              ... = b * a + a : by rw ih
              ... = a + b * a : by rw add_commutativity
              ... = 1 * a + b * a : by rw left_times_one
              ... = (1 + b) * a : by rw right_distributivity
              ... = (b + 1) * a : by rw add_commutativity
)

-- Question 1c
theorem times_associativity (a b c : Natural) : (a * b) * c = a * (b * c) :=
Natural.rec_on c
(show (a * b) * 0 = a * (b * 0), from calc
      (a * b) * 0 = 0 : rfl
              ... = a * 0 : rfl
              ... = a * (b * 0) : rfl
)
(assume c, assume ih : (a * b) * c = a * (b * c),
 show (a * b) * (c + 1) = a * (b * (c + 1)), from calc
      (a * b) * (c + 1) = (a * b) * c + a * b : rfl
                    ... = a * (b * c) + a * b : by rw ih
                    ... = a * ((b * c) + b) : by rw left_distributivity
                    ... = a * (b * (c + 1)) : rfl
)

end hidden


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
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from by auto [add_three, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_add_div_same, div_
end --Needs more than 2000 tokens!

--OUTPUT 2
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
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2), from by auto [add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add
end --Needs more than 2000 tokens!

--OUTPUT 3
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
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from by auto [add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_div, add_
end --Needs more than 2000 tokens!

/- 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
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  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
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = 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
  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⁻¹],

  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],

  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)-/


-- Interseccion_con_la_imagen.lean
-- Intersección con la imagen
-- José A. Alonso Jiménez
-- Sevilla, 19 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    (f '' s) ∩ v = f '' (s ∩ f ⁻¹' v)
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variable  s : set α
variable  v : set β

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

example : (f '' s) ∩ v = f '' (s ∩ f ⁻¹' v) :=
begin
  ext y,
  split,
  { intro hy,
    cases hy with hyfs yv,
    cases hyfs with x hx,
    cases hx with xs fxy,
    use x,
    split,
    { split,
      { exact xs, },
      { rw mem_preimage,
        rw fxy,
        exact yv, }},
    { exact fxy, }},
  { intro hy,
    cases hy with x hx,
    split,
    { use x,
      split,
      { exact hx.1.1, },
      { exact hx.2, }},
    { cases hx with hx1 fxy,
      rw ← fxy,
      rw ← mem_preimage,
      exact hx1.2, }},
end

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

example : (f '' s) ∩ v = f '' (s ∩ f ⁻¹' v) :=
begin
  ext y,
  split,
  { rintros ⟨⟨x, xs, fxy⟩, yv⟩,
    use x,
    split,
    { split,
      { exact xs, },
      { rw mem_preimage,
        rw fxy,
        exact yv, }},
    { exact fxy, }},
  { rintros ⟨x, ⟨xs, xv⟩, fxy⟩,
    split,
    { use [x, xs, fxy], },
    { rw ← fxy,
      rw ← mem_preimage,
      exact xv, }},
end

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

example : (f '' s) ∩ v = f '' (s ∩ f ⁻¹' v) :=
begin
  ext y,
  split,
  { rintros ⟨⟨x, xs, fxy⟩, yv⟩,
    finish, },
  { rintros ⟨x, ⟨xs, xv⟩, fxy⟩,
    finish, },
end

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

example : (f '' s) ∩ v = f '' (s ∩ f ⁻¹' v) :=
by ext ; split ; finish

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

example : (f '' s) ∩ v = f '' (s ∩ f ⁻¹' v) :=
by finish [ext_iff, iff_def]

-- 6ª demostración
-- ===============

example : (f '' s) ∩ v = f '' (s ∩ f ⁻¹' v) :=
(image_inter_preimage f s v).symm


-- M40002 (Analysis I) Chapter 5. Continuity

import M40002.M40002_C4
import data.polynomial

namespace M40002

-- Definition of limits of functions (f(x) → b as x → a)
def func_converges_to (f : ℝ → ℝ) (a b : ℝ) := ∀ ε > 0, ∃ δ > 0, ∀ x : ℝ, abs (x - a) < δ → abs (f x - b) < ε

-- Definition of continuity at a point
def func_continuous_at (f : ℝ → ℝ) (a : ℝ) := func_converges_to f a (f a)

-- Definition of a continuous function
def func_continuous (f : ℝ → ℝ) := ∀ a : ℝ, func_continuous_at f a

-- Defintion composition of functions and sequences for sequential continuity
def func_seq_comp (f : ℝ → ℝ) (s : ℕ → ℝ) (n : ℕ) := f (s n)

-- The definition for limits can have an alternative restriction of 0 < abs (x - a)
theorem func_continuous_at_to_pos (f : ℝ → ℝ) (a : ℝ) : func_continuous_at f a ↔ ∀ ε > 0, ∃ δ > 0, ∀ x : ℝ, 0 < abs (x - a) ∧ abs (x - a) < δ → abs (f x - f a) < ε :=
begin
	split,
		{intros hconv ε hε,
		rcases hconv ε hε with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
		use δ, use hδ₁,
		intros x hx,
		from hδ₂ x hx.right
		},
		{intros hconv ε hε,
		rcases hconv ε hε with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
		use δ, use hδ₁,
		intros x hx,
		cases lt_or_le 0 (abs (x - a)),
			from hδ₂ x ⟨h, hx⟩,
			have : x = a :=
				by {suffices : abs (x - a) = 0,
				from eq_of_abs_sub_eq_zero this,
				cases lt_or_eq_of_le h,
				rw ←not_le at h_1, exfalso,
				apply h_1, from abs_nonneg (x - a),
				assumption
				},
			rw this, simp,
			assumption
		}
end

-- Sequential continuity
lemma seq_contin_conv_lem {s : ℕ → ℝ} {a : ℝ} (h : ∀ n : ℕ, abs (s n - a) < 1 / (n + 1)) : s ⇒ a :=
begin
	intros ε hε,
	cases exists_nat_gt (1 / ε) with N₀ hN₀,
	let N : ℕ := max N₀ 1,
	have hN : 1 / ε < (N : ℝ) :=
		by {apply lt_of_lt_of_le hN₀,
		norm_cast, apply le_max_left
		},
	use N, intros n hn,
	apply lt_trans (h n),
	rw one_div_lt _ hε,
		{apply lt_trans hN,
		norm_cast, linarith},
		{norm_cast, linarith}
end

theorem lambda_rw (n : ℕ) (f : ℕ → ℝ) : (λ x : ℕ, f x) n = f n := by {rw eq_self_iff_true, trivial}

theorem seq_contin {f : ℝ → ℝ} {a b : ℝ} : (func_converges_to f a b) ↔ ∀ s : ℕ → ℝ, s ⇒ a → func_seq_comp f s ⇒ b :=
begin
    split,
        {intros h s hs ε hε,
        rcases h ε hε with ⟨δ, ⟨hδ, hr⟩⟩,
        cases hs δ hδ with N hN,
        use N, intros n hn,
        have : abs (s n - a) < δ := hN n hn,
        from hr (s n) this
        },
        {intros h,
        cases classical.em (func_converges_to f a b) with ha ha,
        from ha,
        unfold func_converges_to at ha,
        push_neg at ha,
        rcases ha with ⟨ε, ⟨hε, hδ⟩⟩,
		have hα : ∀ n : ℕ, 1 / ((n : ℝ) + 1) > 0 :=
			by {intro n, simp,
			norm_cast, from nat.zero_lt_one_add n},
		have hβ : ∀ n : ℕ, ∃ (x : ℝ), abs (x - a) < (1 / (n + 1)) ∧ ε ≤ abs (f x - b) := λ n, hδ (1 / (n + 1)) (hα n),
        let s : ℕ → ℝ := λ n : ℕ, classical.some (hβ n),
		have h₀ : s  = λ n : ℕ, classical.some (hβ n) := rfl,
		have hsn : ∀ n : ℕ, abs (s n - a) < 1 / ((n : ℝ) + 1) ∧ ε ≤ abs (func_seq_comp f s n - b) :=
			by {intro n, rw [h₀, lambda_rw n s],
			from classical.some_spec (hβ n)
			},
		have h₁ : s ⇒ a :=
			by {have : ∀ n : ℕ, abs (s n - a) < 1 / ((n : ℝ) + 1) :=
				by {intro n, from (hsn n).left},
			from seq_contin_conv_lem this
			},
        have h₂ : ¬ (func_seq_comp f s ⇒ b) :=
            by {unfold converges_to,
            push_neg, use ε,
            split, from hε,
            intro N, use N,
            split, from nat.le_refl N,
			from (hsn N).right
            },
		exfalso; from h₂ (h s h₁)
        }
end

-- Algebra of limits for functions
def func_add_func (f g : ℝ → ℝ) := λ r : ℝ, f r + g r
instance : has_add (ℝ → ℝ) := ⟨func_add_func⟩

theorem func_add_func_conv (f g : ℝ → ℝ) (a b₁ b₂) : func_converges_to f a b₁ ∧ func_converges_to g a b₂ → func_converges_to (f + g) a (b₁ + b₂) :=
begin
	rintro ⟨ha, hb⟩,
	rw seq_contin,
	intros s hs,
	have : func_seq_comp (f + g) s = seq_add_seq (func_seq_comp f s) (func_seq_comp g s) := rfl,
	rw this,
	apply add_lim_conv,
	from ⟨seq_contin.mp ha s hs, seq_contin.mp hb s hs⟩
end

theorem func_add_func_contin (f g : ℝ → ℝ) : func_continuous f ∧ func_continuous g → func_continuous (f + g) :=
begin
	rintros ⟨ha, hb⟩ a,
	apply func_add_func_conv,
	from ⟨ha a, hb a⟩
end

def func_mul_func (f g : ℝ → ℝ) := λ r : ℝ, f r * g r
notation f ` × ` g := func_mul_func f g

theorem func_mul_func_conv (f g : ℝ → ℝ) (a b₁ b₂) : func_converges_to f a b₁ ∧ func_converges_to g a b₂ → func_converges_to (f × g) a (b₁ * b₂) :=
begin
	rintro ⟨ha, hb⟩,
	rw seq_contin,
	intros s hs,
	have : func_seq_comp (f × g) s = seq_mul_seq (func_seq_comp f s) (func_seq_comp g s) := rfl,
	rw this,
	apply mul_lim_conv,
	from seq_contin.mp ha s hs,
	from seq_contin.mp hb s hs,
end

theorem func_mul_func_contin (f g : ℝ → ℝ) : func_continuous f ∧ func_continuous g → func_continuous (f × g) :=
begin
	rintros ⟨ha, hb⟩ a,
	apply func_mul_func_conv,
	from ⟨ha a, hb a⟩
end

noncomputable def func_div_func (f g : ℝ → ℝ) := λ r : ℝ, (f r) / (g r)
noncomputable instance func_div : has_div (ℝ → ℝ) := ⟨func_div_func⟩

theorem func_div_func_conv (f g : ℝ → ℝ) (a b₁ b₂) (h : b₂ ≠ 0) : func_converges_to f a b₁ ∧ func_converges_to g a b₂ → func_converges_to (f / g) a (b₁ / b₂) :=
begin
	rintro ⟨ha, hb⟩,
	rw seq_contin,
	intros s hs,
	have : func_seq_comp (f / g) s = seq_div_seq (func_seq_comp f s) (func_seq_comp g s) := rfl,
	rw this,
	apply div_lim_conv,
	from seq_contin.mp ha s hs,
	from seq_contin.mp hb s hs,
	norm_cast, assumption
end

theorem func_comp_func_conv (f g : ℝ → ℝ) (a b c : ℝ) : func_converges_to f a b ∧ func_converges_to g b c → func_converges_to (g ∘ f) a c :=
begin
	repeat {rw seq_contin},
	rintro ⟨ha, hb⟩,
	intros s hs,
	have : func_seq_comp (g ∘ f) s = func_seq_comp g (func_seq_comp f s) := rfl,
	rw this,
	apply hb (func_seq_comp f s),
	from ha s hs
end

theorem func_comp_func_contin (f g : ℝ → ℝ) : func_continuous f ∧ func_continuous g → func_continuous (g ∘ f) :=
begin
	repeat {unfold func_continuous},
	rintros ⟨ha, hb⟩ a,
	apply func_comp_func_conv,
	swap, from f a,
	from ⟨ha a, hb (f a)⟩
end

-- All polynomials and rational functions are continuous

lemma constant_contin (c : ℝ) : func_continuous (λ x : ℝ, c) :=
begin
	intros a ε hε,
	simp, use ε,
	from ⟨hε, λ x, λ hx, hε⟩
end

lemma x_contin : func_continuous (λ x : ℝ, x) :=
begin
	intros a ε hε,
	simp, use ε,
	from ⟨hε, λ x, λ hx, hx⟩
end

lemma xn_contin (n : ℕ) : func_continuous (λ x : ℝ, x ^ n) :=
begin
	induction n with k hk,
		{simp, from constant_contin (1 : ℝ)},
		{have : (λ (x : ℝ), x ^ nat.succ k) = func_mul_func (λ x : ℝ, x) (λ x : ℝ, x ^ k) := rfl,
		rw this,
		apply func_mul_func_contin,
		from ⟨x_contin, hk⟩
		}
end

theorem poly_contin {f : polynomial ℝ} : func_continuous (λ x, f.eval x) :=
begin
	apply polynomial.induction_on f,
		{intro a, simp,
		from constant_contin a
		},
		{intros p q hp hq, simp,
		apply func_add_func_contin (λ x : ℝ, polynomial.eval x p) (λ x : ℝ, polynomial.eval x q),
		from ⟨hp, hq⟩
		},
		simp,
		intros n a hcon,
		apply func_mul_func_contin,
		from ⟨constant_contin a, xn_contin (n + 1)⟩
end

-- Intermediate Value Theorem
theorem intermediate_value {f : ℝ → ℝ} {a b : ℝ} (h₀ : a ≤ b) (h₁ : func_continuous f) : ∀ y : ℝ, f a ≤ y ∧ y ≤ f b → ∃ c : ℝ, a ≤ c ∧ c ≤ b ∧ f c = y :=
begin
	rintros y ⟨hy₁, hy₂⟩,
	cases eq_or_lt_of_le hy₁ with heq hlt₀,
		{use a, split, linarith,
		rw heq, from ⟨h₀, refl y⟩
		},
		{cases eq_or_lt_of_le hy₂ with heq hlt₁,
			{use b, split, linarith,
			rw heq, from ⟨le_refl b, refl (f b)⟩
			},
		clear hy₁ hy₂,
		let S : set ℝ := {d : ℝ | a ≤ d ∧ d ≤ b ∧ f d < y},
		have hbdd : bounded_above S :=
			by {use b, intros s hs,
			rw set.mem_set_of_eq at hs,
			from hs.right.left
			},
		have hnempty : S ≠ ∅ :=
			by {dsimp, rw set.not_eq_empty_iff_exists,
			use a, rw set.mem_set_of_eq,
			from ⟨le_refl a, h₀, hlt₀⟩
			},
		cases completeness S hbdd hnempty with M hM,
		use M, split,
			apply hM.left a,
			rw set.mem_set_of_eq,
			from ⟨le_refl a, h₀, hlt₀⟩,
		split,
			unfold sup at hM,
			have hα : upper_bound S b :=
				by {intros s hs,
				rw set.mem_set_of_eq at hs,
				from hs.right.left
				},
			cases le_or_lt M b with hβ hγ,
				from hβ,
				exfalso; from (hM.right b hγ) hα,
		rw le_antisymm_iff,
		split,
			{apply classical.by_contradiction,
			push_neg, intro h,
			have : ∃ ε : ℝ, ε = f M - y ∧ 0 < ε :=
				by {use f M - y,
				split, refl,
				linarith
				},
			cases this with ε hε,
			rcases h₁ M ε hε.right with ⟨δ, ⟨hδ, hhδ⟩⟩,
			rw hε.left at hhδ,
			have : ∀ (x : ℝ), abs (x - M) < δ → - (f M - y) < f x - f M ∧ f x - f M < f M - y :=
				by {intros x hx,
				apply abs_lt.mp,
				from hhδ x hx},
			simp at this,
			replace this : ∀ (x : ℝ), abs (x - M) < δ → x ∉ S :=
				by {intros x hx hS,
				rw set.mem_set_of_eq at hS,
				apply asymm (hS.right.right),
				from (this x hx).left
				},
			replace this : upper_bound S (M - δ) :=
				by {intros s hs,
				cases lt_or_le s (M - δ),
					{from le_of_lt h_1},
					{cases lt_or_eq_of_le h_1,
					swap, linarith,
					have hkt : abs (s - M) < δ :=
						by {rw abs_lt,
						split, linarith,
						rw sub_lt_iff_lt_add,
						apply lt_of_le_of_lt (hM.left s hs),
						linarith
						},
					exfalso,
					from (this s hkt) hs
					}
				},
			have hfa : M - δ < M :=
				by {linarith},
			from (hM.right (M - δ) hfa) this
			},

			{have hα : upper_bound S b :=
				by {intros s hs,
				rw set.mem_set_of_eq at hs,
				from hs.right.left
				},
			have hβ : M ≤ b := by {rw ←not_lt, intro hγ, from hM.right b hγ hα},
			cases lt_or_eq_of_le hβ,
			swap, rw h, from le_of_lt hlt₁,

			apply classical.by_contradiction,
			push_neg, intro h,
			have : ∃ ε : ℝ, ε = y - f M ∧ 0 < ε :=
				by {use y - f M,
				split, refl,
				linarith
				},
			cases this with ε hε,
			rcases h₁ M ε hε.right with ⟨δ, ⟨hδ, hhδ⟩⟩,
			rw hε.left at hhδ,
			have : abs (M + (δ / 2) - M) < δ :=
				by {simp,
				rw abs_of_pos (half_pos hδ),
				linarith
				},
			replace this : abs (M + min (δ / 2) ((b - M) / 2) - M) < δ :=
				by {apply lt_of_le_of_lt _ this,
				rw add_comm, simp,
				have hpos : 0 < min (δ / 2) ((b + -M) / 2) :=
					by {simp, split,
					from half_pos hδ,
					linarith
					},
				rw [abs_of_pos hpos, abs_of_pos (half_pos hδ)],
				from min_le_left (δ / 2) ((b - M) / 2),
				},
			replace this : abs (f (M + min (δ / 2) ((b - M) / 2)) - f M) < y - f M :=
				by {from hhδ (M + min (δ / 2) ((b - M) / 2)) this},
			rw abs_lt at this,
			cases this with h₃ h₄,
			simp at h₄,
			have h₅ : M < M + min (δ / 2) ((b + -M) / 2) :=
				by {simp, split,
				from half_pos hδ,
				linarith
				},
			have h₆ : M + min (δ / 2) ((b + -M) / 2) ∈ S :=
				by {rw set.mem_set_of_eq,
				split, apply le_of_lt (lt_of_le_of_lt _ h₅),
				have : a ∈ S := by {rw set.mem_set_of_eq, from ⟨le_refl a, h₀, hlt₀⟩},
				from hM.left a this,
				split,
				cases le_or_lt (δ / 2) ((b + -M) / 2),
					rw min_eq_left h_1,
					suffices : (δ / 2) < b + -M, linarith,
					apply lt_of_le_of_lt h_1, linarith,
					rw min_eq_right (le_of_lt h_1),
					linarith,
					from h₄
				},
			have h₇ : ¬ upper_bound S M :=
				by {unfold upper_bound,
				push_neg,
				use (M + min (δ / 2) ((b + -M) / 2)),
				from ⟨h₆, h₅⟩
				},
			from h₇ hM.left
			}
		}
end

def func_bounded_above {S : set ℝ} (f : S → ℝ) := bounded_above {t : ℝ | ∀ x : S, t = f x}
def func_bounded_below {S : set ℝ} (f : S → ℝ) := bounded_below {t : ℝ | ∀ x : S, t = f x}

-- TODO Extreme value theorem

def closed_interval (a b : ℝ) := {x : ℝ | a ≤ x ∧ x ≤ b}

lemma mem_of_closed_interval {a b x : ℝ} : x ∈ closed_interval a b ↔ a ≤ x ∧ x ≤ b :=
by {unfold closed_interval, rw set.mem_set_of_eq}

lemma abs_le_closed_interval {x y δ : ℝ} : y ∈ closed_interval (x - δ) (x + δ) ↔ abs (y - x) ≤ δ :=
begin
	unfold closed_interval,
	rw [set.mem_set_of_eq, abs_le],
	split, repeat {rintro ⟨hα, hβ⟩, split, repeat {linarith}}
end

def open_interval (a b : ℝ) := {x : ℝ | a < x ∧ x < b}

lemma mem_of_open_interval {a b x : ℝ} : x ∈ open_interval a b ↔ a < x ∧ x < b :=
by {unfold open_interval, rw set.mem_set_of_eq}

lemma abs_lt_open_interval {x y δ : ℝ} : y ∈ open_interval (x - δ) (x + δ) ↔ abs (y - x) < δ :=
begin
	unfold open_interval,
	rw [set.mem_set_of_eq, abs_lt],
	split, repeat {rintro ⟨hα, hβ⟩, split, repeat {linarith}}
end

-- Defining open and closed sets
def is_open (S : set ℝ) := ∀ x ∈ S, ∃ δ > 0, open_interval (x - δ) (x + δ) ⊆ S
def is_closed (S : set ℝ) := ∀ a : ℕ → ℝ, seq_in a S → (∃ l : ℝ, a ⇒ l) → ∃ l ∈ S, a ⇒ l

def is_compact (S : set ℝ) := is_closed S ∧ bounded S

-- An open interval is open
theorem open_interval_is_open (a b : ℝ) : is_open (open_interval a b) :=
begin
	unfold open_interval,
	intros x hx,
	have hδ : 0 < min (x - a) (b - x) :=
		by {apply lt_min_iff.mpr,
		rw set.mem_set_of_eq at hx,
		cases hx with ha hb,
		split, repeat {linarith},
		},
	use min (x - a) (b - x), use hδ,
	unfold open_interval,
	intros y hy,
	rw set.mem_set_of_eq at hy,
	rw set.mem_set_of_eq,
	cases hy with hy₁ hy₂,
	split,
		{apply lt_of_le_of_lt _ hy₁,
		have : min (x - a) (b - x) ≤ x - a := min_le_left (x - a) (b - x),
		linarith
		},
		{apply lt_of_lt_of_le hy₂,
		have : min (x - a) (b - x) ≤ b - x := min_le_right (x - a) (b - x),
		linarith
		}
end

-- A closed interval is compact
theorem closed_interval_is_compact (a b : ℝ) : is_compact (closed_interval a b) :=
begin
	split,
		{unfold is_closed,
		rintros s ha ⟨l, hl⟩,
		use l,
		have h : l ∈ closed_interval a b :=
			by{unfold closed_interval,
			rw set.mem_set_of_eq,
			split,
				{let c : ℕ → ℝ := λ n : ℕ, a,
				have : c ⇒ a := cons_conv,
				apply le_lim c s a l,
				repeat {assumption},
				intro n,
				show a ≤ s n,
				suffices : s n ∈ closed_interval a b,
					unfold closed_interval at this,
					rw set.mem_set_of_eq at this,
					from this.left,
				from ha n
				},
				{let c : ℕ → ℝ := λ n : ℕ, b,
				have : c ⇒ b := cons_conv,
				apply le_lim s c l b,
				repeat {assumption},
				intro n,
				show s n ≤ b,
				suffices : s n ∈ closed_interval a b,
					unfold closed_interval at this,
					rw set.mem_set_of_eq at this,
					from this.right,
				from ha n
				}
			},
		use h, assumption
		},
		{split,
			{use b, intro s,
			unfold closed_interval,
			rw set.mem_set_of_eq,
			intro h, from h.right
			},
			{use a, intro s,
			unfold closed_interval,
			rw set.mem_set_of_eq,
			intro h, from h.left
			}
		}
end

-- The union of open sets is also open
theorem two_union_open_is_open {S T : set ℝ} (h₁ : is_open S) (h₂ : is_open T) : is_open (S ∪ T) :=
begin
	intros x hx,
	rw (set.mem_union x S T) at hx,
	cases hx,
		{rcases (h₁ x hx) with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
		use δ, use hδ₁,
		intros a ha, left,
		from hδ₂ ha
		},
		{rcases (h₂ x hx) with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
		use δ, use hδ₁,
		intros a ha, right,
		from hδ₂ ha
		}
end

-- The empty set is open
theorem empty_open : is_open ∅ :=
begin
	intros x hx,
	exfalso, from hx
end

-- The union of a collection of open sets is also open
theorem union_open_is_open {I : Type} {S : I → set ℝ} (h₁ : ∀ i : I, is_open (S i)) : is_open ⋃ i : I, S i :=
begin
	intros x hx,
	rw set.mem_Union at hx,
	cases hx with i hi,
	have h₂ : is_open (S i) := h₁ i,
	unfold is_open at h₂,
	have h₃ : S i ⊆ ⋃ (i : I), S i := set.subset_Union S i,
	rcases h₂ x hi with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
	use δ, use hδ₁,
	from set.subset.trans hδ₂ h₃
end

lemma element_of_Inter {S : ℕ → set ℝ} {n i : ℕ} : ∀ x ∈ ⋂ i ∈ finset.range n, S i, i ∈ finset.range n → x ∈ S i :=
by {intros x hx hi, rw set.mem_Inter at hx, finish}

lemma comp_open_to_closed {S : set ℝ} : is_open S → is_closed (-S) :=
begin
	intro hopen,
	rintros a x ⟨l, hl⟩,
	use l,
	have : l ∈ -S :=
		by {intro hS,
		rcases hopen l hS with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
		cases hl δ hδ₁ with N hN,
		apply x N,
		suffices : a N ∈ open_interval (l - δ) (l + δ),
			from hδ₂ this,
		rw abs_lt_open_interval,
		apply hN N (le_refl N)
		},
	use this, assumption
end

lemma lt_ε_ge_zero {N : ℕ} {ε : ℝ} (h : 0 < ε) : 1 / ε < N → 1 / (N : ℝ) < ε :=
by {intro hα,
	have hβ : 0 < N, cases lt_or_le 0 N, assumption,
	exfalso, apply not_le.mpr h,
	suffices : 1 / ε ≤ 0, simp only [one_div_eq_inv, inv_nonpos] at this, assumption,
	apply le_of_lt, apply lt_of_lt_of_le hα, norm_cast, assumption,

	rw [div_lt_iff, mul_comm], rwa div_lt_iff at hα,
	assumption, norm_cast, assumption
}

lemma comp_closed_to_open {S : set ℝ} : is_closed S → is_open (-S) :=
begin
	intros hclosed x hx,
	apply classical.by_contradiction,
	push_neg,
	intro hnopen,
	have : ∀ n : ℕ, ∃ s ∈ open_interval (x - (1 / (n + 1))) (x + (1 / (n + 1))), s ∈ S :=
		by {intros n,
		apply classical.by_contradiction,
		push_neg,
		intro h,
		suffices : open_interval (x - (1 / (n + 1))) (x + (1 / (n + 1))) ⊆ -S,
			from hnopen (1 / (n + 1)) nat.one_div_pos_of_nat this,
		intros s hs,
		from h s hs
		},
	simp only [classical.skolem] at this,
	rcases this with ⟨t, ht₁, ht₂⟩,
	have ht : t ⇒ x :=
		by {intros ε hε,
		cases exists_nat_gt (1 / ε) with N hN,
		use N, intros n hn,
		rw ←abs_lt_open_interval,
		suffices : open_interval  (x - 1 / (n + 1)) (x + 1 / (n + 1)) ⊆ open_interval (x - ε) (x + ε),
			apply this, from ht₁ n,
		unfold open_interval,
		simp only [set.set_of_subset_set_of],
		rintros a ⟨hα, hβ⟩,
		split,
			apply lt_trans _ hα, swap,
			apply lt_trans hβ,
			all_goals {
				simp only [neg_lt_neg_iff, add_lt_add_iff_left, sub_eq_add_neg],
				apply lt_trans _ ((lt_ε_ge_zero hε) hN),
				have hγ : 0 < (N : ℝ), norm_cast,
					cases lt_or_le 0 N, assumption,
					exfalso, apply not_le.mpr hε,
					suffices : 1 / ε ≤ 0, simp only [one_div_eq_inv, inv_nonpos] at this, assumption,
					apply le_of_lt, apply lt_of_lt_of_le hN, norm_cast, assumption,
				have : 0 < (n : ℝ) + 1,
					norm_cast, norm_cast at hγ,
					apply lt_trans hγ,
					apply lt_of_le_of_lt hn, linarith,
				rw (one_div_lt_one_div this hγ), norm_cast, linarith
			}
		},
	unfold is_closed at hclosed,
	have hseqin : seq_in t S :=
		by {intro n, from ht₂ n},
	have hcontra : ∃ (l : ℝ) (H : l ∈ S), t ⇒ l :=
		by {apply hclosed t hseqin,
		use x, assumption},
	rcases hcontra with ⟨l, ⟨hl₁, hl₂⟩⟩,
	have hleqx : l = x := unique_lim t l x hl₂ ht,
	apply hx, rwa ←hleqx
end

theorem comp_open_iff_closed {S : set ℝ} : is_open S ↔ is_closed (-S) :=
begin
	split,
		from comp_open_to_closed,
		have h₁ : (- -S) = S := by {simp},
		have h₂ : (- - -S) = -S :=by {simp},
		rw [←h₁, h₂],
		from comp_closed_to_open
end

-- A function f : ℝ → ℝ is continuous iff. ∀ U ⊆ R, f⁻¹(U) is open
theorem contin_open_pre_image {f : ℝ → ℝ} : func_continuous f ↔ ∀ U : set ℝ, is_open U → is_open {x : ℝ | f x ∈ U} :=
begin
	split,
		{intros h₁ U hU x hx,
		have hf : f x ∈ U := by {rw set.mem_set_of_eq at hx, assumption},
		rcases hU (f x) hf with ⟨ε, ⟨hε, hrang⟩⟩,
		rcases h₁ x ε hε with ⟨δ, ⟨hδ, hcontin⟩⟩,
		use δ, use hδ,
		intros y hy,
		rw set.mem_set_of_eq,
		rw abs_lt_open_interval at hy,
		suffices : f y ∈ open_interval (f x - ε) (f x + ε),
			from hrang this,
		rw abs_lt_open_interval,
		from hcontin y hy
		},
		{intros hU y ε hε,
		let U : set ℝ := open_interval (f y - ε) (f y + ε),
		have : f y ∈ U := by {rw abs_lt_open_interval, simpa},
		rcases hU U (open_interval_is_open (f y - ε) (f y + ε)) y this with ⟨δ, ⟨hδ, hrang⟩⟩,
		use δ, use hδ,
		intros x hx,
		rw ←abs_lt_open_interval at hx,
		rw ←abs_lt_open_interval,
		suffices : x ∈ {x : ℝ | f x ∈ U},
			rw set.mem_set_of_eq at this,
			assumption,
		from hrang hx
		}
end

-- a n → l iff ∀ U ⊆ ℝ, U an open set, l ∈ U ⇒ ∃ N ∈ ℕ, ∀ n ≥ N, a n ∈ U (Unseen 2 Term 2)
lemma seq_converge_imples_all_open {a : ℕ → ℝ} {l : ℝ} : a ⇒ l → ∀ U : set ℝ, is_open U ∧ l ∈ U → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → (a n) ∈ U :=
begin
	rintros hconv U ⟨hU, hlU⟩,
	rcases hU l hlU with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
	cases hconv δ hδ₁ with N hN,
	use N, intros n hn,
	suffices : a n ∈ open_interval (l - δ) (l + δ),
		from hδ₂ this,
	rw abs_lt_open_interval,
	from hN n hn
end

lemma all_open_imples_seq_converge {a : ℕ → ℝ} {l : ℝ} : (∀ U : set ℝ, is_open U ∧ l ∈ U → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → (a n) ∈ U) → a ⇒ l :=
begin
	intros hU ε hε,
	let U : set ℝ := open_interval (l - ε) (l + ε),
	have hopen : is_open U :=
		by {apply open_interval_is_open},
	have hlU : l ∈ open_interval (l - ε) (l + ε) :=
		by {unfold open_interval,
			rw set.mem_set_of_eq,
			split, all_goals {linarith},
		},
	cases hU U ⟨hopen, hlU⟩ with N hN,
	use N, intros n hn,
	rw ←abs_lt_open_interval,
	from hN n hn
end

theorem seq_converge_iff_all_open {a : ℕ → ℝ} {l : ℝ} : a ⇒ l ↔ ∀ U : set ℝ, is_open U ∧ l ∈ U → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → (a n) ∈ U :=
by {split, all_goals {try {from seq_converge_imples_all_open <|> from all_open_imples_seq_converge}}}

-- Uniform continuity and convergence
def unif_contin (f : ℝ → ℝ) := ∀ ε > 0, ∃ δ > 0, ∀ x y : ℝ, abs (x - y) < δ → abs (f x - f y) < ε

-- Uniformly continuous implies continuous (hence is stronger)
theorem unif_contin_implies_contin {f : ℝ → ℝ} : unif_contin f → func_continuous f :=
begin
	intros h₁ a ε hε,
	rcases h₁ ε hε with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
	use δ, use hδ₁, intro x,
	from hδ₂ x a
end

-- Uniformly continuous functions will map a Cauchy sequence to another Cauchy sequence
theorem unif_contin_map_cauchy {f : ℝ → ℝ} {a : ℕ → ℝ} (h : unif_contin f) : cauchy a → cauchy (λ n : ℕ, f (a n)) :=
begin
	intros hcauchy ε hε,
	rcases h ε hε with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
	cases hcauchy δ hδ₁ with N hN,
	use N,
	intros n m hnm,
	show abs (f (a n) - f (a m)) < ε,
	convert hδ₂ (a n) (a m) _,
	from hN n m hnm
end

def func_pointwise_converge_to (f : ℕ → ℝ → ℝ) (g : ℝ → ℝ) := ∀ x : ℝ, ∀ ε > 0, ∃ N : ℕ, ∀ n : ℕ, N ≤ n → abs (f n x - g x) < ε
def func_converge_uniform (f : ℕ → ℝ → ℝ) (g : ℝ → ℝ) := ∀ ε > 0, ∃ N : ℕ, ∀ x : ℝ, ∀ n : ℕ, N ≤ n → abs (f n x - g x) < ε

-- function.swap swaps
-- f: ℕ → ℝ → ℝ = fₙ(x)

-- If a sequence of uniformly continuous functions fₙ converges to f, then f is uniformly continuous
theorem unif_contin_lim_unif_contin (f : ℕ → ℝ → ℝ) (g : ℝ → ℝ) (h : ∀ n : ℕ, unif_contin (f n)) : func_converge_uniform f g → unif_contin g :=
begin
	intros h₁ ε hε,
	have  hε₂: 0 < ε / 3 := by linarith,
	cases h₁ (ε / 3) hε₂ with N hN,
	rcases h N (ε / 3) hε₂ with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
	use δ, use hδ₁,
	intros x y hxy,
	suffices : abs (g x -f N x) + abs (f N x - f N y) + abs (f N y - g y) < ε,
		{apply lt_of_le_of_lt _ this,
		 convert le_trans (abs_add (g x - f N y) (f N y - g y)) _, simp,
		 apply add_le_add_right',
		 convert abs_add (g x - f N x) (f N x - f N y),
		 simp
		},
	have : ε = ε / 3 + ε / 3 + ε / 3 := by {linarith},
	rw this,
	repeat {apply add_lt_add},
		{rw abs_sub,
		from hN x N (le_refl N)},
		{from hδ₂ x y hxy},
		{from hN y N (le_refl N)}
end

-- A similar but weaker proposition than the above: If a sequence of continuous functions fₙ converges to f, then f is continuous
theorem contin_lim_contin (f : ℕ → ℝ → ℝ) (g : ℝ → ℝ) (h : ∀ n : ℕ, func_continuous (f n)) : func_converge_uniform f g → func_continuous g :=
begin
	intros h₁ y ε hε,
	have hε₂ : 0 < ε / 3 := by linarith,
	cases h₁ (ε / 3) hε₂ with N hN,
	rcases h N y (ε / 3) hε₂ with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
	use δ, use hδ₁,
	intros x hxy,
	suffices : abs (g x -f N x) + abs (f N x - f N y) + abs (f N y - g y) < ε,
		{apply lt_of_le_of_lt _ this,
		 convert le_trans (abs_add (g x - f N y) (f N y - g y)) _, simp,
		 apply add_le_add_right',
		 convert abs_add (g x - f N x) (f N x - f N y),
		 simp
		},
	have : ε = ε / 3 + ε / 3 + ε / 3 := by {linarith},
	rw this,
	repeat {apply add_lt_add},
		{rw abs_sub,
		from hN x N (le_refl N)},
		{from hδ₂ x hxy},
		{from hN y N (le_refl N)}
end

-- TODO: define sum of functions and prove Weierstrass M-test

end M40002


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si 0 < 0, entonces a > 37 para cualquier
-- número a.
-- ----------------------------------------------------------------------

variable a : ℕ

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

example
  (h : 0 < 0)
  : a > 37 :=
begin
  exfalso,
  apply lt_irrefl 0 h,
end

-- Prueba
-- ======

/-
a : ℕ,
h : 0 < 0
⊢ a > 37
  >> exfalso,
a : ℕ,
h : 0 < 0
⊢ false
  >> apply lt_irrefl 0 h,
no goals
-/

-- Comentario: La táctica exfalso sustituye el objetivo por false.

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

example
  (h : 0 < 0)
  : a > 37 :=
absurd h (lt_irrefl 0)

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

example
  (h : 0 < 0)
  : a > 37 :=
begin
  have h' : ¬ 0 < 0,
    from lt_irrefl 0,
  contradiction,
end

-- Prueba
-- ======

/-
a : ℕ,
h : 0 < 0
⊢ a > 37
  >> have h' : ¬ 0 < 0,
  >>   from lt_irrefl 0,
h' : ¬0 < 0
⊢ a > 37
  >> contradiction,
no goals
-/

-- Comentario: La táctica contradiction busca dos hipótesis
-- contradictorias.


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

import algebra.polynomial.big_operators
import data.nat.choose.cast
import data.nat.choose.vandermonde
import data.polynomial.derivative

/-!
# Hasse derivative of polynomials

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

The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It is a variant of the usual derivative, and satisfies `k! * (hasse_deriv k f) = derivative^[k] f`.
The main benefit is that is gives an atomic way of talking about expressions such as
`(derivative^[k] f).eval r / k!`, that occur in Taylor expansions, for example.

## Main declarations

In the following, we write `D k` for the `k`-th Hasse derivative `hasse_deriv k`.

* `polynomial.hasse_deriv`: the `k`-th Hasse derivative of a polynomial
* `polynomial.hasse_deriv_zero`: the `0`th Hasse derivative is the identity
* `polynomial.hasse_deriv_one`: the `1`st Hasse derivative is the usual derivative
* `polynomial.factorial_smul_hasse_deriv`: the identity `k! • (D k f) = derivative^[k] f`
* `polynomial.hasse_deriv_comp`: the identity `(D k).comp (D l) = (k+l).choose k • D (k+l)`
* `polynomial.hasse_deriv_mul`:
  the "Leibniz rule" `D k (f * g) = ∑ ij in antidiagonal k, D ij.1 f * D ij.2 g`

For the identity principle, see `polynomial.eq_zero_of_hasse_deriv_eq_zero`
in `data/polynomial/taylor.lean`.

## Reference

https://math.fontein.de/2009/08/12/the-hasse-derivative/

-/

noncomputable theory

namespace polynomial

open_locale nat big_operators polynomial
open function nat (hiding nsmul_eq_mul)

variables {R : Type*} [semiring R] (k : ℕ) (f : R[X])

/-- The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It satisfies `k! * (hasse_deriv k f) = derivative^[k] f`. -/
def hasse_deriv (k : ℕ) : R[X] →ₗ[R] R[X] :=
lsum (λ i, (monomial (i-k)) ∘ₗ distrib_mul_action.to_linear_map R R (i.choose k))

lemma hasse_deriv_apply :
  hasse_deriv k f = f.sum (λ i r, monomial (i - k) (↑(i.choose k) * r)) :=
by simpa only [← nsmul_eq_mul]

lemma hasse_deriv_coeff (n : ℕ) :
  (hasse_deriv k f).coeff n = (n + k).choose k * f.coeff (n + k) :=
begin
  rw [hasse_deriv_apply, coeff_sum, sum_def, finset.sum_eq_single (n + k), coeff_monomial],
  { simp only [if_true, add_tsub_cancel_right, eq_self_iff_true], },
  { intros i hi hink,
    rw [coeff_monomial],
    by_cases hik : i < k,
    { simp only [nat.choose_eq_zero_of_lt hik, if_t_t, nat.cast_zero, zero_mul], },
    { push_neg at hik, rw if_neg, contrapose! hink,
      exact (tsub_eq_iff_eq_add_of_le hik).mp hink, } },
  { intro h, simp only [not_mem_support_iff.mp h, monomial_zero_right, mul_zero, coeff_zero] }
end

lemma hasse_deriv_zero' : hasse_deriv 0 f = f :=
by simp only [hasse_deriv_apply, tsub_zero, nat.choose_zero_right,
  nat.cast_one, one_mul, sum_monomial_eq]

@[simp] lemma hasse_deriv_zero : @hasse_deriv R _ 0 = linear_map.id :=
linear_map.ext $ hasse_deriv_zero'

lemma hasse_deriv_eq_zero_of_lt_nat_degree (p : R[X]) (n : ℕ)
  (h : p.nat_degree < n) : hasse_deriv n p = 0 :=
begin
  rw [hasse_deriv_apply, sum_def],
  refine finset.sum_eq_zero (λ x hx, _),
  simp [nat.choose_eq_zero_of_lt ((le_nat_degree_of_mem_supp _ hx).trans_lt h)]
end

lemma hasse_deriv_one' : hasse_deriv 1 f = derivative f :=
by simp only [hasse_deriv_apply, derivative_apply, ← C_mul_X_pow_eq_monomial, nat.choose_one_right,
    (nat.cast_commute _ _).eq]

@[simp] lemma hasse_deriv_one : @hasse_deriv R _ 1 = derivative :=
linear_map.ext $ hasse_deriv_one'

@[simp] lemma hasse_deriv_monomial (n : ℕ) (r : R) :
  hasse_deriv k (monomial n r) = monomial (n - k) (↑(n.choose k) * r) :=
begin
  ext i,
  simp only [hasse_deriv_coeff, coeff_monomial],
  by_cases hnik : n = i + k,
  { rw [if_pos hnik, if_pos, ← hnik], apply tsub_eq_of_eq_add_rev, rwa add_comm },
  { rw [if_neg hnik, mul_zero],
    by_cases hkn : k ≤ n,
    { rw [← tsub_eq_iff_eq_add_of_le hkn] at hnik, rw [if_neg hnik] },
    { push_neg at hkn, rw [nat.choose_eq_zero_of_lt hkn, nat.cast_zero, zero_mul, if_t_t] } }
end

lemma hasse_deriv_C (r : R) (hk : 0 < k) : hasse_deriv k (C r) = 0 :=
by rw [← monomial_zero_left, hasse_deriv_monomial, nat.choose_eq_zero_of_lt hk,
    nat.cast_zero, zero_mul, monomial_zero_right]

lemma hasse_deriv_apply_one (hk : 0 < k) : hasse_deriv k (1 : R[X]) = 0 :=
by rw [← C_1, hasse_deriv_C k _ hk]

lemma hasse_deriv_X (hk : 1 < k) : hasse_deriv k (X : R[X]) = 0 :=
by rw [← monomial_one_one_eq_X, hasse_deriv_monomial, nat.choose_eq_zero_of_lt hk,
    nat.cast_zero, zero_mul, monomial_zero_right]

lemma factorial_smul_hasse_deriv :
  ⇑(k! • @hasse_deriv R _ k) = ((@derivative R _)^[k]) :=
begin
  induction k with k ih,
  { rw [hasse_deriv_zero, factorial_zero, iterate_zero, one_smul, linear_map.id_coe], },
  ext f n : 2,
  rw [iterate_succ_apply', ← ih],
  simp only [linear_map.smul_apply, coeff_smul, linear_map.map_smul_of_tower, coeff_derivative,
    hasse_deriv_coeff, ← @choose_symm_add _ k],
  simp only [nsmul_eq_mul, factorial_succ, mul_assoc, succ_eq_add_one, ← add_assoc,
    add_right_comm n 1 k, ← cast_succ],
  rw ← (cast_commute (n+1) (f.coeff (n + k + 1))).eq,
  simp only [← mul_assoc], norm_cast, congr' 2,
  apply @cast_injective ℚ,
  have h1 : n + 1 ≤ n + k + 1 := succ_le_succ le_self_add,
  have h2 : k + 1 ≤ n + k + 1 := succ_le_succ le_add_self,
  have H : ∀ (n : ℕ), (n! : ℚ) ≠ 0, { exact_mod_cast factorial_ne_zero },
  -- why can't `field_simp` help me here?
  simp only [cast_mul, cast_choose ℚ, h1, h2, -one_div, -mul_eq_zero,
    succ_sub_succ_eq_sub, add_tsub_cancel_right, add_tsub_cancel_left] with field_simps,
  rw [eq_div_iff_mul_eq (mul_ne_zero (H _) (H _)), eq_comm, div_mul_eq_mul_div,
    eq_div_iff_mul_eq (mul_ne_zero (H _) (H _))],
  norm_cast,
  simp only [factorial_succ, succ_eq_add_one], ring,
end

lemma hasse_deriv_comp (k l : ℕ) :
  (@hasse_deriv R _ k).comp (hasse_deriv l) = (k+l).choose k • hasse_deriv (k+l) :=
begin
  ext i : 2,
  simp only [linear_map.smul_apply, comp_app, linear_map.coe_comp, smul_monomial,
    hasse_deriv_apply, mul_one, monomial_eq_zero_iff, sum_monomial_index, mul_zero,
    ← tsub_add_eq_tsub_tsub, add_comm l k],
  rw_mod_cast nsmul_eq_mul,
  congr' 2,
  by_cases hikl : i < k + l,
  { rw [choose_eq_zero_of_lt hikl, mul_zero],
    by_cases hil : i < l,
    { rw [choose_eq_zero_of_lt hil, mul_zero] },
    { push_neg at hil, rw [← tsub_lt_iff_right hil] at hikl,
      rw [choose_eq_zero_of_lt hikl , zero_mul], }, },
  push_neg at hikl, apply @cast_injective ℚ,
  have h1 : l ≤ i     := le_of_add_le_right hikl,
  have h2 : k ≤ i - l := le_tsub_of_add_le_right hikl,
  have h3 : k ≤ k + l := le_self_add,
  have H : ∀ (n : ℕ), (n! : ℚ) ≠ 0, { exact_mod_cast factorial_ne_zero },
  -- why can't `field_simp` help me here?
  simp only [cast_mul, cast_choose ℚ, h1, h2, h3, hikl, -one_div, -mul_eq_zero,
    succ_sub_succ_eq_sub, add_tsub_cancel_right, add_tsub_cancel_left] with field_simps,
  rw [eq_div_iff_mul_eq, eq_comm, div_mul_eq_mul_div, eq_div_iff_mul_eq, ← tsub_add_eq_tsub_tsub,
    add_comm l k],
  { ring, },
  all_goals { apply_rules [mul_ne_zero, H] }
end

lemma nat_degree_hasse_deriv_le (p : R[X]) (n : ℕ) :
  nat_degree (hasse_deriv n p) ≤ nat_degree p - n :=
begin
  classical,
  rw [hasse_deriv_apply, sum_def],
  refine (nat_degree_sum_le _ _).trans _,
  simp_rw [function.comp, nat_degree_monomial],
  rw [finset.fold_ite, finset.fold_const],
  { simp only [if_t_t, max_eq_right, zero_le', finset.fold_max_le, true_and, and_imp,
               tsub_le_iff_right, mem_support_iff, ne.def, finset.mem_filter],
    intros x hx hx',
    have hxp : x ≤ p.nat_degree := le_nat_degree_of_ne_zero hx,
    have hxn : n ≤ x,
    { contrapose! hx',
      simp [nat.choose_eq_zero_of_lt hx'] },
    rwa [tsub_add_cancel_of_le (hxn.trans hxp)] },
  { simp }
end

lemma nat_degree_hasse_deriv [no_zero_smul_divisors ℕ R] (p : R[X]) (n : ℕ) :
  nat_degree (hasse_deriv n p) = nat_degree p - n :=
begin
  cases lt_or_le p.nat_degree n with hn hn,
  { simpa [hasse_deriv_eq_zero_of_lt_nat_degree, hn] using (tsub_eq_zero_of_le hn.le).symm },
  { refine map_nat_degree_eq_sub _ _,
    { exact λ h, hasse_deriv_eq_zero_of_lt_nat_degree _ _ },
    { classical,
      simp only [ite_eq_right_iff, ne.def, nat_degree_monomial, hasse_deriv_monomial],
      intros k c c0 hh,
      -- this is where we use the `smul_eq_zero` from `no_zero_smul_divisors`
      rw [←nsmul_eq_mul, smul_eq_zero, nat.choose_eq_zero_iff] at hh,
      exact (tsub_eq_zero_of_le (or.resolve_right hh c0).le).symm } }
end

section
open add_monoid_hom finset.nat

lemma hasse_deriv_mul (f g : R[X]) :
  hasse_deriv k (f * g) = ∑ ij in antidiagonal k, hasse_deriv ij.1 f * hasse_deriv ij.2 g :=
begin
  let D := λ k, (@hasse_deriv R _ k).to_add_monoid_hom,
  let Φ := @add_monoid_hom.mul R[X] _,
  show (comp_hom (D k)).comp Φ f g =
    ∑ (ij : ℕ × ℕ) in antidiagonal k, ((comp_hom.comp ((comp_hom Φ) (D ij.1))).flip (D ij.2) f) g,
  simp only [← finset_sum_apply],
  congr' 2, clear f g,
  ext m r n s : 4,
  simp only [finset_sum_apply, coe_mul_left, coe_comp, flip_apply, comp_app,
    hasse_deriv_monomial, linear_map.to_add_monoid_hom_coe, comp_hom_apply_apply, coe_mul,
    monomial_mul_monomial],
  have aux : ∀ (x : ℕ × ℕ), x ∈ antidiagonal k →
    monomial (m - x.1 + (n - x.2)) (↑(m.choose x.1) * r * (↑(n.choose x.2) * s)) =
    monomial (m + n - k) (↑(m.choose x.1) * ↑(n.choose x.2) * (r * s)),
  { intros x hx, rw [finset.nat.mem_antidiagonal] at hx, subst hx,
    by_cases hm : m < x.1,
    { simp only [nat.choose_eq_zero_of_lt hm, nat.cast_zero, zero_mul, monomial_zero_right], },
    by_cases hn : n < x.2,
    { simp only [nat.choose_eq_zero_of_lt hn, nat.cast_zero,
        zero_mul, mul_zero, monomial_zero_right], },
    push_neg at hm hn,
    rw [tsub_add_eq_add_tsub hm, ← add_tsub_assoc_of_le hn, ← tsub_add_eq_tsub_tsub,
      add_comm x.2 x.1, mul_assoc, ← mul_assoc r, ← (nat.cast_commute _ r).eq, mul_assoc,
      mul_assoc], },
  conv_rhs { apply_congr, skip, rw aux _ H, },
  rw_mod_cast [← linear_map.map_sum, ← finset.sum_mul, ← nat.add_choose_eq],
end

end

end polynomial


/-
Copyright (c) 2021 Alex Zhao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Zhao
-/
import data.nat.modeq
import group_theory.submonoid.basic
import group_theory.submonoid.membership
import tactic.ring
import tactic.zify

/-!
# Frobenius Number in Two Variables

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

In this file we first define a predicate for Frobenius numbers, then solve the 2-variable variant
of this problem.

## Theorem Statement

Given a finite set of relatively prime integers all greater than 1, their Frobenius number is the
largest positive integer that cannot be expressed as a sum of nonnegative multiples of these
integers. Here we show the Frobenius number of two relatively prime integers `m` and `n` greater
than 1 is `m * n - m - n`. This result is also known as the Chicken McNugget Theorem.

## Implementation Notes

First we define Frobenius numbers in general using `is_greatest` and `add_submonoid.closure`. Then
we proceed to compute the Frobenius number of `m` and `n`.

For the upper bound, we begin with an auxiliary lemma showing `m * n` is not attainable, then show
`m * n - m - n` is not attainable. Then for the construction, we create a `k_1` which is `k mod n`
and `0 mod m`, then show it is at most `k`. Then `k_1` is a multiple of `m`, so `(k-k_1)`
is a multiple of n, and we're done.

## Tags

frobenius number, chicken mcnugget, chinese remainder theorem, add_submonoid.closure
-/

open nat

/-- A natural number `n` is the **Frobenius number** of a set of natural numbers `s` if it is an
upper bound on the complement of the additive submonoid generated by `s`.
In other words, it is the largest number that can not be expressed as a sum of numbers in `s`. -/
def is_frobenius_number (n : ℕ) (s : set ℕ) : Prop :=
is_greatest {k | k ∉ add_submonoid.closure (s)} n

variables {m n : ℕ}

/-- The **Chicken Mcnugget theorem** stating that the Frobenius number
  of positive numbers `m` and `n` is `m * n - m - n`. -/
theorem is_frobenius_number_pair (cop : coprime m n) (hm : 1 < m) (hn : 1 < n) :
  is_frobenius_number (m * n - m - n) {m, n} :=
begin
  simp_rw [is_frobenius_number, add_submonoid.mem_closure_pair],
  have hmn : m + n ≤ m * n := add_le_mul hm hn,
  split,
  { push_neg,
    intros a b h,
    apply cop.mul_add_mul_ne_mul (add_one_ne_zero a) (add_one_ne_zero b),
    simp only [nat.sub_sub, smul_eq_mul] at h, zify at h ⊢,
    rw [← sub_eq_zero] at h ⊢, rw ← h,
    ring, },
  { intros k hk, dsimp at hk, contrapose! hk,
    let x := chinese_remainder cop 0 k,
    have hx : x.val < m * n := chinese_remainder_lt_mul cop 0 k (ne_bot_of_gt hm) (ne_bot_of_gt hn),
    suffices key : x.1 ≤ k,
    { obtain ⟨a, ha⟩ := modeq_zero_iff_dvd.mp x.2.1,
      obtain ⟨b, hb⟩ := (modeq_iff_dvd' key).mp x.2.2,
      exact ⟨a, b, by rw [mul_comm, ←ha, mul_comm, ←hb, nat.add_sub_of_le key]⟩, },
    refine modeq.le_of_lt_add x.2.2 (lt_of_le_of_lt _ (add_lt_add_right hk n)),
    rw nat.sub_add_cancel (le_tsub_of_add_le_left hmn),
    exact modeq.le_of_lt_add
      (x.2.1.trans (modeq_zero_iff_dvd.mpr (nat.dvd_sub' (dvd_mul_right m n) dvd_rfl)).symm)
      (lt_of_lt_of_le hx le_tsub_add), },
end


/-
An axiom is an assumed proof of a
given proposition. For example, we
accept as an *axiom* that there is
a proof that equality is reflexive.
refl : ∀ {α : Type} (a : α), a = a.

Natural deduction is a system of
reasoning rules for deducing proofs
of more complex propositions from
axioms.

What we are doing in class now is
to implement (or at least to see
how an implementation is given in
the Lean libraries) of the syntax
of predicate logic and the rules
of natural deduction.

For example, we implement the usual
and connective of predicate logic as
a polymorphic proposition : one with
two propositions as type arguments
(remember, propositions are types in
the logic of Lean).

inductive and (P Q : Prop) : Prop

The single intro constructor of this
polymorphic proposition provides the
axiom that explains how to deduce a
proof of P ∧ Q: apply "intro" to two
arguments, one a proof of P and one
a proof of Q.

While the introduction axioms of natural
deduction explain how to construct (or
deduce) proofs of more complex propositions,
elimination rules tell us how we can "take
apart" proofs to access the elements from
which they were constructed. These elements
are often proofs themselves.

For example, a proof of P ∧ Q is "built"
from a proof of P and a proof of Q, and
the "and elimination rules" give us ways
to extract these "smaller" proofs from a
larger proof of P ∧ Q. In this way, these
elimination rules extend our ability to
deduce consequences: e.g., P ∧ Q → P.

Each form of proposition has its own
introduction and elimination rules. The
syntax of the predicate logic of everyday mathematics defines propositions formed
using the following connectives and
quantifiers. It is your taks to learn
the introduction and elimination rules
for each one, and to be able to use them
in constructing and using proofs, both
formal and expressed in natural language.

∀
→
∧
↔
=
¬
∨
∃

In the rest of this document, we succinctly
summarize these rules. We give examples of
how to use such rule. We give each example
in three forms: as a proof term, as a proof
script, and as a natural language proof.
-/

/-
We start by assuming (as axioms) that P
and Q are arbitrary propositions. This
allows us not to have to introduce them
as assumptions in each of the examples.

For example, instead of writing

∀ (P Q : Prop), P ∧ Q → P, we can now
just write P ∧ Q → P, because P and Q
are already assumed to be propositions
(terms of type Prop in Lean).
-/

axioms P Q : Prop

/-
With this presentation easing trick out
of the way, we now proceed to discuss each
connective and quantifier and its rules of
inference (introduction, elimination rules).
-/

/- *** FORALL *** -/

/-
Here's the form of a universal generalization.
It asserts that if one is given any proof of P,
then there is a proof of Q.
-/
def univeral_generalization := ∀ (p : P), Q

/-
To prove a proposition of this form, we first
*assume* that we're given an arbitarary but
specific proof of (value of type) P, and in
that context, our remaining goal is to build
a proof of Q. Here we don't know in detail
what proposition Q is, so we can't complete
the proof; but nevertheless, as far as it
goes, the proof fully illustrates how one
uses the "forall introduction" rule.
-/
example : univeral_generalization :=
λ p,
_

/-
As a proof script.
-/
example : univeral_generalization :=
begin
unfold univeral_generalization,
/-
The unfold tactic replaces an identifier
with the value to which it's bound. In this
case, it helps us to see more clearly what
is to be proved. Surprisingly, what is to
be proved is an implication: P → Q. A key
insight is that P → Q is just a shorthand
for ∀ (p : P), Q! What is to be shown is
that *if* one is given *any* proof of P,
then one can always construct a proof of
Q. Now one proceeds to use the introduction
rule for →: assume that one is given a
proof of P, and the remaining goal is to
show Q.
-/
assume (p : P),
/-
The show tactic simply documents in a
proof script what remains to be done:
in this case, to produce a proof (we
can give it a name, here q) of Q.
-/
show (q : Q),
/-
And once again, we can make no further
progress, so we just leave the proof
unfinished. Note: no use can be made
of an unfinished proof; if we finish
a proof with "sorry", we're telling
Lean to accept the proposition as true
without proof, i.e., as an axiom. We
do not wish to do that here, so we just
leave the proof unfinished.
-/
_,
end

/-
As a final comment, we emphasize that
the proceeding example shows how we
can approach the construction of a proof
in a step by step way

(1) Ask what is the syntactic form of
proposition to be proved. Here the
answer is "it's a ∀ proposition, i.e.,
a universal generalization.
(2) Ask what introduction "rules" can be
used to construct such a proof. For ∀
there is only one: ∀ introduction.
(3) Apply the rule. In this case, what
that means is that we need to show that
if we assume we're given any proof of
P, we can always create a proof of Q.
We do this by defining a function with
one argument, an *assumed* proof of P.
What remains to be proved is that, in
this context, a term of type Q, that
is, a proof of Q, can be produced.
In developing proofs incrementally,
we often leave a "hole" for such a
term. This hole represents "the rest"
of what needs to be given to have a
complete proof: here what's left to
prove is Q.
-/

/-
Finally, here's a natural language proof.

-/

/- *** ∀ elimination *** -/

/-
If we know that *any* ball is blue, and
we know that b is a specific ball, then
we know that b is blue.
-/

Moreover, a proof of ∀ (p : P), Q
is effectively, and can be applied
as a function to any proof of P to
construct a proof of Q.
-/

example :

    (∀ (p : P), Q) → P → Q
    :=
λ (a : (∀ (p : P), Q)),
    λ (p : P),
        _

example : (∀ (p : P), Q) → P → Q :=
begin
    assume (f : ∀ (p : P), Q),
    assume p,
    exact f p
end

/-
In English. If P and Q are arbitrary
propositions, (∀ (p : P), Q) → P → Q.
To prove it, assume there are proofs
of both (∀ (p : P), Q) and of P. Apply
the former to the latter to derive a
proof of Q.

-/

/-  *** → introduction ***

Arrow introduction is identical to
∀ introduction: assume the premise.
Then what remains to be proved, in
that context, is the conclusion. →
introduction *is* ∀ introduction:
assume that values of specified
argument/premise types are given.
-/

example : P → Q :=
    λ (p : P),      -- assume P
        _           -- show Q

example : P → Q :=
begin
assume (p : P),     -- assume P
_                   -- show Q
end

/-
In English, given propositions P and
Q, show P → Q. To start we assume P.
In this context we produce a proof of
Q. [There are not enough details about
either P or Q to complete the proof,
but the step taken (assume P then
show Q) illustrates → introduction].
-/

/-
   *** →  elimination ***

Arrow elimination is application:
Given a proof of P → Q (which we
can treat as a function of this
type, that converts proofs of P
into proofs of Q), we can *use*
the proof of P → Q  by *applying*
it to to any proof of P. The result
is a proof of Q.

In the following exmples, we just
replace the ∀ notation from the two
preceding examples of ∀ elimination
with → notation. Compare the examples
carefully.
-/

example :
    (P → Q) →
    P →
    Q :=
λ (f : ∀ (p : P), Q), -- proof of ∀
    λ (p : P),        -- proof of P
        _        -- ∀ elimination

example : (P → Q) → P → Q :=
begin
    assume (f : ∀ (p : P), Q),
    assume p,
    exact (f p)
end

/-
In English. Assume P and Q are arbitrary
propositions and whow (P → Q) → P → Q.

Proof: Assume P → Q and assume P. Deduce
Q by applying P → Q to P to obtain Q. QED.
-/

/- *** ∧ introduction ***

The ∧ connective is defined as an inductive
logical type that is polymorphic, taking two
propositions (call them P and Q) as arguments
yielding the proposition, P ∧ Q. It provides
one proof constructor, in Lean called intro
(and.intro), of type P → Q → P ∧ Q. Given a
proof, p, of P, and a proof, q, of Q, it
constructs the term (and.intro p q), which
is accepted as being of type P ∧ Q, and so
to be a proof of this proposition.
-/

example : P → Q → P ∧ Q :=
λ (p : P),
    λ (q : Q),
        and.intro p q

example : P → Q → P ∧ Q :=
begin
    assume (p : P) (q : Q),
    exact (and.intro p q),
end

/-
In Enslish. Assume P and Q are arbitrary
propositions and show that P → Q → P ∧ Q.

Proof: Assuming P and Q are true and apply
and introduction to deduce P ∧ Q.
-/

/- *** ∧ elimination ***

One should note that the definition
of the logical connective, and, is
the analog, for logical types, of the
product type (Prod, in lean) of pairs
of values of the given types (proofs
of) P and Q.

The elimination rules for ∧ are then
just the analogs of the "projection"
functions for a given pair, by which
its component values can be extracted.
-/

example : (P ∧ Q) → P :=
λ (h : P ∧ Q),  -- given proof of P∧Q
    and.elim_left h -- return Q proof

example : (P ∧ Q) → P :=
begin
    assume h,
    exact h.left
end

/-
In English. Assume P and Q are arbitrary
propostions and show (P ∧ Q) → P.

Proof: This is done by the applying the
left elimination rule of natural deduction
to (P ∧ Q). QED.
-/

/- *** = introduction ***

= is a polymorphic binary relation, on
objects of any type. It is formalized in
Lean as the inductive type, eq, which
takes on type argument, implicitly.

The rule for constructing a proof of
an equality proposition is that for
any value, a, of any type, α, a = a.
This is the introduction rule for =.
It is a universal generalization. To
obtain a proof of equality for any
specific values, one *applies* it to
one of those values. As long as the
two values really are equal, such a
proof is a proof that they are equal.
-/

example : 1 + 3 = 5 - 1 := eq.refl 4

/-
In English: We start by simplifying
each side of the equality proposition.
The result is 4 = 4. This is true by
application of the reflexive property
of equality to the specific value, 4.
-/

/- *** = elimination ***

We have not yet discussed = elimination.

If one has values a and b of a type, T,
and proofs of (1) a = b, and of (2)
"L a", where L is any predicate, of
type P → Prop, then one uses equality
elimination to deduce "L b" from "L a".

As an example, if Bill likes coffee
(LC Bill), and if Bill = Bob, then Bob
likes coffee (LC Bob).
-/

axiom L : P → Prop  -- assume predicate L

example : ∀ (a b : P), a = b → (L a → L b) :=
λ (a0 b0 : P),
λ (ab : a0 = b0),
λ (l : L a0),
(eq.subst ab l)

/-
    λ a b,  -- assume a and b are values of P
    λ heq,  -- assume a proof of a = b
    λ la,   -- assume a proof of (L a)
    (eq.subst heq la) -- deduce proof of (L b)
-/

/-
The comments give a concise English language
proof. Citing the substitution rule for equality
on the last line would make the proof clearer.
-/

example : ∀ (a b : P), a = b → (L a → L b) :=
begin
    assume a b,
    assume heq,
    assume la,
    rewrite <- heq,  -- change b to a in goal
    exact la,
end

/-
The eq.subst rule allows one to substitute
equals for equals in propositions without
changing their meaning. So, again, if Bill
likes coffee (LC Bill), and if Bill = Bob,
then it must be Bob likes coffee (LC Bob).
-/

/- *** Putting it all together ***

Proofs are constructed by composing these
introduction and elimination rules. Often
one needs both kinds of rules to complete
a proof. As an example, consider proving
P ∧ Q → Q ∧ P. To do so, we assume that
P ∧ Q is true. From that assumption we
deduce that P is true and Q is true. We
then apply the rule of and introduction
to the derived proofs of Q and P, in that
order, to complete the overall proof.
We thus show that *if* P ∧ Q is true,
for any propositions P, Q, then Q ∧ P
is true. The proof uses the introduction
rule for →, the left and right elimination
rules for ∧, and the introduction rule for
∧ to put it all together. Here are formal
versions, first as a proof term and then
using a tactic script to build that proof
term.
-/

example : P ∧ Q → Q ∧ P :=
λ (pq : P ∧ Q),     -- assume proof P ∧ Q
    and.intro       -- apply and.intro to
        pq.right    -- proof of Q
        pq.left     -- proof of P

example : P ∧ Q → Q ∧ P :=
begin
    assume pq,
    apply and.intro,    -- introduction
    exact pq.right,     -- elimination
    exact pq.left,      -- elimination
end

/-
In English: Let P and Q be arbitrary
propositions [∀ intro]. Show that
P ∧ Q → Q ∧ P. To do so, assume P ∧ Q
[→ intro]. From this assumption,
deduce P and Q,respectively [∧ elim].
Finally, deduce Q ∧ P [∧ intro].
-/

/-
Here's a slightly more complex example,
in which a proof of (Q → R) is *applied*
to an argument (a proof of Q) to obtain
a proof of R. Proof construction is pure
functional programming!
-/

example : (P ∧ Q) ∧ (Q → R) → R :=
    λ h,                -- assume premise
        h.right         -- apply func : Q → R
        h.left.right    -- to proof of Q
                        -- to get proof of R

-- As a tactic script
example : (P ∧ Q) ∧ (Q → R) → R :=
begin
assume h : (P ∧ Q) ∧ (Q → R),
exact (h.right) (h.left.right),
end

-- Same, named intermediate results
example : (P ∧ Q) ∧ (Q → R) → R :=
begin
assume h : (P ∧ Q) ∧ (Q → R),
have qr : Q → R := h.right,
have q : Q := h.left.right,
exact (qr q),
end

-- Same, with type inference
example : (P ∧ Q) ∧ (Q → R) → R :=
begin
assume h,
have qr := h.right,
have q := h.left.right,
exact (qr q),
end

/-
In English: Suppose P and Q are
propositions. Show that (P ∧ Q) ∧
(Q → R) → R. To start, suppose
(P ∧ Q) ∧ (Q → R) [→ intro]. Deduce
Q from the left conjunct and Q → R
from the right [and elim]. Apply
the latter to the former [→ elim]
to deduce R. QED.
-/

/-
A good practice for the exam would be
to prove, in Lean, each of the inference
rules that we validated in propositional
logic. You are prepared to this for the
rules that do NOT involve exists or not.
For ↔, use iff.intro and iff.elim_left
and iff.elim_right as if they were the
rules for and intro and elimination but
with proofs of implications as arguments.
-/

#check @iff.intro
#check @iff.elim_left
#check @iff.elim_right

/-
What does it mean, ¬ P?
-/

/-
Meet "false".
-/

def f : false := _

def weird (f : false) : 0 = 1 :=
    false.elim f

example : false → 0 = 1 :=
λ f, false.elim f

example : ¬ P :=
λ (p : P), _

example : P → ¬ P → false :=
λ (p : P),
λ (np : ¬ P),
_

theorem proof_by_negation : ¬P :=
λ (p : P), _

/-

¬ P ==== P →

-/