/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Binomial coefficients, "n choose k".
-/
import data.nat.div data.nat.fact data.finset
open decidable

namespace nat

/- choose -/

definition choose : ℕ → ℕ → ℕ
| 0 0               := 1
| 0 (succ k)        := 0
| (succ n) 0        := 1
| (succ n) (succ k) := choose n (succ k) + choose n k

theorem choose_zero_right (n : ℕ) : choose n 0 = 1 :=
nat.cases_on n rfl (take m, rfl)

theorem choose_zero_succ (k : ℕ) : choose 0 (succ k) = 0 := rfl

theorem choose_succ_succ (n k : ℕ) : choose (succ n) (succ k) = choose n (succ k) + choose n k :=
rfl

theorem choose_eq_zero_of_lt {n : ℕ} : ∀{k : ℕ}, n < k → choose n k = 0 :=
nat.induction_on n
  (take k, assume H : 0 < k,
    obtain k' (H : k = succ k'), from exists_eq_succ_of_pos H,
    by rewrite H)
  (take n',
    assume IH: ∀ k, n' < k → choose n' k = 0,
    take k,
    suppose succ n' < k,
    obtain k' (keq : k = succ k'), from exists_eq_succ_of_lt this,
    have n' < k', by rewrite keq at this; apply lt_of_succ_lt_succ this,
    by rewrite [keq, choose_succ_succ, IH _ this, IH _ (lt.trans this !lt_succ_self)])

theorem choose_self (n : ℕ) : choose n n = 1 :=
begin
  induction n with [n, ih],
    {apply rfl},
  rewrite [choose_succ_succ, ih, choose_eq_zero_of_lt !lt_succ_self]
end

theorem choose_succ_self (n : ℕ) : choose (succ n) n = succ n :=
begin
  induction n with [n, ih],
    {apply rfl},
  rewrite [choose_succ_succ, ih, choose_self, add.comm]
end

theorem choose_one_right (n : ℕ) : choose n 1 = n :=
begin
  induction n with [n, ih],
    {apply rfl},
  change choose (succ n) (succ 0) = succ n,
  krewrite [choose_succ_succ, ih, choose_zero_right]
end

theorem choose_pos {n : ℕ} : ∀ {k : ℕ}, k ≤ n → choose n k > 0 :=
begin
  induction n with [n, ih],
    {intros [k, H],
      have k = 0, from eq_of_le_of_ge H !zero_le,
      subst k, rewrite choose_zero_right; apply zero_lt_one},
  intro k,
  cases k with k,
    {intros, rewrite [choose_zero_right], apply zero_lt_one},
  suppose succ k ≤ succ n,
  have k ≤ n, from le_of_succ_le_succ this,
  by rewrite [choose_succ_succ]; apply add_pos_right (ih this)
end

-- A key identity. The proof is subtle.
theorem succ_mul_choose_eq (n : ℕ) :
  ∀ k, succ n * (choose n k) = choose (succ n) (succ k) * succ k :=
