import .love02_backward_proofs_demo

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

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Connectives and Quantifiers

1.1. Carry out the following proofs using basic tactics.

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

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

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

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
begin
  intros,
  apply a_1 a_3 a_2,
end

lemma proj_1st (a : Prop) :
  a → a → a :=
begin
  intros,
  apply a_1,
end

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

lemma proj_2nd (a : Prop) :
  a → a → a :=
begin
  intros,
  apply a_2,
end

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
begin
  intros,
  apply a_1 a_2 a_4,
end
/-! 1.2. Prove the contraposition rule using basic tactics. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
begin
  intros,
  apply not.intro,
  intro,
  apply a_2,
  apply a_1 a_3,
end
/-! 1.3. Prove the distributivity of `∀` over `∧` using basic tactics.

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

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

/-! ## Question 2: Natural Numbers

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

#check mul

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

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

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

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
begin
  induction m,
  { simp[mul_zero, mul] },
  {
    simp [mul_succ, m_ih, add, add_succ, mul, mul_zero, add_assoc, mul_add],
    cc
  },
end

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

lemma add_mul (l m n : ℕ) :
  mul (add l m) n = add (mul n l) (mul n m) :=
begin
  induction l,
  {
    simp [add_zero, mul, mul_comm],
  },
  {
    rw mul_comm (add l_n.succ m) n,
    apply mul_add,
  },
end

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
begin
  induction l,
  { simp[mul_zero, mul] },
  {
    simp [mul_succ],
    rw <- l_ih,
    rw mul_comm (mul l_n m) n,
    rw mul_comm m n,
    rw add_mul (mul l_n m),
  },
end

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

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

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

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

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

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

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

Hint: You will need `or.elim` and `false.elim`. You can use
`simp [excluded_middle, peirce]` to unfold the definitions of `excluded_middle`
and `peirce`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
sorry

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

lemma dn_of_peirce :
  peirce → double_negation :=
sorry

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

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end LoVe


import Mathlib.Tactic.Basic
import Mathlib.Tactic.Cases
import Mathlib.Init.Data.Nat.Basic
/-!
## Structural Recursion

_Structural recursion_ is a form of recursion that allows us to peel off one constructor from the
value on which we recurse. The factorial function below is structurally recursive:
-/
def fact : ℕ → ℕ
| 0 => 0
| (n + 1) => (n + 1) * fact n
/-!
The constructor we peel off here is `Nat.succ` (written `+ 1`). Such functions are guaranteed to
call themselves only finitely many times before the recursion stops; for example, `fact 12345` will
call itself 12345 times. This is a prerequisite for establishing that the function terminates, an
important property to ensure both logical consistency and termination of evaluation.

With structural recursion, there are as many equations as there are constructors. Novices are often
tempted to supply additional, redundant cases, as in the following example:
-/
def fact₁ : ℕ → ℕ
| 0 => 0
| 1 => 1
| (n + 1) => (n + 1) * fact n
/-!
It is in your own best interest to resist this temptation. The more cases you have in your
definitions, the more work it will be to reason about them. Keep in mind the saying that one good
definition is worth three theorems.

For structurally recursive functions, Lean can automatically prove termination. For more general
recursive schemes, the termination check may fail. Sometimes it does so for a good reason, as in the
following example:

```lean
def illegal : ℕ → ℕ
| n => illegal n + 1

-- fails saying: fail to show termination for `illegal`
```
If Lean were to accept this definition, we could exploit it to prove that `0 = 1`, by subtracting
`illegal n` on each side of the equation `illegal n = illegal n + 1`. From `0 = 1`, we could derive `false`,
and from `false`, we could derive anything, including the three-color theorem. Clearly, we do not want
that.

If we had used a variable and axiom, nothing could have saved us:
-/
def immoral (x : ℕ) : ℕ := x + 1

axiom immoral_eq (n : ℕ) : immoral n = immoral n + 1

lemma proof_of_false :
false := by
  have h1 : immoral 0 = immoral 0 + 1 := immoral_eq 0
  simp [h1] at *

/-!
Another reason for preferring `def` is that the defining equations are used to compute. Tactics such
as `rfl` that unify up to computation become stronger each time we introduce a definition, and the
diagnosis commands `#eval` and `#reduce` can be used on defined constants.

The observant reader will have noticed that the above definitions of factorial are mathematically
wrong: `fact` shockingly returns `0` regardless of the argument, and `fact₂ 0` should give `1`, not
`0`. We quite literally facted up. These embarrassing mistakes remind us to test our definitions and
prove some properties about them. Although flawed axioms arise now and then, what is much more
common are definitions that fail to capture the intended concepts. Just because a function is called
`fact` does not mean that it actually computes factorials.
-/


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebraic_geometry.prime_spectrum.basic
import ring_theory.polynomial.basic
/-!
The morphism `Spec R[x] --> Spec R` induced by the natural inclusion `R --> R[x]` is an open map.

The main result is the first part of the statement of Lemma 00FB in the Stacks Project.

https://stacks.math.columbia.edu/tag/00FB
-/

open ideal polynomial prime_spectrum set
open_locale polynomial

namespace algebraic_geometry

namespace polynomial

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

/-- Given a polynomial `f ∈ R[x]`, `image_of_Df` is the subset of `Spec R` where at least one
of the coefficients of `f` does not vanish.  Lemma `image_of_Df_eq_comap_C_compl_zero_locus`
proves that `image_of_Df` is the image of `(zero_locus {f})ᶜ` under the morphism
`comap C : Spec R[x] → Spec R`. -/
def image_of_Df (f) : set (prime_spectrum R) :=
  {p : prime_spectrum R | ∃ i : ℕ , (coeff f i) ∉ p.as_ideal}

lemma is_open_image_of_Df : is_open (image_of_Df f) :=
begin
  rw [image_of_Df, set_of_exists (λ i (x : prime_spectrum R), coeff f i ∉ x.as_ideal)],
  exact is_open_Union (λ i, is_open_basic_open),
end

/-- If a point of `Spec R[x]` is not contained in the vanishing set of `f`, then its image in
`Spec R` is contained in the open set where at least one of the coefficients of `f` is non-zero.
This lemma is a reformulation of `exists_C_coeff_not_mem`. -/
lemma comap_C_mem_image_of_Df {I : prime_spectrum R[X]}
  (H : I ∈ (zero_locus {f} : set (prime_spectrum R[X]))ᶜ ) :
  prime_spectrum.comap (polynomial.C : R →+* R[X]) I ∈ image_of_Df f :=
exists_C_coeff_not_mem (mem_compl_zero_locus_iff_not_mem.mp H)

/-- The open set `image_of_Df f` coincides with the image of `basic_open f` under the
morphism `C⁺ : Spec R[x] → Spec R`. -/
lemma image_of_Df_eq_comap_C_compl_zero_locus :
  image_of_Df f = prime_spectrum.comap (C : R →+* R[X]) '' (zero_locus {f})ᶜ :=
begin
  ext x,
  refine ⟨λ hx, ⟨⟨map C x.as_ideal, (is_prime_map_C_of_is_prime x.is_prime)⟩, ⟨_, _⟩⟩, _⟩,
  { rw [mem_compl_iff, mem_zero_locus, singleton_subset_iff],
    cases hx with i hi,
    exact λ a, hi (mem_map_C_iff.mp a i) },
  { ext x,
    refine ⟨λ h, _, λ h, subset_span (mem_image_of_mem C.1 h)⟩,
    rw ← @coeff_C_zero R x _,
    exact mem_map_C_iff.mp h 0 },
  { rintro ⟨xli, complement, rfl⟩,
    exact comap_C_mem_image_of_Df complement }
end

/--  The morphism `C⁺ : Spec R[x] → Spec R` is open.
Stacks Project "Lemma 00FB", first part.

https://stacks.math.columbia.edu/tag/00FB
-/
theorem is_open_map_comap_C :
  is_open_map (prime_spectrum.comap (C : R →+* R[X])) :=
begin
  rintros U ⟨s, z⟩,
  rw [← compl_compl U, ← z, ← Union_of_singleton_coe s, zero_locus_Union, compl_Inter, image_Union],
  simp_rw [← image_of_Df_eq_comap_C_compl_zero_locus],
  exact is_open_Union (λ f, is_open_image_of_Df),
end

end polynomial

end algebraic_geometry


import analysis.real tactic.norm_num algebra.group_power

theorem Q5a1 (S : set ℝ) : (∃ x : ℝ, x ∈ lower_bounds S)
    ↔ (∃ y : ℝ, y ∈ upper_bounds {t : ℝ | ∃ s ∈ S, t = -s }) :=
begin
split,
{ intros H,
  cases H with x Hx,
  existsi (-x),
  intro w,
  have Hmw := Hx (-w),
  intro Hw,
  cases Hw with t Ht,
  cases Ht with u Hu,
  refine le_neg_of_le_neg _,
  apply Hmw _,
  rw [Hu],
  rwa neg_neg },
{ intros H,
  cases H with y Hy,
  existsi (-y),
  intro mt,
  have Ht := Hy (-mt),
  intro Hmt,
  refine neg_le_of_neg_le _,
  apply Ht _,
  existsi mt,
  existsi Hmt,
  refl
}
end

theorem Q5a2 (S : set ℝ) (x : ℝ) : is_glb S x ↔
    is_lub {t : ℝ | ∃ s ∈ S, t = -s} (-x) :=
begin
split,
{ intro HSx,
  split,
  { intros ms Hms,
    refine le_neg_of_le_neg _,
    refine HSx.left _ _,
    cases Hms with s Hs,
    cases Hs with H1 H2,
    rw H2,
    rwa neg_neg },
  { intros b Hb,
    apply neg_le_of_neg_le _,
    apply HSx.2 (-b),
    intros c Hc,
    apply neg_le_of_neg_le _,
    apply Hb (-c),
    existsi c,
    existsi Hc,
    refl },
},
{ intro HSx,
  split,
  { intros ms Hms,
    refine le_of_neg_le_neg _,
    refine HSx.left _ _,
    existsi [ms,Hms],
    refl },
  { intros b Hb,
    apply le_of_neg_le_neg _,
    apply HSx.2 (-b),
    intros c Hc,
    cases Hc with mc Hmc,
    cases Hmc with H1 H2,
    apply le_neg_of_le_neg _,
    apply Hb (-c),
    rw H2,
    rwa neg_neg },
},
end

lemma Q5bhelper (S : set ℝ) (x₁ x₂ : ℝ) : is_glb S x₁ ∧ is_glb S x₂ → x₁ ≤ x₂ :=
begin
intro H,
have Hglb1 := H.left,
have Hlb1 := Hglb1.left,
have Hglb2 := H.right,
have H1 := Hglb2.right,
exact H1 _ Hlb1,
end

theorem Q5b (S : set ℝ) (x₁ x₂ : ℝ) : is_glb S x₁ ∧ is_glb S x₂ → x₁ = x₂ :=
begin
intro H,
have H1 := Q5bhelper _ _ _ H,
have H2 := Q5bhelper _ _ _ ⟨H.right,H.left⟩,
--exact eq_iff_le_and_le. 2 ⟨H1,H2⟩,
-- TODO : did this used to work? What do I do now??
exact le_antisymm H1 H2,
end

theorem Q5c :  (∀ S : set ℝ, (∃ w : ℝ, w ∈ S) → (∃ x : ℝ, x ∈ upper_bounds S) → ∃ y : ℝ, is_lub S y)
   →   (∀ T : set ℝ, (∃ w₁ : ℝ, w₁ ∈ T) → (∃ x₁ : ℝ, x₁ ∈ lower_bounds T) → ∃ y₁ : ℝ, is_glb T y₁) :=
