set_option pp.structure_projections false

namespace l10
open nat

#check nat
#check ℕ
#check zero
#check succ
#check succ zero
#check succ (succ(succ zero))

/--
inductive nat: Type
| zero : nat
| succ : nat → nat
--/

--zero and succ are different
--succ is injective : if succ m = succ n then m = n
--all the natural numbers are generaed from zero and succ

example : ∀ n : ℕ, 0 ≠ succ n :=
begin
  assume n h,
  contradiction,
end

def pred : ℕ → ℕ
| zero := zero
| (succ n) := n

#reduce (pred 7)

theorem inj_succ : ∀ m n : ℕ, succ m = succ n → m = n :=
begin
  assume m n h,
  change pred (succ m) = pred (succ n),
  rewrite h,
end
--utomatically for all inductive types which avoids the need to define pred:
example :  ∀ m n : nat, succ m = succ n → m = n :=
begin
  assume m n h,
  injection h, --given h : succ m = succ n, we can prove m = n
end

--structural recursion (primitive recursion)
def double : ℕ → ℕ
| zero := 0
| (succ n) := succ (succ (double n))
--double 7 = double (succ 6) = succ (succ (double 6)) = succ (succ 12) = 14

#reduce (double 7)

def half : ℕ → ℕ
| zero := zero
| (succ zero) := zero
| (succ (succ n)) := succ (half n)

#reduce (half 7)
#reduce (half (double 7))

/--
def foo3 : ℕ → ℕ
| 0 := 0
| (succ n) := foo3 (succ n)
--/
--non terminating recursion

--proof by induction
theorem half_double : ∀ n : ℕ , half (double n) = n :=
begin
  assume n,
  induction n with n' ih, --induction hypothesis
  refl,
  dsimp [double],
  dsimp [half],  --similar to apply
  apply congr_arg succ, --eliminate same term
  --exact ih,
  rewrite ih,
end
end l10

namespace l11

set_option pp.structure_projections false
open nat

--primirative/structural recursion
--induction

def foo : ℕ → ℕ
| 0 := 0
| (succ n) := succ (foo n)

#reduce (foo 7)

example : ∀ n : ℕ , foo n = n :=
begin
  assume n,
  induction n with n' ih,
  --dsimp[foo],
  reflexivity,

  dsimp[foo],
  --apply congr_arg succ,
  --exact ih,
  rewrite ih,
end

def add : ℕ → ℕ → ℕ
| m  zero     := m
| m  (succ n) := succ (add m n)

#reduce add 7 3

local notation m + n := add m n

theorem add_rneutr : ∀ n : ℕ, n + 0 = n := --right neutral
begin
  assume n,
  dsimp[(+),add],
  refl,
end

theorem add_lneutr : ∀ n : ℕ, 0 + n  = n :=
begin
  assume n,
  induction n with n' ih,
  refl,

  apply congr_arg succ, --local notation
  exact ih,
end

--associativity

theorem add_assoc : ∀ l m n : ℕ , (l + m) + n = l + (m + n) :=
begin
  assume l m n,
  induction n with n' ih,
  --dsimp[(+),add],
  refl,

  dsimp [(+), add],
  apply congr_arg succ,
  exact ih,
end
--shown that + with 0 is a monoid
--another monoid 1 * n

-- commutativity
lemma add_succ_lem : ∀ m n : ℕ, succ m + n = succ (m + n) :=
begin
  assume m n,
  induction n with n' ih,
  --dsimp[(+),add],
  refl,

  apply congr_arg succ,
  exact ih,
end

theorem add_comm : ∀ m n : ℕ , m + n = n + m :=
begin
  assume m n,
  induction m with m' ih,
  dsimp[(+),add],
  apply add_lneutr,--left neutral --rewrite lneutr,

  dsimp[(+),add],
  --transitivity,
  rewrite add_succ_lem,
  apply congr_arg succ,
  exact ih,
end