begin
  induction n with [n, ih],
    {intro k,
      cases k with k',
        {krewrite [*choose_self, one_mul, mul_one]},
        {have H : 1 < succ (succ k'), from succ_lt_succ !zero_lt_succ,
         krewrite [one_mul, choose_zero_succ, choose_eq_zero_of_lt H, zero_mul]}},
  intro k,
  cases k with k',
    {krewrite [choose_zero_right, choose_one_right]},
  rewrite [choose_succ_succ (succ n), right_distrib, -ih (succ k')],
  rewrite [choose_succ_succ at {1}, left_distrib, *succ_mul (succ n), mul_succ, -ih k'],
  rewrite [*add.assoc, add.left_comm (choose n _)]
end

theorem choose_mul_fact_mul_fact {n : ℕ} :
  ∀ {k : ℕ}, k ≤ n → choose n k * fact k * fact (n - k) = fact n :=
begin
  induction n using nat.strong_induction_on with [n, ih],
  cases n with n,
    {intro k H, have k = 0, from eq_zero_of_le_zero H, rewrite this},
  intro k,
  intro H,  -- k ≤ n,
  cases k with k,
    {rewrite [choose_zero_right, fact_zero, *one_mul]},
  have k ≤ n, from le_of_succ_le_succ H,
  show choose (succ n) (succ k) * fact (succ k) * fact (succ n - succ k) = fact (succ n), from
  begin
    rewrite [succ_sub_succ, fact_succ, -mul.assoc, -succ_mul_choose_eq],
    rewrite [fact_succ n, -ih n !lt_succ_self this, *mul.assoc]
  end
end

theorem choose_def_alt {n k : ℕ} (H : k ≤ n) : choose n k = fact n / (fact k * fact (n -k)) :=
eq.symm (nat.div_eq_of_eq_mul_left (mul_pos !fact_pos !fact_pos)
    (by rewrite [-mul.assoc, choose_mul_fact_mul_fact H]))

theorem fact_mul_fact_dvd_fact {n k : ℕ} (H : k ≤ n) : fact k * fact (n - k) ∣ fact n :=
by rewrite [-choose_mul_fact_mul_fact H, mul.assoc]; apply dvd_mul_left

open finset

/- the number of subsets of s of size k is n choose k -/

section card_subsets
variables {A : Type} [deceqA : decidable_eq A]
include deceqA

private theorem aux₀ (s : finset A) : {t ∈ powerset s | card t = 0} = '{∅} :=
ext (take t, iff.intro
  (assume H,
    have t = ∅, from eq_empty_of_card_eq_zero (of_mem_sep H),
    show t ∈ '{ ∅ }, by rewrite [this, mem_singleton_iff])
  (assume H,
    have t = ∅, by rewrite mem_singleton_iff at H; assumption,
    by substvars; exact mem_sep_of_mem !empty_mem_powerset rfl))

private theorem aux₁ (k : ℕ) : {t ∈ powerset (∅ : finset A) | card t = succ k} = ∅ :=
eq_empty_of_forall_not_mem (take t, assume H,
  have t ∈ powerset ∅, from mem_of_mem_sep H,
  have t = ∅, by rewrite [powerset_empty at this, mem_singleton_iff at this]; assumption,
  have card (∅ : finset A) = succ k, by rewrite -this; apply of_mem_sep H,
  nat.no_confusion this)

private theorem aux₂ {a : A} {s t : finset A} (anins : a ∉ s) (tpows : t ∈ powerset s) : a ∉ t :=
suppose a ∈ t,
have a ∈ s, from mem_of_subset_of_mem (subset_of_mem_powerset tpows) this,
anins this

private theorem aux₃ {a : A} {s t : finset A} (anins : a ∉ s) (k : ℕ) :
  t ∈ (insert a) ' (powerset s) ∧ card t = succ k ↔
    t ∈ (insert a) ' {t' ∈ powerset s | card t' = k} :=
iff.intro
  (assume H,
    obtain H' cardt, from H,
    obtain t' [(t'pows : t' ∈ powerset s) (teq : insert a t' = t)], from exists_of_mem_image H',
    have aint : a ∈ t, by rewrite -teq; apply mem_insert,
    have anint' : a ∉ t', from
      (assume aint',
        have a ∈ s, from mem_of_subset_of_mem (subset_of_mem_powerset t'pows) aint',
        anins this),
    have t' = erase a t, by rewrite [-teq, erase_insert (aux₂ anins t'pows)],
    have card t' = k, by rewrite [this, card_erase_of_mem aint, cardt],
    mem_image (mem_sep_of_mem t'pows this) teq)
  (assume H,
    obtain t' [Ht' (teq : insert a t' = t)], from exists_of_mem_image H,
    have t'pows : t' ∈ powerset s, from mem_of_mem_sep Ht',
    have cardt' : card t' = k, from of_mem_sep Ht',
    and.intro
      (show t ∈ (insert a) ' (powerset s), from mem_image t'pows teq)
      (show card t = succ k,
        by rewrite [-teq, card_insert_of_not_mem (aux₂ anins t'pows), cardt']))

private theorem aux₄ {a : A} {s : finset A} (anins : a ∉ s) (k : ℕ) :
  {t ∈ powerset (insert a s)| card t = succ k} =
    {t ∈ powerset s | card t = succ k} ∪ (insert a) ' {t ∈ powerset s | card t = k} :=
begin
  apply ext, intro t,
  rewrite [powerset_insert anins, mem_union_iff, *mem_sep_iff, mem_union_iff, and.right_distrib,
           aux₃ anins]
end

private theorem aux₅ {a : A} {s : finset A} (anins : a ∉ s) (k : ℕ) :
  {t ∈ powerset s | card t = succ k} ∩ (insert a) ' {t ∈ powerset s | card t = k} = ∅ :=
inter_eq_empty
  (take t, assume Ht₁ Ht₂,
    have tpows : t ∈ powerset s, from mem_of_mem_sep Ht₁,
    have anint : a ∉ t, from aux₂ anins tpows,
    obtain t' [Ht' (teq : insert a t' = t)], from exists_of_mem_image Ht₂,
    have aint : a ∈ t, by rewrite -teq; apply mem_insert,
    show false, from anint aint)

private theorem aux₆ {a : A} {s : finset A} (anins : a ∉ s) (k : ℕ) :
  card ((insert a) ' {t ∈ powerset s | card t = k}) = card {t ∈ powerset s | card t = k} :=
have set.inj_on (insert a) (ts {t ∈ powerset s| card t = k}), from
  take t₁ t₂, assume Ht₁ Ht₂,
  assume Heq : insert a t₁ = insert a t₂,
  have t₁ ∈ powerset s, from mem_of_mem_sep Ht₁,
  have anint₁ : a ∉ t₁, from aux₂ anins this,
  have t₂ ∈ powerset s, from mem_of_mem_sep Ht₂,
  have anint₂ : a ∉ t₂, from aux₂ anins this,
  calc
    t₁    = erase a (insert a t₁) : by rewrite (erase_insert anint₁)
      ... = erase a (insert a t₂) : Heq
      ... = t₂                    : by rewrite (erase_insert anint₂),
card_image_eq_of_inj_on this

theorem card_subsets (s : finset A) : ∀k, card {t ∈ powerset s | card t = k} = choose (card s) k :=
begin
  induction s with a s anins ih,
    {intro k,
      cases k with k,
        {rewrite aux₀},
      rewrite aux₁},
  intro k,
  cases k with k,
    {rewrite [aux₀, choose_zero_right]},
  rewrite [*(card_insert_of_not_mem anins), aux₄ anins, card_union_of_disjoint (aux₅ anins k),
           aux₆ anins k, *ih]
end

end card_subsets

end nat


import NNG.Metadata
import NNG.Tactics

Level 5

Title "The induction_on spell"

Introduction
"
Welcome to Addition World. If you've done all four levels in tutorial world
and know about `rewrite` and `rfl`, then you're in the right place. Here's
a reminder of the things you're now equipped with which we'll need in this world.

## Data:

  * a type called `ℕ`
  * a term `0 : ℕ`, interpreted as the number zero.
  * a function `succ : ℕ → ℕ`, with `succ n` interpreted as \"the number after `n`\".
  * Usual numerical notation 0,1,2 etc (although 2 onwards will be of no use to us until much later ;-) ).
  * Addition (with notation `a + b`).

## Theorems:

  * `add_zero (a : ℕ) : a + 0 = a`. Use with `rewrite [add_zero]`.
  * `add_succ (a b : ℕ) : a + succ(b) = succ(a + b)`. Use with `rewrite [add_succ]`.
  * The principle of mathematical induction. Use with `induction_on` (see below)

## Spells:

  * `rfl` :  proves goals of the form `X = X`
  * `rewrite [h]` : if h is a proof of `A = B`, changes all A's in the goal to B's.
  * `induction_on n with d hd` : we're going to learn this right now.

# Important thing:

This is a *really* good time to check you understand about the spell book and the inventory on
the left. Eveything you need is collected in those lists. They
will prove invaluable as the number of theorems we prove gets bigger. On the other hand,
we only need to learn one more spell to really start going places, so let's learn about
that spell right now.

OK so let's see induction in action. We're going to prove

  `zero_add (n : ℕ) : 0 + n = n`.

That is: for all natural numbers $n$, $0+n=n$. Wait $-$ what is going on here?
Didn't we already prove that adding zero to $n$ gave us $n$?
No we didn't! We proved $n + 0 = n$, and that proof was called `add_zero`. We're now
trying to establish `zero_add`, the proof that $0 + n = n$. But aren't these two theorems
the same? No they're not! It is *true* that `x + y = y + x`, but we haven't
*proved* it yet, and in fact we will need both `add_zero` and `zero_add` in order
to prove this. In fact `x + y = y + x` is the boss level for addition world,
and `induction_on` is the only other spell you'll need to beat it.

Now `add_zero` is one of Peano's axioms, so we don't need to prove it, we already have it
(indeed, if you've opened the Addition World theorem statements on the left, you can even see it).
To prove `0 + n = n` we need to use induction on $n$. While we're here,
note that `zero_add` is about zero add something, and `add_zero` is about something add zero.
The names of the proofs tell you what the theorems are. Anyway, let's prove `0 + n = n`.

Start by casting `induction_on n`.
"

Statement (n : ℕ) : 0 + n = n := by
  induction_on n
  rewrite [add_zero]
  rfl
  rewrite [add_succ]
  rewrite [ind_hyp]
  rfl

Message : (0 : ℕ) + 0 = 0  => "
We now have *two goals!* The
induction spell has generated for us a base case with `n = 0` (the goal at the top)
and an inductive step (the goal underneath). The golden rule: **spells operate on the current goal** --
the goal at the top. So let's just worry about that top goal now, the base case `0 + 0 = 0`.

Remember that `add_zero` (the proof we have already) is the proof of `x + 0 = x`
(for any $x$) so we can try

`rewrite [add_zero]`

What do you think the goal will change to? Remember to just keep
focussing on the top goal, ignore the other one for now, it's not changing
and we're not working on it.
"

Message (n : ℕ) (ind_hyp: 0 + n = n) : 0 + succ n = succ n =>
"
Great! You solved the base case. We are now be back down
to one goal -- the inductive step.

We have a fixed natural number `n`, and the inductive hypothesis `ind_hyp : 0 + n = n`
saying that we have a proof of `0 + n = n`.
Our goal is to prove `0 + succ n = succ n`. In words, we're showing that
if the lemma is true for `n`, then it's also true for the number after `n`.
That's the inductive step. Once we've proved this inductive step, we will have proved
`zero_add` by the principle of mathematical induction.

To prove our goal, we need to use `add_succ`. We know that `add_succ 0 n`
is the result that `0 + succ n = succ (0 + n)`, so the first thing
we need to do is to replace the left hand side `0 + succ n` of our
goal with the right hand side. We do this with the `rewrite` spell. You can write

`rewrite [add_succ]`

(or even `rewrite [add_succ 0 n]` if you want to give Lean all the inputs instead of making it
figure them out itself).
"

Message (n : ℕ) (ind_hyp: 0 + n = n) : succ (0 + n) = succ n =>
"Well-done! We're almost there. It's time to use our induction hypothesis.
Cast

`rewrite [ind_hyp]`

and finish by yourself.
"

Conclusion "Congratulations for completing your first inductive proof!"

Tactics rfl rewrite induction_on

Lemmas add_succ add_zero


-- Math 52: Week 4

import .utils.int_refl

-- Lakins Definition 1.2.1:
definition is_even (n : ℤ) := ∃ (k : ℤ), n = 2 * k
definition is_odd (n : ℤ) := ∃ (k : ℤ), n = 2 * k + 1

-- Lakins Definition 2.1.1: Let a, b ∈ Z.
-- a divides b if there exists n ∈ ℤ such that b = an.
-- We write a ∣ b for "a divides b" and say that a is
-- a divisor of b.
definition divides (a b : ℤ) : Prop := ∃ (n : ℤ), a * n = b

-- The notation `a ∣ b` can be used for `divides a b`
local infix ∣ := divides

-- Lakins Example 2.1.2:
example : 3 ∣ 12 :=
begin
unfold divides,
existsi (4:ℤ),
refl,
end

-- Theorem: For every integer a, a ∣ a.
theorem divides_refl : ∀ (a : ℤ), a ∣ a :=
begin
intro a,
unfold divides,
existsi (1:ℤ),
calc a * 1 = a : by rw mul_one,
end
-- Proof: Let a ∈ ℤ be arbitrary. We must show that a ∣ a;
-- i.e., we must find an integer k such that a = a * k.
-- Since a = a * 1 and 1 is an integer, we see that
-- a ∣ a is true. □

-- Lakins Proposition 2.1.3: For all integers a, b, c,
-- if a ∣ b and b ∣ c, then a ∣ c.
theorem divides_trans : ∀ (a b c : ℤ), a ∣ b ∧ b ∣ c → a ∣ c :=
begin
sorry
end
-- Proof: Let a,b,c ∈ ℤ be arbitrary and assume that
-- a ∣ b and b ∣ c. We must show that a ∣ c; i.e., we
-- must find an integer k such that c = a * k.
--
-- Since a ∣ b, by Definition 2.1.1 we may fix n ∈ ℤ
-- such that b = a * n. Similarly, since b | c, we may
-- fix m ∈ ℤ such that c = b * m, again by Definition
-- 2.1.1. Then
--   c = b * m = (a * n) * m = a * (n * m),
-- since multiplication of integers is associative
-- (Basic Properties of Integers 1.2.3). Since
-- n * m ∈ ℤ, we have proved that a ∣ c, by
-- Definition 2.1.1, as desired. 􏰟

-- Lakins Exercise 2.1.1: Let a,b, and c be integers.
-- For all integers m and n, if a ∣ b and a ∣ c, then
-- a ∣ (bm + cn).
theorem L211 : ∀ (a b c m n : ℤ), a ∣ b ∧ a ∣ c → a ∣ (b * m + c * n) :=
begin
sorry
end

-- Theorem: For every integer a, a is even if and only if 2 ∣ a.
theorem is_even_iff_two_divides : ∀ (a : ℤ), is_even a ↔ 2 ∣ a :=
begin
sorry
end

-- We will prove this fact later after we discuss induction.
-- For now we take it as an axiom, i.e., as statement that we
-- take as true without proof.
axiom even_or_odd (a : ℤ) : is_even a ∨ is_odd a

-- Lakins Theorem 2.1.9: For all integers a, a(a + 1) is even.
theorem even_product : ∀ (a : ℤ), is_even (a * (a + 1)) :=
begin
sorry
end
-- Proof: Let a ∈ ℤ. We show that a(a + 1) is even by
-- considering two cases.
--
-- Case I: a is even.
-- Then 2 ∣ a, by Definition 1.2.1. Since a ∣ a(a + 1)
-- by Definition 2.1.1, we have that 2 ∣ a(a + 1) since
-- the divisibility relation is transitive (Proposition
-- 2.1.3). Hence a(a + 1) is even.
--
-- Case II: a is not even.
-- Since a is not even, we know that a is odd. Then
-- a+1 is even by Exercise 1.2.2b. Then, using an
-- argument similar to that of Case I, we have that
-- 2 ∣ (a+1) and (a+1) ∣ a(a+1), and hence 2 ∣ a(a+1)
-- by Proposition 2.1.3. Thus a(a + 1) is even.
--
-- Hence, since we have considered all possible cases
-- for the integer a, we have proved that for all
-- integers a, a(a + 1) is even. 􏰟


/-
Grading rubric. 7 points per question up to 100 max.
Partial credit by subproblem.
-/

/-
Note: An incorrect answer above or below
a correct answer can cause Lean to be unable
to process the correct answer. If you are not
able to complete a problem succesfully please
comment out your incomplete answer so that we
can see your work but so that your incomplete
work does not cause problems for surrounding
problems and answers.
-/

/-
PART I: Functions. Functions are an essential
element of the language of predicate logic. In
this section, you show that you understand how
to define, use, and reason about functions in
Lean.
-/

/- 1.

Study each of the following definitions,
then answer the associated question about
the types involved in these definitions.
-/

-- Consider this function
def f (n : ℕ) (s : string) := s

/-
a. What is it's return type? Answer: string
-/

/-
b. What is the type of (f 5)? Answer: string → string
-/

/-
c. What is the value of (f 0 "yay") "yay"
-/

/-
d. What is the type of this function? nat → string → string
-/

/- 2.

Define three functions called square,
square', and square'', each of type
ℕ to ℕ. Each function must return the
square of the value to which it is
applied. Write the first function in
"C" style, the second using a tactic
script, and the third using a lambda
abstraction. Declare argument and return
types explicitly in each case.
-/

def square (n : ℕ) : ℕ := n^2

def square' (n : ℕ) : ℕ :=
begin
exact n^2
end

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

/- 3.

Construct three proofs to test your
function definitions. The first must
use "lemma" to define a proof, called
square_3_9, of the proposition that
(square 3) equals 9. The second must
use "theorem" to define a proof, called
square'_4_16, of the proposition that
square' applied to 4 reduces to 16. The
third must prove that square'' 5 is
equal to 25. This third proof must not
use the equals sign, =, but must use
"eq" instead to state the proposition
to be proved. Hint on #3, sometimes
you need to use parentheses to express
how you want terms to be grouped.
-/

lemma square_3_9 : square 3 = 9 := rfl
theorem square_4_16 : square' 4 = 16 := rfl
example : eq (square'' 5) 25 := rfl

/- 4.
Define a function called last_first.
It takes two string values, called
"first" and "last" (without quotes),
as arguments, and it returns a string
consisting of "last" followed by a
comma and a space followed by "first".
For example (first "Orson" "Welles").
Write a test case for your function to
prove that (last_first "Orson" "Welles")
is "Welles, Orson". Use "example", to
check the proof. Hint: The ++ operator
implements the string append function.
-/

def last_first (first last : string) :=
    last ++ ", " ++ first

example: (last_first "Orson" "Welles") = "Welles, Orson" := rfl

/- 5.

Complete the following definition of a
function, called apply3. It takes, as an
argument, a function, you might call it f,
of type ℕ → ℕ. It must return a function,
also of type ℕ to ℕ, that, when applied
to a value, n, returns the result of
applying the given function, f, to the
given value, n, three times. That is, it
returns a function that computes f(f(f(n))).
-/

def apply3 : (ℕ → ℕ) → (ℕ → ℕ) :=
    λ f : (ℕ → ℕ),
        λ n, f (f (f n))

-- Just an extra sanity check, not required
#reduce apply3 (λ n, n^2) 2

/- 6.

The Lean libraries define a function,
string.length, that takes a string and
returns its length as a natural number.
Define a function, len2, that takes two
strings and returns the sum of their
lengths. You may use the ++ operator
but not the + operator in your answer.
Follow your function definition with a
test case in the form of a proof using
"example" showing that len2 applied to
"Orson" and "Welles" is 11.
-/

def len2 (s1 s2 : string) : ℕ :=
    string.length (s1 ++ s2)

example : len2 "Orson" "Welles" = 11 := rfl

/- 7.
Use "example" to prove that there is a
function of the following type:

((ℕ → ℕ) → (ℕ → ℕ)) →
    ((ℕ → ℕ) → ℕ) →
        ((ℕ → ℕ) → ℕ)
-/

example :
((ℕ → ℕ) → (ℕ → ℕ)) →
    ((ℕ → ℕ) → ℕ) →
        ((ℕ → ℕ) → ℕ)
:= λ f g, g

/-
PART II: Functions, revited. In
mathematics,  functions play a central
role. A function, f, in the mathematical
sense is a triple, f = { D, P, C }, where
D, a set, is the domain of definition of
f, C is the co-domain of f, and P is a
set of ordered pairs, each with a first
element from D and a second element from
C,. In addition, P has one additional
essential  property, the subject of one
of the following questions.
-/

/- 8.

What one additional property is essential to
the definition of what it means for a triple,
{ D, P, C } to be a function?

Name the property. Answer: Single-Valued

Now explain precisely what it means:  "That there
are no two pairs, (x, y) and (x', y') such that..."

Fill in the blank, and use a logical ∧ in answering.
You might also want to use = or ≠.

Answer: x = x' ∧ y ≠ y'
-/

/- 9.

Give names to the following concepts:

The set of all values appearing as the first
element of any pair in P.

Answer: domain

The set of all values appearing as the second
element of any pair in P.

Answer: range

The property that the set of all values
appearing as the first element of P is the
same as D.

Answer: total

Answer: The property that the set of all
values appearing as the first element of
P is the same as C.

Answer: surjective

The property of having both of the preceding
properties.

Answer: bijective

-/

/- 10.

What does it mean for a function, f, to be
injective? Give you answer by completing the
following sentences with logical expressions.

"A function, f, is said to be injective if
it has no two pairs, (x, y) and (x', y'),
such that ..."

Answer: x ≠ x' ∧ y = y'

In other words, "If (x, y) and (x', y') are
related by f and x ≠ x' then ..."

Answer: y ≠ y'
-/

/- 11.

Suppose that S and T are types and that f
is defined to be a function, *in Lean*, of
type S → T. Which of the following properties,
if any, does f necessarily have?

- N: injective
- N: surjective
- N: bijective
- N: one-to-many
- N: one-to-one
- N: onto
- Y: single-valued
- Y: partial (but not strictly partial)
- Y: total

Answer: single valued, total, partial (if we define partial functions
to include total functions)

-/

/-
PART III: Logic and Proof.
-/

/- 12a.

Use axiom and/or axioms in Lean to express,
in formal logic, the following assumptions:

- T is a type
- t1 and t2 are values of type T
- t1 = t2

Answer immediately after this comment block.
If you need to introduce a name, use eqt1t2.
-/

axiom T : Type
axioms t1 t2 : T
axiom eqt1t2 : t1 = t2

/- 12b.

Use axiom or axioms to represent the
additional assumptions that

- P is a property of objects of type T
- t1 has property P

If you need to use a name, use Pt1
-/

axiom P : T → Prop
axiom Pt1 : P t1

/- 12 c.

Now use "example" to assert, and then
prove, that t2 also has property P.
-/
example : P t2 := eq.subst eqt1t2 Pt1

/- 13 a.
Define eq_1_0 to be the proposition, 1 = 0.
-/

def eq_1_0 := 1 = 0

/- 13 b.
Define pf_eq_0_0 to be a proof of the
proposition that 0 = 0. Use the lemma
keyword.
-/

lemma pf_eq_0_0 : 0 = 0 := rfl

/- 13 c.
Write a function, w, that takes three
values, a, b, and c of type ℕ, and that
also takes proofs, cb : c = b, and
ba : b = a, and that returns a proof
that a = c.
-/

def w (a b c : ℕ) (cb : c = b) (ba : b = a) :
a = c :=
    eq.trans (eq.symm ba) (eq.symm cb)

#check w

/- 13d.

What is the type of this function?

Answer: ∀ (a b c : ℕ), c = b → b = a → a = c

What is the form of this proposition?

Answer: universal generalization

What's the form the proposition after the
comma?

Answer: Implication

What is the premise of the proposition after
the comma?

Answer: c = b

-/

/- 14.
Complete the following proofs. Give each one
in the form indicate by a comment preceding
the statement of the conjecture to be proved.
When using tactic scripts, remember to write
begin/end pairs right away, so Lean knowns
you want to use a tactic script.
-/

-- lambda expression
example : ∀ (s : string), s = s :=
λ s, eq.refl s

-- lambda expresion
example : ∀ (n : ℕ), ∀ (m : ℕ), true :=
λ n m, true.intro

-- tactic script
example : ∀ (T : Type), ∀ (t : T), eq t t :=
begin
assume T t,
exact eq.refl t
end

-- tactic script
example :
    ∀ (T : Type),
    ∀ (P : T → Prop),
    ∀ t1 t2 : T,
    ∀ Pt1 : P t1,
    ∀ t2t1 : t2 = t1,
    P t2 :=
begin
assume T P t1 t2 Pt1 t2t1,
exact eq.subst (eq.symm t2t1) Pt1
end

/-
The following problems involve implications.
For example, false → P in an implication. To
prove an implication, just show that there is
(by giving) a function of the specified type.
-/

-- lambda expression
example : ∀ (P : Prop), false → P :=
λ P, λ f, false.elim f

-- tactic script
example : ∀ (P : Prop), false → P :=
begin
assume P f,
exact false.elim f
end

-- lambda expression
example : ∀ (P Q : Prop), P ∧ Q → Q ∧ P :=
λ P Q pq, and.intro pq.right pq.left

-- tactic script
example : ∀ (P Q : Prop), P ∧ Q → Q ∧ P :=
begin
assume P Q pq,
exact and.intro pq.right pq.left
end

-- tactic script
example :
    ∀ T : Type,
    ∀ (t1 t2 t3 : T),
    t1 = t2 ∧ t2 = t3 → t1 = t3 :=
begin
assume T t1 t2 t3 p,
exact eq.trans p.left p.right
end

/- 15.

Use Lean to model a world in which there
are Dogs, all Dogs are friendly, and Fido
is a Dog, then give a proof that in this
world, Fido must be friendly, too.
-/

axioms Dog : Type
axiom Fido : Dog
axiom Friendly : Dog → Prop
axiom allFriendly : ∀ d : Dog, Friendly d

-- proof is by application of forall elimination
example : Friendly Fido := allFriendly Fido


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Eric Wieser
-/
import data.real.basic

/-!
# Real sign function

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

This file introduces and contains some results about `real.sign` which maps negative
real numbers to -1, positive real numbers to 1, and 0 to 0.

## Main definitions

 * `real.sign r` is $\begin{cases} -1 & \text{if } r < 0, \\
                               ~~\, 0 & \text{if } r = 0, \\
                               ~~\, 1 & \text{if } r > 0. \end{cases}$

## Tags

sign function
-/

namespace real

/-- The sign function that maps negative real numbers to -1, positive numbers to 1, and 0
otherwise. -/
noncomputable
def sign (r : ℝ) : ℝ :=
if r < 0 then -1 else
if 0 < r then 1 else
0

lemma sign_of_neg {r : ℝ} (hr : r < 0) : sign r = -1 :=
by rw [sign, if_pos hr]

lemma sign_of_pos {r : ℝ} (hr : 0 < r) : sign r = 1 :=
by rw [sign, if_pos hr, if_neg hr.not_lt]

@[simp]
lemma sign_zero : sign 0 = 0 :=
by rw [sign, if_neg (lt_irrefl _), if_neg (lt_irrefl _)]

@[simp]
lemma sign_one : sign 1 = 1 :=
sign_of_pos $ by norm_num

lemma sign_apply_eq (r : ℝ) : sign r = -1 ∨ sign r = 0 ∨ sign r = 1 :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { exact (or.inl $ sign_of_neg hn) },
  { exact (or.inr $ or.inl $ sign_zero) },
  { exact (or.inr $ or.inr $ sign_of_pos hp) },
end

/-- This lemma is useful for working with `ℝˣ` -/
lemma sign_apply_eq_of_ne_zero (r : ℝ) (h : r ≠ 0) : sign r = -1 ∨ sign r = 1 :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { exact (or.inl $ sign_of_neg hn) },
  { exact (h rfl).elim },
  { exact (or.inr $ sign_of_pos hp) },
end

@[simp]
lemma sign_eq_zero_iff {r : ℝ} : sign r = 0 ↔ r = 0 :=
begin
  refine ⟨λ h, _, λ h, h.symm ▸ sign_zero⟩,
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { rw [sign_of_neg hn, neg_eq_zero] at h, exact (one_ne_zero h).elim },
  { refl },
  { rw sign_of_pos hp at h, exact (one_ne_zero h).elim },
end

lemma sign_int_cast (z : ℤ) : sign (z : ℝ) = ↑(int.sign z) :=
begin
  obtain hn | rfl | hp := lt_trichotomy z (0 : ℤ),
  { rw [sign_of_neg (int.cast_lt_zero.mpr hn), int.sign_eq_neg_one_of_neg hn, int.cast_neg,
      int.cast_one], },
  { rw [int.cast_zero, sign_zero, int.sign_zero, int.cast_zero], },
  { rw [sign_of_pos (int.cast_pos.mpr hp), int.sign_eq_one_of_pos hp, int.cast_one] }
end

lemma sign_neg {r : ℝ} : sign (-r) = - sign r :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { rw [sign_of_neg hn, sign_of_pos (neg_pos.mpr hn), neg_neg] },
  { rw [sign_zero, neg_zero, sign_zero] },
  { rw [sign_of_pos hp, sign_of_neg (neg_lt_zero.mpr hp)] },
end

lemma sign_mul_nonneg (r : ℝ) : 0 ≤ sign r * r :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { rw sign_of_neg hn,
    exact mul_nonneg_of_nonpos_of_nonpos (by norm_num) hn.le },
  { rw mul_zero, },
  { rw [sign_of_pos hp, one_mul],
    exact hp.le }
end

lemma sign_mul_pos_of_ne_zero (r : ℝ) (hr : r ≠ 0) : 0 < sign r * r :=
begin
  refine lt_of_le_of_ne (sign_mul_nonneg r) (λ h, hr _),
  have hs0 := (zero_eq_mul.mp h).resolve_right hr,
  exact sign_eq_zero_iff.mp hs0,
end

@[simp]
lemma inv_sign (r : ℝ) : (sign r)⁻¹ = sign r :=
begin
  obtain (hn | hz | hp) := sign_apply_eq r,
  { rw hn, norm_num },
  { rw hz, exact inv_zero },
  { rw hp, exact inv_one }
end

@[simp]

end real


-- Suma_de_los_primeros_cuadrados.lean
-- Suma de los primeros cuadrados
-- José A. Alonso Jiménez
-- Sevilla, 21 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que la suma de los primeros cuadrados
--    0² + 1² + 2² + 3² + ··· + n²
-- es n(n+1)(2n+1)/6
-- ---------------------------------------------------------------------

import data.nat.basic
import tactic
open nat

variable (n : ℕ)

set_option pp.structure_projections false

@[simp]
def sumaCuadrados : ℕ → ℕ
| 0     := 0
| (n+1) := sumaCuadrados n + (n+1)^2

-- 1ª demostración
example :
  6 * sumaCuadrados n = n* (n + 1) * (2 * n + 1) :=
begin
  induction n with n HI,
  { simp, },
  { calc 6 * sumaCuadrados (succ n)
         = 6 * (sumaCuadrados n + (n+1)^2)
           : by simp
     ... = 6 * sumaCuadrados n + 6 * (n+1)^2
           : by ring_nf
     ... = n * (n + 1) * (2 * n + 1) + 6 * (n+1)^2
           : by {congr; rw HI}
     ... = (n + 1) * (n * (2 * n + 1) + 6 * (n+1))
           : by ring_nf
     ... = (n + 1) * (2 * n^2 + 7 * n + 6)
           : by ring_nf
     ... = (n + 1) * (n + 2) * (2 * n + 3)
           : by ring_nf
     ... = succ n * (succ n + 1) * (2 * succ n + 1)
           : by refl, },
end

-- 2ª demostración
example :
  6 * sumaCuadrados n = n* (n + 1) * (2 * n + 1) :=
begin
  induction n with n HI,
  { simp, },
  { calc 6 * sumaCuadrados (succ n)
         = 6 * (sumaCuadrados n + (n+1)^2)
           : by simp
     ... = 6 * sumaCuadrados n + 6 * (n+1)^2
           : by ring_nf
     ... = n * (n + 1) * (2 * n + 1) + 6 * (n+1)^2
           : by {congr; rw HI}
     ... = (n + 1) * (n + 2) * (2 * n + 3)
           : by ring_nf
     ... = succ n * (succ n + 1) * (2 * succ n + 1)
           : by refl, },
end

-- Referencia:
-- ¿Qué es la Matemática? https://bit.ly/3lrPKAp de R. Courant y
-- H. Robbins p. 21


import algebra.field analysis.real tactic.norm_num tactic.ring
universe u
noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable

theorem real_lt_swap : ∀ a b : ℝ, a > b ↔ b < a := λ a b, ⟨λ h,h,λ h,h⟩
theorem real_le_swap : ∀ a b : ℝ, a ≥ b ↔ b ≤ a := λ a b, ⟨λ h,h,λ h,h⟩
lemma q_1a (x y : ℝ) : abs (x + y) ≤ abs x + abs y := abs_add_le_abs_add_abs x y
lemma q_1b (x y : ℝ) : abs (x + y) ≥ abs x - abs y := by {have := abs_sub_abs_le_abs_sub x (-y), simp at *, assumption}
lemma q_1c (x y : ℝ) : abs (x + y) ≥ abs y - abs x := by rw add_comm;exact q_1b y x
lemma q_1d (x y : ℝ) : abs (x - y) ≥ abs (abs x - abs y) := abs_abs_sub_abs_le_abs_sub x y
lemma q_1e (x y : ℝ) : abs x ≤ abs y + abs (x - y) := by rw[add_comm, ←sub_right_le_iff_le_add];exact abs_sub_abs_le_abs_sub _ _
lemma q_1f (x y : ℝ) : abs x ≥ abs y - abs (x - y) := by rw[real_le_swap,sub_right_le_iff_le_add,abs_sub];exact q_1e y x
lemma q_1g (x y z : ℝ) : abs (x - y) ≤ abs (x - z) + abs (y - z) := have h : x - y = (x - z) + (z - y) := by ring, by rw [h,abs_sub y];exact q_1a _ _

lemma q_3 (S : set ℝ) (u : ℝ) : S ≠ ∅ → u ∈ upper_bounds S → (is_lub S u ↔ (∀ ε, ε > 0 → ∃ s : ℝ, s > u - ε ∧ s ∈ S)) := begin
  assume hS hu,split,
  assume hSu ε hε,
  simp [is_lub,is_least,upper_bounds,lower_bounds] at hSu,
  apply by_contradiction,rw not_exists,assume h,
  have : ∀ s : ℝ, s ∈ S → s ≤ u - ε,
    assume s hs, have := h s,rw not_and' at this,
    have := this hs, exact le_of_not_gt this,
  have := hSu.right (u - ε) this,
  have h := (@sub_lt_sub_iff_left _ _ u ε 0).mpr hε,rw sub_zero at h,
  exact not_le_of_gt h this,
  assume h,simp[is_lub,is_least,upper_bounds,lower_bounds],simp [upper_bounds] at hu,
  split,exact hu,assume x hx,cases set.exists_mem_of_ne_empty hS with s hs,
  refine by_contradiction _,
  assume hux,have hux₁ := lt_of_not_ge hux,
  cases h (u-x) (sub_pos.mpr hux₁) with y hy,
  have : u - (u - x) = x,ring,rw this at hy,
  exact not_lt_of_ge (hx y hy.right) hy.left,
end

lemma half_gt_zero : ((1 : ℝ) / (2 : ℝ)) > 0 := by norm_num
def is_convergent {α : Type u} [has_lt α] : (α → ℝ) → Prop := λ f, ∃ l : ℝ, ∀ ε : ℝ, ε > 0 → ∃ N : α, ∀ n : α, n > N → abs (f n) ≤ ε

lemma irrational : {r : ℝ // ∀ q : ℚ, ↑q ≠ r} := sorry

lemma q_2a : ¬∀ S : set ℝ, S ≠ ∅ → upper_bounds S ≠ ∅ → (∀ s∈S, ∃ q : ℚ, s = ↑q) → ∃ (sup : ℝ) (q : ℚ), is_lub S sup ∧ sup = ↑q := begin
 rw not_forall,
 existsi {x : ℝ | (∃ q : ℚ, x = ↑q) ∧ x < ↑irrational},
 assume h,
 have h₁ : {x : ℝ | (∃ q : ℚ, x = ↑q) ∧ x < ↑irrational} ≠ ∅,
  cases exists_rat_lt ↑irrational,
  have : ↑w ∈ {x : ℝ | (∃ q : ℚ, x = ↑q) ∧ x < ↑irrational},
   simp[h_1],existsi ((↑w):ℚ),simp,
  refine set.ne_empty_of_mem this,
 have h₂ : upper_bounds {x : ℝ |  (∃ q : ℚ, x = ↑q) ∧ x < ↑irrational} ≠ ∅,
  have : ↑irrational ∈ upper_bounds {x : ℝ | (∃ q : ℚ, x = ↑q) ∧ x < ↑irrational},
   simp[upper_bounds],assume a r h h₁, exact le_of_lt h₁,
  exact set.ne_empty_of_mem this,
 have h₃ : (∀ (s : ℝ), s ∈ {x : ℝ | (∃ q : ℚ, x = ↑q) ∧ x < ↑irrational} → (∃ (q : ℚ), s = ↑q)),
  simp,assume s q hsq hs,
  exact exists.intro q hsq,
 cases h h₁ h₂ h₃ with sup hsup,clear h₁ h₂ h₃ h,
 cases hsup with q hsup,
 simp [is_lub,upper_bounds,lower_bounds,is_least] at hsup,
 cases lt_trichotomy sup ↑irrational,
 cases exists_rat_btwn h with q' hq',
 exact not_lt_of_ge (hsup.left.left q' q' (by simp) hq'.right) hq'.left,
 cases h,rw hsup.right at h,cases irrational,simp at *,have := property q,trivial,
 cases exists_rat_btwn h with q' hq',
 have : (∀ (a_1 : ℝ) (x : ℚ), a_1 = ↑x → a_1 < ↑irrational → a_1 ≤ q'),
  assume x y h h₁, exact le_of_lt (lt_trans h₁ hq'.left),
 exact not_lt_of_ge (hsup.left.right q' this) hq'.right,
end
lemma q_6 : ∀ ε : ℝ, ε > 0 → ∃ N : ℕ, ∀ n : ℕ, n > N → abs ((1 : ℝ) - n / (n + 2)) ≤ ε := begin
 assume ε hε,
 cases exists_lt_nat (2/ε) with N hN,
 existsi N,assume n hn,
 have h2n : (2 : ℝ) + n > 0,
  rw [(by norm_num : (2:ℝ) = ↑(2:ℕ)),←nat.cast_add,←nat.cast_zero],
  rw [real_lt_swap,nat.cast_lt,add_comm],exact dec_trivial,
 have h : (0:ℝ) ≤ 1 - (↑n / (↑n + 2)),
  suffices h : (↑n : ℝ) / (↑n + 2) + 0 ≤ 1,
   exact le_sub_left_iff_add_le.mpr h,
  simp,refine div_le_of_le_mul _ _,
  norm_num,exact h2n,
 simp at h,
 rw abs_of_nonneg h,
 suffices : ((1 : ℝ) + -(↑n / (2 + ↑n))) * (2 + ↑n) ≤ ε * (2 + ↑n),
  have : (((1:ℝ) + -(↑n / (2 + ↑n))) * (2 + ↑n)) / (2 + n) ≤ (ε * (2 + n)) / (2 + n),
   exact div_le_div_of_le_of_pos this h2n,
  rwa [mul_div_cancel _ (ne_of_lt h2n).symm,mul_div_cancel _ (ne_of_lt h2n).symm] at this,
 simp[add_mul],rw div_mul_cancel _ (ne_of_lt h2n).symm,simp,
 rw [←mul_lt_mul_left hε,mul_comm,div_mul_cancel _ (ne_of_lt hε).symm] at hN,
 rw mul_add,
 suffices : ε * ↑N < ε * 2 + ε * ↑n,
  exact le_of_lt (lt_trans hN this),
 suffices : ε * ↑N < ε * ↑n,rw add_comm,
  refine lt_add_of_lt_of_nonneg this _,
  exact mul_nonneg (le_of_lt hε) (by norm_num),
 have : (↑n:ℝ) > N,rwa [real_lt_swap,nat.cast_lt],
 exact (mul_lt_mul_left hε).mpr this,
end
example : ¬∃ z : ℤ, (1:ℚ)/2 = z := begin
 rw not_exists,assume x h,have: (1:ℚ) = 2 * ↑x,rw ←h,norm_num,
 have h: (2:ℚ) = (2:ℤ),norm_num,
 rw [h,←int.cast_one,←int.cast_mul,int.cast_inj] at this,
 have h₁:= dvd_mul_right 2 x,rw ←this at h₁,exact absurd h₁ dec_trivial,
end


import MyNat.Definition
namespace MyNat
open MyNat
/-!
# Proposition world.

## Level 5 : `P → (Q → P)`.

In this level, our goal is to construct an implication, like in level 2.

```
⊢ P → (Q → P)
```

So `P` and `Q` are propositions, and our goal is to prove
that `P ⟹(Q ⟹ P)`.
We don't know whether `P`, `Q` are true or false, so initially
this seems like a bit of a tall order. But let's give it a go.

Our goal is `P → X` for some true/false statement `X`, and if our
goal is to construct an implication then we almost always want to use the
`intro` tactic from level 2, Lean's version of "assume `P`", or more precisely
"assume `p` is a proof of `P`". So let's start with

`intro p`

and we then find ourselves in this tactic state:

```
P Q : Prop,
p : P
⊢ Q → P
```

We now have a proof `p` of `P` and we are supposed to be constructing
a proof of `Q ⟹ P`. So let's assume that `Q` is true and try
and prove that `P` is true. We assume `Q` like this:

`intro q`

and now we have to prove `P`, but have a proof handy:

`exact p`

## Lemma
For any propositions `P` and `Q`, we always have
`P ⟹(Q ⟹ P)`.
-/
example (P Q : Prop) : P → (Q → P) := by
  intro p
  intro q
  exact p

/-!
A mathematician would treat the proposition `P ⟹(Q ⟹ P)`
as the same as the proposition `P ∧ Q ⟹ P`,
because to give a proof of either of these is just to give a method which takes
a proof of `P` and a proof of `Q`, and returns a proof of `P`. Thinking of the
goal as `P ∧ Q ⟹ P` we see why it is provable.

## Did you notice?

I wrote `P → (Q → P)` but Lean just writes `P → Q → P`. This is because
computer scientists adopt the convention that `→` is *right associative*,
which is a fancy way of saying "when we write `P → Q → R`, we mean `P → (Q → R)`.
Mathematicians would never dream of writing something as ambiguous as
`P ⟹ Q ⟹ R` (they are not really interested in proving abstract
propositions, they would rather work with concrete ones such as Fermat's Last Theorem),
so they do not have a convention for where the brackets go. It's important to
remember Lean's convention though, or else you will get confused. If your goal
is `P → Q → R` then you need to know whether `intro h` will create `h : P` or `h : P → Q`.
Make sure you understand which one.
-/
/-!
Next up [Level 6](./Level6.lean.md)
-/


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.associated
import algebra.big_operators.basic
/-!
# Prime elements in rings
This file contains lemmas about prime elements of commutative rings.
-/

variables {R : Type*} [comm_cancel_monoid_with_zero R]
open finset

open_locale big_operators

/-- If `x * y = a * ∏ i in s, p i` where `p i` is always prime, then
  `x` and `y` can both be written as a divisor of `a` multiplied by
  a product over a subset of `s`  -/
lemma mul_eq_mul_prime_prod {α : Type*} [decidable_eq α] {x y a : R} {s : finset α}
  {p : α → R} (hp : ∀ i ∈ s, prime (p i)) (hx : x * y = a * ∏ i in s, p i) :
  ∃ (t u : finset α) (b c : R),
      t ∪ u = s
    ∧ disjoint t u
    ∧ a = b * c
    ∧ x = b * ∏ i in t, p i
    ∧ y = c * ∏ i in u, p i :=
begin
  induction s using finset.induction with i s his ih generalizing x y a,
  { exact ⟨∅, ∅, x, y, by simp [hx]⟩ },
  { rw [prod_insert his, ← mul_assoc] at hx,
    have hpi : prime (p i), { exact hp i (mem_insert_self _ _) },
    rcases ih (λ i hi, hp i (mem_insert_of_mem hi)) hx with
      ⟨t, u, b, c, htus, htu, hbc, rfl, rfl⟩,
    have hit : i ∉ t, from λ hit, his (htus ▸ mem_union_left _ hit),
    have hiu : i ∉ u, from λ hiu, his (htus ▸ mem_union_right _ hiu),
    obtain ⟨d, rfl⟩ | ⟨d, rfl⟩ : p i ∣ b ∨ p i ∣ c,
      from hpi.div_or_div ⟨a, by rw [← hbc, mul_comm]⟩,
    { rw [mul_assoc, mul_comm a, mul_right_inj' hpi.ne_zero] at hbc,
      exact ⟨insert i t, u, d, c, by rw [insert_union, htus],
        disjoint_insert_left.2 ⟨hiu, htu⟩,
          by simp [hbc, prod_insert hit, mul_assoc, mul_comm, mul_left_comm]⟩ },
    { rw [← mul_assoc, mul_right_comm b, mul_left_inj' hpi.ne_zero] at hbc,
      exact ⟨t, insert i u, b, d, by rw [union_insert, htus],
        disjoint_insert_right.2 ⟨hit, htu⟩,
          by simp [← hbc, prod_insert hiu, mul_assoc, mul_comm, mul_left_comm]⟩ } }
end

/-- If ` x * y = a * p ^ n` where `p` is prime, then `x` and `y` can both be written
  as the product of a power of `p` and a divisor of `a`. -/
lemma mul_eq_mul_prime_pow {x y a p : R} {n : ℕ} (hp : prime p) (hx : x * y = a * p ^ n) :
  ∃ (i j : ℕ) (b c : R),
    i + j = n
  ∧ a = b * c
  ∧ x = b * p ^ i
  ∧ y = c * p ^ j :=
begin
  rcases mul_eq_mul_prime_prod (λ _ _, hp)
    (show x * y = a * (range n).prod (λ _, p), by simpa) with
    ⟨t, u, b, c, htus, htu, rfl, rfl, rfl⟩,
  exact ⟨t.card, u.card, b, c, by rw [← card_disjoint_union htu, htus, card_range], by simp⟩,
end


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro p,
  intro np,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro p,
  by_contra,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
split,
  -- ¬¬P → P --
  intro p,
  by_contra,
  contradiction,
  -- P → ¬¬P --
  intro p,
  intro np,
  contradiction,
end

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

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

end

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

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

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

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro hp,
  intro p,
  cases hp with hp p,
  contradiction,
  assumption,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro hp,
  intro q,
  intro p,
  have z := hp p,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro hp,
  intro p,
  by_cases q: Q,
  assumption,
  have z:= hp q,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  -- (P → Q) → (¬Q → ¬P) --
  intro hp,
  intro q,
  intro p,
  have z := hp p,
  contradiction,
  -- (¬Q → ¬P) → (P → Q) --
  intro hp,
  intro p,
  by_cases q: Q,
  assumption,
  have z:= hp q,
  contradiction,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro p,
    have a : P∨¬P,
    right,
    intro hp,
      have b: P∨¬P,
      left,
      assumption,
    contradiction,
  contradiction,
end

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

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

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro a,
  intro b,
  cases b with bp bq,
  cases a with bp bq,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro a,
  intro b,
  cases a with q p,
  cases b with nq np,
  contradiction,
  contradiction,
end

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

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro a,
  split,
    intro p,
    apply a,
    left,
    assumption,

    intro q,
    apply a,
    right,
    assumption,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro a,
  intro b,
  cases a with np nq,
  cases b,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro a,
  by_cases b: P,
  left,
  intro q,
  have c: P∧Q,
  split,
    assumption,
    assumption,
    contradiction,
    right,
    assumption,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro a,
  intro b,
  cases b with pp qq,
  cases a with nq np,
  contradiction,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  -- ¬(P∧Q) → (¬Q ∨ ¬P) --
intro a,
  by_cases b: P,
  left,
  intro q,
  have c: P∧Q,
  split,
    assumption,
    assumption,
    contradiction,
    right,
    assumption,
  -- (¬P ∨ ¬Q) → ¬(P∧Q) --
    intro a,
    intro b,
    cases b with pp qq,
    cases a with nq np,
    contradiction,
    contradiction,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  --   ¬(P∧Q) → (¬Q ∨ ¬P)   --
    intro a,
    split,
    intro p,
    apply a,
    left,
    assumption,

    intro q,
    apply a,
    right,
    assumption,
  -- (¬P ∧ ¬Q) → ¬(P∨Q)  --
    intro a,
    intro b,
    cases a with np nq,
    cases b,
    contradiction,
    contradiction,
end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro a,
  cases a with p q,
  cases q with pp qq,
  left,
  split,
  assumption,
  assumption,
  right,
  split,
  assumption,
  assumption,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro a,
  split,
    cases a with pq pr,
    cases pq with p q,
      assumption,
    cases pr with p r,
      assumption,
    cases a,
      cases a with p q,
      left,
      assumption,
      cases a with p r,
      right,
      assumption,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro a,
  split,
  cases a,
  left,
  assumption,
  cases a with q r,
  right,
  assumption,
  cases a,
  left,
  assumption,
  cases a with q r,
  right,
  assumption,
end

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

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro a,
  intro p,
  intro q,
  apply a,
  split,
  assumption,
  assumption,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro a,
  intro b,
  cases b,
  apply a,
  assumption,
  assumption,
end

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

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

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

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro a,
  left,
  assumption,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro a,
  right,
  assumption,
end

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

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

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

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro a,
  cases a,
  assumption,
  assumption,
  intro b,
  right,
  assumption,
end

end propositional

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

section predicate

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

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

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro a,
  intro b,
  intro pb,
  apply a,
  existsi b,
  assumption,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro a,
  intro b,
  cases b with c d,
  apply a c,
  assumption,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro a,
  by_contra b,
  apply a,
  intro c,
  by_contra d,
  apply b,
  existsi c,
  assumption,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro a,
  cases a with b c,
  intro d,
  have := d b,
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
split,
  --  ¬(∀x, P x) → (∃x, ¬P x)  --
  intro a,
  by_contra b,
  apply a,
  intro c,
  by_contra d,
  apply b,
  existsi c,
  assumption,
  -- (∃x, ¬P x) → ¬(∀x, P x)  --
  intro a,
  cases a with b c,
  intro d,
  have := d b,
  contradiction,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  -- ¬(∃x, P x) → (∀x, ¬P x) --
  intro a,
  intro b,
  intro pb,
  apply a,
  existsi b,
  assumption,
  -- (∀x, ¬P x) → ¬(∃x, P x) --
  intro a,
  intro b,
  cases b with c d,
  apply a c,
  assumption,
end

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro a,
  cases a with b c,
  intro d,
  have x := d b,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro a,
  intro b,
  cases b with c d,
  have x := a c,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro a,
  intro b,
  by_contra c,
  apply a,
  existsi b,
  assumption,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro a,
  by_contra b,
  apply a,
  intro c,
  intro d,
  apply b,
  existsi c,
  assumption,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  --  (∀x, P x) → ¬(∃x, ¬P x) --
  intro a,
  intro b,
  cases b with c d,
  have x := a c,
  contradiction,
  -- ¬(∃x, ¬P x) → (∀x, P x) --
  intro a,
  intro b,
  by_contra c,
  apply a,
  existsi b,
  assumption,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  -- (∃x, P x) → ¬(∀x, ¬P x) --
  intro a,
  cases a with b c,
  intro d,
  have x := d b,
  contradiction,
  -- ¬(∀x, ¬P x) → (∃x, P x) --
  intro a,
  by_contra b,
  apply a,
  intro c,
  intro d,
  apply b,
  existsi c,
  assumption,
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 a,
  cases a with b c,
  cases c with d e,
  split,
  existsi b,
  assumption,
  existsi b,
  assumption,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro a,
  cases a with b c,
  cases c with d e,
  left,
  existsi b,
  assumption,
  right,
  existsi b,
  assumption,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro a,
  cases a with b c,
  cases b with d e,
  existsi d,
  left,
  assumption,
  cases c with x y,
  existsi x,
  right,
  assumption,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro a,
  split,
  intro b,
  have x:= a b,
  cases x,
  assumption,
  intro c,
  have y:= a c,
  cases y,
  assumption,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro a,
  cases a with a b,
  intro c,
  split,
  have x:= a c,
  assumption,
  have y:= b c,
  assumption,

end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro a,
  intro c,
  cases a with a b,
  have x:= a c,
  left,
  assumption,
  have y:= b c,
  right,
  assumption,

end

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

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

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

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

end predicate


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

import tactic

/-

# Complete lattices

A lattice has sups and infs for all subsets with 2 elements. A *complete lattice* has sups
and infs for *every* subset. An example would be the set of all subsets of a fixed base set
(or, in Lean speak, the type `set X` of all subsets of a type `X`). Other examples: all
subgroups of a group, all subspaces of a vector space (and all subrings of a ring, all
subfields of a field...). A non-example would be the real numbers: we do say that the
reals are "complete" but we're talking about a different kind of completeness here
(an order-theoretic concept, not a metric space concept), and indeed subsets of ℝ like
the natural numbers, or the empty set, do *not* have a sup.

If `L` is a complete lattice, and `S : set L` is a subset, then its sup is `Sup S`
and its inf is `Inf S`. Here's the basic API for `Sup`:

`le_Sup : a ∈ S → a ≤ Sup S`
`Sup_le : (∀ (b : L), b ∈ S → b ≤ a) → Sup S ≤ a`

and you can probably guess the basic API for `Inf` :-)

A special case: the empty set has a `Sup` and and an `Inf`, and if you think carefully
about this then you'll discover that this means that the lattice has a least element and a
greatest element. These elements are called `⊥` and `⊤` respectively, pronounced `bot`
and `top`.

`Sup_empty : Sup ∅ = ⊥`

See if you can prove basic things about `⊥` and `Sup` just using the API for `Sup`.
All these results are in the library, but it's a good exercise to prove them from
the axioms directly.

-/

-- Let `L` be a complete lattice and say `a` is a general element of `L`
variables (L : Type) [complete_lattice L] (a : L)

-- this is called `bot_le`
example : ⊥ ≤ a :=
begin
  rw ← Sup_empty,
  apply Sup_le,
  rintro b ⟨⟩, -- recall `b ∈ ∅` is defined to mean `false`, and `cases` on a proof of `false`
end            -- solves the goal

-- this is called `le_bot_iff`
example : a ≤ ⊥ ↔ a = ⊥ :=
begin
  split,
  { rw ← Sup_empty,
    intro h,
    -- to prove x = y suffices to prove x ≤ y and y ≤ x, and we alreasdy have x ≤ y (it's `h`)
    apply le_antisymm h,
    apply Sup_le,
    rintro _ ⟨⟩, },
  { rintro rfl, -- quicker than `intro h, rw h`
    refl, }, -- `≤` is reflexive
end

-- this is called Sup_le_Sup
example (S T : set L) : S ⊆ T → Sup S ≤ Sup T :=
begin
  intro hST,
  apply Sup_le,
  intros b hb,
  apply le_Sup,
  apply hST, -- definitional abuse: S ⊆ T is *defined* to mean `∀ a, a ∈ S → a ∈ T`
  exact hb,
end


import tactic.basic
import .ch07_indprop

open nat (
  le less_than_or_equal.refl less_than_or_equal.step lt
)

open indprop (next_nat total_relation total_relation.intro)
open indprop.next_nat

variables {α : Type}
variables {n m o p: ℕ}

namespace rel

/-
Definition relation (X: Type) := X → X → Prop.
-/

def relation (α : Type) := α → α → Prop

/-
Print le.
(* ====> Inductive le (n : nat) : nat -> Prop :=
             le_n : n <= n
           | le_S : forall m : nat, n <= m -> n <= S m *)

Check le : nat → nat → Prop.
Check le : relation nat.
-/

#print le

#check (le : ℕ → ℕ → Prop)
#check (le : relation ℕ)

/-
Definition partial_function {X: Type} (R: relation X) :=
  ∀x y1 y2 : X, R x y1 → R x y2 → y1 = y2.
-/

def partial_function (R : relation α) :=
  ∀{x y₁ y₂} (h₁ : R x y₁) (h₂ : R x y₂), y₁ = y₂

/-
Print next_nat.
(* ====> Inductive next_nat (n : nat) : nat -> Prop :=
           nn : next_nat n (S n) *)

Check next_nat : relation nat.

Theorem next_nat_partial_function :
   partial_function next_nat.
Proof.
  unfold partial_function.
  intros x y1 y2 H1 H2.
  inversion H1. inversion H2.
  reflexivity. Qed.
-/

#print next_nat

#check (next_nat : relation ℕ)

theorem next_nat_partial_function : partial_function next_nat :=
begin
  unfold partial_function,
  intros,
  cases h₁,
  cases h₂,
  refl,
end

/-
Theorem le_not_a_partial_function :
  ¬(partial_function le).
Proof.
  unfold not. unfold partial_function. intros Hc.
  assert (0 = 1) as Nonsense. {
    apply Hc with (x := 0).
    - apply le_n.
    - apply le_S. apply le_n. }
  discriminate Nonsense. Qed.
-/

theorem le_not_a_partial_function : ¬partial_function le :=
begin
  unfold partial_function,
  by_contradiction c,
  have nonsense : 0 = 1,
    apply @c 0 0 1,
      apply less_than_or_equal.refl,
    apply less_than_or_equal.step,
    apply less_than_or_equal.refl,
  cases nonsense,
end

theorem total_relation_not_partial : ¬partial_function total_relation :=
begin
  unfold partial_function,
  by_contradiction c,
  cases c (total_relation.intro 0 0) (total_relation.intro 0 1),
end

theorem empty_relation_partial : partial_function (@empty_relation α) :=
begin
  unfold partial_function,
  intros,
  cases h₁,
end

/-
Definition reflexive {X: Type} (R: relation X) :=
  ∀a : X, R a a.

Theorem le_reflexive :
  reflexive le.
Proof.
  unfold reflexive. intros n. apply le_n. Qed.
-/

def reflexive (R : relation α) := ∀a, R a a

theorem le_refl : reflexive le :=
begin
  unfold reflexive,
  intro n,
  apply less_than_or_equal.refl,
end

/-
Definition transitive {X: Type} (R: relation X) :=
  ∀a b c : X, (R a b) → (R b c) → (R a c).

Theorem le_trans :
  transitive le.
Proof.
  intros n m o Hnm Hmo.
  induction Hmo.
  - (* le_n *) apply Hnm.
  - (* le_S *) apply le_S. apply IHHmo. Qed.

Theorem lt_trans:
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  apply le_S in Hnm.
  apply le_trans with (a := (S n)) (b := (S m)) (c := o).
  apply Hnm.
  apply Hmo. Qed.
-/

#check transitive

def transitive (R : relation α) :=
  ∀{a b c : α} (hab : R a b) (hbc : R b c), R a c

theorem le_trans: transitive le :=
begin
  unfold transitive,
  intros,
  induction hbc with b' h ih,
    exact hab,
  apply less_than_or_equal.step,
  exact ih,
end

theorem lt_trans : transitive lt :=
begin
  unfold transitive,
  intros,
  exact le_trans (less_than_or_equal.step hab) hbc,
end

/-
Theorem lt_trans' :
  transitive lt.
Proof.
  (* Prove this by induction on evidence that m is less than o. *)
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction Hmo as [| m' Hm'o].
    (* FILL IN HERE *) Admitted.
-/

theorem lt_trans' : transitive lt :=
begin
  unfold transitive,
  intros,
  induction hbc with b' h ih,
    exact less_than_or_equal.step hab,
  exact less_than_or_equal.step ih,
end

/-
Theorem lt_trans'' :
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction o as [| o'].
  (* FILL IN HERE *) Admitted.
-/

theorem lt_trans'' : transitive lt :=
begin
  unfold transitive,
  intros,
  induction c with c ih,
    cases hbc,
  cases hbc with _ h,
    exact less_than_or_equal.step hab,
  exact less_than_or_equal.step (ih h),
end

/-
Theorem le_Sn_le : ∀n m, S n ≤ m → n ≤ m.
Proof.
  intros n m H. apply le_trans with (S n).
  - apply le_S. apply le_n.
  - apply H.
Qed.
-/

theorem nat.le_of_succ_le (h : n + 1 ≤ m) : n ≤ m :=
begin
  apply le_trans,
    apply less_than_or_equal.step,
    apply less_than_or_equal.refl,
  exact h,
end

/-
Theorem le_S_n : ∀n m,
  (S n ≤ S m) → (n ≤ m).
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem nat.le_of_succ_le_succ (h : n + 1 ≤ m + 1) : n ≤ m :=
begin
  cases h with _ h,
    exact less_than_or_equal.refl,
  exact nat.le_of_succ_le h,
end

/-
Theorem le_Sn_n : ∀n,
  ¬(S n ≤ n).
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem nat.not_succ_le_self (n) : ¬(n + 1 ≤ n) :=
begin
  by_contra c,
  induction n with n ih,
    cases c,
  exact ih (nat.le_of_succ_le_succ c),
end

/-
Definition symmetric {X: Type} (R: relation X) :=
  ∀a b : X, (R a b) → (R b a).
-/

def symmetric (R : relation α) := ∀{a b : α} (h : R a b), R b a

/-
Theorem le_not_symmetric :
  ¬(symmetric le).
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem le_not_symmetric : ¬symmetric le :=
begin
  unfold symmetric,
  by_contra c,
  cases c (less_than_or_equal.step (@less_than_or_equal.refl 0)),
end

/-
Definition antisymmetric {X: Type} (R: relation X) :=
  ∀a b : X, (R a b) → (R b a) → a = b.
-/

def anti_symmetric (R : relation α) := ∀{a b} (hab : R a b) (hba : R b a), a = b

/-
Theorem le_antisymmetric :
  antisymmetric le.
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem le_antisymm : anti_symmetric le :=
begin
  unfold anti_symmetric,
  intros,
  induction a with a ih generalizing b,
    cases hba,
    refl,
  cases b,
    cases hab,
  apply congr_arg,
  apply ih,
    exact nat.le_of_succ_le_succ hab,
  exact nat.le_of_succ_le_succ hba,
end

/-
Theorem le_step : ∀n m p,
  n < m →
  m ≤ S p →
  n ≤ p.
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem le_step (hn : n < m) (hm : m ≤ p + 1) : n ≤ p :=
  nat.le_of_succ_le_succ $ le_trans hn hm

/-
Definition equivalence {X:Type} (R: relation X) :=
  (reflexive R) ∧ (symmetric R) ∧ (transitive R).
-/

def equivalence (R : relation α) := reflexive R ∧ symmetric R ∧ transitive R

/-
Definition order {X:Type} (R: relation X) :=
  (reflexive R) ∧ (antisymmetric R) ∧ (transitive R).
-/

def partial_order (R : relation α) :=
  reflexive R ∧ anti_symmetric R ∧ transitive R

/-
Definition preorder {X:Type} (R: relation X) :=
  (reflexive R) ∧ (transitive R).

Theorem le_order :
  order le.
Proof.
  unfold order. split.
    - (* refl *) apply le_reflexive.
    - split.
      + (* antisym *) apply le_antisymmetric.
      + (* transitive. *) apply le_trans. Qed.
-/

def preorder (R : relation α) := reflexive R ∧ transitive R

theorem le_order : partial_order le :=
begin
  unfold partial_order,
  split,
    apply le_refl,
  split,
    apply le_antisymm,
  apply le_trans,
end

/-
Inductive clos_refl_trans {A: Type} (R: relation A) : relation A :=
    | rt_step x y (H : R x y) : clos_refl_trans R x y
    | rt_refl x : clos_refl_trans R x x
    | rt_trans x y z
          (Hxy : clos_refl_trans R x y)
          (Hyz : clos_refl_trans R y z) :
          clos_refl_trans R x z.
-/

inductive clos_refl_trans (R : relation α) : relation α
| rt_step {x y} (h : R x y) : clos_refl_trans x y
| rt_refl (x) : clos_refl_trans x x
| rt_trans {x y z}
  (hxy : clos_refl_trans x y)
  (hyz : clos_refl_trans y z) : clos_refl_trans x z

open clos_refl_trans

/-
Theorem next_nat_closure_is_le : ∀n m,
  (n ≤ m) ↔ ((clos_refl_trans next_nat) n m).
Proof.
  intros n m. split.
  - (* -> *)
    intro H. induction H.
    + (* le_n *) apply rt_refl.
    + (* le_S *)
      apply rt_trans with m. apply IHle. apply rt_step.
      apply nn.
  - (* <- *)
    intro H. induction H.
    + (* rt_step *) inversion H. apply le_S. apply le_n.
    + (* rt_refl *) apply le_n.
    + (* rt_trans *)
      apply le_trans with y.
      apply IHclos_refl_trans1.
      apply IHclos_refl_trans2. Qed.
-/

theorem next_nat_closure_is_le : n ≤ m ↔ (clos_refl_trans next_nat) n m :=
begin
  split,
    intro h,
    induction h with m h ih,
      apply rt_refl,
    apply rt_trans,
    apply ih,
      apply rt_step,
    apply nn,
  intro h,
  induction h,
    case rt_step : x y h {
      cases h,
      apply less_than_or_equal.step,
      exact less_than_or_equal.refl,
    },
  case rt_refl : x { exact less_than_or_equal.refl, },
  case rt_trans : x y z hxy hyz ihx ihy { exact le_trans ihx ihy, },
end

/-
Inductive clos_refl_trans_1n {A : Type}
                             (R : relation A) (x : A)
                             : A → Prop :=
  | rt1n_refl : clos_refl_trans_1n R x x
  | rt1n_trans (y z : A)
      (Hxy : R x y) (Hrest : clos_refl_trans_1n R y z) :
      clos_refl_trans_1n R x z.
-/

inductive clos_refl_trans_1n (R : relation α) : α → α → Prop
| rt1n_refl (x) : clos_refl_trans_1n x x
| rt1n_trans {x y z} (hxy : R x y) (hyz : clos_refl_trans_1n y z)
  : clos_refl_trans_1n x z

open clos_refl_trans_1n

/-
Lemma rsc_R : ∀(X:Type) (R:relation X) (x y : X),
       R x y → clos_refl_trans_1n R x y.
Proof.
  intros X R x y H.
  apply rt1n_trans with y. apply H. apply rt1n_refl. Qed.
-/

lemma rsc_R {R : relation α} {x y} (h : R x y) : clos_refl_trans_1n R x y
  := rt1n_trans h (rt1n_refl y)

/-
Lemma rsc_trans :
  ∀(X:Type) (R: relation X) (x y z : X),
      clos_refl_trans_1n R x y →
      clos_refl_trans_1n R y z →
      clos_refl_trans_1n R x z.
Proof.
  (* FILL IN HERE *) Admitted.
-/

lemma rsc_trans {R : relation α} {x y z}
  (hxy : clos_refl_trans_1n R x y) (hyz : clos_refl_trans_1n R y z)
  : clos_refl_trans_1n R x z :=
begin
  induction hxy,
  case rt1n_refl { exact hyz, },
  case rt1n_trans : x' y' z' hxy' hyz' ih { exact rt1n_trans hxy' (ih hyz), },
end

/-
Theorem rtc_rsc_coincide :
         ∀(X:Type) (R: relation X) (x y : X),
  clos_refl_trans R x y ↔ clos_refl_trans_1n R x y.
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem rtc_rsc_coincide {R : relation α} {x y}
  : clos_refl_trans R x y ↔ clos_refl_trans_1n R x y :=
begin
  split,
    intro h,
    induction h,
    case rt_step : x' y' h' { exact rsc_R h', },
    case rt_refl { exact rt1n_refl h, },
    case rt_trans : x' y' z' hxy hyz ihy ihz { exact rsc_trans ihy ihz, },
  intro h,
  induction h,
  case rt1n_refl { exact rt_refl h },
  case rt1n_trans : x' y' z' hxy hyz ih { exact rt_trans (rt_step hxy) ih, },
end

end rel


import data.real.basic
import data.int.parity

/-
In this file, we learn how to handle the ∃ quantifier.

In order to prove `∃ x, P x`, we give some x₀ using tactic `use x₀` and
then prove `P x₀`. This x₀ can be an object from the local context
or a more complicated expression.
-/
example : ∃ n : ℕ, 8 = 2*n :=
begin
  use 4,
  refl,  -- this is the tactic analogue of the rfl proof term
end

/-
In order to use `h : ∃ x, P x`, we use the `cases` tactic to fix
one x₀ that works.

Again h can come straight from the local context or can be a more
complicated expression.
-/
example (n : ℕ) (h : ∃ k : ℕ, n = k + 1) : n > 0 :=
begin
  -- Let's fix k₀ such that n = k₀ + 1.
  cases h with k₀ hk₀,
  -- It now suffices to prove k₀ + 1 > 0.
  rw hk₀,
  -- and we have a lemma about this
  exact nat.succ_pos k₀,
end

/-
The next exercises use divisibility in ℤ (beware the ∣ symbol which is
not ASCII).

By definition, a ∣ b ↔ ∃ k, b = a*k, so you can prove a ∣ b using the
`use` tactic.
-/

-- Until the end of this file, a, b and c will denote integers, unless
-- explicitly stated otherwise
variables (a b c : ℤ)

-- 0029
example (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c :=
begin
  cases h₁ with k₁ hk₁,
  cases h₂ with k₂ hk₂,
  rw hk₁ at hk₂,
  rw hk₂,
  use k₁* k₂,
  ring,
end

/-
A very common pattern is to have an assumption or lemma asserting
  h : ∃ x, y = ...
and this is used through the combo:
  cases h with x hx,
  rw hx at ...
The tactic `rcases` allows us to do recursive `cases`, as indicated by its name,
and also simplifies the above combo when the name hx is replaced by the special
name `rfl`, as in the following example.
It uses the anonymous constructor angle brackets syntax.
-/

example (h1 : a ∣ b) (h2 : a ∣ c) : a ∣ b+c :=
begin
  rcases h1 with ⟨k, rfl⟩,
  rcases h2 with ⟨l, rfl⟩,
  use k+l,
  ring,
end

/-
You can use the same `rfl` trick with the `rintros` tactic.
-/

example : a ∣ b → a ∣ c → a ∣ b+c :=
begin
  rintros ⟨k, rfl⟩ ⟨l, rfl⟩,
  use k+l,
  ring,
end

-- 0030
example : 0 ∣ a ↔ a = 0 :=
begin
  split,
  rintro ⟨k, rfl⟩,
  ring,
  intro ha,
  rw ha,
end

/-
We can now start combining quantifiers, using the definition

  surjective (f : X → Y) := ∀ y, ∃ x, f x = y

-/
open function

-- In the remaining of this file, f and g will denote functions from
-- ℝ to ℝ.
variables (f g : ℝ → ℝ)

-- 0031
example (h : surjective (g ∘ f)) : surjective g :=
begin
  intro b,
  rcases h b with ⟨k, rfl⟩,
  use f(k),
end

/-
The above exercise can be done in three lines. Try to do the
next exercise in four lines.
-/

-- 0032
example (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  intro b,
  rcases hg b with ⟨k, rfl⟩,
  rcases hf k with ⟨r, rfl⟩,
  use r,
end


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

import ring_theory.witt_vector.identities

/-!

# Witt vectors over a domain

This file builds to the proof `witt_vector.is_domain`,
an instance that says if `R` is an integral domain, then so is `𝕎 R`.
It depends on the API around iterated applications
of `witt_vector.verschiebung` and `witt_vector.frobenius`
found in `identities.lean`.

The [proof sketch](https://math.stackexchange.com/questions/4117247/ring-of-witt-vectors-over-an-integral-domain/4118723#4118723)
goes as follows:
any nonzero $x$ is an iterated application of $V$
to some vector $w_x$ whose 0th component is nonzero (`witt_vector.verschiebung_nonzero`).
Known identities (`witt_vector.iterate_verschiebung_mul`) allow us to transform
the product of two such $x$ and $y$
to the form $V^{m+n}\left(F^n(w_x) \cdot F^m(w_y)\right)$,
the 0th component of which must be nonzero.

## Main declarations

* `witt_vector.iterate_verschiebung_mul_coeff` : an identity from [Haze09]
* `witt_vector.is_domain`

-/

noncomputable theory
open_locale classical

namespace witt_vector
open function

variables {p : ℕ} {R : Type*}

local notation `𝕎` := witt_vector p -- type as `\bbW`

/-!
## The `shift` operator
-/

/--
`witt_vector.verschiebung` translates the entries of a Witt vector upward, inserting 0s in the gaps.
`witt_vector.shift` does the opposite, removing the first entries.
This is mainly useful as an auxiliary construction for `witt_vector.verschiebung_nonzero`.
-/
def shift (x : 𝕎 R) (n : ℕ) : 𝕎 R := mk p (λ i, x.coeff (n + i))

lemma shift_coeff (x : 𝕎 R) (n k : ℕ) : (x.shift n).coeff k = x.coeff (n + k) :=
rfl

variables [hp : fact p.prime] [comm_ring R]
include hp

lemma verschiebung_shift (x : 𝕎 R) (k : ℕ) (h : ∀ i < k+1, x.coeff i = 0) :
  verschiebung (x.shift k.succ) = x.shift k :=
begin
  ext ⟨j⟩,
  { rw [verschiebung_coeff_zero, shift_coeff, h],
    apply nat.lt_succ_self },
  { simp only [verschiebung_coeff_succ, shift],
    congr' 1,
    rw [nat.add_succ, add_comm, nat.add_succ, add_comm] }
end

lemma eq_iterate_verschiebung {x : 𝕎 R} {n : ℕ} (h : ∀ i < n, x.coeff i = 0) :
  x = (verschiebung^[n] (x.shift n)) :=
begin
  induction n with k ih,
  { cases x; simp [shift] },
  { dsimp, rw verschiebung_shift,
    { exact ih (λ i hi, h _ (hi.trans (nat.lt_succ_self _))), },
    { exact h } }
end

lemma verschiebung_nonzero {x : 𝕎 R} (hx : x ≠ 0) :
  ∃ n : ℕ, ∃ x' : 𝕎 R, x'.coeff 0 ≠ 0 ∧ x = (verschiebung^[n] x') :=
begin
  have hex : ∃ k : ℕ, x.coeff k ≠ 0,
  { by_contra' hall,
    apply hx,
    ext i,
    simp only [hall, zero_coeff] },
  let n := nat.find hex,
  use [n, x.shift n],
  refine ⟨nat.find_spec hex, eq_iterate_verschiebung (λ i hi, not_not.mp _)⟩,
  exact nat.find_min hex hi,
end

/-!
## Witt vectors over a domain

If `R` is an integral domain, then so is `𝕎 R`.
This argument is adapted from
<https://math.stackexchange.com/questions/4117247/ring-of-witt-vectors-over-an-integral-domain/4118723#4118723>.
-/

instance [char_p R p] [no_zero_divisors R] : no_zero_divisors (𝕎 R) :=
⟨λ x y, begin
  contrapose!,
  rintros ⟨ha, hb⟩,
  rcases verschiebung_nonzero ha with ⟨na, wa, hwa0, rfl⟩,
  rcases verschiebung_nonzero hb with ⟨nb, wb, hwb0, rfl⟩,
  refine ne_of_apply_ne (λ x, x.coeff (na + nb)) _,
  rw [iterate_verschiebung_mul_coeff, zero_coeff],
  refine mul_ne_zero (pow_ne_zero _ hwa0) (pow_ne_zero _ hwb0),
end⟩

instance [char_p R p] [is_domain R] : is_domain (𝕎 R) :=
no_zero_divisors.to_is_domain _

end witt_vector


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.list.nodup
import data.list.range

/-!
# Antidiagonals in ℕ × ℕ as lists

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

This file defines the antidiagonals of ℕ × ℕ as lists: the `n`-th antidiagonal is the list of
pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more
generally for sums going from `0` to `n`.

## Notes

Files `data.multiset.nat_antidiagonal` and `data.finset.nat_antidiagonal` successively turn the
`list` definition we have here into `multiset` and `finset`.
-/

open list function nat

namespace list
namespace nat

/-- The antidiagonal of a natural number `n` is the list of pairs `(i, j)` such that `i + j = n`. -/
def antidiagonal (n : ℕ) : list (ℕ × ℕ) :=
(range (n+1)).map (λ i, (i, n - i))

/-- A pair (i, j) is contained in the antidiagonal of `n` if and only if `i + j = n`. -/
@[simp] lemma mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
  x ∈ antidiagonal n ↔ x.1 + x.2 = n :=
begin
  rw [antidiagonal, mem_map], split,
  { rintros ⟨i, hi, rfl⟩, rw [mem_range, lt_succ_iff] at hi, exact add_tsub_cancel_of_le hi },
  { rintro rfl, refine ⟨x.fst, _, _⟩,
    { rw [mem_range, add_assoc, lt_add_iff_pos_right], exact zero_lt_succ _ },
    { exact prod.ext rfl (add_tsub_cancel_left _ _) } }
end

/-- The length of the antidiagonal of `n` is `n + 1`. -/
@[simp] lemma length_antidiagonal (n : ℕ) : (antidiagonal n).length = n+1 :=
by rw [antidiagonal, length_map, length_range]

/-- The antidiagonal of `0` is the list `[(0, 0)]` -/
@[simp] lemma antidiagonal_zero : antidiagonal 0 = [(0, 0)] :=
rfl

/-- The antidiagonal of `n` does not contain duplicate entries. -/
lemma nodup_antidiagonal (n : ℕ) : nodup (antidiagonal n) :=
(nodup_range _).map (@left_inverse.injective ℕ (ℕ × ℕ) prod.fst (λ i, (i, n-i)) $ λ i, rfl)

@[simp] lemma antidiagonal_succ {n : ℕ} :
  antidiagonal (n + 1) = (0, n + 1) :: ((antidiagonal n).map (prod.map nat.succ id)) :=
begin
  simp only [antidiagonal, range_succ_eq_map, map_cons, true_and, nat.add_succ_sub_one, add_zero,
    id.def, eq_self_iff_true, tsub_zero, map_map, prod.map_mk],
  apply congr (congr rfl _) rfl,
  ext; simp,
end

lemma antidiagonal_succ_succ' {n : ℕ} :
  antidiagonal (n + 2) =
  (0, n + 2) :: ((antidiagonal n).map (prod.map nat.succ nat.succ)) ++ [(n + 2, 0)] :=
by { rw antidiagonal_succ', simpa }

lemma map_swap_antidiagonal {n : ℕ} :
  (antidiagonal n).map prod.swap = (antidiagonal n).reverse :=
begin
  rw [antidiagonal, map_map, prod.swap, ← list.map_reverse,
    range_eq_range', reverse_range', ← range_eq_range', map_map],
  apply map_congr,
  simp [nat.sub_sub_self, lt_succ_iff] { contextual := tt },
end

end nat
end list


section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable  h : ∀ x, P x → P (f x)

  -- Show the following:
  example : ∀ y, P y → P (f (f y)) :=
  assume x,
  assume h1: P x,
  have h2 : P x → P (f x), from h x,
  have h3: P (f x), from h2 h1,
  have h4 : P (f x) → P (f (f x)), from h (f x),
  show P (f (f x)), from h4 h3
end

section
  variable U : Type
  variables A B : U → Prop

  example : (∀ x, A x ∧ B x) → ∀ x, A x :=
  assume h : ∀ x, A x ∧ B x,
  assume y,
  have h1 : A y ∧ B y, from h y,
  show A y, from and.left h1
end

---

section
  variable U : Type
  variables A B C : U → Prop

  variable h1 : ∀ x, A x ∨ B x
  variable h2 : ∀ x, A x → C x
  variable h3 : ∀ x, B x → C x

  example : ∀ x, C x :=
  assume y,
  or.elim (h1 y)
    (assume ha1, show C y, from (h2 y) ha1)
    (assume ha2, show C y, from (h3 y) ha2)
end

---

open classical   -- not needed, but you can use it

-- This is an exercise from Chapter 4. Use it as an axiom here.
axiom not_iff_not_self (P : Prop) : ¬ (P ↔ ¬ P)

example (Q : Prop) : ¬ (Q ↔ ¬ Q) :=
not_iff_not_self Q

section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀ x, shaves barber x ↔ ¬ shaves x x

  -- Show the following:
  example : false :=
  show false, from
    (not_iff_not_self (shaves barber barber)) (h barber)
end

---

section
  variable U : Type
  variables A B : U → Prop

  example : (∃ x, A x) → ∃ x, A x ∨ B x :=
  assume h,
  exists.elim h
    (assume y (h1 : A y),
      exists.intro y (or.inl h1))
end

---

section
  variable U : Type
  variables A B : U → Prop

  variable h1 : ∀ x, A x → B x
  variable h2 : ∃ x, A x

  example : ∃ x, B x :=
  exists.elim h2
  (assume y h3,
    exists.intro y (h1 y h3))
end

---

variable  U : Type
variables A B C : U → Prop

example (h1 : ∃ x, A x ∧ B x) (h2 : ∀ x, B x → C x) :
    ∃ x, A x ∧ C x :=
exists.elim h1
(assume y h3,
    exists.intro y ⟨ and.left h3, h2 y (and.right h3) ⟩ )

---

variable  U : Type
variables A B C : U → Prop

example : (¬ ∃ x, A x) → ∀ x, ¬ A x :=
λ h1 y h3, h1 (exists.intro y h3)

example : (∀ x, ¬ A x) → ¬ ∃ x, A x :=
λ h1 h2, exists.elim h2 (λ y h3, h1 y h3)

---

variable  U : Type
variables R : U → U → Prop

example : (∃ x, ∀ y, R x y) → ∀ y, ∃ x, R x y :=
assume h1 y,
exists.elim h1
(assume x (h2 : ∀ x1, R x x1),
    exists.intro x (h2 y))

---

theorem foo {A : Type} {a b c : A} : a = b → c = b → a = c :=
assume h1 : a = b,
assume h2 : c = b,
show a = c, by rw [h2,h1]
-- notice that you can now use foo as a rule. The curly braces mean that
-- you do not have to give A, a, b, or c

section
  variable A : Type
  variables a b c : A

  example (h1 : a = b) (h2 : c = b) : a = c :=
  foo h1 h2
end

section
  variable {A : Type}
  variables {a b c : A}

  -- replace the sorry with a proof, using foo and rfl, without using eq.symm.
  theorem my_symm (h : b = a) : a = b :=
  have h1 : a = a, from eq.refl a,
  foo h1 h

  -- now use foo, rfl, and my_symm to prove transitivity
  theorem my_trans (h1 : a = b) (h2 : b = c) : a = c :=
  foo h1 (my_symm h2)
end

---

-- these are the axioms for a commutative ring

#check @add_assoc
#check @add_comm
#check @add_zero
#check @zero_add
#check @mul_assoc
#check @mul_comm
#check @mul_one
#check @one_mul
#check @left_distrib
#check @right_distrib
#check @add_left_neg
#check @add_right_neg
#check @sub_eq_add_neg

variables x y z : int

theorem t1 : x - x = 0 :=
calc
x - x = x + -x : by rw sub_eq_add_neg
    ... = 0      : by rw add_right_neg

theorem t2 (h : x + y = x + z) : y = z :=
calc
y     = 0 + y        : by rw zero_add
    ... = (-x + x) + y : by rw add_left_neg
    ... = -x + (x + y) : by rw add_assoc
    ... = -x + (x + z) : by rw h
    ... = (-x + x) + z : by rw add_assoc
    ... = 0 + z        : by rw add_left_neg
    ... = z            : by rw zero_add

theorem t3 (h : x + y = z + y) : x = z :=
calc
x     = x + 0        : by rw add_zero
    ... = x + (y + -y) : by rw add_right_neg
    ... = (x + y) + -y : by rw add_assoc
    ... = (z + y) + -y : by rw h
    ... = z + (y + -y) : by rw add_assoc
    ... = z + 0        : by rw add_right_neg
    ... = z            : by rw add_zero

theorem t4 (h : x + y = 0) : x = -y :=
calc
x     = x + 0        : by rw add_zero
    ... = x + (y + -y) : by rw add_right_neg
    ... = (x + y) + -y : by rw add_assoc
    ... = 0 + -y       : by rw h
    ... = -y           : by rw zero_add

theorem t5 : x * 0 = 0 :=
have h1 : x * 0 + x * 0 = x * 0 + 0, from
calc
    x * 0 + x * 0 = x * (0 + 0) : by rw left_distrib
            ... = x * 0       : by rw add_zero
            ... = x * 0 + 0   : by rw add_zero,
show x * 0 = 0, from t2 _ _ _ h1

theorem t6 : x * (-y) = -(x * y) :=
have h1 : x * (-y) + x * y = 0, from
calc
    x * (-y) + x * y = x * (-y + y) : by rw left_distrib
                ... = x * 0        : by rw add_left_neg
                ... = 0            : by rw t5 x,
show x * (-y) = -(x * y), from t4 _ _ h1

theorem t7 : x + x = 2 * x :=
calc
x + x = 1 * x + 1 * x : by rw one_mul
    ... = (1 + 1) * x   : by rw right_distrib
    ... = 2 * x         : rfl


import fol

set_option pp.beta true

namespace fol_nat

open fol

-- example 1a: A language of natural numbers with the constant symbols `zero` and `one`
-- and the function symbols `succ` and `add`
inductive funcs : ℕ → Type
| zero : funcs 0
| one : funcs 0
| succ : funcs 1
| add : funcs 2

inductive preds : ℕ → Type
| equals : preds 2

def L : language := ⟨funcs, preds⟩
-- End Example

-- Example 1b: shorthand for each function/constant symbol in L of example 1a
def zero : term L := term.func funcs.zero fin.empty
def one : term L := term.func funcs.one fin.empty
def succ (arg : term L) : term L :=
term.func funcs.succ (arg :: fin.empty)
def add (arg1 arg2 : term L) : term L :=
term.func funcs.add (arg1 :: arg2 :: fin.empty)
def equ (arg1 arg2 : term L) : atom L :=
atom.atom preds.equals (arg1 :: arg2 :: fin.empty)
-- End Example

-- Example 2a: model for the natural number language of example 1a
def interpret_func (n : ℕ) (c : funcs n) : (fin.vec n ℕ → ℕ) :=
match n, c with
| 0, funcs.zero := (λ_, 0)
| 0, funcs.one  := (λ_, 1)
| 1, funcs.succ := (λargs, args 0 + 1)
| 2, funcs.add  := (λargs, args 0 + args 1)
end

def interpret_pred (n : ℕ) (c : preds n) : (fin.vec n ℕ → Prop) :=
match n, c with
| 2, preds.equals := (λargs, args 0 = args 1)
end

def M : model L :=
{domain := ℕ, funcs := interpret_func, preds := interpret_pred}
-- End Example

-- Example 2b: interpreting a ground term in the natural language using the natural model
def interpret_term (t : term L) : ℕ :=
term.valuation M (λi, nat.zero) t

#reduce interpret_term $ succ (add one one)

example : interpret_term (succ (add one one)) = 3 :=
rfl
-- End Example

-- Example 2c: interpreting a ground predicate and proving the predicate
def interpret_atom (p : atom L) : Prop :=
atom.valuation M (λi, nat.zero) p

#reduce interpret_atom $ equ one (succ zero)

example : interpret_atom (equ one (succ zero)) ↔ (1 = 1) :=
iff.rfl

example : interpret_atom (equ one (succ zero)) :=
rfl
-- End Example

-- Example 2d: interpreting some sentences and proving the sentences
def interpret_formula (f : formula L) : Prop :=
formula.valuation M (λi, nat.zero) f

def reflexivity : formula L :=
∀_(A_ (equ (term.var 0) (term.var 0)))

#reduce interpret_formula reflexivity

example : interpret_formula reflexivity :=
by {intro, exact rfl}

def symmetry : formula L :=
∀_∀_((A_ (equ (term.var 0) (term.var 1)))
     _→_(A_ (equ (term.var 1) (term.var 0))))

#reduce interpret_formula symmetry

example : interpret_formula symmetry :=
begin
intros x y h,
exact h.symm
end

-- End Example

end fol_nat


/- ***********************-/
/- *** ∃ Introduction *** -/
/-************************-/

/-
An existentially quantified
proposition asserts that there
exists *some* value of some type
that makes a given predicate
true. Here's an example.
-/

def anExistsProp :=
    ∃ m , m + m = 8

/- This proposition asserts that
there is some value m (inferred
to be of type ℕ) that makes the
predicate, m + m = 8, true.

Basic algebra tells us that there
is such a value, namely 4, so this
existentially quantified proposition
can be proved and is true.

The key thing to remember is that
a proof of such an existentially
quantified proposition is a pair.

The first element is a value that
makes the sub-proposition true. We
call such a value a "witness". In
the example, the witness is 4.

The second element in a proof
is a proof of that the proposition
obtained by substituting the witness
in for the value of the variable in
the predicate is true. Here, the
proof must be a proof of 4 + 4 = 8.

A proof of ∃ m , m + m = 8, is
thus the pair, ⟨ 4, eq.refl 8 ⟩. Here we use
special angle brackets, a notation that
Lean recognizes for writing proofs of
existentially quantified propositions.
-/

/-
Here are a couple more examples.
Note, as with all propositions,
these existential propositions do
not have to be true.
-/

def anotherExistsProp :=
  exists m, m > 10

def yetAnotherExistsProp :=
  exists m, m - m = 3

/-
Consider a familiar expression:

You can fool all of the people some of the time…
  ∀ p ∈ People, ∃ t ∈ time, fool(p, t)
    — everybody can be fooled at one time or another
  ∃ t ∈ time, ∀ p ∈ People, fool(p, t)
    — there exists a time when all of the people can be fooled simultaneously
  ∃ t ∈ time, ∀ p ∈ People, fool(p, t) →
    ∀ p ∈ People, ∃ t ∈ time, fool(p, t)
…and some of the people all of the time.
  ∃ p ∈ People, ∀ t ∈ time, fool(p, t)
    — there exists somebody who can be fooled all of the time
  ∀ t ∈ time, ∃ p ∈ People, fool(p, t)
    — at any given moment, there exists somebody who can be fooled
  ∃ p ∈ People, ∀ t ∈ time, fool(p, t) →
    ∀ t ∈ time, ∃ p ∈ People, fool(p, t)
-/

/-
More generally the introduction
rule for ∃ is as follows:

{ T : Type } { p: T → Prop } (w : T) (e : p w)
---------------------------------------------- exists.intr
                    ∃ a : T, p a
-/

#print exists.intro

/-
Here's code that illustrates the use of
-/

def existsIntro
(T: Type)           -- arguments
(pred: T → Prop)
(w : T)
(e : pred w)
:
exists w, pred w    -- return type
:=
exists.intro w e    -- direct use of exists. intro

#check existsIntro

/-
Abstract example
-/
variable T : Type
variable witness : T
variable predicate : T → Prop
#check predicate witness
variable proof : predicate witness

-- direct use of exists.intro
def pfOfExists : ∃ m, predicate m :=
    exists.intro witness proof

-- shorthand
def pfOfExists' : ∃ m, predicate m :=
    ⟨ witness, proof ⟩

-- a script in which we build the proof interactively
def fourAgain : exists m, m + m = 8 :=
begin
    apply exists.intro 4,
    exact rfl,
end

#reduce fourAgain

/-
Concrete example
-/

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

#check isEven

/-
A bad definition of isEven (last time).
-/

def isEvenBadDef (n : nat) : Prop :=
    exists m : nat, n / m = 2

example : isEvenBadDef 7 :=
    ⟨ 3.5, rfl ⟩

-- OOPS "/"" is natural number division
#reduce (7 / 2 : nat)

#reduce isEven 8
--
def eightEven := isEven 8

#check eightEven
#reduce eightEven

-- exact proof term using exists.intro
theorem even8 : eightEven :=
    exists.intro 4 rfl

-- syntactic sugar
theorem even8' : eightEven :=
    ⟨ 4, rfl ⟩

-- as a tactic script
-- unfold expands a definition
theorem even8'' : isEven 8 :=
begin
unfold isEven,      -- not necessary
apply exists.intro 4,
exact rfl
end

/-
EXERCISE: Construct a proof, isNonZ,
of the proposition that there exists
a natural number n such that 0 ≠ n.
-/

-- Possible Answers --

theorem isNonZ : exists n : nat, 0 ≠ n :=
exists.intro 1 (λ pf : (0 = 1),
nat.no_confusion pf)
-- second arg is a pf of 0=1→false

theorem isNonZ' : exists n : nat, 0 ≠ n :=
begin
  apply exists.intro 1,
  assume contra: 0=1,
  exact nat.no_confusion contra
end

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

  exact ⟨ 2, pf0isnt1 ⟩
end

theorem isNonZ''' : exists n : nat, 0 ≠ n :=
  ⟨ 3, dec_trivial ⟩

/- **********************-/
/- *** ∃ Elimination *** -/
/-***********************-/

/-
Suppose you want to show: ∃ x, P x → Q.

If one assumes that ∃ x, P x, then one
can assume there is some specific value,
w, such that P w is true. If one can then
show, without making additional assumptions
about w, that some conclusion, Q (that does
not depend on w), follows, then one has shown
that Q follows from the mere existence of a
w with property P, and thus from ∃ x, P x.

The formal rule is a little bit involved.
Here it is as an inference rule. We explain
each piece below.

∀ {Q : Prop}, ∀ {T : Type }, ∀ { P : T → Prop},
pfEx: (∃ x : T, P x), pfP2Q: ∀ w : T, P w → Q
----------------------------------------------
               Q

Ignore the implicit parameters for a moment,
and focus on pfEx and pfP2Q. This rule says
that (1) if there is some object, x that has
property P, and (2) if whenever *any* object
has this property, Q follows, then Q follows.

This is the elimination rule for ∃. It
lets you draw a conclusion, Q, from the
premise that ∃ x, P x (there is an x with
property P) and from a proof that if any
x has this property (and we just assumed
there is one) then there is a proof of Q.

The following function shows all of the
pieces needed to use exists.elim and how
to use it. Note that the conclusion, Q,
the type of elements involved, T, and
the property, P, are given implicitly,
as they can be inferred from the ∃ and
from the proof that Q follows from any
such value.
-/

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

/-
EXAMPLE. Let's prove that if there
is a value of some type that has two
properties, P and Q, then it has one
of those properties.

-/

-- assume pred1 and pred2 are properties of nats
variable pred1 : ℕ → Prop
variable pred2 : ℕ → Prop

/-
∀ {Q : Prop}, ∀ {T : Type }, ∀ { P : T → Prop},
pfEx: (∃ x : T, P x), pfP2Q: ∀ w : T, P w → Q
----------------------------------------------
               Q
-/

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

/-
We'll need to understand the following fact
to fully understand the proof of the theorem
that follows. This fact says that if "a" is a
value (here of type ℕ) and pred is a predicate
on values (or type ℕ), and if you further have
a function that takes a value, x, and returns
pred x, then applying that function to a value
a returns pred a. Just keep this in mind as we
work through the follow-on proof.
-/

example:
  ∀ (a: ℕ), ∀ (pred: ℕ → Prop),
    (λ (x: ℕ), pred x) a = (pred a) :=
begin
  assume a pred,
  apply rfl
end

/-
We now define two simple predicates,
gt1 (λ x, x > 1) and pred4 (λ x, x < 4),
and two more complex predicates, P and Q.
P is the predicate that asserts that both
gt1 and pred4 are true of some x, and
Q is the predicate that asserts that
there is some x that satisfies gt1.

The reason for this "set up" is so that
we can state the main theorem that follows
in a way that makes cler the relevance
of the elimination rule for exists. We
want to prove Q from ∃(x: ℕ), P x.
-/

def gt1: ℕ → Prop := λ (x: ℕ), x > 1
def lt4: ℕ → Prop := λ (x: ℕ), x < 4
abbreviation P : ℕ → Prop := λ (x: ℕ), gt1 x ∧ lt4 x
abbreviation Q : Prop := ∃ (x: ℕ), gt1 x

#check P 2

theorem forgetAProperty':
  (∃(x: ℕ), P x) → Q :=
begin
  assume pf_existsP,
  show Q,  -- document goal for readability
  from
    begin
      apply exists.elim pf_existsP, -- give one arg, build  other
      assume w pf_Pw,               -- assume w and proof of P w
      show Q,
      apply exists.intro w,
      exact pf_Pw.left,
    end,
end

/-
*** EXERCISE:

Prove:
Assuming n is a natural number and P and S are
properties of natural numbers, prove that
(∃ n, P n ∧ S n) → (∃ n, S n ∧ P n).
-/

-- Answer

theorem reverseProperty : ∀ (P S : ℕ → Prop),
  (exists n, P n ∧ S n) → (exists n, S n ∧ P n) :=
  -- here Q, the conclusion, is (exists n, S n ∧ P n)
begin
  assume P S,
  assume ex,
  show ∃ (n : ℕ), S 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 : ℕ), S n ∧ P n,
      -- here's some new notation for and.intro
      from ⟨ w, ⟨ Pw.right, Pw.left ⟩ ⟩
    end,
end

/-
The difficulty of proving propositions in
predicate logic is often related to the
nesting of quantifiers. Here's a little
example illustrating such nesting.

We formalize and prove this claim: if
there is a person who can be fooled at
any time, then at any time someone can
be fooled.

Here's a logical rendition of this idea:
∃ p ∈ Person,   ∀ t ∈ Time,     canFool(p, t) →
∀ t ∈ Time,     ∃ p ∈ Person,   canFool(p, t).

Note the different nestings of the quantifiers.

Let's prove it.
-/

theorem existsforall_impl_forallexists:
∀ (Time Person: Type),
∀ (canFool: Time → Person → Prop),
    (∃ p: Person, ∀ t: Time, canFool t p) →
        (∀ t: Time, ∃ p: Person, canFool t p)
:=
begin
  assume Time Person,
  assume canFool,
  assume someoneCanBeFooledAllTheTime,
  show ∀ (t : Time), ∃ (p : Person), canFool t p, from
  begin
    assume aTime,
    show ∃ (p : Person), canFool aTime p, from
        begin
        apply exists.elim someoneCanBeFooledAllTheTime,
        assume somePerson,
        assume canFoolThatPersonAnytime,
        have canFoolThatPersonSometime :=
            canFoolThatPersonAnytime aTime,
        exact exists.intro somePerson canFoolThatPersonSometime,
        --exact ⟨ somePerson, canFoolThatPersonSometime ⟩,
        end,
  end,
end

/-
The same proposition and proof using neutral identifiers.
-/
theorem existsforall_impl_forallexists':
∀ (T P: Type),
∀ (rel: T → P → Prop),
    (∃ p: P, ∀ t: T, rel t p) →
        (∀ t: T, ∃ p: P, rel t p)
:=
begin
  assume T P,
  assume rel,
  assume somePrelAllT,
  assume someT,
  apply exists.elim somePrelAllT,
  assume someP,
  assume thatPrelAllT,
  have thatTrelThatP :=
    thatPrelAllT someT,
  exact ⟨ someP, thatTrelThatP ⟩,
end

/-
Discussion: Is the converse proposition true?
-/

/-
Negating Existential and Universal Quantifiers

What happens when you negate an existential
quantifier? What does this mean:
¬(∃ t ∈ time, fool(me, t)) -
  there does not exist a time when you can fool me
∀ t ∈ time, ¬fool(me, t) -
  at any time, you will not fool me
Are these equivalent?

How about this:
¬(∀ t ∈ time, fool(me, t)) -
  you cannot fool me all of the time
∃ t ∈ time, ¬fool(me, t) -
  there exists a time when you cannot fool me
Are these equivalent?
-/

theorem not_exists_t_iff_always_not_t:
  ∀ (T: Type) (pred: (T → Prop)),
    (¬(∃(t: T), pred(t))) ↔
      ∀(t: T), ¬pred(t) :=
begin
  assume T pred,
  apply iff.intro,

  -- forward
  show (¬∃ (t : T), pred t) → ∀ (t : T), ¬pred t, from
    begin
        assume pf_not_exists_t,
        show ∀ (t : T), ¬pred t, from
        begin
            assume t,
            assume pred_t,
            have pf_exists_t := exists.intro t pred_t,
            exact (pf_not_exists_t pf_exists_t),
            -- contradiction,
        end,
    end,

    -- reverse
  show (∀ (t : T), ¬pred t) → (¬∃ (t : T), pred t), from
    begin
        assume all_not_pred,
        show ¬∃ (t : T), pred t, from
            begin
            assume ex_t_pred,
            show false, from
                begin
                apply exists.elim ex_t_pred,
                assume t,
                assume pred_t,
                have not_pred_t := all_not_pred t,
                --exact pf_not_pred_t pf_pred_t
                contradiction,
                end,
            end,
    end,
end

open classical
-- em is axiom of the excluded middle

theorem not_all_t_iff_exists_not_t:
  ∀ (T: Type) (pred: (T → Prop)),
    (¬(∀ t: T, pred(t))) ↔
      ∃ t: T, ¬pred(t) :=
begin
  intros,
  apply iff.intro,
    assume pf_not_all_t,
    cases (em (∃ (t : T), ¬pred t)) with pf_exists_not_t pf_not_exists_not_t,
      exact pf_exists_not_t,

      have contra_double_neg: ∀(t: T), ¬¬pred t,
        assume t,
        assume pf_n_pred_t,
        have pf_exists_t := exists.intro t pf_n_pred_t,
        exact (pf_not_exists_not_t pf_exists_t),

      have contra: ∀(t: T), pred t,
        assume t,
        have pf_nn_pred_t := (contra_double_neg t),
        cases em (pred t) with pf_pred_t pf_n_pred_t,
          assumption,

          exact false.elim (pf_nn_pred_t pf_n_pred_t),

      exact false.elim (pf_not_all_t contra),

    assume pf_exists_not_t,
    apply exists.elim pf_exists_not_t,
    assume w not_pred_w,
    assume pf_all_t,
    show false, from
      begin
        have pred_w := pf_all_t w,
        exact not_pred_w pred_w,
      end,
end

/-
Satisfiability

Satisfiability is about finding values for
sub-propositions that make a larger proposition
true. We typically like to formulate these
questions in something known as conjunctive
normal form (or CNF). In CNF we have a series
of disjunctions, e.g., x1 ∨ x2 ∨ ¬x3 ∨ x4.
These disjunctions are then combined into
the larger proposition using conjunctions, e.g.:
(x1 ∨ x2 ∨ ¬x3 ∨ x4) ∧ (¬x1 ∨ x2 ∨ ¬x3).

For example, do there exist values for P and Q
such that:
(P ∨ Q) ∧ (¬P ∨ ¬Q) is true?
-/

example: ∃(P Q: Prop), (P ∨ Q) ∧ (¬P ∨ ¬Q) :=
begin
  apply exists.intro true,
  apply exists.intro false,
  apply and.intro,
    -- prove true or false
    apply or.inl true.intro,

    -- prove not true or not false,
    apply or.inr false.elim,
end

/-
Exercise:
Do there exist values for P and Q such that:
(P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P or Q) is true?
If so, prove it.
-/

-- Answer:

example: ∃(P Q: Prop), (P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) :=
begin
  apply exists.intro false,
  apply exists.intro true,
  apply and.intro,
    -- prove true or false
    apply or.inr true.intro,

    apply and.intro,
      -- prove not true or not false
      apply or.inl false.elim,

      -- prove not false or true
      apply or.inr true.intro
end

/-
Exercise:
Do there exist values for P and Q such that:
(P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) ∧ (¬Q) is true?
If so, prove it.
-/

-- Answer:

-- No such values exist

/-
3-SAT

3-SAT is a special case of satisfiability (SAT) where
there are no more than 3 terms in each disjunction.
E.g., (P ∨ Q ∨ R) ∧ (¬P ∨ ¬Q ∨ ¬S) ∧ (¬P ∨ Q ∨ T) ∧ …

3-SAT is SAT, and 2-SAT is 3-SAT. The prior problems
were technically all 3-SAT.

All SAT problems can be reduced to 3-SAT problems.
3-SAT (and hence SAT) is NP-complete.

Here is one that uses all 3 terms:

Exercise:
Do there exist values for P, Q, and R such that:
(P ∨ Q ∨ R) ∧ (¬P ∨ ¬Q ∨ ¬R) ∧ (¬P ∨ Q ∨ R) ∧ (¬Q ∨ ¬R) is true?
If so, prove it.
-/

-- Answer:

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,
  apply and.intro,
    -- prove false ∨ true ∨ false
    apply or.inr,
    exact or.inl true.intro,

    apply and.intro,
    -- prove ¬false ∨ ¬true ∨ ¬false
    exact or.inl false.elim,

    apply and.intro,
    -- prove ¬false ∨ true ∨ false
    exact or.inl false.elim,

    -- prove ¬true or ¬false
    exact or.inr false.elim
end