begin
intro H,
intro T,
have H1 := H {x : ℝ | ∃ y : ℝ, y ∈ T ∧ x = -y},
clear H,
intro J2,
cases J2 with w2 Jw2,
have H2 := H1 _,
{ intro J3,
  clear H1,
  cases J3 with w3 Jw3,
  have H3 := H2 _,
  { clear H2,
    cases H3 with y3 Hy3,
    existsi (-y3),
    split,
    { intro t,
      have H4 := Hy3.left (-t),
      intro J5,
      rw neg_le,
      apply H4,
      clear H4,
      existsi t,
      simp [J5]
    },
    intros t Ht,
    have H4 := Hy3.right (-t),
    rw le_neg,
    apply H4,
    clear H4,
    intros u Hu,
    cases Hu with v Hv,
    rw [Hv.right],
    refine neg_le_neg _,
    apply Ht,
    exact Hv.left,
  },
  existsi (-w3),
  intros z Hz,
  rw le_neg,
  apply Jw3,
  cases Hz with u Hu,
  rw Hu.right,
  rw neg_neg,
  exact Hu.left
},
existsi (-w2),
existsi w2,
simp [Jw2],
end


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

/-
# A

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

def x := 0

/-
# B

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 f (n : ℕ) : ℕ := n * n

/-
# C

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

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

/-
# D

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

-- Prop → Prop

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

/-
# 1

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

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

/-
#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 sorry with your answer.
-/

def aBbCCa
    { T : Type }
    (a b c : T)
    (ab : a = b)
    (bc: c = b) :
    (c = a)
    := eq.symm (eq.trans ab (eq.symm bc))

-- Sullivan Note: Confusing name: bc

/-
#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 → c = b → c = a
    :=
        λ T a b c ab bc,
            eq.symm (eq.trans ab (eq.symm bc))

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

/-
#3

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

/-
#4

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

theorem t1 : P → Q → R → P :=
    λ pfP pfQ pfR, pfP

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

theorem t3 : (P ∧ Q) ∧ (Q ∧ R) → (P ∧ R) :=
    λ pqr,
        and.intro pqr.left.left pqr.right.right

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

/-
#6

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

/-
#7

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, n -- or λ n, 0; etc.

/-
#8

Define a function called double
that takes any natural number, n,
and returns two times n.
-/
def double (n : ℕ) := 2 * n

/-
#9

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

/-
#10

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 sum3 /- ℕ → ℕ → ℕ → ℕ -/:=
    λ a b c : ℕ, a + b + c

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

/-

#11

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 :=
begin
    assume p : P,
    assume np : ¬ P,
    apply false.elim (np p),
end

/-

# 12

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

/-
ANSWER: Proof by negation can when used
when the goal is to prove a proposition,
¬ P. To prove ¬ P, one shows that assuming
P provides a path to a proof of false.

Proof by contradiction can be used when
the goal is to prove P. To prove it, one
shows that assuming ¬ P provides a path
to a proof of false. This proves ¬ ¬ P.
From this and by use of excluded middle
one obtains from this ¬ ¬ P, a proof of
P.
-/

/-

# 13

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

/-
Answer: It's the law of the
excluded middle that enables
double negation elimination,
which is needed to deduce P
from ¬ ¬ P.
-/

/-

14

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

def f_plus_one (f: ℕ → ℕ) : (ℕ → ℕ) :=
    λ n,
        1 + f n

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


import kb_real_defs

/-
# Chapter 1 : Sets

## Level 9
-/

/-
This is a little more complicated example asking you to work with intervals of reals.
The result will be of help in the sup-inf world.
-/

notation `[` a `,` b `]`  := set.Icc a b

def mem_prod_sets (A : set ℝ) (B : set ℝ) := { x : ℝ | ∃ y ∈ A, ∃ z ∈ B, x = y * z}

/- Lemma
If $x = 0$, then `x ∈ mem_prod_sets [(-2:ℝ),-1] [(0:ℝ), 3]`
-/
lemma zero_in_prod : (0:ℝ) ∈ mem_prod_sets [(-2:ℝ), -1] [(0:ℝ), 3] :=
begin
  rw mem_prod_sets,
  dsimp,
  use -2,
  split,
  { rw mem_Icc_iff,
    split; linarith
  },
  use 0,
  split,
  { rw mem_Icc_iff,
    split; linarith
  },
  norm_num
end


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

import data.int.cast.defs

/-!
# Characteristic zero