theorem add_comm2 : ∀ m n : ℕ , m + n = n + m :=
begin
  assume m n,
  induction m with m' ih,
  dsimp[(+),add],
  rewrite add_lneutr,
  calc
    succ m' + n = succ (m' + n) : by apply add_succ_lem
    ... = succ (n + m') : by apply congr_arg succ ih
    ... = n + succ m' : by refl
end

end l11


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro hp,
  intro hdn,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro hp,
  by_cases h : P,
  exact h,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  apply iff.intro,
  apply doubleneg_elim,
  apply doubleneg_intro,
end

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

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

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

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

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  intro hp,
  cases h with hnp hnq,
  contradiction,
  assumption,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro h,
  intro hpq,
  cases h with hnp hnq,
  contradiction,
  assumption,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro hp,
  intro hnpq,
  intro hnp,
  have hq : Q := hp hnp,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro hp,
  intro hpq,
  by_contra,
  apply hp,
  contradiction,
  assumption,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  apply iff.intro,
  apply impl_as_contrapositive,
  apply impl_as_contrapositive_converse,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro h,
  apply h,
  right,
  intro hp,
  apply h,
  left,
  assumption,
end

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

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro hp,
  intro hnnp,
  apply hnnp,
  apply hp,
  intro hnp,
  by_cases h: Q,
  exact h,
  contradiction,
end

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro hi,
  intro hc,
  cases hc with hnp hnq,
  cases hi with hip hiq,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro hc,
  intro hn,
  cases hn with hnp hnq,
  cases hc with hcp hcq,
  contradiction,
  cases hc with hcp hcq,
  contradiction,
end

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

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

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro hc,
  intro hnor,
  cases hnor with hp hq,
  cases hc with hnp hnq,
  contradiction,
  cases hc with hnp hnq,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro hi,
  by_contra hn,
  apply hi,
  split,
  by_contra hnp,
  apply hn,
  right,
  exact hnp,
  by_contra hnq,
  apply hn,
  left,
  exact hnq,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro hnd,
  intro hc,
  cases hc with hcp hcq,
  cases hnd with hndp hndq,
  contradiction,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  apply iff.intro,
  apply demorgan_conj,
  apply demorgan_conj_converse,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  apply iff.intro,
  apply demorgan_disj,
  apply demorgan_disj_converse,
end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro hi,
  cases hi with hip hiq,
  cases hiq with hiq hir,
  left,
  split,
  exact hip,
  exact hiq,
  right,
  split,
  exact hip,
  exact hir,
end

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

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

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

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

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

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro hi,
  intro hpcq,
  apply hi,
  cases hpcq,
  exact hpcq_left,
  cases hpcq,
  exact hpcq_right,
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 hp,
  cases hp,
  exact hp_left,
end

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

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  apply iff.intro,
  apply weaken_conj_right,
  intro hpp,
  split,
  by_contra,
  contradiction,
  by_contra,
  contradiction,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  apply iff.intro,
  intro hd,
  cases hd,
  exact hd,
  exact hd,
  apply weaken_disj_right,
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
  intro hnepx,
  intro x,
  intro hpx,
  apply hnepx,
  existsi x,
  exact hpx,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro hepx,
  intro nx,
  cases nx with x hpx,
  have hnpx : ¬P x := hepx x,
  contradiction,
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


/-
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
import data.real.basic -- imports the real numbers

/-

# Figuring out how to use the reals

## The `library_search` tactic

We saw in the previous sheet that we couldn't even prove something
as simple as "if `aₙ → L` then `-aₙ → -L`" because when you write down
the proof carefully, it relies on the fact that `|x - y| = |y - x|`
or, equivalently, that `|(-x)| = |x|`. I say "equivalently" because
`ring` will prove that `-(x - y) = y - x`.

You don't want to be proving stuff like `|x - y| = |y - x|` from first
principles. Someone else has already done all the hard work for you.
All you need to do is to learn how to find out the names of the lemmas.
The `library_search` tactic tells you the names of all these lemmas.
See where it says "try this" -- click there and Lean will replace
`library_search` with the actual name of the lemma. Once you've done
that, hover over the lemma name to see in what generality it holds.

## The `linarith` tactic

Some of the results below are bare inequalities which are too complex
to be in the library. The library contains "natural" or "standard"
results, but it doesn't contain a random inequality fact just because
it happens to be true -- the library just contains "beautiful" facts.
However `linarith` doesn't know about anything other than `=`, `≠`,
`<` and `≤`, so don't expect it to prove any results about `|x|` or
`max A B`.

Experiment with the `library_search` and `linarith` tactics below.
Try and learn something about the naming convention which Lean uses;
see if you can start beginning to guess what various lemmas should be called.

-/

example (x : ℝ) : |(-x)| = |x| :=
begin
  library_search, -- or norm_num
end

example (x y : ℝ) : |x - y| = |y - x| :=
begin
  library_search, -- click where it says "try this" to replace
                  -- library_search with an "exact" proof
                  -- Why do this? Because it's much quicker!
end

example (A B C : ℕ) : max A B ≤ C ↔ A ≤ C ∧ B ≤ C :=
begin
  library_search, -- Hmm. What would a theorem saying "the max is
                  -- less-or-equal to something iff something else
                  -- be called, according to Lean's naming conventions?"
end

example (x y : ℝ) : |x| < y ↔ -y < x ∧ x < y :=
begin
  library_search, -- abs of something less than something...
end

example (ε : ℝ) (hε : 0 < ε) : 0 < ε / 2 :=
begin
  linarith,
end

example (a b x y : ℝ) (h1 : a < x) (h2 : b < y) : a + b < x + y :=
begin
  library_search, -- or linarith, or guess the name...
end

example (ε : ℝ) (hε : 0 < ε) : 0 < ε / 3 :=
begin
  linarith, -- apparently deemed too obscure for the library
end

example (a b c d x y : ℝ) (h1 : a + c < x) (h2 : b + d < y) :
  a + b + c + d < x + y :=
begin
  linarith, -- note that add_lt_add doesn't work because
            -- ((a+b)+c)+d and (a+c)+(b+d) are not definitionally equal
end


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

import tactic.ring
import data.nat.prime

/-!
# IMO 1959 Q1

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

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

open nat

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

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


import data.real.basic

/-
In the previous file, we saw how to rewrite using equalities.
The analogue operation with mathematical statements is rewriting using
equivalences. This is also done using the `rw` tactic.
Lean uses ↔ to denote equivalence instead of ⇔.

In the following exercises we will use the lemma:

  sub_nonneg {x y : ℝ} : 0 ≤ y - x ↔ x ≤ y

The curly braces around x and y instead of parentheses mean Lean will always try to figure out what
x and y are from context, unless we really insist on telling it (we'll see how to insist much later).
Let's not worry about that for now.

In order to announce an intermediate statement we use:

  have my_name : my statement,

This triggers the apparition of a new goal: proving the statement. After this is done,
the statement becomes available under the name `my_name`.
We can focus on the current goal by typing tactics between curly braces.
-/

example {a b c : ℝ} (hab : a ≤ b) : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  have key : (c + b) - (c + a) = b - a, -- Here we introduce an intermediate statement named key
  { ring, },  -- and prove it between curly braces
  rw key, -- we can now use the key statement
  rw sub_nonneg,
  exact hab,
end

/-
Of course the previous lemma is already in the core library, named `add_le_add_left`, so we can use it below.

Let's prove a variation (without invoking commutativity of addition since this would spoil our fun).
-/

-- 0009
example {a b : ℝ} (hab : a ≤ b) (c : ℝ) : a + c ≤ b + c :=
begin
  rw <- sub_nonneg,
  have key : b+c - (a+c) = b-a,
  { ring, },
  rw key,
  rw sub_nonneg,
  exact hab,
end

/-
Let's see how we could use this lemma. It is already in the core library, under the name `add_le_add_right`:

  add_le_add_right {a b : ℝ} (hab : a ≤ b) (c : ℝ) : a + c ≤ b + c

This can be read as: "add_le_add_right is a function that will take as input real numbers a and b, an
assumption `hab` claiming a ≤ b and a real number c, and will output a proof of a + c ≤ b + c".

In addition, recall that curly braces around a b mean Lean will figure out those arguments unless we
insist to help. This is because they can be deduced from the next argument `hab`.
So it will be sufficient to feed `hab` and c to this function.
-/

example {a b : ℝ}  (ha : 0 ≤ a) : b ≤ a + b :=
begin
  calc b = 0 + b : by ring
     ... ≤ a + b : by exact add_le_add_right ha b,
end

/-
In the second line of the above proof, we need to prove 0 + b ≤ a + b.
The proof after the colon says: this is exactly lemma `add_le_add_right` applied to ha and b.
Actually the `calc` block expects proof terms, and the `by` keyword is used to tell Lean we will use tactics
to build such a proof term. But since the only tactic used in this block is `exact`, we can skip
tactics entirely, and write:
-/

example (a b : ℝ)  (ha : 0 ≤ a) : b ≤ a + b :=
begin
  calc b = 0 + b : by ring
     ... ≤ a + b : add_le_add_right ha b,
end

/- Let's do a variant. -/

-- 0010
example (a b : ℝ) (hb : 0 ≤ b) : a ≤ a + b :=
begin
  calc a = a + 0 : by ring
     ... ≤ a + b : add_le_add_left hb a,
end

/-
The two preceding examples are in the core library :

  le_add_of_nonneg_left  {a b : ℝ} (ha : 0 ≤ a) : b ≤ a + b
  le_add_of_nonneg_right {a b : ℝ} (hb : 0 ≤ b) : a ≤ a + b

Again, there won't be any need to memorize those names, we will
soon see how to get rid of such goals automatically.
But we can already try to understand how their names are built:
"le_add" describe the conclusion "less or equal than some addition"
It comes first because we are focussed on proving stuff, and
auto-completion works by looking at the beginning of words.
"of" introduces assumptions. "nonneg" is Lean's abbreviation for non-negative.
"left" or "right" disambiguates between the two variations.

Let's use those lemmas by hand for now.

Note that you can have several inequalities steps in a `calc` block,
transitivity of inequalities will be used automatically to assemble
the pieces.
-/

-- 0011
example (a b : ℝ) (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b :=
begin
  calc 0 ≤ a : ha
     ... ≤ a + b : le_add_of_nonneg_right hb,
end

/- And let's combine with our earlier lemmas. -/

-- 0012
example (a b c d : ℝ) (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
begin
 have key : 0 ≤ d - c, rw sub_nonneg, exact hcd,
 have key' : 0 ≤ b - a, rw sub_nonneg, exact hab,
 calc a + c ≤ a + c + (d-c) : le_add_of_nonneg_right key
        ... = a + d         : by ring
        ... ≤ a + d + (b-a) : le_add_of_nonneg_right key'
        ... = b + d         : by ring,
end

/-
In the above examples, we prepared proofs of assumptions of our lemmas beforehand, so
that we could feed them to the lemmas. This is called forward reasoning.
The `calc` proofs also belong to this category.

We can also announce the use of a lemma, and provide proofs after the fact, using
the `apply` tactic. This is called backward reasoning because we get the conclusion
first, and provide proofs later. Using `rw` on the goal (rather than on an assumption
from the local context) is also backward reasoning.

Let's do that using the lemma

  mul_nonneg {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : 0 ≤ x*y
-/

example (a b c  : ℝ) (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  rw ← sub_nonneg,
  have key : b*c - a*c = (b - a)*c,
  { ring },
  rw key,
  apply mul_nonneg, -- Here we don't provide proofs for the lemma's assumptions
  -- Now we need to provide the proofs.
  { rw sub_nonneg,
    exact hab },
  { exact hc },
end

/-
Let's prove the same statement using only forward reasoning: announcing stuff,
proving it by working with known facts, moving forward.
-/

example (a b c  : ℝ) (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  have hab' : 0 ≤ b - a,
  { rw ← sub_nonneg at hab,
    exact hab, },
  have h₁ : 0 ≤ (b - a)*c,
  { exact mul_nonneg hab' hc },
  have h₂ : (b - a)*c = b*c - a*c,
  { ring, },
  have h₃ : 0 ≤ b*c - a*c,
  { rw h₂ at h₁,
    exact h₁, },
  rw sub_nonneg at h₃,
  exact h₃,
end

/-
One reason why the backward reasoning proof is shorter is because Lean can
infer of lot of things by comparing the goal and the lemma statement. Indeed
in the `apply mul_nonneg` line, we didn't need to tell Lean that x = b - a
and y = c in the lemma. It was infered by "unification" between the lemma
statement and the goal.

To be fair to the forward reasoning version, we should introduce a convenient
variation on `rw`. The `rwa` tactic performs rewrite and then looks for an
assumption matching the goal. We can use it to rewrite our latest proof as:
-/

example (a b c  : ℝ) (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  have hab' : 0 ≤ b - a,
  { rwa ← sub_nonneg at hab, },
  have h₁ : 0 ≤ (b - a)*c,
  { exact mul_nonneg hab' hc },
  have h₂ : (b - a)*c = b*c - a*c,
  { ring, },
  have h₃ : 0 ≤ b*c - a*c,
  { rwa h₂ at h₁, },
  rwa sub_nonneg at h₃,
end

/-
Let's now combine forward and backward reasoning, to get our most
efficient proof of this statement. Note in particular how unification is used
to know what to prove inside the parentheses in the `mul_nonneg` arguments.
-/
example (a b c : ℝ) (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  rw ← sub_nonneg,
  calc 0 ≤ (b - a)*c  : mul_nonneg (by rwa sub_nonneg) hc
     ... =  b*c - a*c : by ring,
end

/-
Let's now practice all three styles using:

  mul_nonneg_of_nonpos_of_nonpos {a b : α} (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b

  sub_nonpos {a b : α} : a - b ≤ 0 ↔ a ≤ b
-/

/- First using mostly backward reasoning -/
-- 0013
example (a b c : ℝ) (hc : c ≤ 0) (hab :  a ≤ b) : b*c ≤ a*c :=
begin
  rw ← sub_nonneg,
  rw ← sub_mul,
  apply mul_nonneg_of_nonpos_of_nonpos,
  rw sub_nonpos, exact hab,
  exact hc,
end

/- Using forward reasoning -/
-- 0014
example (a b c : ℝ) (hc : c ≤ 0) (hab :  a ≤ b) : b*c ≤ a*c :=
begin
  have key    : a - b ≤ 0, exact sub_nonpos.2 hab,
  have key'   : 0 ≤ (a - b)*c, exact mul_nonneg_of_nonpos_of_nonpos key hc,
  have key''  : 0 ≤ a*c - b*c, rwa sub_mul at key',
  have key''' : b*c ≤ a*c, rwa sub_nonneg at key'',
  exact key''',
end

/-- Using a combination of both, with a `calc` block -/
-- 0015
example (a b c : ℝ) (hc : c ≤ 0) (hab :  a ≤ b) : b*c ≤ a*c :=
begin
    rw ← sub_nonneg,
    have key : a-b ≤ 0, rw ← sub_nonpos at hab, exact hab,
    calc a*c - b*c = (a-b)*c : by ring
               ... ≥ 0 : by exact mul_nonneg_of_nonpos_of_nonpos key hc,
end

/-
Let's now move to proving implications. Lean denotes implications using
a simple arrow →, the same it uses for functions (say denoting the type of functions
from ℕ to ℕ by ℕ → ℕ). This is because it sees a proof of P ⇒ Q as a function turning
a proof of P into a proof Q.

Many of the examples that we already met are implications under the hood. For instance we proved

  le_add_of_nonneg_left (a b : ℝ) (ha : 0 ≤ a) : b ≤ a + b

But this can be rephrased as

  le_add_of_nonneg_left (a b : ℝ) : 0 ≤ a → b ≤ a + b

In order to prove P → Q, we use the tactic `intros`, followed by an assumption name.
This creates an assumption with that name asserting that P holds, and turns the goal into Q.

Let's check we can go from our old version of `le_add_of_nonneg_left` to the new one.

-/
example (a b : ℝ): 0 ≤ a → b ≤ a + b :=
begin
  intros ha,
  exact le_add_of_nonneg_left ha,
end

/-
Actually Lean doesn't make any difference between those two versions. It is also happy with
-/
example (a b : ℝ): 0 ≤ a → b ≤ a + b :=
le_add_of_nonneg_left

/- No tactic state is shown in the above line because we don't even need to enter
tactic mode using `begin` or `by`.

Let's practise using `intros`. -/

-- 0016
example (a b : ℝ): 0 ≤ b → a ≤ a + b :=
begin
  intros hb,
  exact le_add_of_nonneg_right hb,
end

/-
What about lemmas having more than one assumption? For instance:

  add_nonneg {a b : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b

A natural idea is to use the conjunction operator (logical AND), which Lean denotes
by ∧. Assumptions built using this operator can be decomposed using the `cases` tactic,
which is a very general assumption-decomposing tactic.
-/
example {a b : ℝ} : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
begin
  intros hyp,
  cases hyp with ha hb,
  exact add_nonneg ha hb,
end

/-
Needing that intermediate line invoking `cases` shows this formulation is not what is used by
Lean. It rather sees `add_nonneg` as two nested implications:
if a is non-negative then if b is non-negative then a+b is non-negative.
It reads funny, but it is much more convenient to use in practice.
-/
example {a b : ℝ} : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
add_nonneg

/-
The above pattern is so common that implications are defined as right-associative operators,
hence parentheses are not needed above.

Let's prove that the naive conjunction version implies the funny Lean version. For this we need
to know how to prove a conjunction. The `split` tactic creates two goals from a conjunction goal.
It can also be used to create two implication goals from an equivalence goal.
-/
example {a b : ℝ} (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b) : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha,
  intros hb,
  apply H,
  split,
  exact ha,
  exact hb,
end

/-
Let's practice `cases` and `split`. In the next exercise, P, Q and R denote
unspecified mathematical statements.
-/

-- 0017
example (P Q R : Prop) : P ∧ Q → Q ∧ P :=
begin
  intros h,
  cases h with hp hq,
  split,
  exact hq,
  exact hp,
end

/-
Of course using `split` only to be able to use `exact` twice in a row feels silly. One can
also use the anonymous constructor syntax: ⟨ ⟩
Beware those are not parentheses but angle brackets. This is a generic way of providing
compound objects to Lean when Lean already has a very clear idea of what it is waiting for.

So we could have replaced the last three lines by:
  exact ⟨hQ, hP⟩

We can also combine the `intros` steps. We can now compress our earlier proof to:
-/

example {a b : ℝ} (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b) : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  exact H ⟨ha, hb⟩,
end

/-
The anonymous contructor trick actually also works in `intros` provided we use
its recursive version `rintros`. So we can replace
  intro h,
  cases h with h₁ h₂
by
  rintros ⟨h₁, h₂⟩,
Now redo the previous exercise using all those compressing techniques, in exactly two lines. -/

-- 0018
example (P Q R : Prop): P ∧ Q → Q ∧ P :=
begin
  rintros ⟨hp,hq⟩,
  exact ⟨hq,hp⟩,
end

/-
We are ready to come back to the equivalence between the different formulations of
lemmas having two assumptions. Remember the `split` tactic can be used to split
an equivalence into two implications.
-/

-- 0019
example (P Q R : Prop) : (P ∧ Q → R) ↔ (P → (Q → R)) :=
begin
  split,
  intros h hp hq,
  exact h ⟨hp,hq⟩,
  rintros h ⟨hp, hq⟩,
  exact h hp hq,
end

/-
If you used more than five lines in the above exercise then try to compress things
(without simply removing line ends).

One last compression technique: given a proof h of a conjunction P ∧ Q, one can get
a proof of P using h.left and a proof of Q using h.right, without using cases.
One can also use the more generic (but less legible) names h.1 and h.2.

Similarly, given a proof h of P ↔ Q, one can get a proof of P → Q using h.mp
and a proof of Q → P using h.mpr (or the generic h.1 and h.2 that are even less legible
in this case).

Before the final exercise in this file, let's make sure we'll be able to leave
without learning 10 lemma names. The `linarith` tactic will prove any equality or
inequality or contradiction that follows by linear combinations of assumptions from the
context (with constant coefficients).
-/

example (a b : ℝ) (hb : 0 ≤ b) : a ≤ a + b :=
begin
  linarith,
end

/-
Now let's enjoy this for a while.
-/

-- 0020
example (a b : ℝ) (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b :=
begin
  linarith,
end

/- And let's combine with our earlier lemmas. -/

-- 0021
example (a b c d : ℝ) (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
begin
  linarith,
end

/-
Final exercise

In the last exercise of this file, we will use the divisibility relation on ℕ,
denoted by ∣ (beware this is a unicode divisibility bar, not the ASCII pipe character),
and the gcd function.

The definitions are the usual ones, but our goal is to avoid using these definitions and
only use the following three lemmas:

  dvd_refl (a : ℕ) : a ∣ a

  dvd_antisymm {a b : ℕ} : a ∣ b → b ∣ a → a = b :=

  dvd_gcd_iff {a b c : ℕ} : c ∣ gcd a b ↔ c ∣ a ∧ c ∣ b
-/

-- All functions and lemmas below are about natural numbers.
open nat

-- 0022
example (a b : ℕ) : a ∣ b ↔ gcd a b = a :=
begin
  have m := dvd_gcd_iff.1 (dvd_refl (gcd a b)),
  split,
  intro h,
  have j := dvd_refl a,
  have k : a ∣ gcd a b, exact dvd_gcd_iff.2 ⟨j,h⟩,
  have l : gcd a b ∣ a,  exact m.1,
  exact dvd_antisymm l k,
  intro h, rw h at m, exact m.2,
end


/-
Introduction rule requires a witness where a predicate
can be proven to be true for that witness
-/
def existsIntro
  (T: Type)
  (pred: T → Prop)
  (witness : T)
  (proof : pred witness)
  : ∃(w: T), pred w
  := exists.intro witness proof

example{T: Type}{witness: T}
  {predicate: T → Prop}
  {proof: predicate witness}:
  ∃ m, predicate m :=
    ⟨ witness, proof ⟩

def isEven(n : nat) : Prop :=
  ∃(m : nat), m + m = n

lemma pf8is4twice: 4 + 4 = 8 := rfl

theorem even8: isEven 8 :=
  exists.intro 4 pf8is4twice

theorem even8': ∃(m : nat), m + m = 8 :=
  exists.intro 4 pf8is4twice

theorem even8'': isEven 8 :=
  ⟨ 4, pf8is4twice ⟩

theorem even8''' : isEven 8 :=
begin
  unfold isEven, -- not necessary
  exact ⟨ 4, pf8is4twice ⟩
end

theorem isNonZ : exists n : nat, 0 ≠ n :=
  exists.intro 1 (λ pf : (0 = 1),
    nat.no_confusion pf)

theorem isNonZ' : exists n : nat, 0 ≠ n :=
begin
  have pf0isnt1: (0 ≠ 1),
    apply nat.no_confusion,

  exact ⟨ 1, pf0isnt1 ⟩,
end

theorem isNonZ'' : exists n : nat, 0 ≠ n :=
begin
  have pf0isnt1: (0 ≠ 1) :=
  begin
    apply nat.no_confusion,
  end,

  exact ⟨ 1, pf0isnt1 ⟩,
end

def existsElim
  { Q : Prop }
  { T : Type }
  { P : T → Prop }
  ( ex : exists x, P x)
  ( pw2q : ∀ a : T, P a → Q)
  : Q
  := exists.elim ex pw2q

theorem forgetAProperty'{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, P n) :=
   -- here Q, the conclusion, is
   -- (exists n, P n)
begin
  assume ex,
  apply exists.elim ex,
  assume w Pw,
  exact ⟨w, Pw.left⟩,
end

theorem forgetAProperty{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, P n) :=
   -- here Q, the conclusion, is (exists n, P n)
begin
  assume ex,
  show ∃ (n : ℕ), P n,
  from
    begin
      apply exists.elim ex, -- give one arg, build other
      assume w Pw, -- assume w and proof of P w
      show ∃ (n : ℕ), P n,
      from exists.intro w Pw.left,
    end,
end

example: ∀(P Q: Prop), P → Q → P ∧ Q
:= begin
  assume P Q,
  assume pfP pfQ,
  exact ⟨pfP, pfQ⟩,
end

theorem reverseProperty{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, S n ∧ P n) :=
begin
  assume ex,
  apply exists.elim ex,
  assume w Pw,
  have pfWReverse: S w ∧ P w :=
    and.intro Pw.right Pw.left,
  exact exists.intro w pfWReverse,
end

theorem reverseProperty'{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, S n ∧ P n) :=
begin
  assume ex,
  apply exists.elim ex,
  assume w Pw,
  apply exists.intro w,
  exact and.intro Pw.right Pw.left,
end

theorem reverseProperty''{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, S n ∧ P n) :=
begin
  assume ex,
  have pfw2q: ∀(w : ℕ), P w ∧ S w →
     (∃ (n : ℕ), S n ∧ P n) :=
  begin
    assume w Pw,
    have pfWReverse: S w ∧ P w :=
      and.intro Pw.right Pw.left,
    exact ⟨w, pfWReverse⟩,
  end,
  exact exists.elim ex pfw2q,
end

def isASquare: ℕ → Prop :=
  λ n, exists m, n = m ^ 2

def isASquare'(n: ℕ) :=
  ∃ m, n = m ^ 2

theorem isPS9 : isASquare 9 :=
begin
  unfold isASquare,
  exact exists.intro 3 (eq.refl 9),
end

axiom mypred: ℕ → Prop
#reduce (λ n, mypred n) 3

theorem not_exists_t_iff_always_not_t
  {T: Type}{pred: (T → Prop)}:
    (¬(∃ t: T, pred(t))) ↔
      ∀ t: T, ¬pred(t) :=
begin
  apply iff.intro,
    -- ¬(∃ t: T, pred(t)) → ∀ t: T, ¬pred(t)
    assume pf_not_exists_t,
    assume t,
    assume Q,
    have pf_exists_t := exists.intro t Q,
    contradiction,

    -- ∀ t: T, ¬pred(t) → ¬(∃ t: T, pred(t))
    assume pf_forall_t_not,
    assume pf_exists_t,
    apply exists.elim pf_exists_t,
    assume w,
    assume pf_w,
    have pf_not_w := pf_forall_t_not w,
    contradiction,
end

example: ∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ ¬Q) :=
begin
  apply exists.intro true,
  apply exists.intro false,
  have pf_not_f := λ(f: false), f,
  have pf_not_t_or_not_f :=
    or.intro_right (¬true) pf_not_f,
  have pf_t_or_f :=
    or.intro_left false true.intro,
  have pf_t_or_f' : true ∨ false :=
    or.inl true.intro,
  exact and.intro pf_t_or_f pf_not_t_or_not_f,
end

example: ∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) :=
begin
  apply exists.intro false,
  apply exists.intro true,
  split,
    -- P ∨ Q
    exact or.inr true.intro,
    split,
      -- ¬P ∨ ¬Q
      apply or.inl,
      assume f,
      assumption,
      -- ¬P ∨ Q
      apply or.inr,
      exact true.intro,
end

example: ¬(∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) ∧ (¬Q)) :=
begin
  assume pf_exists,
  apply exists.elim pf_exists,
  assume P pw',
  apply exists.elim pw',
  assume Q pw,
  have pf_not_q := pw.right.right.right,
  have pf_not_p_or_q := pw.right.right.left,
  cases pf_not_p_or_q with pf_not_p pf_q,
    -- ¬P
    have pf_p_or_q := pw.left,
    cases pf_p_or_q with pf_p pf_q,
      -- P
      contradiction,
      -- Q
      contradiction,
    -- Q
    contradiction,
end

example: ∃(P Q R: Prop),
  (P ∨ Q ∨ R) ∧ (¬P ∨ ¬Q ∨ ¬R) ∧
    (¬P ∨ Q ∨ R) ∧ (¬Q ∨ ¬R) :=
begin
  apply exists.intro false,
  apply exists.intro true,
  apply exists.intro false,
  split,
    -- P ∨ Q ∨ R
    exact or.inr (or.inl true.intro),
    have f := λ(f: false), f,
    split,
      -- ¬P ∨ ¬Q ∨ ¬R
      exact or.inl f,
      split,
        -- ¬P ∨ Q ∨ R
        exact or.inl f,
        -- ¬Q ∨ ¬R
        exact or.inr f,
end

example: ∀(T: Type)(pred: T → Prop),
  ¬(∃(t: T), pred t) ↔
    ∀(t: T), ¬(pred t) :=
begin
  intros,
  split,
    -- forward
    assume pf_notexists,
    assume t,
    assume pf_predt,
    have pf_exists := exists.intro t pf_predt,
    contradiction,
    -- backward
    assume pf_forall,
    assume pf_exists,
    apply exists.elim pf_exists,
    assume w pw,
    have pf_npredw := pf_forall w,
    contradiction,
end

axiom em: ∀(P: Prop), P ∨ ¬P

example: ∀(T: Type)(pred: T → Prop),
  ¬(∀(t: T), pred t) ↔
    ∃(t: T), ¬(pred t) :=
begin
  intros,
  split,
    -- forward
    assume pf_notforall,
    cases (em (∃ (t : T), ¬pred t)) with
        pf_exists pf_notexists,
      -- exists
      assumption,
      -- doesn't exist
      have pf_forall_doubleneg: ∀(t: T), ¬¬(pred t) :=
      begin
        assume t,
        assume pf_neg,
        have pf_exists := exists.intro t pf_neg,
        contradiction,
      end,
      have pf_forall: ∀(t: T), pred t :=
      begin
        assume t,
        have pf_doubleneg := pf_forall_doubleneg t,
        cases (em (pred t)) with pf_pred pf_npred,
          -- pred t
          assumption,
          -- ¬pred t
          contradiction,
      end,
     contradiction,
    -- backward
    assume pf_existsnot,
    assume pf_forall,
    apply exists.elim pf_existsnot,
    assume w pw,
    have pf_predw := pf_forall w,
    contradiction,
end


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro h,
  intro g,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro h,
  by_contradiction hboom,
  have hq : false := h hboom,
  exact hq,
end

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

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

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro h,
  cases h with hp hq,

  right,
  exact hp,

  left,
  exact hq,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h,
  cases h with hp hq,
  split,
  repeat {assumption},
end

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

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  intro hp,
  cases h,
  contradiction,
  exact h,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro h,
  intro hnp,
  cases h,
  contradiction,
  exact h,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro h,
  intro hq,
  intro nq,
  have hpq: Q := h nq,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro h,
  intro hp,
  by_contradiction hboom,
  have hpq: ¬P := h hboom,
  contradiction,
end

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

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro h,
  apply h,
  by_cases P,
  left,
  exact h,
  right,
  exact h,
end

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

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro h,
  intro hp,
  apply hp,
  apply h,
  intro hpq,
  contradiction,
end

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro h,
  intro hnpnq,
  cases h with hp hq,
  cases hnpnq,
  contradiction,
  cases hnpnq,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro h,
  intro hp,
  cases h,
  cases hp,
  repeat {contradiction},
end

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

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro h,
  split,
  intro hp,
  apply h,
  left,
  exact hp,

  intro hq,
  apply h,
  right,
  exact hq,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro h,
  cases h,
  intro hpq,
  cases hpq,
  repeat {contradiction},
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro h,
  by_cases hp: P,
  left,
  intro hq,
  apply h,
  apply and.intro hp hq,
  right,
  exact hp,
end

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

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

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

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

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

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h,
  split,
  cases h,
  repeat {
    cases h with hp hq,
    exact hp,
  },
  cases h,
  left,
  cases h with hp hq,
  exact hq,
  right,
  cases h with hq hr,
  exact hr,
end

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

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h,
  cases h with hpq hqr,
  cases hpq,
  left,
  exact hpq,

  cases hqr,
  left,
  exact hqr,
  right,
  split,
  repeat {assumption},

end

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro h,
  intro hp,
  intro hq,
  apply h,
  split,
  repeat {assumption},
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro h,
  intro hpq,
  apply h,
  repeat {
    cases hpq with hp hq,
    assumption
  },
end

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

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

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

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

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

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

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

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro h,
    cases h,
    exact h_left,
  intro h,
  split,
  repeat {exact h},
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro h,
    cases h,
    repeat {exact h},
  intro h,
  left,
  exact h,
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
  intro h,
  intro u,
  intro hp,
  apply h,
  existsi u,
  exact hp,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro h,
  intro hp,
  cases hp with u hu,
  apply h u,
  exact hu,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro h,
  by_contradiction hboom,
  apply h,
  intro u,
  by_contra,
  apply hboom,
  existsi u,
  exact h,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro h,
  intro hp,
  cases h with u hu,
  apply hu,
  apply hp u,
end

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

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

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro h,
  intro hp,
  cases h with u hu,
  apply hp u,
  exact hu,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro h,
  intro hp,
  cases hp with u hu,
  apply hu,
  apply h u,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro h,
  intro u,
  by_contradiction hboom,
  apply h,
  existsi u,
  exact hboom,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro h,
  by_contradiction hboom,
  apply h,
  intro u,
  intro pu,
  apply hboom,
  existsi u,
  exact pu,
end

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

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

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

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro h,
  cases h with u hu,
  cases hu with hp hq,
  split,
  repeat {
    existsi u,
    assumption,
  },

end

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

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro h,
  cases h,
  repeat {
    cases h with u hu,
    existsi u,
  },
  left,
  exact hu,
  right,
  exact hu,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro h,
  split,
  intro u,
  apply (h u).left,
  intro v,
  apply (h v).right,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro h,
  intro u,
  cases h with hp hq,
  split,
  apply hp,
  apply hq,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro h,
  intro u,
  cases h,
  left,
  apply h,
  right,
  apply h,
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


/-
Copyright (c) 2021 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.W.basic
import set_theory.cardinal.ordinal

/-!
# Cardinality of W-types

This file proves some theorems about the cardinality of W-types. The main result is
`cardinal_mk_le_max_aleph_0_of_fintype` which says that if for any `a : α`,
`β a` is finite, then the cardinality of `W_type β` is at most the maximum of the
cardinality of `α` and `ℵ₀`.
This can be used to prove theorems about the cardinality of algebraic constructions such as
polynomials. There is a surjection from a `W_type` to `mv_polynomial` for example, and
this surjection can be used to put an upper bound on the cardinality of `mv_polynomial`.

## Tags

W, W type, cardinal, first order
-/
universe u

variables {α : Type u} {β : α → Type u}

noncomputable theory

namespace W_type

open_locale cardinal

open cardinal

lemma cardinal_mk_eq_sum : #(W_type β) = sum (λ a : α, #(W_type β) ^ #(β a)) :=
begin
  simp only [cardinal.power_def, ← cardinal.mk_sigma],
  exact mk_congr (equiv_sigma β)
end

/-- `#(W_type β)` is the least cardinal `κ` such that `sum (λ a : α, κ ^ #(β a)) ≤ κ` -/
lemma cardinal_mk_le_of_le {κ : cardinal.{u}} (hκ : sum (λ a : α, κ ^ #(β a)) ≤ κ) :
  #(W_type β) ≤ κ :=
begin
  induction κ using cardinal.induction_on with γ,
  simp only [cardinal.power_def, ← cardinal.mk_sigma, cardinal.le_def] at hκ,
  cases hκ,
  exact cardinal.mk_le_of_injective (elim_injective _ hκ.1 hκ.2)
end

/-- If, for any `a : α`, `β a` is finite, then the cardinality of `W_type β`
  is at most the maximum of the cardinality of `α` and `ℵ₀`  -/
lemma cardinal_mk_le_max_aleph_0_of_fintype [Π a, fintype (β a)] : #(W_type β) ≤ max (#α) ℵ₀ :=
(is_empty_or_nonempty α).elim
  (begin
    introI h,
    rw [cardinal.mk_eq_zero (W_type β)],
    exact zero_le _
  end) $
λ hn, let m := max (#α) ℵ₀ in cardinal_mk_le_of_le $
calc cardinal.sum (λ a, m ^ #(β a))
    ≤ #α * ⨆ a, m ^ #(β a) : cardinal.sum_le_supr _
... ≤ m * ⨆ a, m ^ #(β a) : mul_le_mul' (le_max_left _ _) le_rfl
... = m : mul_eq_left.{u} (le_max_right _ _)
  (csupr_le' $ λ i, pow_le (le_max_right _ _) (lt_aleph_0_of_fintype _)) $
  pos_iff_ne_zero.1 $ order.succ_le_iff.1
    begin
      rw succ_zero,
      obtain ⟨a⟩ : nonempty α, from hn,
      refine le_trans _ (le_csupr (bdd_above_range.{u u} _) a),
      rw ←power_zero,
      exact power_le_power_left (pos_iff_ne_zero.1
        (aleph_0_pos.trans_le (le_max_right _ _))) (zero_le _)
    end

end W_type


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

/-!

# Infinite unions and intersections

If `X : Type` and `A B : set X` are subsets of `X`, then we've
seen that Lean understands the notation `A ∪ B`. Furthermore,
if `x : X` is a term of type `X` then `x ∈ A ∪ B` is
definitionally equal to `x ∈ A ∨ x ∈ B`, and `x ∈ A ∩ B` is
definitionally `x ∈ A ∧ x ∈ B`.

But what about infinite unions and intersections? Turns out
that there are *three* ways to do them in Lean, all with
slightly different notations. There are also ways to switch
between these things.

## `Union` : indexed union over a type.

Say `A₀, A₁, A₂, ...` are infinitely many subsets of `X`.
In Lean we would model this as `A : ℕ → set X`, a function
from the naturals to subsets of `X` sending `i` to `Aᵢ`.
More generally we could have an arbitrary "index type" `ι : Type`
(that's an "iota", the notation typically used for index types)
and a function `A : ι → set X`, corresponding to subsets `Aᵢ` of `X`
as `i` varies through `ι`.

The way to take the union of these sets is `set.Union A` (note the capital U;
small u means union of two things, capital means union of arbitrary
number of things). But you should use the notation for this function,
which is `⋃ (i : ι), A i`. Here is some code and a couple of examples
for you to try.

-/

section Union

-- Let `Aᵢ` for `i : ι` be a collection of subsets of `X`
variables (X : Type) (ι : Type) (A : ι → set X)

-- The union of the Aᵢ

example : set X := ⋃ (i : ι), A i

example : set.Union A = ⋃ (i : ι), A i :=
begin
  -- RHS is notation for LHS; in fact they're syntactically equal
  refl
end

-- A term `x : X` is in the Union if and only if it's in one of the `Aᵢ`

-- The below lemma is not `refl`. It's `set.mem_Union`.

example (x : X) : (x ∈ ⋃ (i : ι), A i) ↔ ∃ i : ι, x ∈ A i :=
begin
  exact set.mem_Union,
end

-- Of course mem_Union is very useful for rewriting, even though it's
-- definitional.

-- You can take the union over more than index type,
-- if have sets `Bᵢₖ` indexed by two variables.

example (ι κ : Type) (B : ι → κ → set X) : set X :=
⋃ (i : ι) (k : κ), B i k

-- This is just implemented as a Union of a Union (just like
-- `∀ a n : ℕ, ...` is internally `∀ a : ℕ, ∀ b : ℕ, ...`)

example (ι κ : Type) (B : ι → κ → set X) :
  (⋃ (i : ι) (k : κ), B i k) = ⋃ (i : ι), ⋃ (k : κ), B i k :=
begin
  -- note that they're actually syntactically equal
  refl
end

/-

## Inter : indexed intersection over a type

Here's the story for the intersection: It's called Inter,
it has all the same syntax.

-/

example : set X := ⋂ (i : ι), A i

example (x : X) : (x ∈ ⋂ (i : ι), A i) ↔ ∀ i : ι, x ∈ A i :=
begin
  exact set.mem_Inter, -- also not `refl`.
end

-- Now try these exercises.

variable (Y : Type)

example (F : ι → set X) (f : X → Y) :
  f '' (⋃ (i : ι), F i) = ⋃ (i : ι), f '' (F i) :=
begin
  -- Try a proof from first principles starting with `ext y`
  -- Also try `library_search`.
  sorry
end

example (G : ι → set Y) (f : X → Y) :
  f ⁻¹' (⋃ (i : ι), G i) = ⋃ (i : ι), f ⁻¹' (G i) :=
begin
  -- If you tried `library_search` last time, try
  -- guessing the name of the theorem this time
  sorry
end

example (G : ι → set Y) (f : X → Y) :
  f ⁻¹' (⋂ (i : ι), G i) = ⋂ (i : ι), f ⁻¹' (G i) :=
begin
  -- If you don't want to do it, can you guess the name?
  sorry
end

-- What do you think about `set.image_Inter` by the way?
-- Try stating what it should say. Is it true?

-- NB note the brackets around the LHS; Lean seems to
-- eat the equality and keep eating when trying to figure
-- out the ⋃ notation otherwise

-- Here's a couple more for you to try
example (S : set X) : (⋃ i, A i) ⊆ S ↔ (∀ i, A i ⊆ S) :=
begin
  sorry
end

example (κ : Type) (B : ι → κ → set X) :
  (⋃ (i : ι) (k : κ), B i k) = ⋃ (k : κ) (i : ι), B i k :=
begin
  sorry,
end

-- Feel free to make some up yourselves if you want abstract practice;
-- however you might just want to get to the topology.

end Union

/-

## `bUnion` : union of indexed sets satisfying a condition

What if we still have our family of sets `A₀`, `A₁`, `A₂` indexed over the
naturals, but we want to only take the union over the `Aᵢ` with `i` even,
or with `i` prime? More generally, what if we have `A : ι → set X` and some
subset `S : set ι` and we want to take the union of `Aᵢ` for `i ∈ S`?

Lean calls this concept `set.bUnion`. The actual definition `set.bUnion`
doesn't exist, but the lemmas about it all have this name.

-/

section bUnion

-- Let `Aᵢ` for `i : ι` be a collection of subsets of `X`
variables (X : Type) (ι : Type) (A : ι → set X) (S : set ι)

-- The union of the Aᵢ for which P(i) is true

example : set X := ⋃ (i ∈ S), A i

-- here's what the notation expands to
example : (⋃ (i ∈ S), A i) = ⋃ (i : ι) (h : i ∈ S), A i := rfl

-- So get this; it's taking a union over all i of a union over all proofs
-- that `i ∈ S` of Aᵢ. This works! If `i : ι` then if you take the
-- union over all proofs that `i ∈ S` of `A i` then either there's no
-- proofs (because it's false) and the union is empty, or there's
-- at least one proof (because it's true) and so you get `A i`. Now
-- take the union over all `i` and it works!

-- A term `x : X` is in the sUnion if and only if it's in one of the
-- elements of S

-- The below lemma can be proved with `refl`. It's `set.mem_sUnion`
-- (even if it's true by definition, having name is useful for rewriting)

example (x : X) : x ∈ (⋃ (i ∈ S), A i) ↔ ∃ (i : ι) (h : i ∈ S), x ∈ A i :=
begin
  -- not refl
  exact set.mem_bUnion_iff, -- it's slightly sad that mem_bUnion
  -- is only one implication and mem_bUnion_iff is the iff statement.
  -- This isn't like the mem_Union situation.
end

/-

## bInter : indexed intersection over a subset of an index set.

Here's the story:

-/

example : set X := ⋂ (i ∈ S), A i

example (x : X) : x ∈ (⋂ (i ∈ S), A i) ↔ ∀ (i : ι) (h : i ∈ S), x ∈ A i :=
begin
  -- not refl
  exact set.mem_bInter_iff,
end

-- Some exercises

variable (Y : Type)

example (f : X → Y) :
  f '' (⋃ (i ∈ S), A i) = ⋃ (i ∈ S), f '' (A i) :=
begin
  -- If you can guess what it's called you don't need to prove it ;-)
  sorry
end

example (B : ι → set Y) (f : X → Y) :
  f ⁻¹' (⋂ (i ∈ S), B i) = ⋂ (i ∈ S), f ⁻¹' (B i) :=
begin
  sorry
end

end bUnion

/-

## sUnion : union of a set of subsets

Sometimes we don't have a natural indexing type to take an arbitrary union
over; for example the interior of a subset `A` of a topological space is the
union of the open sets contained in `A`.

So here the setup is we have `S : set (set X)`, i.e. a collection of
subsets of `X` (like the open sets in a topology for example),
and we want to take the union of these sets. This union is `set.sUnion S`,
and it has notation `⋃₀`. More precisely:
-/

section sUnion

-- Let `S` be a set of subsets of `X`
variables (X : Type) (S : set (set X))

-- The union of the elements of S
example : set X := ⋃₀ S

example : set.sUnion S = ⋃₀ S :=
begin
  -- RHS is notation for LHS; in fact they're syntactically equal
  refl
end

-- A term `x : X` is in the sUnion if and only if it's in one of the
-- elements of S

-- The below lemma can be proved with `refl`. It's `set.mem_sUnion`
-- (even if it's true by definition, having name is useful for rewriting)

example (x : X) : (x ∈ ⋃₀ S) ↔ ∃ s ∈ S, x ∈ s :=
begin
  exact set.mem_sUnion, -- this
end

-- In fact sUnion is a special case of bUnion, where the index set is `set X`.
example : (⋃₀ S) = ⋃ (s ∈ S), s :=
begin
  exact set.sUnion_eq_bUnion
end

/-

## sInter : intersection of a set of sets

Here's the story:

-/

example : set X := ⋂₀ S

example : set.sInter S = ⋂₀ S :=
begin
  -- RHS is notation for LHS; in fact they're syntactically equal
  refl
end

-- A term `x : X` is in the sInter if and only if it's in all of the
-- elements of S. Can be proved with `refl`. It's `set.mem_sInter`

example (x : X) : (x ∈ ⋂₀ S) ↔ ∀ s ∈ S, x ∈ s :=
begin
  exact set.mem_sInter, -- this is definitional
end

-- Some exercises

variable (Y : Type)

example (S : set (set X)) (f : X → Y) :
  f '' (⋃₀ S) = ⋃₀ ((set.image f) '' S) :=
begin
  -- This should be set.image_sUnion but it doesn't seem to be there?
  sorry
end

example (S : set (set X)) (U : set X) (hU : U ∈ S) :
  ⋂₀ S ⊆ U :=
begin
  -- If you don't want to do it, can you guess the name?
  sorry
end

end sUnion


/-
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
import data.real.basic -- the reals

/-!

# Sets in Lean, sheet 6 : pushforward and pullback

## Pushforward of a set along a map

If `f : X → Y` then given a subset `S : set X` of `X` we can push it
forward to make a subset `f(S) : set Y` of `Y`. The definition
of `f(S)` is `{y : Y | ∃ x : X, x ∈ S ∧ f x = y}`.

However `f(S)` doesn't make sense in Lean, because `f` eats
terms of type `X` and not `S`, which has type `set X`.
In Lean we use the notation `f '' S` for this. This is notation
for `set.image` and if you need any API for this, it's likely
to use the word `image`.

## Pullback of a set along a map

If `f : X → Y` then given a subset `T : set Y` of `Y` we can
pull it back to make a subset `f⁻¹(T) : set X` of `X`. The definition
of `f⁻¹(T)` is `{x : X | f x ∈ T}`.

However `f⁻¹(T)` doesn't make sense in Lean either, because
`⁻¹` is notation for `has_inv.inv`, whose type in Lean
is `α → α`. In other words, if `x` has a certain type, then
`x⁻¹` *must* have the same type. The notation was basically designed
for group theory. In Lean we use the notation `f ⁻¹' T` for this pullback.

-/

variables (X Y : Type) (f : X → Y) (S : set X) (T : set Y)

example : S ⊆ f ⁻¹' (f '' S) :=
begin
  intros x hx,
  exact ⟨x, hx, rfl⟩, -- use x, etc etc also works
end

example : f '' (f ⁻¹' T) ⊆ T :=
begin
  rintros - ⟨x, hx, rfl⟩,
  exact hx,
end

theorem gc : f '' S ⊆ T ↔ S ⊆ f ⁻¹' T :=
begin
  split,
  { intros h x hxS,
    refine h ⟨x, hxS, rfl⟩ },
  { rintro h - ⟨x, hx, rfl⟩,
    refine h hx }
end

-- image and preimage form a Galois connection
-- look up Galois connections in the mathlib docs to learn about what these are
-- right click on `galois_connection` or do `unfold galois_connection` to
-- find out what this question's asking
-- NB `≤` on subsets is defined to be `⊆`
example : galois_connection (λ S, f '' S) (λ T, f ⁻¹' T) :=
begin
  apply gc,
end


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

! This file was ported from Lean 3 source module logic.hydra
! leanprover-community/mathlib commit e9b8651eb1ad354f4de6be35a38ef31efcd2cfaa
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finsupp.Lex
import Mathbin.Data.Finsupp.Multiset
import Mathbin.Order.GameAdd

/-!
# Termination of a hydra game

This file deals with the following version of the hydra game: each head of the hydra is
labelled by an element in a type `α`, and when you cut off one head with label `a`, it
grows back an arbitrary but finite number of heads, all labelled by elements smaller than
`a` with respect to a well-founded relation `r` on `α`. We show that no matter how (in
what order) you choose cut off the heads, the game always terminates, i.e. all heads will
eventually be cut off (but of course it can last arbitrarily long, i.e. takes an
arbitrary finite number of steps).

This result is stated as the well-foundedness of the `cut_expand` relation defined in
this file: we model the heads of the hydra as a multiset of elements of `α`, and the
valid "moves" of the game are modelled by the relation `cut_expand r` on `multiset α`:
`cut_expand r s' s` is true iff `s'` is obtained by removing one head `a ∈ s` and
adding back an arbitrary multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.

We follow the proof by Peter LeFanu Lumsdaine at https://mathoverflow.net/a/229084/3332.

TODO: formalize the relations corresponding to more powerful (e.g. Kirby–Paris and Buchholz)
hydras, and prove their well-foundedness.
-/

namespace Relation

open Multiset Prod

variable {α : Type _}

/-- The relation that specifies valid moves in our hydra game. `cut_expand r s' s`
  means that `s'` is obtained by removing one head `a ∈ s` and adding back an arbitrary
  multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.

  This is most directly translated into `s' = s.erase a + t`, but `multiset.erase` requires
  `decidable_eq α`, so we use the equivalent condition `s' + {a} = s + t` instead, which
  is also easier to verify for explicit multisets `s'`, `s` and `t`.

  We also don't include the condition `a ∈ s` because `s' + {a} = s + t` already
  guarantees `a ∈ s + t`, and if `r` is irreflexive then `a ∉ t`, which is the
  case when `r` is well-founded, the case we are primarily interested in.

  The lemma `relation.cut_expand_iff` below converts between this convenient definition
  and the direct translation when `r` is irreflexive. -/
def CutExpand (r : α → α → Prop) (s' s : Multiset α) : Prop :=
  ∃ (t : Multiset α)(a : α), (∀ a' ∈ t, r a' a) ∧ s' + {a} = s + t
#align relation.cut_expand Relation.CutExpand

variable {r : α → α → Prop}

theorem cutExpand_le_invImage_lex [hi : IsIrrefl α r] :
    CutExpand r ≤ InvImage (Finsupp.Lex (rᶜ ⊓ (· ≠ ·)) (· < ·)) toFinsupp :=
  fun s t ⟨u, a, hr, he⟩ => by
  classical
    refine' ⟨a, fun b h => _, _⟩ <;> simp_rw [to_finsupp_apply]
    · apply_fun count b  at he
      simp_rw [count_add] at he
      convert he <;> convert(add_zero _).symm <;> rw [count_eq_zero] <;> intro hb
      exacts[h.2 (mem_singleton.1 hb), h.1 (hr b hb)]
    · apply_fun count a  at he
      simp_rw [count_add, count_singleton_self] at he
      apply Nat.lt_of_succ_le
      convert he.le
      convert(add_zero _).symm
      exact count_eq_zero.2 fun ha => hi.irrefl a <| hr a ha
#align relation.cut_expand_le_inv_image_lex Relation.cutExpand_le_invImage_lex

theorem cutExpand_singleton {s x} (h : ∀ x' ∈ s, r x' x) : CutExpand r s {x} :=
  ⟨s, x, h, add_comm s _⟩
#align relation.cut_expand_singleton Relation.cutExpand_singleton

theorem cutExpand_singleton_singleton {x' x} (h : r x' x) : CutExpand r {x'} {x} :=
  cutExpand_singleton fun a h => by rwa [mem_singleton.1 h]
#align relation.cut_expand_singleton_singleton Relation.cutExpand_singleton_singleton

theorem cutExpand_add_left {t u} (s) : CutExpand r (s + t) (s + u) ↔ CutExpand r t u :=
  exists₂_congr fun _ _ => and_congr Iff.rfl <| by rw [add_assoc, add_assoc, add_left_cancel_iff]
#align relation.cut_expand_add_left Relation.cutExpand_add_left

theorem cutExpand_iff [DecidableEq α] [IsIrrefl α r] {s' s : Multiset α} :
    CutExpand r s' s ↔
      ∃ (t : Multiset α)(a : _), (∀ a' ∈ t, r a' a) ∧ a ∈ s ∧ s' = s.eraseₓ a + t :=
  by
  simp_rw [cut_expand, add_singleton_eq_iff]
  refine' exists₂_congr fun t a => ⟨_, _⟩
  · rintro ⟨ht, ha, rfl⟩
    obtain h | h := mem_add.1 ha
    exacts[⟨ht, h, t.erase_add_left_pos h⟩, (@irrefl α r _ a (ht a h)).elim]
  · rintro ⟨ht, h, rfl⟩
    exact ⟨ht, mem_add.2 (Or.inl h), (t.erase_add_left_pos h).symm⟩
#align relation.cut_expand_iff Relation.cutExpand_iff

theorem not_cutExpand_zero [IsIrrefl α r] (s) : ¬CutExpand r s 0 := by
  classical
    rw [cut_expand_iff]
    rintro ⟨_, _, _, ⟨⟩, _⟩
#align relation.not_cut_expand_zero Relation.not_cutExpand_zero

/-- For any relation `r` on `α`, multiset addition `multiset α × multiset α → multiset α` is a
  fibration between the game sum of `cut_expand r` with itself and `cut_expand r` itself. -/
theorem cutExpand_fibration (r : α → α → Prop) :
    Fibration (GameAdd (CutExpand r) (CutExpand r)) (CutExpand r) fun s => s.1 + s.2 :=
  by
  rintro ⟨s₁, s₂⟩ s ⟨t, a, hr, he⟩; dsimp at he⊢
  classical
    obtain ⟨ha, rfl⟩ := add_singleton_eq_iff.1 he
    rw [add_assoc, mem_add] at ha
    obtain h | h := ha
    · refine' ⟨(s₁.erase a + t, s₂), game_add.fst ⟨t, a, hr, _⟩, _⟩
      · rw [add_comm, ← add_assoc, singleton_add, cons_erase h]
      · rw [add_assoc s₁, erase_add_left_pos _ h, add_right_comm, add_assoc]
    · refine' ⟨(s₁, (s₂ + t).eraseₓ a), game_add.snd ⟨t, a, hr, _⟩, _⟩
      · rw [add_comm, singleton_add, cons_erase h]
      · rw [add_assoc, erase_add_right_pos _ h]
#align relation.cut_expand_fibration Relation.cutExpand_fibration

/-- A multiset is accessible under `cut_expand` if all its singleton subsets are,
  assuming `r` is irreflexive. -/
theorem acc_of_singleton [IsIrrefl α r] {s : Multiset α} :
    (∀ a ∈ s, Acc (CutExpand r) {a}) → Acc (CutExpand r) s :=
  by
  refine' Multiset.induction _ _ s
  · exact fun _ => Acc.intro 0 fun s h => (not_cut_expand_zero s h).elim
  · intro a s ih hacc
    rw [← s.singleton_add a]
    exact
      ((hacc a <| s.mem_cons_self a).prod_gameAdd <|
            ih fun a ha => hacc a <| mem_cons_of_mem ha).of_fibration
        _ (cut_expand_fibration r)
#align relation.acc_of_singleton Relation.acc_of_singleton

/-- A singleton `{a}` is accessible under `cut_expand r` if `a` is accessible under `r`,
  assuming `r` is irreflexive. -/
theorem Acc.cutExpand [IsIrrefl α r] {a : α} (hacc : Acc r a) : Acc (CutExpand r) {a} :=
  by
  induction' hacc with a h ih
  refine' Acc.intro _ fun s => _
  classical
    rw [cut_expand_iff]
    rintro ⟨t, a, hr, rfl | ⟨⟨⟩⟩, rfl⟩
    refine' acc_of_singleton fun a' => _
    rw [erase_singleton, zero_add]
    exact ih a' ∘ hr a'
#align acc.cut_expand Acc.cutExpand

/-- `cut_expand r` is well-founded when `r` is. -/
theorem WellFounded.cutExpand (hr : WellFounded r) : WellFounded (CutExpand r) :=
  ⟨letI h := hr.is_irrefl
    fun s => acc_of_singleton fun a _ => (hr.apply a).CutExpand⟩
#align well_founded.cut_expand WellFounded.cutExpand

end Relation


/- This file contains the basic definitions needed to talk about matroid union and matroid
intersection.-/

import matroid.submatroid.projection prelim.minmax

open_locale classical
noncomputable theory
open matroid set

variables {α : Type*} [fintype α]

-- setting up the various types we are minimizing/maximizing over, and associated nonempty/fintype
-- instances
section prelim

/-- property of a pair of independent sets in M₁, M₂ respectively  -/
def is_indep_pair (M₁ M₂ : matroid α) := λ (p : set α × set α), M₁.is_indep p.1 ∧ M₂.is_indep p.2

/-- property of being bases of both M₁ M₂  -/
def is_basis_pair (M₁ M₂ : matroid α) := λ (p : set α × set α), M₁.is_basis p.1 ∧ M₂.is_basis p.2

/-- type of disjoint pairs of sets in α -/
def is_disjoint (pair : (set α × set α)) := pair.1 ∩ pair.2 = ∅

/-- type of pairs of independent sets of M₁,M₂ respectively -/
def indep_pair (M₁ M₂ : matroid α) := {p : set α × set α // is_indep_pair M₁ M₂ p }

/-- type of pairs of bases of M₁, M₂ -/
def basis_pair (M₁ M₂ : matroid α) := {p : set α × set α // is_basis_pair M₁ M₂ p }

/-- type of pairs of independent sets that are both contained in a subset X -/
def indep_pair_of_subset (M₁ M₂ : matroid α) (X : set α) :=
  {p : set α × set α // is_indep_pair M₁ M₂ p ∧ (p.1 ⊆ X ∧ p.2 ⊆ X) }

/-- size of the intersection of a pair of sets -/
def inter_size (pair : (set α × set α)) : ℤ := size (pair.1 ∩ pair.2)

/-- size of the union of a pair of sets -/
def union_size (pair : (set α × set α)) : ℤ := size (pair.1 ∪ pair.2)

/-- type of pairs of disjoint independent sets of M₁,M₂ respectively -/
def disjoint_indep_pair (M₁ M₂ : matroid α) := {pair : indep_pair M₁ M₂ // is_disjoint pair.1}

/-- type of pairs of disjoint bases of M₁,M₂ respectively -/
def disjoint_basis_pair (M₁ M₂ : matroid α) := {pair : basis_pair M₁ M₂ // is_disjoint pair.1}

/-- is the intersection of a basis of M₁ and a basis of M₂ -/
def is_inter_bases (M₁ M₂ : matroid α) :=
  λ X, ∃ B₁ B₂, is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∩ B₂ = X

/-- type of sets that are the intersection of a basis of M₁ and a basis of M₂-/
def inter_bases (M₁ M₂ : matroid α) := {X : set α // is_inter_bases M₁ M₂ X}

/-- is contained in the intersection of a basis of M₁ and a basis of M₂-/
def is_subset_inter_bases (M₁ M₂ : matroid α) :=
  λ X, ∃ Y, is_inter_bases M₁ M₂ Y ∧ X ⊆ Y

/-- is the union of an independent set of M₁ and an independent set of M₂-/
def is_union_two_indep (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ I₁ I₂, is_indep M₁ I₁ ∧ is_indep M₂ I₂ ∧ X = I₁ ∪ I₂

/-- has a partition into an independent set of M₁ and an independent set of M₂-/
def is_two_partitionable (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ I₁ I₂, is_indep M₁ I₁ ∧ is_indep M₂ I₂ ∧ X = I₁ ∪ I₂ ∧ I₁ ∩ I₂ = ∅

/-- has a partition into a basis of M₁ and a basis set of M₂-/
def is_two_basis_partitionable (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ B₁ B₂ , is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∪ B₂ = X ∧ B₁ ∩ B₂ = ∅

/-- is the union of a basis of M₁ and a basis of M₂ -/
def is_union_two_bases (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ B₁ B₂, is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∪ B₂ = X

/--independence in both M₁ and M₂ -/
def is_common_ind (M₁ M₂ : matroid α) :=
  λ X, is_indep M₁ X ∧ is_indep M₂ X

/-- subtype of common independent sets -/
def common_ind (M₁ M₂ : matroid α) := {X : set α // is_common_ind M₁ M₂ X}

-- All the types above are trivially finite, and nonempty because bases/independent sets exist

instance indep_pair_fintype {M₁ M₂ : matroid α} : fintype (indep_pair M₁ M₂) :=
  by {unfold indep_pair, apply_instance }

instance basis_pair_fintype {M₁ M₂ : matroid α} : fintype (basis_pair M₁ M₂) :=
  by {unfold basis_pair, apply_instance }

instance indep_pair_nonempty {M₁ M₂ : matroid α} : nonempty (indep_pair M₁ M₂) :=
begin
  simp only [indep_pair, nonempty_subtype, prod.exists],
  from ⟨∅, ∅, ⟨M₁.empty_indep, M₂.empty_indep⟩ ⟩ ,
end

instance indep_pair_of_subset_nonempty {M₁ M₂ : matroid α} {X : set α} :
  nonempty (indep_pair_of_subset M₁ M₂ X) :=
begin
  simp only [indep_pair_of_subset, nonempty_subtype, prod.exists],
  from ⟨∅, ∅, ⟨M₁.empty_indep, M₂.empty_indep⟩, ⟨empty_subset _, empty_subset _⟩ ⟩ ,
end

instance indep_pair_of_subset_fintype {M₁ M₂ : matroid α} {X : set α} :
  fintype (indep_pair_of_subset M₁ M₂ X) :=
begin
  unfold indep_pair_of_subset, apply_instance,
end

instance basis_pair_nonempty {M₁ M₂ : matroid α} : nonempty (basis_pair M₁ M₂) :=
begin
  simp only [basis_pair, exists_and_distrib_right, nonempty_subtype, exists_and_distrib_left,
  prod.exists],
  cases exists_basis M₁ with B₁ hB₁,
  cases exists_basis M₂ with B₂ hB₂,
  from ⟨B₁, B₂, hB₁, hB₂⟩,
end

lemma exists_inter_bases (M₁ M₂ : matroid α) :
  ∃ I, (is_inter_bases M₁ M₂ I) :=
begin
  cases exists_basis M₁ with B₁ hB₁,
  cases exists_basis M₂ with B₂ hB₂,
  from ⟨B₁ ∩ B₂, ⟨B₁,B₂,hB₁,hB₂,rfl⟩⟩,
end

instance inter_bases_nonempty (M₁ M₂ : matroid α) : nonempty (inter_bases M₁ M₂) :=
by {apply nonempty_subtype.mpr, apply exists_inter_bases, }

instance inter_bases_fintype (M₁ M₂ : matroid α) : fintype (inter_bases M₁ M₂) :=
by {unfold inter_bases, apply_instance,}

instance disjoint_indep_pair_nonempty (M₁ M₂ : matroid α) :
  nonempty (disjoint_indep_pair M₁ M₂) :=
by {unfold disjoint_indep_pair, refine nonempty_subtype.mpr _,
     use ⟨⟨∅,∅⟩, ⟨empty_indep M₁, empty_indep M₂⟩⟩, tidy,  }

instance nonempty_common_ind (M₁ M₂ : matroid α) : nonempty (common_ind M₁ M₂) :=
by {apply nonempty_subtype.mpr, from ⟨∅, ⟨empty_indep M₁, empty_indep M₂⟩⟩}

instance fintype_common_ind (M₁ M₂ : matroid α ) : fintype (common_ind M₁ M₂):=
  by {unfold common_ind, apply_instance}

instance coe_common_ind (M₁ M₂ : matroid α) : has_coe (common_ind M₁ M₂) (set α) :=
  ⟨λ X, X.val⟩

end prelim

section params

/-- size of largest common independent set of M₁ and M₂ -/
def ν (M₁ M₂ : matroid α) : ℤ :=
  max_val (λ (X : common_ind M₁ M₂), size X.val)

/-- size of the largest set that is the union of independent sets of M₁ and M₂-/
def π₂ (M₁ M₂ : matroid α) : ℤ :=
  max_val (λ (Ip : indep_pair M₁ M₂), union_size Ip.val)

end params

section lists

open_locale big_operators

variables {n : ℕ}

def is_indep_tuple (Ms : fin n → matroid α) (Xs : fin n → set α) :=
  ∀ i, (Ms i).is_indep (Xs i)

def indep_tuple (Ms : fin n → matroid α) :=
  {Is : fin n → set α // is_indep_tuple Ms Is}

instance indep_tuple_nonempty (Ms : fin n → matroid α) : nonempty (indep_tuple Ms) :=
  by {apply nonempty_subtype.mpr, exact ⟨λ i, ∅, λ i, (Ms i).empty_indep⟩,}

instance indep_tuple_fintype (Ms : fin n → matroid α) : fintype (indep_tuple Ms) :=
  by {unfold indep_tuple, apply_instance,  }

/-- size of largest partitionable set wrt a tuple of matroids -/
def π {n : ℕ} (Ms : fin n → matroid α) : ℤ :=
  max_val (λ Is : (indep_tuple Ms), size (set.Union Is.val))

def is_union_indep_tuple {n : ℕ} (Ms : fin n → matroid α) : (set α) → Prop :=
  λ X, ∃ (Is : indep_tuple Ms), X = set.Union Is.val

end lists
/-
/- property of a pair (M,X) that X is indep in M -/
def is_matroid_indep_pair : (matroid α) × (set α) → Prop := λ p, is_indep p.1 p.2

/- rank in M of X, given a pair (M,X) -/
def matroid_set_pair_to_rank : (matroid α) × (set α) → ℤ := λ p, p.1.r p.2

/- property of being a list of independent sets wrt a list of matroids -/
def is_indep_list (Ms : list (matroid α)) : list (set α) → Prop :=
  λ Xs, Xs.length = Ms.length ∧ (∀ MX ∈ Ms.zip Xs, is_matroid_indep_pair MX)

/- type of indep lists of a list of matroids -/
def indep_list (Ms : list (matroid α)) := {Xs : list (set α) // is_indep_list Ms Xs}

/- property of being the union of an indep list (equivalent to partitionability) -/
def is_union_indep_list'' (Ms : list (matroid α)) : (set α) → Prop :=
  λ Y, ∃ (Xs : indep_list Ms), list_union Xs.val = Y

def is_indep_pair_list : list (matroid α × set α) → Prop :=
  λ Ps, (∀ p ∈ Ps, is_matroid_indep_pair p)

def indep_pair_list := {Ps : list (matroid α × set α) // is_indep_pair_list Ps}

def is_union_indep_list' (Ms : list (matroid α)) : set α → Prop :=
  λ Y, ∃ (Ps : indep_pair_list), Ps.val.unzip.1 = Ms ∧ list_union Ps.val.unzip.2 = Y

/- sum of ranks of a list of sets in a list of matroids -/
def sum_of_ranks_of_sets (Ms : list (matroid α)) (Xs : list (set α)) : ℤ :=
  list.sum (list.map (matroid_set_pair_to_rank) (Ms.zip Xs))

/- sum of ranks of a fixed set in a list of matroids -/
def sum_of_ranks_of_set (Ms : list (matroid α)) (X : set α) :ℤ :=
  sum_of_ranks_of_sets Ms (list.repeat X Ms.length)

@[simp] lemma sum_ranks_sets_empty_list (X : list (set α)) :
  sum_of_ranks_of_sets (list.nil) X = 0 :=
by {unfold sum_of_ranks_of_sets, simp, }

@[simp] lemma sum_ranks_set_empty_list (X : set α) :
  sum_of_ranks_of_set (list.nil) X = 0 :=
by {unfold sum_of_ranks_of_set, simp, }

instance indep_list_nonempty (Ms : list (matroid α)) : nonempty (indep_list Ms) :=
begin
  apply nonempty_subtype.mpr,
  unfold is_indep_list,
  induction Ms,
  from ⟨list.nil, by dec_trivial⟩,
  rcases Ms_ih with ⟨Ms',⟨h1,h2⟩⟩ ,
  refine ⟨Ms'.cons ∅, ⟨by simp [h1], λ MX, _⟩⟩,
  simp only [list.mem_cons_iff, list.zip_cons_cons],
  rintro ⟨c1, c2⟩,
  apply empty_indep, apply h2, from H,
  -- I imagine this shouldn't be so hard
end

instance indep_list_fintype (Ms : list (matroid α)) : fintype (indep_list Ms) :=
begin
  set f : indep_list Ms → vector (set α) (Ms.length) := λ Xs, ⟨Xs.val, Xs.property.1⟩ with hf,
  refine fintype.of_injective f (λ x x' hxx', _),
  dsimp [f] at hxx', cases x, cases x',
  rw subtype.mk_eq_mk at ⊢ hxx', from hxx',
  -- likewise
end

lemma indep_list_nil_elim {Xs : list (set α)} :
  is_indep_list (list.nil : list (matroid α)) Xs → Xs = list.nil :=
by {rintros ⟨hx,hx'⟩, simp [list.length_eq_zero] at hx, from hx,}

lemma indep_list_nil_iff_nil {Xs : list (set α)} :
  is_indep_list (list.nil : list (matroid α)) Xs ↔ Xs = list.nil :=
by {refine ⟨λ h, indep_list_nil_elim h, λ h,_⟩, unfold is_indep_list, rw h, simp, }

lemma indep_list_nil_elim_subtype (Xs : indep_list (list.nil : list (matroid α))) :
  Xs.val = list.nil :=
indep_list_nil_elim Xs.property

instance indep_nil_list_subsingleton :
  subsingleton (indep_list (list.nil : list (matroid α))) :=
⟨λ x y, by {cases x, cases y, rw [subtype.mk_eq_mk], rw [indep_list_nil_elim x_property, indep_list_nil_elim y_property],  }⟩

-- These next two lemmas are TODO - they should be provable and useful. Commented to avoid sorries

/-lemma indep_list_iff_exists_zip (Ms : list (matroid α)) (X : set α) :
  is_union_indep_list Ms X ↔
    (∃ zMs : list ((matroid α) × (set α)),
    (
      ∀ p ∈ zMs, is_matroid_indep_pair p) ∧
      (list.unzip zMs).1 = Ms ∧
      list_union (list.unzip zMs).2 = X
    ) :=
begin

end

lemma union_of_indep_cons (Ms : list (matroid α)) (N : matroid α) (X : set α) :
  is_union_indep_list (N :: Ms) X ↔ ∃ Y X₀, is_indep N Y ∧ is_union_indep_list Ms X₀ ∧ Y ∪ X₀ = X :=
begin
  unfold is_union_indep_list,
  simp only [exists_exists_eq_and, exists_and_distrib_left, subtype.val_eq_coe],
  refine ⟨λ h, _, λ h, _⟩,
  rcases h with ⟨⟨Xs, hXs⟩, hu⟩,
  induction Xs with Xhd Xtl, simp at hu,
end-/

/-
@[simp] lemma union_fin_zero (a : fin 0 → set α) :
  (⋃ i, a i) = ∅ :=

-/

-/


/-
CS 2102 F19, Homework #8, Predicate Logic & Proofs.
-/

namespace hw8

/-
#1. Equality and proofs of equality.
-/

/-
A. [10 points] Fill in the blank.

When we say that the binary equality relation,
=, on objects of any type, α, is reflexive, we
mean that for any value, a, of type, α, _______.

ANSWER:
a = a
-/

/-
B. [10 points]
Complete the following definition in Lean
to formalize the proposition that 1 equals
1.
-/

def one_eq_one : Prop :=
    -- ANSWER
    1 = 1

/-
C. [10 points]
Give an English language proof of the
proposition that 1 = 1 by completing the
following incomplete proof.

To obtain a proof of 1 = 1 we apply the ________
property of the ________ relation to the specific
value, _________.

ANSWER:
    reflexive, equals, 1
-/

/-
D. [10 points]
Give a formal proof of this proposition
by completing the following definition.
-/

def proof_that_one_eq_one : one_eq_one :=
    -- ANSWER
    eq.refl 1

/- [10 points]
E. Complete the following test case to produce
an example that suggests (correctly) that Lean
will accept a proof that two *different terms* are
equal as long as they reduce to the same value.
-/

-- ANSWER: Give a proposition and proof in Lean

def two_plus_two_eq_four : Prop :=
    (2+2)=4

def proof_that_two_plus_two_eq_four : two_plus_two_eq_four :=
    eq.refl (2+2)
-- ANSWER Does eq.refl work as suggested? _____
--Yes, the refletive prop works the way I would expect it to

/-
#2. Predicates and Properties

A predicate is a parameterized proposition. By
applying a predicate to different arguments, we get
different propositions. Such a propopsition can
be said to be "about" the argument to which it was
applied.

We interpret such a proposition as asserting that
its argument has a *property* of interest. If the
proposition has a proof (is true), the object does
have the asserted property, and if the proposition
is not true, the object doesn't have that property.

In the  following set of problems, we will take the
property of a natural number "being even" as a case
in point.

In natural language, we will say that a natural
number, n, is even if and only if (1) it is zero,
or, (2) it is two more than another even number.

Think about this inductive definition. Why does it
cover all possible cases -- an infinitude of cases?
(No need for an answer here.)
-/

/-

A. [10 points]

We have accepted as *axioms* in our definition
of evennness that zero is even and that any number
that is two more than another even number is even.
These are the only axioms you may use in giving a
proof that four is even. Give a natural language
proof now. Hint, start by saying the following:

Proof: To prove that four is even, *it will suffice*
to show that 2 is even, because if two is even then,
given that 4 is two more than two, if two is even
then so is four, by rule (2). Now all that remains
to be proved is that _______________.

Give the rest of your natural language proof here,
and be sure to indicate which of the two rules you
are applying at each step in your reasoning.

ANSWER:
All that remains to be proved is that 2 is even. This
can be done by showing that 0 is even and that 2 is
two more than zero. We know that 0 is even because it is
even rule 1. We know that two is even because it is two more
than zero (2)
-/

/-
B. [10 points]

We formalize a predicate, such as is_even, as a
family of "inductive propositions" given by a
function from argument values to propositions.
Such an inductive definition thus has the type,
α → Prop, where α is the type of argument to
which the predicate is applied.

Please see the first line of the definition of
is_even that follows for an example.

Having specified the *type* of a predicate, in
this case from ℕ → Prop, we then define the set
of constructors to define the logical rules that
can be used to construct proofs of any such
proposition.

These rules are the (formal) axioms that can be
used to construct proofs. The first one (below)
states that the term, pf_zero_is_even, is to be
accepted as a proof of is_even 0 (which is how
we write the application of a predicate to a value
to obtain a proposition, here that "0 is even").

The second constructor/axiom/rule provides a way
to build a proof of (is_even 2+n) by applying the
constructor to any n along with a proof that that
particular n is even. (Yes: the ∀ specifies the
first argument to pf_even_plus_two_is_even. This
is necessary to give the argument a name, here n,
so that that name can be used in defining the rest
of the constructor's type).
-/

inductive is_even : ℕ → Prop
| pf_zero_is_even : (is_even 0)
| pf_even_plus_two_is_even :
    ∀ (n : ℕ), is_even n → is_even (nat.succ (nat.succ n))

/-
Give formal proofs for each of the following
propositions. (Notice how we obtain different
propositions by applying the predicate, is_even,
to different argument values. This is what we
mean when we say that a predicate defines a
family of propositions.)
-/

open is_even

theorem zero_even   : is_even 0 :=
    -- ANSWER
    pf_zero_is_even

/-
In this case, give a proof term without using
a begin/end proof script.
-/
theorem two_even    : is_even 2 :=
    -- ANSWER
    pf_even_plus_two_is_even 0 zero_even

/-
In this case, give a proof using a begin/end
proof script.
-/
theorem eight_even  : is_even 8 :=
begin
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,  -- replace this with answer
    apply pf_even_plus_two_is_even,
    exact two_even                   -- exact is the answer
end

/-
C. [10 points]

Formally specify a predicate, is_odd, on the
natural numbers.  You can reason about any
natural number being odd using two rules, just
as for being even. Once you've defined your
predicate (an inductive family of proposition,
just like is_even), formally state and prove
the following propositions (however you wish).

- 1 is odd
- 7 is odd

-/

-- ANSWER
inductive is_odd : ℕ → Prop
| pf_one_is_odd : (is_odd (nat.succ 0))
| pf_odd_plus_two_is_odd :
    ∀ (n : ℕ), is_odd n → is_odd (nat.succ (nat.succ n))
open is_odd

-- ANSWER
theorem one_odd : is_odd 1 :=
    pf_one_is_odd

-- ANSWER
theorem seven_odd : is_odd 7 :=
begin
    apply pf_odd_plus_two_is_odd,
    apply pf_odd_plus_two_is_odd,
    apply pf_odd_plus_two_is_odd,
    exact one_odd
end

/-
Introducing an important concept. In the preceding
problems, we've seen that we can think of a predicate
with one argument as defining a property objects, such
as the property of being even. Now we shift perspective
from the concept of a property, per se, to the concept
of "the set of objects that have a given property." The
set of objects that have the is_even property, for
example, could be written as

    evens = {0, 2, 4, 6, 8, 10, ...}

or more formally as

    evens = { n : ℕ | is_even n}

The elements of these sets are all, and only,
the values that "satisfy" the is_even predicate.
A value satisfies its predicate if, when plugged
in, the resulting proposition has a proof (and so
is true). The key conclusion is that a predicate
with a single argument defines a *set*, namely
the set of all and only those objects that have
that property.
-/

/-
#4. Predicates and binary relations

Mathematicians define *binary relations* as sets
of ordered pairs. For example, the equality relation
on natural numbers comprises the set of of all pairs
of natural numbers such that the first and second
elements are the same. We could write this set like
this:

    equals = { (0,0), (1,1), (2,2), ...},

or like this:

    equals = { (m : ℕ, n : ℕ) | m = n }

We formalize binary relations as predicates with
*two* arguments. The type of such a predicate in
Lean is thus α → β → Prop, where α and β are the
types of the arguments.

In our example, we have a two-place predicate that
defines the set of ordered pairs of natural numbers
where the two elements of each pair are co-equal.

Study and understand the following specification
of this binary relation. Look at the construtor,
mk, in particular: it says that you can construct
a proof that a pair of values, n and m, is in our
id_nat_relation if you have a proof of n = m. (In
other words, it suffices to show that n = m using
Lean's built in equality relation to construct a
proof that (n, m) is in our id_nat_relation.)
-/

inductive id_nat_relation : ℕ → ℕ → Prop
| mk : ∀ (n m : ℕ), n = m → id_nat_relation n m
| sy : ∀ (n m : ℕ), n = m ∧ m = n → id_nat_relation n m
| tr : ∀ (n m c : ℕ), (n = m ∧ m = c ) → n = c → id_nat_relation n m

/-
A. [10 points]

Give a formal proof that id_nat_relation contains
the pair, (3, 3). Do it by completing the following
proof. Think carefully about the third argument: you
need a *value* of what type here? What do we call a
value of a logical type?
-/

theorem three_three_in_id : id_nat_relation 3 3 :=
    -- ANSWER (apply a constructor, of course)
    id_nat_relation.mk 3 3 (eq.refl 3)

/-
B. [10 points]

Explain in just a few words why it is not
possible to prove that (3,5) is in this relation.
-/

-- ANSWER
-- 3 and 5 are not reflexive

/-
EXTRA CREDIT.
-/

/-
Here's a definition of what it means for a
relation to be reflexive.
-/

def reflexive {α : Type} (r : α → α → Prop) :=
    ∀ (a : α), r a a

/-
A. Formally state and prove that id_nat_relation
is reflexive. Hint: use a script and start it
with "assume (a : ℕ)". Remember that to prove a ∀
proposition, we *assume* that we're given some
arbitrary but specific value of the given type,
then we prove the rest of the proposition about
it. But because we didn't say anything about
the element we picked, we can conclude that the
statement must be true of any element of the type.
-/

-- ANSWER

theorem id_nat_refl : reflexive id_nat_relation :=
begin
assume (a : ℕ),
    apply id_nat_relation.mk a a,
    exact eq.refl a
end

/-
B. [Double extra credit.]

Formally define what we mean by a relation being
symmetric and transitive, in the style of the above
definition of reflexive, and formally state and show
that our id_nat_reflexive relation is also symmetric
and transitive.
-/

def symmetric {α : Type} (r : α → α → Prop) :=
    ∀ (a b : α), r a b ↔ r b a

def transitive {α : Type} (r : α → α →  Prop) :=
    ∀ (a b c: α), (r a b ∧ r b c) → r a c

theorem id_nat_symm : symmetric id_nat_relation :=
begin
assume (a : ℕ),
    apply id_nat_relation.sy
end
end hw8


-- Chapter 1. Overview

#check "hello, world!"

-- page 6
namespace hide

inductive nat: Type
| zero: nat
| succ: nat → nat

def add: nat → nat → nat
| m nat.zero := m
| m (nat.succ n) := nat.succ (add m n)

#eval add nat.zero (nat.succ (nat.succ nat.zero))

end hide

def double (n: ℕ) : ℕ := n + n

#check double
#print double
#eval double 2

-- page 7
section
  variables (G : Type) [group G]
  variables g₁ g₂ : G

  #check g₂⁻¹ * g₁ * g₂
  #check g₁⁻¹ * g₁
end

-- page 8
/- An important feature of dependent type theory is that every expression
  has a computational interpretation, which is to say, there are rules
  that specify how they can be /reduced/ to a normal form.
  Moreover, expressions in a computationally pure fragment of the language
  evaluate to /values/ in the way you would expect.
  For example, assuming the definition does not depend on nonconstructive
  components in an essential way, every closed term of type =ℕ= evaluates
  to a numeral. Lean's kernel can carry out this evaluation: -/

#eval (27 + 9) * 33

/- As part of the kernel, the results of this evaluation can be highly trusted.
  The evaluator is not very efficient, however, and is not intended to be used
  for substantial computational tasks. For that purpose, Lean also generates
  bytecode for every definition of a computable object, and can evaluate it on
  demand. To process the bytecode quickly, it uses an efficient /virtual machine/,
  similar to the ones used to interpret OCaml and Python. -/

def double (n : ℕ) : ℕ := n + n

#eval (27 + 9) * 33
#eval (2227 + 9999) * 33
#eval double 9999
#eval [(1, 2), (3, 4), (5, 6)] ++ [(7, 8), (9, 10)]

/- Relying on results from the bytecode evaluator requires a higher level
  of trust than relying on the kernel. For example, for efficiency, the
  bytecode evaluator uses the GNU multiple precision library to carry out
  numerical computations involving the natural numbers and integers, so
  the correctness of those computations are no longer underwritten by
  the axiomatic foundation. -/

/- This points to a second intended use of Lean, namely, as a
  /programming language/. Because dependent type theory is so
  expressive, we can make use of all the usual methods and techniques of
  functional programming, including higher types, type classes, records,
  monads, and other abstractions.

  For example, we can write a generic sort procedure that sorts elements
  of a list according to a specified binary relation =r= on an arbitrary
  type =α=, assuming only that we can determine computationally when =r= holds. -/

section sort
  universe u
  parameters {α : Type u} (r : α → α → Prop) [decidable_rel r]
  local infix `≼` : 50 := r

  def ordered_insert (a : α) : list α → list α
  | []       := [a]
  | (b :: l) := if a ≼ b then a :: (b :: l) else b :: ordered_insert l

  def insertion_sort : list α → list α
  | []       := []
  | (b :: l) := ordered_insert b (insertion_sort l)

-- We can run the procedure above on a list of natural numbers, using the usual ordering:

#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end sort

-- Substantial programs can be written in Lean and run by the bytecode interpreter.

-- page 9
section
def even (n : ℕ) : Prop := ∃ m, n = 2 * m
#check even 10
#check even 11
#check ∀ n, even n ∨ even (n + 1)
#check ∀ n m, even n → even m → even (n + m)

-- Here is how we prove 10 is even.
example: even 10 := ⟨5, rfl⟩

/- To prove an existential statement, it is enough to present a witness to the
   existential quantifier and then show that the claim is true of that witness.
   The Unicode angle brackets just package this data together; enter them in emacs
   with \< and \>, or use the ASCII equivalents, (| and |). -/

-- Here is a proof that the sum of two evens is even.
theorem even_add : ∀ m n, even m → even n → even (m + n) :=
take m n
assume ⟨k, (Hk : m = 2 * k)⟩
assume ⟨l, (Hl : n = 2 * l)⟩
have m + n = 2 * (k + l),
  by simp [Hk, Hl, mul_add]
show even (m + n),
  from ⟨ _ , this⟩

end


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

import tactic -- imports all the Lean tactics

/-!

# `equiv`

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

```

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

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

```

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

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

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

example (X Y : Type) (e : X ≃ Y) : Y ≃ X :=
{ to_fun := e.inv_fun,
  inv_fun := e.to_fun,
  left_inv := begin exact e.right_inv end,
  right_inv := e.left_inv }

-- can you build `equiv.trans` yourself?
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
{ to_fun := λ x, eYZ.to_fun (eXY.to_fun x),
  inv_fun := λ z, eXY.inv_fun (eYZ.inv_fun z), -- ditto
  left_inv := begin
    intro x,
    dsimp only,
    rw [eYZ.left_inv, eXY.left_inv],
  end,
  right_inv := begin
    intro z,
    dsimp only,
    rw [eXY.right_inv, eYZ.right_inv],
  end }

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

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

-- See if you can make the following bijection using dot notation
example (A B C X : Type) (eAX : A ≃ X) (eBX : B ≃ X) : A ≃ B :=
eAX.trans eBX.symm

--sorry -- don't use tactic mode, see if you can find a one-liner
-- using `equiv.symm` and `equiv.trans`

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

example : ℚ ≃ ℚ :=
{ to_fun := λ x, 3 * x + 4,
  inv_fun := λ y, (y-4)/3,
  left_inv := begin
    intro x,
    simp,
    ring,
  end,
  right_inv := begin
    intro y,
    dsimp,
    ring,
  end }

/-

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

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

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

-/

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

example : equivalence R :=
begin
  refine ⟨_, _, _⟩,
  { intro X,
    use equiv.refl X },
  { rintros X Y ⟨e, he⟩,
    use e.symm },
  { rintros X Y Z ⟨eXY, -⟩ ⟨eYZ, -⟩,
    use eXY.trans eYZ,
  }
end

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