A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered
as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R`
except for the existence of `1` in this file characteristic zero is defined for additive monoids
with `1`.

## Main definition

`char_zero` is the typeclass of an additive monoid with one such that the natural homomorphism
from the natural numbers into it is injective.

## TODO

* Unify with `char_p` (possibly using an out-parameter)
-/

/-- Typeclass for monoids with characteristic zero.
  (This is usually stated on fields but it makes sense for any additive monoid with 1.)

*Warning*: for a semiring `R`, `char_zero R` and `char_p R 0` need not coincide.
* `char_zero R` requires an injection `ℕ ↪ R`;
* `char_p R 0` asks that only `0 : ℕ` maps to `0 : R` under the map `ℕ → R`.

For instance, endowing `{0, 1}` with addition given by `max` (i.e. `1` is absorbing), shows that
`char_zero {0, 1}` does not hold and yet `char_p {0, 1} 0` does.
This example is formalized in `counterexamples/char_p_zero_ne_char_zero`.
 -/
class char_zero (R : Type*) [add_monoid_with_one R] : Prop :=
(cast_injective : function.injective (coe : ℕ → R))

theorem char_zero_of_inj_zero {R : Type*} [add_group_with_one R]
  (H : ∀ n:ℕ, (n:R) = 0 → n = 0) : char_zero R :=
⟨λ m n h, begin
  induction m with m ih generalizing n, { rw H n, rw [← h, nat.cast_zero] },
  cases n with n, { apply H, rw [h, nat.cast_zero], },
  simp_rw [nat.cast_succ, add_right_cancel_iff] at h, rwa ih,
end⟩

namespace nat
variables {R : Type*} [add_monoid_with_one R] [char_zero R]

theorem cast_injective : function.injective (coe : ℕ → R) :=
char_zero.cast_injective

@[simp, norm_cast] theorem cast_inj {m n : ℕ} : (m : R) = n ↔ m = n :=
cast_injective.eq_iff

@[simp, norm_cast] theorem cast_eq_zero {n : ℕ} : (n : R) = 0 ↔ n = 0 :=
by rw [← cast_zero, cast_inj]

@[norm_cast] theorem cast_ne_zero {n : ℕ} : (n : R) ≠ 0 ↔ n ≠ 0 :=
not_congr cast_eq_zero

lemma cast_add_one_ne_zero (n : ℕ) : (n + 1 : R) ≠ 0 :=
by exact_mod_cast n.succ_ne_zero

@[simp, norm_cast]

@[norm_cast] theorem cast_ne_one {n : ℕ} : (n : R) ≠ 1 ↔ n ≠ 1 :=
cast_eq_one.not

end nat


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

universes u v

namespace Mathlib

/-!
# Trailing degree of univariate polynomials

## Main definitions

* `trailing_degree p`: the multiplicity of `X` in the polynomial `p`
* `nat_trailing_degree`: a variant of `trailing_degree` that takes values in the natural numbers
* `trailing_coeff`: the coefficient at index `nat_trailing_degree p`

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

namespace polynomial

/-- `trailing_degree p` is the multiplicity of `x` in the polynomial `p`, i.e. the smallest
`X`-exponent in `p`.
`trailing_degree p = some n` when `p ≠ 0` and `n` is the smallest power of `X` that appears
in `p`, otherwise
`trailing_degree 0 = ⊤`. -/
def trailing_degree {R : Type u} [semiring R] (p : polynomial R) : with_top ℕ :=
  finset.inf (finsupp.support p) some

theorem trailing_degree_lt_wf {R : Type u} [semiring R] : well_founded fun (p q : polynomial R) => trailing_degree p < trailing_degree q :=
  inv_image.wf trailing_degree (with_top.well_founded_lt nat.lt_wf)

/-- `nat_trailing_degree p` forces `trailing_degree p` to `ℕ`, by defining
`nat_trailing_degree ⊤ = 0`. -/
def nat_trailing_degree {R : Type u} [semiring R] (p : polynomial R) : ℕ :=
  option.get_or_else (trailing_degree p) 0

/-- `trailing_coeff p` gives the coefficient of the smallest power of `X` in `p`-/
def trailing_coeff {R : Type u} [semiring R] (p : polynomial R) : R :=
  coeff p (nat_trailing_degree p)

/-- a polynomial is `monic_at` if its trailing coefficient is 1 -/
def trailing_monic {R : Type u} [semiring R] (p : polynomial R) :=
  trailing_coeff p = 1

theorem trailing_monic.def {R : Type u} [semiring R] {p : polynomial R} : trailing_monic p ↔ trailing_coeff p = 1 :=
  iff.rfl

protected instance trailing_monic.decidable {R : Type u} [semiring R] {p : polynomial R} [DecidableEq R] : Decidable (trailing_monic p) :=
  eq.mpr sorry (_inst_2 (trailing_coeff p) 1)

@[simp] theorem trailing_monic.trailing_coeff {R : Type u} [semiring R] {p : polynomial R} (hp : trailing_monic p) : trailing_coeff p = 1 :=
  hp

@[simp] theorem trailing_degree_zero {R : Type u} [semiring R] : trailing_degree 0 = ⊤ :=
  rfl

@[simp] theorem nat_trailing_degree_zero {R : Type u} [semiring R] : nat_trailing_degree 0 = 0 :=
  rfl

theorem trailing_degree_eq_top {R : Type u} [semiring R] {p : polynomial R} : trailing_degree p = ⊤ ↔ p = 0 := sorry

theorem trailing_degree_eq_nat_trailing_degree {R : Type u} [semiring R] {p : polynomial R} (hp : p ≠ 0) : trailing_degree p = ↑(nat_trailing_degree p) := sorry

theorem trailing_degree_eq_iff_nat_trailing_degree_eq {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (hp : p ≠ 0) : trailing_degree p = ↑n ↔ nat_trailing_degree p = n := sorry

theorem trailing_degree_eq_iff_nat_trailing_degree_eq_of_pos {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (hn : 0 < n) : trailing_degree p = ↑n ↔ nat_trailing_degree p = n := sorry

theorem nat_trailing_degree_eq_of_trailing_degree_eq_some {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (h : trailing_degree p = ↑n) : nat_trailing_degree p = n := sorry

@[simp] theorem nat_trailing_degree_le_trailing_degree {R : Type u} [semiring R] {p : polynomial R} : ↑(nat_trailing_degree p) ≤ trailing_degree p := sorry

theorem nat_trailing_degree_eq_of_trailing_degree_eq {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] {q : polynomial S} (h : trailing_degree p = trailing_degree q) : nat_trailing_degree p = nat_trailing_degree q := sorry

theorem le_trailing_degree_of_ne_zero {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} (h : coeff p n ≠ 0) : trailing_degree p ≤ ↑n :=
  (fun (this : finset.inf (finsupp.support p) some ≤ some n) => this) (finset.inf_le (iff.mpr finsupp.mem_support_iff h))

theorem nat_trailing_degree_le_of_ne_zero {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} (h : coeff p n ≠ 0) : nat_trailing_degree p ≤ n := sorry

theorem trailing_degree_le_trailing_degree {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : coeff q (nat_trailing_degree p) ≠ 0) : trailing_degree q ≤ trailing_degree p := sorry

theorem trailing_degree_ne_of_nat_trailing_degree_ne {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} : nat_trailing_degree p ≠ n → trailing_degree p ≠ ↑n := sorry

theorem nat_trailing_degree_le_of_trailing_degree_le {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} {hp : p ≠ 0} (H : ↑n ≤ trailing_degree p) : n ≤ nat_trailing_degree p :=
  iff.mp with_top.coe_le_coe
    (eq.mp (Eq._oldrec (Eq.refl (↑n ≤ trailing_degree p)) (trailing_degree_eq_nat_trailing_degree hp)) H)

theorem nat_trailing_degree_le_nat_trailing_degree {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} {hq : q ≠ 0} (hpq : trailing_degree p ≤ trailing_degree q) : nat_trailing_degree p ≤ nat_trailing_degree q := sorry

@[simp] theorem trailing_degree_monomial {R : Type u} {a : R} {n : ℕ} [semiring R] (ha : a ≠ 0) : trailing_degree (coe_fn (monomial n) a) = ↑n := sorry

theorem nat_trailing_degree_monomial {R : Type u} {a : R} {n : ℕ} [semiring R] (ha : a ≠ 0) : nat_trailing_degree (coe_fn (monomial n) a) = n := sorry

theorem nat_trailing_degree_monomial_le {R : Type u} {a : R} {n : ℕ} [semiring R] : nat_trailing_degree (coe_fn (monomial n) a) ≤ n := sorry

theorem le_trailing_degree_monomial {R : Type u} {a : R} {n : ℕ} [semiring R] : ↑n ≤ trailing_degree (coe_fn (monomial n) a) := sorry

@[simp] theorem trailing_degree_C {R : Type u} {a : R} [semiring R] (ha : a ≠ 0) : trailing_degree (coe_fn C a) = 0 :=
  trailing_degree_monomial ha

theorem le_trailing_degree_C {R : Type u} {a : R} [semiring R] : 0 ≤ trailing_degree (coe_fn C a) :=
  le_trailing_degree_monomial

theorem trailing_degree_one_le {R : Type u} [semiring R] : 0 ≤ trailing_degree 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ trailing_degree 1)) (Eq.symm C_1))) le_trailing_degree_C

@[simp] theorem nat_trailing_degree_C {R : Type u} [semiring R] (a : R) : nat_trailing_degree (coe_fn C a) = 0 :=
  iff.mp nonpos_iff_eq_zero nat_trailing_degree_monomial_le

@[simp] theorem nat_trailing_degree_one {R : Type u} [semiring R] : nat_trailing_degree 1 = 0 :=
  nat_trailing_degree_C 1

@[simp] theorem nat_trailing_degree_nat_cast {R : Type u} [semiring R] (n : ℕ) : nat_trailing_degree ↑n = 0 := sorry

@[simp] theorem trailing_degree_C_mul_X_pow {R : Type u} {a : R} [semiring R] (n : ℕ) (ha : a ≠ 0) : trailing_degree (coe_fn C a * X ^ n) = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (trailing_degree (coe_fn C a * X ^ n) = ↑n)) (C_mul_X_pow_eq_monomial a n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (trailing_degree (coe_fn (monomial n) a) = ↑n)) (trailing_degree_monomial ha)))
      (Eq.refl ↑n))

theorem le_trailing_degree_C_mul_X_pow {R : Type u} [semiring R] (n : ℕ) (a : R) : ↑n ≤ trailing_degree (coe_fn C a * X ^ n) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n ≤ trailing_degree (coe_fn C a * X ^ n))) (C_mul_X_pow_eq_monomial a n)))
    le_trailing_degree_monomial

theorem coeff_eq_zero_of_trailing_degree_lt {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} (h : ↑n < trailing_degree p) : coeff p n = 0 :=
  iff.mp not_not (mt le_trailing_degree_of_ne_zero (not_le_of_gt h))

theorem coeff_eq_zero_of_lt_nat_trailing_degree {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (h : n < nat_trailing_degree p) : coeff p n = 0 := sorry

@[simp] theorem coeff_nat_trailing_degree_pred_eq_zero {R : Type u} [semiring R] {p : polynomial R} {hp : 0 < ↑(nat_trailing_degree p)} : coeff p (nat_trailing_degree p - 1) = 0 :=
  coeff_eq_zero_of_lt_nat_trailing_degree
    (nat.sub_lt (iff.mp (with_top.zero_lt_coe (nat_trailing_degree p)) hp) nat.one_pos)

theorem le_trailing_degree_X_pow {R : Type u} [semiring R] (n : ℕ) : ↑n ≤ trailing_degree (X ^ n) := sorry

theorem le_trailing_degree_X {R : Type u} [semiring R] : 1 ≤ trailing_degree X :=
  le_trailing_degree_monomial

theorem nat_trailing_degree_X_le {R : Type u} [semiring R] : nat_trailing_degree X ≤ 1 :=
  nat_trailing_degree_monomial_le

@[simp] theorem trailing_coeff_eq_zero {R : Type u} [semiring R] {p : polynomial R} : trailing_coeff p = 0 ↔ p = 0 := sorry

theorem trailing_coeff_nonzero_iff_nonzero {R : Type u} [semiring R] {p : polynomial R} : trailing_coeff p ≠ 0 ↔ p ≠ 0 :=
  not_congr trailing_coeff_eq_zero

theorem nat_trailing_degree_mem_support_of_nonzero {R : Type u} [semiring R] {p : polynomial R} : p ≠ 0 → nat_trailing_degree p ∈ finsupp.support p :=
  iff.mpr mem_support_iff_coeff_ne_zero ∘ iff.mpr trailing_coeff_nonzero_iff_nonzero

theorem nat_trailing_degree_le_of_mem_supp {R : Type u} [semiring R] {p : polynomial R} (a : ℕ) : a ∈ finsupp.support p → nat_trailing_degree p ≤ a :=
  nat_trailing_degree_le_of_ne_zero ∘ iff.mp mem_support_iff_coeff_ne_zero

theorem nat_trailing_degree_eq_support_min' {R : Type u} [semiring R] {p : polynomial R} (h : p ≠ 0) : nat_trailing_degree p = finset.min' (finsupp.support p) (iff.mpr nonempty_support_iff h) := sorry

@[simp] theorem trailing_degree_one {R : Type u} [semiring R] [nontrivial R] : trailing_degree 1 = 0 :=
  trailing_degree_C one_ne_zero

@[simp] theorem trailing_degree_X {R : Type u} [semiring R] [nontrivial R] : trailing_degree X = 1 :=
  trailing_degree_monomial one_ne_zero

@[simp] theorem nat_trailing_degree_X {R : Type u} [semiring R] [nontrivial R] : nat_trailing_degree X = 1 :=
  nat_trailing_degree_monomial one_ne_zero

@[simp] theorem trailing_degree_neg {R : Type u} [ring R] (p : polynomial R) : trailing_degree (-p) = trailing_degree p := sorry

@[simp] theorem nat_trailing_degree_neg {R : Type u} [ring R] (p : polynomial R) : nat_trailing_degree (-p) = nat_trailing_degree p := sorry

@[simp] theorem nat_trailing_degree_int_cast {R : Type u} [ring R] (n : ℤ) : nat_trailing_degree ↑n = 0 := sorry

/-- The second-lowest coefficient, or 0 for constants -/
def next_coeff_up {R : Type u} [semiring R] (p : polynomial R) : R :=
  ite (nat_trailing_degree p = 0) 0 (coeff p (nat_trailing_degree p + 1))

@[simp] theorem next_coeff_up_C_eq_zero {R : Type u} [semiring R] (c : R) : next_coeff_up (coe_fn C c) = 0 := sorry

theorem next_coeff_up_of_pos_nat_trailing_degree {R : Type u} [semiring R] (p : polynomial R) (hp : 0 < nat_trailing_degree p) : next_coeff_up p = coeff p (nat_trailing_degree p + 1) := sorry

theorem coeff_nat_trailing_degree_eq_zero_of_trailing_degree_lt {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : trailing_degree p < trailing_degree q) : coeff q (nat_trailing_degree p) = 0 :=
  coeff_eq_zero_of_trailing_degree_lt (has_le.le.trans_lt nat_trailing_degree_le_trailing_degree h)

theorem ne_zero_of_trailing_degree_lt {R : Type u} [semiring R] {p : polynomial R} {n : with_top ℕ} (h : trailing_degree p < n) : p ≠ 0 := sorry


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 4 : "and" (`∧`)

We learn about how to manipulate `P ∧ Q` in Lean.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following tactics:

* `cases`
* `split`

### The `cases` tactic

If `h : P ∧ Q` is a hypothesis, then `cases h with hP hQ,`
decomposes it into two hypotheses `hP : P` and `hQ : Q`.

### The `split` tactic

If `⊢ P ∧ Q` is in the goal, The `split` tactic will turn it into
two goals, `⊢ P` and `⊢ Q`. NB tactics operate on the first goal only.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : P ∧ Q → P :=
begin
  sorry
end

example : P ∧ Q → Q :=
begin
  sorry
end

example : (P → Q → R) → (P ∧ Q → R) :=
begin
  sorry
end

example : P → Q → P ∧ Q :=
begin
  sorry
end

/-- `∧` is symmetric -/
example : P ∧ Q → Q ∧ P :=
begin
  sorry
end

example : P → P ∧ true :=
begin
  sorry
end

example : false → P ∧ false :=
begin
  sorry
end

/-- `∧` is transitive -/
example : (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  sorry,
end

example : ((P ∧ Q) → R) → (P → Q → R) :=
begin
  sorry,
end


/-
- Data type -- inductive definition of a set of constructible terms
- Abstract data type (ADT) -- data type plus set of basic operations on values of this type
- Certified abstract data type (CADT) -- ADT with proofs of desired mathematical properties

In this file, we see how to produce a CADT for Boolean algebra.
-/

namespace hidden

-- DATA TYPE

inductive boo
| ff
| tt

open boo

-- OPERATIONS

-- unary operations

def id : boo → boo
| b := b

def not : boo → boo
| tt := ff
| ff := tt

def fals : boo → boo
| b := ff

def troo : boo → boo
| b := tt

-- binary operations

def and : boo → boo → boo
| ff ff := ff
| ff tt := ff
| tt ff := ff
| tt tt := tt

def or : boo → boo → boo
| ff ff := ff
| ff tt := tt
| tt ff := tt
| tt tt := tt

-- a ternary operation
def ite : boo → boo → boo → boo
|  ff t f := f
|  tt t f := t

-- PROOFS OF CRUCIAL PROPERTIES

-- example

theorem demorgan1 :
  ∀ (b1 b2 : boo),
    not (and b1 b2) = or (not b1) (not b2) :=
  begin
    intros,
    -- case analysis on b1
    cases b1,
    -- for each case for b1, case analysis on b2
    repeat
      {
        cases b2,
        exact rfl,
        exact rfl
      }
  end

/-
As we saw during the lecture, bugs in our "code"
are revealed by an inability to prove that our
implementations of these operations have all the
key mathematical properties of the operations in
the Boolean algebra that we're trying to implement.
Try slightly changing the definition of "and" or
"or" for example, and see if, and if so how, the
changes break the proof(s).
-/

#reduce and tt ff

notation b1 * b2 := and b1 b2
notation b1 + b2 := or b1 b2
prefix ! := not

#reduce boo.tt * boo.ff
#reduce boo.tt + boo.ff
#reduce !(boo.tt + boo.ff)

end hidden


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Alexey Soloyev, Junyan Xu
-/
import data.real.irrational
import data.nat.fib
import data.nat.prime_norm_num
import data.fin.vec_notation
import tactic.ring_exp
import algebra.linear_recurrence

/-!
# The golden ratio and its conjugate

This file defines the golden ratio `φ := (1 + √5)/2` and its conjugate
`ψ := (1 - √5)/2`, which are the two real roots of `X² - X - 1`.

Along with various computational facts about them, we prove their
irrationality, and we link them to the Fibonacci sequence by proving
Binet's formula.
-/

noncomputable theory
open_locale polynomial

/-- The golden ratio `φ := (1 + √5)/2`. -/
@[reducible] def golden_ratio := (1 + real.sqrt 5)/2

/-- The conjugate of the golden ratio `ψ := (1 - √5)/2`. -/
@[reducible] def golden_conj := (1 - real.sqrt 5)/2

localized "notation (name := golden_ratio) `φ` := golden_ratio" in real
localized "notation (name := golden_conj) `ψ` := golden_conj" in real

/-- The inverse of the golden ratio is the opposite of its conjugate. -/
lemma inv_gold : φ⁻¹ = -ψ :=
begin
  have : 1 + real.sqrt 5 ≠ 0,
    from ne_of_gt (add_pos (by norm_num) $ real.sqrt_pos.mpr (by norm_num)),
  field_simp [sub_mul, mul_add],
  norm_num
end

/-- The opposite of the golden ratio is the inverse of its conjugate. -/
lemma inv_gold_conj : ψ⁻¹ = -φ :=
begin
  rw [inv_eq_iff_eq_inv, ← neg_inv, ← neg_eq_iff_eq_neg],
  exact inv_gold.symm,
end

@[simp] lemma gold_mul_gold_conj : φ * ψ = -1 :=
by {field_simp, rw ← sq_sub_sq, norm_num}

@[simp] lemma gold_conj_mul_gold : ψ * φ = -1 :=
by {rw mul_comm, exact gold_mul_gold_conj}

@[simp] lemma gold_add_gold_conj : φ + ψ = 1 := by {rw [golden_ratio, golden_conj], ring}

lemma one_sub_gold_conj : 1 - φ = ψ := by linarith [gold_add_gold_conj]

lemma one_sub_gold : 1 - ψ = φ := by linarith [gold_add_gold_conj]

@[simp] lemma gold_sub_gold_conj : φ - ψ = real.sqrt 5 := by {rw [golden_ratio, golden_conj], ring}

@[simp] lemma gold_sq : φ^2 = φ + 1 :=
begin
  rw [golden_ratio, ←sub_eq_zero],
  ring_exp,
  rw real.sq_sqrt; norm_num,
end

@[simp] lemma gold_conj_sq : ψ^2 = ψ + 1 :=
begin
  rw [golden_conj, ←sub_eq_zero],
  ring_exp,
  rw real.sq_sqrt; norm_num,
end

lemma gold_pos : 0 < φ :=
mul_pos (by apply add_pos; norm_num) $ inv_pos.2 zero_lt_two

lemma gold_ne_zero : φ ≠ 0 := ne_of_gt gold_pos

lemma one_lt_gold : 1 < φ :=
begin
  refine lt_of_mul_lt_mul_left _ (le_of_lt gold_pos),
  simp [← sq, gold_pos, zero_lt_one]
end

lemma gold_conj_neg : ψ < 0 := by linarith [one_sub_gold_conj, one_lt_gold]

lemma gold_conj_ne_zero : ψ ≠ 0 := ne_of_lt gold_conj_neg

lemma neg_one_lt_gold_conj : -1 < ψ :=
begin
  rw [neg_lt, ← inv_gold],
  exact inv_lt_one one_lt_gold,
end

/-!
## Irrationality
-/

/-- The golden ratio is irrational. -/
theorem gold_irrational : irrational φ :=
begin
  have := nat.prime.irrational_sqrt (show nat.prime 5, by norm_num),
  have := this.rat_add 1,
  have := this.rat_mul (show (0.5 : ℚ) ≠ 0, by norm_num),
  convert this,
  field_simp
end

/-- The conjugate of the golden ratio is irrational. -/
theorem gold_conj_irrational : irrational ψ :=
begin
  have := nat.prime.irrational_sqrt (show nat.prime 5, by norm_num),
  have := this.rat_sub 1,
  have := this.rat_mul (show (0.5 : ℚ) ≠ 0, by norm_num),
  convert this,
  field_simp
end

/-!
## Links with Fibonacci sequence
-/

section fibrec

variables {α : Type*} [comm_semiring α]

/-- The recurrence relation satisfied by the Fibonacci sequence. -/
def fib_rec : linear_recurrence α :=
{ order := 2,
  coeffs := ![1, 1]}

section poly

open polynomial

/-- The characteristic polynomial of `fib_rec` is `X² - (X + 1)`. -/
lemma fib_rec_char_poly_eq {β : Type*} [comm_ring β] :
  fib_rec.char_poly = X^2 - (X + (1 : β[X])) :=
begin
  rw [fib_rec, linear_recurrence.char_poly],
  simp [finset.sum_fin_eq_sum_range, finset.sum_range_succ', ← smul_X_eq_monomial]
end

end poly

/-- As expected, the Fibonacci sequence is a solution of `fib_rec`. -/
lemma fib_is_sol_fib_rec : fib_rec.is_solution (λ x, x.fib : ℕ → α) :=
begin
  rw fib_rec,
  intros n,
  simp only,
  rw [nat.fib_add_two, add_comm],
  simp [finset.sum_fin_eq_sum_range, finset.sum_range_succ'],
end

/-- The geometric sequence `λ n, φ^n` is a solution of `fib_rec`. -/
lemma geom_gold_is_sol_fib_rec : fib_rec.is_solution (pow φ) :=
begin
  rw [fib_rec.geom_sol_iff_root_char_poly, fib_rec_char_poly_eq],
  simp [sub_eq_zero]
end

/-- The geometric sequence `λ n, ψ^n` is a solution of `fib_rec`. -/
lemma geom_gold_conj_is_sol_fib_rec : fib_rec.is_solution (pow ψ) :=
begin
  rw [fib_rec.geom_sol_iff_root_char_poly, fib_rec_char_poly_eq],
  simp [sub_eq_zero]
end

end fibrec

/-- Binet's formula as a function equality. -/
theorem real.coe_fib_eq' : (λ n, nat.fib n : ℕ → ℝ) = λ n, (φ^n - ψ^n) / real.sqrt 5 :=
begin
  rw fib_rec.sol_eq_of_eq_init,
  { intros i hi,
    fin_cases hi,
    { simp },
    { simp only [golden_ratio, golden_conj], ring_exp, rw mul_inv_cancel; norm_num } },
  { exact fib_is_sol_fib_rec },
  { ring_nf,
    exact (@fib_rec ℝ _).sol_space.sub_mem
            (submodule.smul_mem fib_rec.sol_space (real.sqrt 5)⁻¹ geom_gold_is_sol_fib_rec)
            (submodule.smul_mem fib_rec.sol_space (real.sqrt 5)⁻¹ geom_gold_conj_is_sol_fib_rec) }
end

/-- Binet's formula as a dependent equality. -/
theorem real.coe_fib_eq : ∀ n, (nat.fib n : ℝ) = (φ^n - ψ^n) / real.sqrt 5 :=
by rw [← function.funext_iff, real.coe_fib_eq']


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

import algebra.big_operators.basic
import ring_theory.polynomial.basic

/-!
# Lagrange interpolation

## Main definitions

* `lagrange.basis s x` where `s : finset F` and `x : F`: the Lagrange basis polynomial
  that evaluates to `1` at `x` and `0` at other elements of `s`.
* `lagrange.interpolate s f` where `s : finset F` and `f : F → F`: the Lagrange interpolant
  that evaluates to `f x` at `x` for `x ∈ s`.
-/

noncomputable theory
open_locale big_operators classical polynomial

universe u

namespace lagrange

variables {F : Type u} [decidable_eq F] [field F] (s : finset F)
variables {F' : Type u} [field F'] (s' : finset F')

open polynomial

/-- Lagrange basis polynomials that evaluate to 1 at `x` and 0 at other elements of `s`. -/
def basis (x : F) : F[X] :=
∏ y in s.erase x, C (x - y)⁻¹ * (X - C y)

@[simp] theorem basis_empty (x : F) : basis ∅ x = 1 :=
rfl

@[simp] theorem basis_singleton_self (x : F) : basis {x} x = 1 :=
by rw [basis, finset.erase_singleton, finset.prod_empty]

@[simp] theorem eval_basis_self (x : F) : (basis s x).eval x = 1 :=
begin
  rw [basis, ← coe_eval_ring_hom, (eval_ring_hom x).map_prod, coe_eval_ring_hom,
    finset.prod_eq_one],
  intros y hy, simp_rw [eval_mul, eval_sub, eval_C, eval_X],
  exact inv_mul_cancel (sub_ne_zero_of_ne (finset.ne_of_mem_erase hy).symm)
end

@[simp] theorem eval_basis_ne (x y : F) (h1 : y ∈ s) (h2 : y ≠ x) : (basis s x).eval y = 0 :=
begin
  rw [basis,
  ← coe_eval_ring_hom, (eval_ring_hom y).map_prod, coe_eval_ring_hom,
    finset.prod_eq_zero (finset.mem_erase.2 ⟨h2, h1⟩)],
  simp_rw [eval_mul, eval_sub, eval_C, eval_X, sub_self, mul_zero]
end

theorem eval_basis (x y : F) (h : y ∈ s) : (basis s x).eval y = if y = x then 1 else 0 :=
by { split_ifs with H, { subst H, apply eval_basis_self }, { exact eval_basis_ne s x y h H } }

@[simp] theorem nat_degree_basis (x : F) (hx : x ∈ s) : (basis s x).nat_degree = s.card - 1 :=
begin
  unfold basis, generalize hsx : s.erase x = sx,
  have : x ∉ sx := hsx ▸ finset.not_mem_erase x s,
  rw [← finset.insert_erase hx, hsx, finset.card_insert_of_not_mem this, add_tsub_cancel_right],
  clear hx hsx s, revert this, apply sx.induction_on,
  { intros hx, rw [finset.prod_empty, nat_degree_one], refl },
  { intros y s hys ih hx, rw [finset.mem_insert, not_or_distrib] at hx,
    have h1 : C (x - y)⁻¹ ≠ C 0 := λ h, hx.1 (eq_of_sub_eq_zero $ inv_eq_zero.1 $ C_inj.1 h),
    have h2 : X ^ 1 - C y ≠ 0 := by convert X_pow_sub_C_ne_zero zero_lt_one y,
    rw C_0 at h1, rw pow_one at h2,
    rw [finset.prod_insert hys, nat_degree_mul (mul_ne_zero h1 h2), ih hx.2,
        finset.card_insert_of_not_mem hys, nat_degree_mul h1 h2,
        nat_degree_C, zero_add, nat_degree, degree_X_sub_C, add_comm], refl,
    rw [ne, finset.prod_eq_zero_iff], rintro ⟨z, hzs, hz⟩,
    rw mul_eq_zero at hz, cases hz with hz hz,
    { rw [← C_0, C_inj, inv_eq_zero, sub_eq_zero] at hz, exact hx.2 (hz.symm ▸ hzs) },
    { rw ← pow_one (X : F[X]) at hz, exact X_pow_sub_C_ne_zero zero_lt_one _ hz } }
end

variables (f : F → F)

/-- Lagrange interpolation: given a finset `s` and a function `f : F → F`,
`interpolate s f` is the unique polynomial of degree `< s.card`
that takes value `f x` on all `x` in `s`. -/
def interpolate : F[X] :=
∑ x in s, C (f x) * basis s x

@[simp] theorem interpolate_empty (f) : interpolate (∅ : finset F) f = 0 :=
rfl

@[simp] theorem interpolate_singleton (f) (x : F) : interpolate {x} f = C (f x) :=
by rw [interpolate, finset.sum_singleton, basis_singleton_self, mul_one]

@[simp] theorem eval_interpolate (x) (H : x ∈ s) : eval x (interpolate s f) = f x :=
begin
  rw [interpolate, ←coe_eval_ring_hom, ring_hom.map_sum, coe_eval_ring_hom, finset.sum_eq_single x],
  { simp },
  { intros y hy hxy, simp [eval_basis_ne s y x H hxy.symm] },
  { intro h, exact (h H).elim }
end

theorem degree_interpolate_lt : (interpolate s f).degree < s.card :=
if H : s = ∅ then by { subst H, rw [interpolate_empty, degree_zero], exact with_bot.bot_lt_coe _ }
else (degree_sum_le _ _).trans_lt $ (finset.sup_lt_iff $ with_bot.bot_lt_coe s.card).2 $ λ b _,
calc  (C (f b) * basis s b).degree
    ≤ (C (f b)).degree + (basis s b).degree : degree_mul_le _ _
... ≤ 0 + (basis s b).degree : add_le_add_right degree_C_le _
... = (basis s b).degree : zero_add _
... ≤ (basis s b).nat_degree : degree_le_nat_degree
... = (s.card - 1 : ℕ) : by { rwa nat_degree_basis }
... < s.card : with_bot.coe_lt_coe.2 (nat.pred_lt $ mt finset.card_eq_zero.1 H)

theorem degree_interpolate_erase {x} (hx : x ∈ s) :
  (interpolate (s.erase x) f).degree < (s.card - 1 : ℕ) :=
begin
  convert degree_interpolate_lt (s.erase x) f,
  rw finset.card_erase_of_mem hx,
end

theorem interpolate_eq_of_eval_eq (f g : F → F) {s : finset F} (hs : ∀ x ∈ s, f x = g x) :
  interpolate s f = interpolate s g :=
begin
  rw [interpolate, interpolate],
  refine finset.sum_congr rfl (λ x hx, _),
  rw hs x hx,
end

/-- Linear version of `interpolate`. -/
def linterpolate : (F → F) →ₗ[F] polynomial F :=
{ to_fun := interpolate s,
  map_add' := λ f g, by { simp_rw [interpolate, ← finset.sum_add_distrib, ← add_mul, ← C_add],
    refl },
  map_smul' := λ c f, by { simp_rw [interpolate, finset.smul_sum, C_mul', smul_smul], refl } }

@[simp] lemma interpolate_add (f g) : interpolate s (f + g) = interpolate s f + interpolate s g :=
(linterpolate s).map_add f g

@[simp] lemma interpolate_zero : interpolate s 0 = 0 :=
(linterpolate s).map_zero

@[simp] lemma interpolate_neg (f) : interpolate s (-f) = -interpolate s f :=
(linterpolate s).map_neg f

@[simp] lemma interpolate_sub (f g) : interpolate s (f - g) = interpolate s f - interpolate s g :=
(linterpolate s).map_sub f g

@[simp] lemma interpolate_smul (c : F) (f) : interpolate s (c • f) = c • interpolate s f :=
(linterpolate s).map_smul c f

theorem eq_zero_of_eval_eq_zero {f : F'[X]} (hf1 : f.degree < s'.card)
  (hf2 : ∀ x ∈ s', f.eval x = 0) : f = 0 :=
by_contradiction $ λ hf3, not_le_of_lt hf1 $
calc  (s'.card : with_bot ℕ)
    ≤ f.roots.to_finset.card : with_bot.coe_le_coe.2 $ finset.card_le_of_subset $ λ x hx,
        (multiset.mem_to_finset).mpr $ (mem_roots hf3).2 $ hf2 x hx
... ≤ f.roots.card : with_bot.coe_le_coe.2 $ f.roots.to_finset_card_le
... ≤ f.degree : card_roots hf3

theorem eq_of_eval_eq {f g : F'[X]} (hf : f.degree < s'.card) (hg : g.degree < s'.card)
  (hfg : ∀ x ∈ s', f.eval x = g.eval x) : f = g :=
eq_of_sub_eq_zero $ eq_zero_of_eval_eq_zero s'
  (lt_of_le_of_lt (degree_sub_le f g) $ max_lt hf hg)
  (λ x hx, by rw [eval_sub, hfg x hx, sub_self])

theorem eq_interpolate_of_eval_eq {g : F[X]} (hg : g.degree < s.card)
  (hgf : ∀ x ∈ s, g.eval x = f x) : interpolate s f = g :=
eq_of_eval_eq s (degree_interpolate_lt _ _) hg $ λ x hx, begin
  rw hgf x hx,
  exact eval_interpolate _ _ _ hx,
end

theorem eq_interpolate (f : F[X]) (hf : f.degree < s.card) :
  interpolate s (λ x, f.eval x) = f :=
eq_of_eval_eq s (degree_interpolate_lt s _) hf $ λ x hx, eval_interpolate s _ x hx

/-- Lagrange interpolation induces isomorphism between functions from `s` and polynomials
of degree less than `s.card`. -/
def fun_equiv_degree_lt : degree_lt F s.card ≃ₗ[F] (s → F) :=
{ to_fun := λ f x, f.1.eval x,
  map_add' := λ f g, funext $ λ x, eval_add,
  map_smul' := λ c f, funext $ by simp,
  inv_fun := λ f, ⟨interpolate s (λ x, if hx : x ∈ s then f ⟨x, hx⟩ else 0),
    mem_degree_lt.2 $ degree_interpolate_lt _ _⟩,
  left_inv := λ f, begin apply subtype.eq,
    simp only [subtype.coe_mk, subtype.val_eq_coe, dite_eq_ite],
    convert eq_interpolate s f (mem_degree_lt.1 f.2) using 1,
    rw interpolate_eq_of_eval_eq,
    intros x hx,
    rw if_pos hx end,
  right_inv := λ f, funext $ λ ⟨x, hx⟩, begin
    convert eval_interpolate s _ x hx,
    simp_rw dif_pos hx end }

theorem interpolate_eq_interpolate_erase_add {x y : F} (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y) :
  interpolate s f =
  C (y - x)⁻¹ * ((X - C x) * interpolate (s.erase x) f + (C y - X) * interpolate (s.erase y) f) :=
begin
  refine eq_interpolate_of_eval_eq _ _ _ (λ z hz, _),
  { rw [degree_mul, degree_C (inv_ne_zero (sub_ne_zero.2 hxy.symm)), zero_add],
    refine lt_of_le_of_lt (degree_add_le _ _) (max_lt _ _),
    { rw [degree_mul, degree_X_sub_C],
      convert (with_bot.add_lt_add_iff_left (with_bot.coe_ne_bot _)).2
        (degree_interpolate_erase s f hx),
      simp [nat.one_add, nat.sub_one, nat.succ_pred_eq_of_pos (finset.card_pos.2 ⟨x, hx⟩)] },
    { rw [degree_mul, ←neg_sub, degree_neg, degree_X_sub_C],
      convert (with_bot.add_lt_add_iff_left (with_bot.coe_ne_bot _)).2
        (degree_interpolate_erase s f hy),
      simp [nat.one_add, nat.sub_one, nat.succ_pred_eq_of_pos (finset.card_pos.2 ⟨y, hy⟩)] } },
  { by_cases hzx : z = x,
    { simp [hzx, eval_interpolate (s.erase y) f x (finset.mem_erase_of_ne_of_mem hxy hx),
            inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm)] },
    { by_cases hzy : z = y,
      { simp [hzy, eval_interpolate (s.erase x) f y (finset.mem_erase_of_ne_of_mem hxy.symm hy),
              inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm)] },
      { simp only [eval_interpolate (s.erase x) f z (finset.mem_erase_of_ne_of_mem hzx hz),
                   eval_interpolate (s.erase y) f z (finset.mem_erase_of_ne_of_mem hzy hz),
                   inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm), eval_mul, eval_C, eval_add,
                   eval_sub, eval_X],
        ring } } }
end

end lagrange


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro h,
  by_contra hp,
  apply hp,
  exact h,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro h,
  by_contra hp,
  apply h,
  exact hp,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  intro h,
  by_contra hp,
  apply h,
  exact hp,

  intro h1,
  by_contra hp1,
  apply hp1,
  exact h1,
end

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

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro hPvQ,
  cases hPvQ with hP hQ,
  right,
  assumption,
  left,
  assumption,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro hPeQ,
  cases hPeQ 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 hPorQ,
  intro hp,
  cases hPorQ with hP hQ,
  exfalso,
  contradiction,
  exact hQ,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro hPorQ,
  intro hp,
  cases hPorQ with hP hQ,
  exfalso,
  contradiction,
  exact hQ,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intros hpq hnq hp,
  apply hnq,
  apply hpq,
  apply hp,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros h hp,
  change (Q → false) → (P → false) at h,
  by_contra hnq,
  apply h,
  exact hnq,
  exact hp,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intros hpq hnq hp,
  apply hnq,
  apply hpq,
  apply hp,

  intros h hp,
  change (Q → false) → (P → false) at h,
  by_contra hnq,
  apply h,
  exact hnq,
  exact hp,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro hp,
  apply hp,
  right,
  intro p,
  have PorP : P ∨ ¬P,
  left,
  exact p,
  apply hp,
  exact PorP,
end

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

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

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro PorQ,
  intro nPenQ,
  cases nPenQ with nPnQ,
  cases PorQ,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro PeQ,
  intro nPonQ,
  cases PeQ with PeQ,
  cases nPonQ,
  contradiction,
  contradiction,
end

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

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

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intros nPenQ PorQ,
  cases nPenQ with nP nQ,
  cases PorQ,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro PeQ,
  by_contra nQornP,
  apply PeQ,
  split,
  by_contra nP,
  apply nQornP,
  right,
  exact nP,
  by_contra nQ,
  apply nQornP,
  left,
  exact nQ,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro nQornP,
  intro PeQ,
  cases PeQ with hP hQ,
  cases nQornP,
  contradiction,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  intro PeQ,
  by_contra nQornP,
  apply PeQ,
  split,
  by_contra nP,
  apply nQornP,
  right,
  exact nP,
  by_contra nQ,
  apply nQornP,
  left,
  exact nQ,

  intro nQornP,
  intro PeQ,
  cases PeQ with hP hQ,
  cases nQornP,
  contradiction,
  contradiction,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  intro PorQ,
  split,
  intro hp,
  have PorQ : P ∨ Q,
  left,
  exact hp,
  contradiction,
  intro hq,
  have PorQ : P ∨ Q,
  right,
  exact hq,
  contradiction,

  intros nPenQ PorQ,
  cases nPenQ with nP nQ,
  cases PorQ,
  contradiction,
  contradiction,
end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  sorry
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  sorry,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  sorry,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  sorry,
end

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

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

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intros pqr PeQ,
  apply pqr,
  cases PeQ with hp hq,
  exact hp,
  cases PeQ 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 PeQ,
  cases PeQ with hp hq,
  exact hp,
end

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

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

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro PorP,
  cases PorP with hp1 hp2,
  exact hp1,
  exact hp2,
  intro hp,
  left,
  exact hp,
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
  sorry,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  sorry,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  sorry,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  sorry,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  sorry,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  sorry,
end

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  sorry,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  sorry,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  sorry,
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
  sorry,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  sorry,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  sorry,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  sorry,
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


variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  Iff.intro
    (fun h : p ∧ q => show q ∧ p from And.intro (And.right h) (And.left h))
    (fun h : q ∧ p => show p ∧ q from And.intro (And.right h) (And.left h))

example : p ∨ q ↔ q ∨ p :=
  Iff.intro
    (fun h : p ∨ q => show q ∨ p from
      Or.elim h
        (fun hp : p =>
          show q ∨ p from Or.intro_right q hp)
        (fun hq : q =>
          show q ∨ p from Or.intro_left p hq))
    (fun h : q ∨ p => show p ∨ q from
      Or.elim h
        (fun hq : q =>
          show p ∨ q from Or.intro_right p hq)
        (fun hp : p =>
          show p ∨ q from Or.intro_left q hp))

-- -- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  Iff.intro
    (fun h: (p ∧ q) ∧ r => show p ∧ (q ∧ r) from
        have hpq : (p ∧ q) := h.left
        have hr : r := h.right
        And.intro (And.left hpq) (And.intro (And.right hpq) hr))
    (fun h: p ∧ (q ∧ r) => show (p ∧ q) ∧ r from
        have hp : p := h.left
        have hqr : (q ∧ r) := h.right
        And.intro (And.intro hp (And.left hqr)) hqr.right)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  Iff.intro
    (fun h : (p ∨ q) ∨ r => show p ∨ (q ∨ r) from
      h.elim
      (fun hpq => show p ∨ (q ∨ r) from
        hpq.elim
        (fun hp : p => Or.inl hp)
        (fun hq : q => Or.intro_right p (Or.intro_left r hq)))
      (fun hr: r => Or.intro_right p (Or.intro_right q hr)))
    (fun h: p ∨ (q ∨ r) => show (p ∨ q) ∨ r from
      h.elim
      (fun hp: p => Or.intro_left r (Or.intro_left q hp))
      (fun hqr : q ∨ r =>
        hqr.elim
        (fun hq => Or.intro_left r (Or.intro_right p hq))
        (fun hr => Or.inr hr)))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  Iff.intro
    (fun h : p ∧ (q ∨ r) => show (p ∧ q) ∨ (p ∧ r) from
      have hp : p := h.left
      Or.elim (h.right)
      (fun hq : q => Or.inl ⟨hp, hq⟩) -- p ∧ q
      (fun hr : r => Or.inr ⟨hp, hr⟩)) -- p ∧ r e Lean add ∨
    (fun h : (p ∧ q) ∨ (p ∧ r) => show p ∧ (q ∨ r) from
      Or.elim h
      (fun hpq =>
        have hp := hpq.left
        have hq := hpq.right
        ⟨hp, Or.inl hq⟩)
      (fun hpr =>
        have hp := hpr.left
        have hr := hpr.right
        ⟨hp, Or.inr hr⟩))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  Iff.intro
    (fun h: p ∨ (q ∧ r) => show (p ∨ q) ∧ (p ∨ r) from
      h.elim
      (fun hp : p => And.intro (Or.intro_left q hp) (Or.intro_left r hp))
      (fun hqr =>
        have hq : q := hqr.left
        have hr : r := hqr.right
        ⟨Or.inr hq, Or.inr hr⟩))
    (fun h: (p ∨ q) ∧ (p ∨ r) => show p ∨ (q ∧ r) from
      have hpq := h.left
      have hpr := h.right
      hpq.elim
      (fun hp => Or.inl hp)
      (fun hq =>
        hpr.elim
        (fun hp => Or.inl hp)
        (fun hr => Or.inr (And.intro hq hr))))

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  Iff.intro
  (fun h : p → (q → r) => show p ∧ q → r from (fun hpq => (h hpq.left) hpq.right))
  (fun h : p ∧ q → r => show p → (q → r) from (fun hp => fun hq => h (And.intro hp hq)))

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  Iff.intro
  (fun h : (p ∨ q) → r => show (p → r) ∧ (q → r) from
    And.intro (fun hp => h (Or.inl hp)) (fun hq => h (Or.inr hq)))
  (fun h : (p → r) ∧ (q → r) => show (p ∨ q) → r from
    (fun hpq => hpq.elim
      (fun hp => h.left hp)
      (fun hq => h.right hq)))

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  Iff.intro
  (fun h : ¬(p ∨ q) => show ¬p ∧ ¬q from
    And.intro (fun hp => h (Or.inl hp)) (fun hq => h (Or.inr hq)))
  (fun h : ¬p ∧ ¬q => show ¬(p ∨ q) from
  (fun hpq => hpq.elim
    (fun hp => h.left hp)
    (fun hq => h.right hq)))

-- example : ¬p ∨ ¬q → ¬(p ∧ q) := sorry
example (h : ¬p ∨ ¬q) : ¬(p ∧ q) :=
  h.elim
  (fun hnp => show ¬(p ∧ q) from (fun hp => hnp hp.left))
  (fun hnq => show ¬(p ∧ q) from (fun hq => hnq hq.right))

example : ¬(p ∧ ¬p) := fun hp => absurd hp.left hp.right

-- example : p ∧ ¬q → ¬(p → q) := sorry
example (h : p ∧ ¬q) : ¬(p → q) := fun hp => absurd (hp h.left) h.right

-- example : ¬p → (p → q) := sorry
example (hnp : ¬p) : (p → q) := fun hp => False.elim (hnp hp)

-- example : (¬p ∨ q) → (p → q) := sorry
example (h : ¬p ∨ q) : (p → q) :=
  fun hp : p =>
    h.elim
    (fun hnp => show q from False.elim (hnp hp))
    (fun hq => hq)

example : p ∨ False ↔ p :=
  Iff.intro
    (fun hpf : p ∨ False => show p from
      hpf.elim
      (fun hp => hp)
      (fun hf => False.elim hf))
    (fun hp : p => show p ∨ False from Or.intro_left False hp)

example : p ∧ False ↔ False :=
  Iff.intro
    (fun h : p ∧ False => show False from h.right)
    (fun h : False => show p ∧ False from False.elim h)

example (h : p → q) : (¬q → ¬p) := fun hnq => fun hp => hnq (h hp)

open Classical

example (h : p → q ∨ r) : (p → q) ∨ (p → r) := Or.elim (em p)
  (fun hp => (Or.elim (h hp)
    (fun hq => Or.inl (fun _ => hq))
    (fun hr => Or.inr (fun _ => hr))))
  (fun hnp => Or.inl (fun hp => False.elim (hnp hp)))

example (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
  Or.elim (em p)
    (fun hp => Or.inr (fun hq => h (And.intro hp hq)))
    (fun hnp => Or.inl hnp)

example : ¬(p → q) → p ∧ ¬q := fun h => Or.elim (em p)
  (fun hp => And.intro hp (fun hq => absurd (fun _ => hq) h))
  (fun hnp => And.intro
    (False.elim (h (fun hp => False.elim (absurd hp hnp))))
    (fun hq => absurd (fun _ => hq) h))

example (h : p → q) : ¬p ∨ q := Or.elim (em p)
  (fun hp => Or.inr (h hp))
  (fun hnp => Or.inl hnp)

example (h : ¬q → ¬p) : (p → q) := fun hp => Or.elim (em q)
  (fun hq => hq)
  (fun hnq => False.elim ((h hnq) hp))

example : p ∨ ¬p := em p

example (_ : p → q) (hp: p) : p := byContradiction (fun hnp => hnp hp)

example : ((p → q) → p) → p := fun h => Or.elim (em p)
    (fun hp => hp)
    (fun hnp => absurd (h (fun hp => byContradiction (fun _ => hnp hp))) hnp)


/- LoVe Homework 8: Operational Semantics -/

import .lovelib

namespace LoVe

/- Question 1: Semantics of Regular Expressions

Regular expression are a very popular tool for software development. Often, when
textual input needs to be analyzed it is matched against a regular expression.
In this homework, we define the syntax of regular expressions and what it means
that a regular expression matches a string.

We define `regex` to represent the following grammar:

    R ::= c       — `char`: accepts one character `c`
        | ∅       — `nothing`: accepts nothing
        | ε       — `empty`: accepts the empty string
        | R ⬝ R    — `concat`: accepts the concatenation of two regexes
        | R + R   — `alt`: accepts either of two regexes
        | R*      — `star`: accept arbitrary many repetitions of a regex

Notice the rough correspondence with a WHILE language:

  `char`   ~ assignment
  `empty`  ~ `skip`
  `concat` ~ sequential composition
  `alt`    ~ conditional statement
  `star`   ~ while loop -/

inductive regex : Type
| char    : char → regex
| nothing : regex
| empty   : regex
| concat  : regex → regex → regex
| alt     : regex → regex → regex
| star    : regex → regex

/- The `accept r s` predicate indicates that the regular expression `r` accepts
the string `s`. -/

inductive accept : regex → list char → Prop
/- accept one character -/
| char (c : char) :
  accept (regex.char c) [c]
/- accept the empty string -/
| empty :
  accept regex.empty []
/- accept two concatenated regexes -/
| concat {r₁ r₂ : regex} (s₁ s₂ : list char) (h₁ : accept r₁ s₁)
    (h₂ : accept r₂ s₂) :
  accept (regex.concat r₁ r₂) (s₁ ++ s₂)
/- accept the left alternative -/
| alt_left {r₁ r₂ : regex} (s : list char) (h : accept r₁ s) :
  accept (regex.alt r₁ r₂) s
/- accept the right alternative -/
| alt_right {r₁ r₂ : regex} (s : list char) (h : accept r₂ s) :
  accept (regex.alt r₁ r₂) s
/- accepts the empty string; this is the base case of `R*` -/
| star_base {r : regex} : accept (regex.star r) []
/- accepts `R` followed again by `R*`; this is the induction step of `R*` -/
| star_step {r : regex} (s s' : list char) (h₁ : accept r s)
    (h₂ : accept (regex.star r) s') :
  accept (regex.star r) (s ++ s')

/- 1.1. Explain why there is no rule for `nothing`. -/

-- enter your answer here

/- 1.2. Prove the following inversion rules.

These proofs are very similar to the inversion rules in the lecture and the
exercise. -/

@[simp] lemma accept_char {s : list char} {c : char} :
  accept (regex.char c) s ↔ s = [c] :=
sorry

@[simp] lemma accept_nothing {s : list char} :
  ¬ accept regex.nothing s :=
sorry

@[simp] lemma accept_empty {s : list char} :
  accept regex.empty s ↔ s = [] :=
sorry

@[simp] lemma accept_concat {s : list char} {r₁ r₂  : regex} :
  accept (regex.concat r₁ r₂) s
  ↔ (∃s₁ s₂, accept r₁ s₁ ∧ accept r₂ s₂ ∧ s = s₁ ++ s₂) :=
sorry

@[simp] lemma accept_alt {s : list char} {r₁ r₂  : regex} :
  accept (regex.alt r₁ r₂) s ↔ (accept r₁ s ∨ accept r₂ s) :=
sorry

lemma accept_star {s : list char} {r : regex} :
  accept (regex.star r) s ↔
  (s = [] ∨ (∃s₁ s₂, accept r s₁ ∧ accept (regex.star r) s₂ ∧ s = s₁ ++ s₂)) :=
sorry

end LoVe


-- La función identidad es menor o igual que la función de extracción
-- ==================================================================

import data.real.basic
open nat

variable {φ : ℕ → ℕ}

set_option pp.structure_projections false

-- ----------------------------------------------------
-- Ejercicio 1. Para extraer una subsucesión se aplica una
-- función de extracción que conserva el orden; por
-- ejemplo, la subsucesión
--    uₒ, u₂, u₄, u₆, ...
-- se ha obtenido con la función de extracción φ tal
-- que φ(n) = 2*n.
--
-- Definir la función
--    extraccion : (ℕ → ℕ) → Prop
-- tal que (extraccion φ) expresa que φ es una función
-- de extracción
-- ----------------------------------------------------

def extraccion : (ℕ → ℕ) → Prop
| φ := ∀ n m, n < m → φ n < φ m

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar que si φ es una función de
-- extracción, entonces
--    ∀ n, n ≤ φ n
-- ----------------------------------------------------

-- 1ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
begin
  intros h n,
  induction n with m HI,
  { exact nat.zero_le (φ 0), },
  { apply nat.succ_le_of_lt,
    have h1 : m < succ m,
      from lt_add_one m,
    calc m ≤ φ m        : HI
       ... < φ (succ m) : h m (succ m) h1, },
end

-- 2ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
begin
  intros h n,
  induction n with m HI,
  { exact nat.zero_le _ },
  { apply nat.succ_le_of_lt,
    calc m ≤ φ m        : HI
       ... < φ (succ m) : by linarith [h m (m+1) (by linarith)] },
end

-- 3ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
begin
  intros h n,
  induction n with m HI,
  { linarith },
  { apply nat.succ_le_of_lt,
    linarith [h m (m+1) (by linarith)] },
end

-- 4ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
begin
  intros h n,
  induction n with m HI,
  { linarith },
  { exact nat.succ_le_of_lt (by linarith [h m (m+1) (by linarith)]) },
end

-- 5ª demostración
example :
  extraccion φ → ∀ n, n ≤ φ n :=
assume h : extraccion φ,
assume n,
nat.rec_on n
  ( show 0 ≤ φ 0,
      from nat.zero_le (φ 0) )
  ( assume m,
    assume HI : m ≤ φ m,
    have h1 : m < succ m,
      from lt_add_one m,
    have h2 : m < φ (succ m), from
      calc m ≤ φ m        : HI
         ... < φ (succ m) : h m (succ m) h1,
    show succ m ≤ φ (succ m),
      from nat.succ_le_of_lt h2)


/-
  Results about matrices, PSD, etc.
-/
import data.real.basic
import data.matrix.basic
import linear_algebra.matrix
import linear_algebra.eigenspace
import to_mathlib.matrix

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

open_locale big_operators
open_locale matrix

open matrix module.End

-- Positive semidefiniteness.

variable [linear_ordered_comm_ring R]

def pos_semidef (M : matrix γ γ R)  : Prop :=
∀ (v : γ → R), 0 ≤ dot_product v (M.mul_vec v)

theorem pos_semidef_sum
  {A B : matrix γ γ R}
  (hApsd : pos_semidef A) (hBpsd : pos_semidef B)
: pos_semidef (A + B) :=
begin
  intros v, rw [matrix.add_mul_vec, dot_product_add],
  exact add_nonneg (hApsd v) (hBpsd v),
end

theorem pos_semidef_nonneg_diagonal {D : γ → R} (hD : 0 ≤ D)
: pos_semidef (diagonal D) :=
begin
  intros v, rw dot_product_comm, rw dot_product_diagonal_mul_vec_eq,
  exact dot_product_of_nonneg hD (vec_mul_self_nonneg v),
end

-- Cholesky.

def cholesky_decomposition (M : matrix γ γ R) (h : symmetric M) : Prop :=
∃ L : matrix μ γ R, M = Lᵀ ⬝ L

theorem pos_semidef_of_cholesky_decomposition (M : matrix γ γ R) (h : symmetric M)
: @cholesky_decomposition γ _ _ μ _ _ R _ M h → pos_semidef M :=
begin
  rintros ⟨L, hL⟩ v, rw hL, rw [dot_product_transpose],
  exact dot_product_self_nonneg _,
end

-- LDLT.

-- TODO: This is technically LTDL...
def LDLT_decomposition (M : matrix γ γ R) (h : symmetric M) : Prop :=
∃ (L : matrix γ γ R) (D : γ → R), M = Lᵀ ⬝ (diagonal D) ⬝ L ∧ 0 ≤ D

theorem pos_semidef_of_LDLT_decomposition (M : matrix γ γ R) (h : symmetric M)
: LDLT_decomposition M h → pos_semidef M :=
begin
  rintros ⟨L, D, hLDLT, hD⟩ v,
  rw [hLDLT, matrix.mul_assoc, dot_product_transpose],
  rw [←mul_vec_mul_vec, dot_product_comm, dot_product_diagonal_mul_vec_eq],
  exact (dot_product_of_nonneg hD (vec_mul_self_nonneg _)),
end

-- Nonnegative eigenvalues.

def nonneg_eigenvalues (M : matrix γ γ R) (h : symmetric M) : Prop :=
∀ r, has_eigenvalue (mul_vec_lin M) r → r ≥ 0


/-
If P and Q are arbitrary propositions, then to prove
P ∨ Q, you need to prove either P or Q and then use
one of the or introduction rules to form a proof of
the disjunction.
-/

-- Suppose P and Q are arbitrary propositions
axioms (P Q : Prop)

-- Suppose you have proofs of P and of Q
axioms (p : P) (q : Q)

-- You can now construct proofs of P ∨ Q

#check or.intro_left Q p
#check or.intro_right P q

/-
If the type of the disjunction for which a
proof is not provided can be inferred then
the shorthand form of these rules can be
used.
-/

example : P ∨ Q := or.inl p
example : P ∨ Q := or.inr q

/-
The elimination rule for using a proof of
a disjunction requires a case analysis. If
you have a proof of P ∨ Q, and you can show
that P → R and Q → R, then you've shown that
R is true *in either case* (whether P ∨ Q is
true because P is or because Q is).
-/

axioms Raining Sprinkler StreetsWet: Prop
axiom rw : Raining → StreetsWet

example : (Raining ∨ Sprinkler) →
          (Raining → StreetsWet) →
          (Sprinkler → StreetsWet) →
          StreetsWet :=
λ (rors : Raining ∨ Sprinkler), -- if you assume R ∨ S
λ (rw : Raining → StreetsWet),   -- and you can prove R→W
λ (sw : Sprinkler → StreetsWet), -- and also S→W
   match rors with  -- then you can prove W "by case analysis"
    | or.inl r := rw r  -- if it's raining the streets are wet
    | or.inr s := sw s  -- if the sprinker's on, they're wet
   end                  -- so they're wet in either case QED.


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

Basic operations on the natural numbers.
-/
import ..num algebra.ring
open binary eq.ops

namespace nat

/- a variant of add, defined by recursion on the first argument -/

definition addl (x y : ℕ) : ℕ :=
nat.rec y (λ n r, succ r) x
infix ` ⊕ `:65 := addl

theorem addl_succ_right (n m : ℕ) : n ⊕ succ m = succ (n ⊕ m) :=
nat.induction_on n
  rfl
  (λ n₁ ih, calc
    succ n₁ ⊕ succ m = succ (n₁ ⊕ succ m)   : rfl
             ...     = succ (succ (n₁ ⊕ m)) : ih
             ...     = succ (succ n₁ ⊕ m)   : rfl)

theorem add_eq_addl (x : ℕ) : ∀y, x + y = x ⊕ y :=
nat.induction_on x
  (λ y, nat.induction_on y
    rfl
    (λ y₁ ih, calc
      0 + succ y₁ = succ (0 + y₁)  : rfl
           ...    = succ (0 ⊕ y₁) : {ih}
           ...    = 0 ⊕ (succ y₁) : rfl))
  (λ x₁ ih₁ y, nat.induction_on y
    (calc
      succ x₁ + 0  = succ (x₁ + 0)  : rfl
               ... = succ (x₁ ⊕ 0) : {ih₁ 0}
               ... = succ x₁ ⊕ 0   : rfl)
    (λ y₁ ih₂, calc
      succ x₁ + succ y₁ = succ (succ x₁ + y₁) : rfl
                   ...  = succ (succ x₁ ⊕ y₁) : {ih₂}
                   ...  = succ x₁ ⊕ succ y₁   : addl_succ_right))

/- successor and predecessor -/

theorem succ_ne_zero [simp] (n : ℕ) : succ n ≠ 0 :=
by contradiction

theorem add_one_ne_zero [simp] (n : ℕ) : n + 1 ≠ 0 :=
by contradiction

-- add_rewrite succ_ne_zero

theorem pred_zero [simp] : pred 0 = 0 :=
rfl

theorem pred_succ [simp] (n : ℕ) : pred (succ n) = n :=
rfl

theorem eq_zero_or_eq_succ_pred (n : ℕ) : n = 0 ∨ n = succ (pred n) :=
nat.induction_on n
  (or.inl rfl)
  (take m IH, or.inr
    (show succ m = succ (pred (succ m)), from congr_arg succ !pred_succ⁻¹))

theorem exists_eq_succ_of_ne_zero {n : ℕ} (H : n ≠ 0) : ∃k : ℕ, n = succ k :=
exists.intro _ (or_resolve_right !eq_zero_or_eq_succ_pred H)

theorem succ.inj {n m : ℕ} (H : succ n = succ m) : n = m :=
nat.no_confusion H imp.id

abbreviation eq_of_succ_eq_succ := @succ.inj

theorem succ_ne_self {n : ℕ} : succ n ≠ n :=
nat.induction_on n
  (take H : 1 = 0,
    have ne : 1 ≠ 0, from !succ_ne_zero,
    absurd H ne)
  (take k IH H, IH (succ.inj H))

theorem discriminate {B : Prop} {n : ℕ} (H1: n = 0 → B) (H2 : ∀m, n = succ m → B) : B :=
have H : n = n → B, from nat.cases_on n H1 H2,
H rfl

theorem two_step_induction_on {P : ℕ → Prop} (a : ℕ) (H1 : P 0) (H2 : P 1)
    (H3 : ∀ (n : ℕ) (IH1 : P n) (IH2 : P (succ n)), P (succ (succ n))) : P a :=
have stronger : P a ∧ P (succ a), from
  nat.induction_on a
    (and.intro H1 H2)
    (take k IH,
      have IH1 : P k, from and.elim_left IH,
      have IH2 : P (succ k), from and.elim_right IH,
        and.intro IH2 (H3 k IH1 IH2)),
  and.elim_left stronger

theorem sub_induction {P : ℕ → ℕ → Prop} (n m : ℕ) (H1 : ∀m, P 0 m)
   (H2 : ∀n, P (succ n) 0) (H3 : ∀n m, P n m → P (succ n) (succ m)) : P n m :=
have general : ∀m, P n m, from nat.induction_on n H1
  (take k : ℕ,
    assume IH : ∀m, P k m,
    take m : ℕ,
    nat.cases_on m (H2 k) (take l, (H3 k l (IH l)))),
general m

/- addition -/

protected theorem add_zero (n : ℕ) : n + 0 = n :=
rfl

theorem add_succ (n m : ℕ) : n + succ m = succ (n + m) :=
rfl

/-
Remark: we use 'local attributes' because in the end of the file
we show not is a comm_semiring, and we will automatically inherit
the associated [simp] lemmas from algebra
-/
local attribute nat.add_zero nat.add_succ [simp]

protected theorem zero_add (n : ℕ) : 0 + n = n :=
by rec_simp

theorem succ_add (n m : ℕ) : (succ n) + m = succ (n + m) :=
by rec_simp

local attribute nat.zero_add nat.succ_add [simp]

protected theorem add_comm (n m : ℕ) : n + m = m + n :=
by rec_simp

theorem succ_add_eq_succ_add (n m : ℕ) : succ n + m = n + succ m :=
by simp

protected theorem add_assoc (n m k : ℕ) : (n + m) + k = n + (m + k) :=
by rec_simp

protected theorem add_left_comm : Π (n m k : ℕ), n + (m + k) = m + (n + k) :=
left_comm nat.add_comm nat.add_assoc

local attribute nat.add_comm nat.add_assoc nat.add_left_comm [simp]

protected theorem add_right_comm : Π (n m k : ℕ), n + m + k = n + k + m :=
right_comm nat.add_comm nat.add_assoc

protected theorem add_left_cancel {n m k : ℕ} : n + m = n + k → m = k :=
nat.induction_on n
  (by simp)
  (take a iH,
    -- TODO(Leo): replace with forward reasoning after we add strategies for it.
    have succ (a + m) = succ (a + k) → a + m = a + k, from !succ.inj,
    by inst_simp)

protected theorem add_right_cancel {n m k : ℕ} (H : n + m = k + m) : n = k :=
have H2 : m + n = m + k, by simp,
nat.add_left_cancel H2

theorem eq_zero_of_add_eq_zero_right {n m : ℕ} : n + m = 0 → n = 0 :=
nat.induction_on n
  (by simp)
  (take k iH, assume H : succ k + m = 0,
    absurd
      (show succ (k + m) = 0, by simp)
      !succ_ne_zero)

theorem eq_zero_of_add_eq_zero_left {n m : ℕ} (H : n + m = 0) : m = 0 :=
eq_zero_of_add_eq_zero_right (!nat.add_comm ⬝ H)

theorem eq_zero_and_eq_zero_of_add_eq_zero {n m : ℕ} (H : n + m = 0) : n = 0 ∧ m = 0 :=
and.intro (eq_zero_of_add_eq_zero_right H) (eq_zero_of_add_eq_zero_left H)

theorem add_one (n : ℕ) : n + 1 = succ n := rfl

local attribute add_one [simp]

theorem one_add (n : ℕ) : 1 + n = succ n :=
by simp

theorem succ_eq_add_one (n : ℕ) : succ n = n + 1 :=
rfl

/- multiplication -/

protected theorem mul_zero (n : ℕ) : n * 0 = 0 :=
rfl

theorem mul_succ (n m : ℕ) : n * succ m = n * m + n :=
rfl

local attribute nat.mul_zero nat.mul_succ [simp]

-- commutativity, distributivity, associativity, identity

protected theorem zero_mul (n : ℕ) : 0 * n = 0 :=
by rec_simp

theorem succ_mul (n m : ℕ) : (succ n) * m = (n * m) + m :=
by rec_simp

local attribute nat.zero_mul nat.succ_mul [simp]

protected theorem mul_comm (n m : ℕ) : n * m = m * n :=
by rec_simp

protected theorem right_distrib (n m k : ℕ) : (n + m) * k = n * k + m * k :=
by rec_simp

protected theorem left_distrib (n m k : ℕ) : n * (m + k) = n * m + n * k :=
by rec_simp

local attribute nat.mul_comm nat.right_distrib nat.left_distrib [simp]

protected theorem mul_assoc (n m k : ℕ) : (n * m) * k = n * (m * k) :=
by rec_simp

local attribute nat.mul_assoc [simp]

protected theorem mul_one (n : ℕ) : n * 1 = n :=
calc
  n * 1 = n * 0 + n : mul_succ
    ... = n         : by simp

local attribute nat.mul_one [simp]

protected theorem one_mul (n : ℕ) : 1 * n = n :=
by simp

local attribute nat.one_mul [simp]

theorem eq_zero_or_eq_zero_of_mul_eq_zero {n m : ℕ} : n * m = 0 → n = 0 ∨ m = 0 :=
nat.cases_on n (by simp)
  (take n',
    nat.cases_on m
      (by simp)
      (take m', assume H,
        absurd
          (show succ (succ n' * m' + n') = 0, by simp)
          !succ_ne_zero))

protected definition comm_semiring [trans_instance] : comm_semiring nat :=
⦃comm_semiring,
 add            := nat.add,
 add_assoc      := nat.add_assoc,
 zero           := nat.zero,
 zero_add       := nat.zero_add,
 add_zero       := nat.add_zero,
 add_comm       := nat.add_comm,
 mul            := nat.mul,
 mul_assoc      := nat.mul_assoc,
 one            := nat.succ nat.zero,
 one_mul        := nat.one_mul,
 mul_one        := nat.mul_one,
 left_distrib   := nat.left_distrib,
 right_distrib  := nat.right_distrib,
 zero_mul       := nat.zero_mul,
 mul_zero       := nat.mul_zero,
 mul_comm       := nat.mul_comm⦄

end nat

section
open nat
definition iterate {A : Type} (op : A → A) : ℕ → A → A
 | 0 := λ a, a
 | (succ k) := λ a, op (iterate k a)

notation f`^[`n`]` := iterate f n
end


import game.limits.seq_bdd_iff_range_bdd

namespace xena --hide

/-
Bounded monotone sequences converge
-/

def is_increasing (a : ℕ → ℝ) := ∀ n : ℕ, a n ≤ a (n+1)
def is_decreasing (a : ℕ → ℝ) := ∀ n : ℕ, a (n + 1) ≤ a n
def is_monotone (a : ℕ → ℝ) := is_increasing a ∨ is_decreasing a

-- begin hide
-- Note: later we use (n ≤ k) → (a n ≤ a k) for `a` monotone increasing
-- and (n ≤ k) → (a k ≤ a n) for decreasing. Should these be proved first,
-- or use mathlib's versions of monotone?
--https://leanprover-community.github.io/mathlib_docs/order/basic.html

theorem is_increasing' (a : ℕ → ℝ) : is_increasing a ↔ (∀ m n : ℕ,
 m ≤ n → a m ≤ a n) :=
begin
split,
intros inc m n,
{intro hyp,
induction hyp with k hyp ihyp,
exact le_refl (a m),
exact le_trans ihyp (inc k),},
intros hyp p,
exact (hyp p (p + 1)) (nat.le_succ p),
end

theorem is_decreasing' (a : ℕ → ℝ) : is_decreasing a ↔ (∀ m n : ℕ,
 m ≤ n → a n ≤ a m) :=
begin
split,
intros dec m n,
{intro hyp,
induction hyp with k hyp ihyp,
exact le_refl (a m),
exact le_trans (dec k) ihyp,},
intros hyp p,
exact (hyp p (p + 1)) (nat.le_succ p),
end
-- end hide

/- Lemma
Bounded monotone sequences converge.
-/

theorem bdd_mono_converges (a : ℕ → ℝ) (h1 : is_bounded a) (h2 : is_monotone a):
is_convergent a :=
begin
-- As before, M is the set of terms of our sequence a
let M := set.range a,

-- The increasing and the decreasing cases will be similar
cases h2 with increasing decreasing,

    -- monotone increasing case
    {
    have fact1: has_lub M,
    -- We use the completeness axiom (least upper bound property)
    -- to show that M has a sup. refine produces two subgoals that we
    -- will need to prove to show that the sup exists.
    refine lub_property_reals M _,

    split,
        -- As our sequence `a` is a function from the nonempty set ℕ,
        -- its range is nonempty
        {
        exact set.range_nonempty a,
        },
        -- We use the → (.mp) direction of our previous `trivial` lemma
        -- to prove that M is bounded above
        {exact ((seq_bdd_iff_range_bdd a).mp h1).left,
        },

    -- So M has a lub, call it s.
    cases fact1 with s hyp_s,

    -- It seems reasonable to assume that s is the limit of a
    use s,
    intros e hype,

    -- We show that s - e cannot be an upper bound for M (our set of terms)
    have fact2: ¬ is_upper_bound M (s - e),
    by_contradiction claim,
    -- hyp_s.right says if y is any upper bound of M, then s ≤ y
    -- (supremum condition)
    let forcontra := hyp_s.right (s - e) claim,
    --forcontra says that s ≤ s - e. But e is positive, so linarith closes.
    linarith,

    -- we now unfold the fact that s - e is not an upper bound for M,
    -- and prove that s is the limit of our increasing sequence
    unfold is_upper_bound at fact2,
    push_neg at fact2,
    cases fact2 with l hypl,
    -- hypl.right is a proof that s - e < l, for some l ∈ M
    -- we want l expressed in the form a N0 for some N0,
    cases hypl.left with N0 hypN0,
    use N0,
    intros k hypk,
    -- applying the theorem proved above
    rw is_increasing' at increasing,
    have fact3:= (increasing N0 k) hypk,
    refine abs_lt.mpr _,
    split,
    linarith,
    have fact4: a k ≤ s,
    exact hyp_s.left (a k) (set.mem_range_self k),
    linarith,
    },

    --monotone decreasing case, using the same strategy
    {
    have fact3: has_glb M,
    refine glb_property_reals M _,

    split,
        {
        exact set.range_nonempty a,
        },

        {
        exact ((seq_bdd_iff_range_bdd a).mp h1).right,
        },

    cases fact3 with i hyp_i,
    use i,

    intros e hype,

    -- We show that i + e cannot be a lower bound for M (our set of terms)
    have fact4: ¬ is_lower_bound M (i + e),
    by_contradiction claim,
    let forcontra := hyp_i.right (i + e) claim,
    linarith,

    unfold is_lower_bound at fact4,
    push_neg at fact4,
    cases fact4 with m hypm,

    cases hypm.left with N0 hypN0,
    use N0,
    intros k hypk,
    -- applying the theorem proved above
    rw is_decreasing' at decreasing,
    have fact5:= (decreasing N0 k) hypk,
    refine abs_lt.mpr _,
    split,
    have fact4: i ≤ a k,
    exact hyp_i.left (a k) (set.mem_range_self k),
    linarith,
    linarith,
    },

end

end xena -- hide


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Div

namespace Nat

private def gcdF (x : Nat) : (∀ x₁, x₁ < x → Nat → Nat) → Nat → Nat :=
  match x with
  | 0      => fun _ y => y
  | succ x => fun f y => f (y % succ x) (mod_lt _ (zeroLtSucc  _)) (succ x)

@[extern "lean_nat_gcd"]
def gcd (a b : @& Nat) : Nat :=
  WellFounded.fix ltWf gcdF a b

@[simp] theorem gcd_zero_left (y : Nat) : gcd 0 y = y :=
  rfl

theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) :=
  rfl

@[simp] theorem gcd_one_left (n : Nat) : gcd 1 n = 1 := by
  rw [gcd_succ, mod_one]
  rfl

@[simp] theorem gcd_zero_right (n : Nat) : gcd n 0 = n := by
  cases n <;> simp [gcd_succ]

@[simp] theorem gcd_self (n : Nat) : gcd n n = n := by
  cases n <;> simp [gcd_succ]

end Nat