section propositional

variables P Q R : Prop

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

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

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  by_cases h : P,
  intro g,
  assumption,
  intro g,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  by_cases h : P,
  intro g,
  assumption,
  intro g,
  contradiction,
  intro h,
  intro g,
  contradiction,
end

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

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

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

end

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

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

end

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

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

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

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro hp,
  intro p,
  by_contra,
  have np := hp h,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intro hp,
  intro q,
  intro p,
  have qo := hp p,
  contradiction,
  intro hp,
  intro nq,
  by_contra,
  have qc := hp h,
  contradiction,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro hp,
  have LEM : P∨¬P,
    right,
    intro p,
    have LEM2 : P∨¬P,
      left,
      assumption,
    contradiction,
  contradiction,

end

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

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro pqp,
  intro np,
  have novopq : (P → Q),
  intro p,
  contradiction,
  have p := pqp  novopq,
  contradiction,

end

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro pq,
  intro npq,
  cases npq,
  cases pq,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro pq,
  intro npq,
  cases pq,
  cases npq,
  contradiction,
  contradiction,
end

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

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro npq,
  split,
  intro p,
  have peq : (P ∨ Q),
  left,
  assumption,
  contradiction,
  intro q,
  have peq : (P ∨ Q),
  right,
  assumption,
  contradiction,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro npnq,
  intro pq,
  cases pq,
  cases npnq,
  contradiction,
  cases npnq,
  contradiction,

end

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

end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro nqnp,
  intro npq,
  cases nqnp,
  apply nqnp,
  cases npq,
  assumption,
  apply nqnp,
  cases npq,
  assumption,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  intro npq,
  by_contra nqp,
  apply npq,
  split,
  by_contra np,
  apply nqp,
  right,
  assumption,
  by_contra nq,
  apply nqp,
  left,
  assumption,
  intro nqnp,
  intro npq,
  cases nqnp,
  apply nqnp,
  cases npq,
  assumption,
  apply nqnp,
  cases npq,
  assumption,

end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  intro npq,
  split,
  intro p,
  have peq : (P ∨ Q),
  left,
  assumption,
  contradiction,
  intro q,
  have peq : (P ∨ Q),
  right,
  assumption,
  contradiction,
  intro npnq,
  intro pq,
  cases pq,
  cases npnq,
  contradiction,
  cases npnq,
  contradiction,

end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro pqr,
  cases pqr,
  cases pqr_right,
  left,
  split,
  assumption,
  assumption,
  right,
  split,
  assumption,
  assumption,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro pqpr,
  split,
  cases pqpr,
  cases pqpr,
  assumption,
  cases pqpr,
  assumption,
  cases pqpr,
  cases pqpr,
  left,
  assumption,
  cases pqpr,
  right,
  assumption,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro pqr,
  split,
  cases pqr,
  left,
  assumption,
  cases pqr,
  right,
  assumption,
  cases pqr,
  left,
  assumption,
  cases pqr,
  right,
  assumption,

end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro pqpr,
  cases pqpr,
  cases pqpr_right,
  left,
  assumption,
  cases pqpr_left,
  left,
  assumption,
  right,
  split,
  assumption,
  assumption,
end

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro pqr,
  intro p,
  intro q,
  have pq : (P∧Q),
  split,
  assumption,
  assumption,
  have r :R := pqr pq,
  assumption,

end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro pqr,
  intro pq,
  cases pq,
  have qr: (Q→R) := pqr pq_left,
  have r : R := qr pq_right,
  assumption,
end

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

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

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

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

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

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro pq,
  cases pq,
  assumption,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro pq,
  cases pq,
  assumption,
end

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

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro pp,
  cases pp,
  assumption,
  assumption,
  intro p,
  left,
  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 expx,
  intro axnpx,
  intro np,
  apply expx,
  existsi axnpx,
  assumption,

end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro xAnpx,
  intro nxEPx,
  cases nxEPx with x px,
  have npx : ¬P x := xAnpx x,
  contradiction,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro xAPx,
  by_contra xEnpx,
  apply xAPx,
  intro x,
  by_contra npx,
  apply xEnpx,
  existsi x,
  exact npx,

end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro xEnPx,
  intro xAPx,
  cases xEnPx with  x npx,
  have px : P x := xAPx x,
  contradiction,

end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  intro xAPx,
  by_contra xEnpx,
  apply xAPx,
  intro x,
  by_contra npx,
  apply xEnpx,
  existsi x,
  exact npx,
  intro xEnPx,
  intro xAPx,
  cases xEnPx with  x npx,
  have px : P x := xAPx x,
  contradiction,

end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  intro expx,
  intro axnpx,
  intro np,
  apply expx,
  existsi axnpx,
  assumption,
  intro xAnpx,
  intro nxEPx,
  cases nxEPx with x px,
  have npx : ¬P x := xAnpx x,
  contradiction,

end

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro xEPx,
  intro xAnPx,
  cases xEPx with  x npx,
  have npx : ¬P x := xAnPx x,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro xAPx,
  intro xnEnPx,
  cases xnEnPx with  x npx,
   have px : P x := xAPx x,
   contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro xnEnPx,
  intro xAPx,
  by_cases pnp : P xAPx,
  assumption,
  have xEnPx : (∃x, ¬P x),
    existsi xAPx,
    assumption,
  contradiction,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
    intro xnAnPx,
  by_contra xnEPx,
  have xAnPx : ∀x, ¬P x,
    intro x,
    intro px,
    have xEPx: ∃x, P x,
      existsi x,
      exact px,
    contradiction,
  contradiction,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  intro xAPx,
  intro xnEnPx,
  cases xnEnPx with  x npx,
   have px : P x := xAPx x,
   contradiction,
    intro xnEnPx,
  intro xAPx,
  by_cases pnp : P xAPx,
  assumption,
  have xEnPx : (∃x, ¬P x),
    existsi xAPx,
    assumption,
  contradiction,

end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
   intro xEPx,
  intro xAnPx,
  cases xEPx with  x npx,
  have npx : ¬P x := xAnPx x,
  contradiction,
    intro xnAnPx,
  by_contra xnEPx,
  have xAnPx : ∀x, ¬P x,
    intro x,
    intro px,
    have xEPx: ∃x, P x,
      existsi x,
      exact px,
    contradiction,
  contradiction,
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 xEPxQx,
  cases xEPxQx with a PaQa,
  cases PaQa,
  split,
  existsi a,
  assumption,
  existsi a,
  assumption,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro xEPxQx,
  cases xEPxQx with a PaQa,
  cases PaQa,
  left,
  existsi a,
  exact PaQa,
  right,
  existsi a,
  exact PaQa,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
    intro xEPxouxEQx,
  cases xEPxouxEQx,
  cases xEPxouxEQx with a Pa,
  have PaQa : P a ∨ Q a,
    left,
    exact Pa,
  existsi a,
  exact PaQa,
  cases xEPxouxEQx with a Qa,
  have PaQa : P a ∨ Q a,
    right,
    exact Qa,
  existsi a,
  exact PaQa,

end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro xAPxeQx,
  split,
  intro x,
  have PxQx := xAPxeQx x,
  cases PxQx with Px Qx,
  assumption,
  intro x,
  have PxQx := xAPxeQx x,
  cases PxQx with Px Qx,
  assumption,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro xAPxxAQx,
  cases xAPxxAQx,
  intro a,
  have Pa: P a := xAPxxAQx_left a,
  have Qa: Q a := xAPxxAQx_right a,
  split,
  exact Pa,
  exact Qa,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
   intro xAPxouxAQx,
  intro x,
  cases xAPxouxAQx with xAPx xAQx,
  have Px := xAPx x,
  left,
  assumption,
  have Qx := xAQx x,
  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) 2021 Alex J. Best. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best

! This file was ported from Lean 3 source module algebra.module.pointwise_pi
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Pointwise.SMul
import Mathlib.GroupTheory.GroupAction.Pi

/-!
# Pointwise actions on sets in Pi types

This file contains lemmas about pointwise actions on sets in Pi types.

## Tags

set multiplication, set addition, pointwise addition, pointwise multiplication, pi

-/

open Pointwise

open Set

variable {K ι : Type _} {R : ι → Type _}

@[to_additive]
theorem smul_pi_subset [∀ i, SMul K (R i)] (r : K) (s : Set ι) (t : ∀ i, Set (R i)) :
    r • pi s t ⊆ pi s (r • t) := by
  rintro x ⟨y, h, rfl⟩ i hi
  exact smul_mem_smul_set (h i hi)
#align smul_pi_subset smul_pi_subset
#align vadd_pi_subset vadd_pi_subset

-- Porting note: Lean 4 can't synthesize `Set.mem_univ i`?
@[to_additive]
theorem smul_univ_pi [∀ i, SMul K (R i)] (r : K) (t : ∀ i, Set (R i)) :
    r • pi (univ : Set ι) t = pi (univ : Set ι) (r • t) :=
  (Subset.antisymm (smul_pi_subset _ _ _)) fun x h ↦
    by
    refine' ⟨fun i ↦ Classical.choose (h i <| Set.mem_univ _), fun i _ ↦ _, funext fun i ↦ _⟩
    · exact (Classical.choose_spec (h i <| Set.mem_univ i)).left
    · exact (Classical.choose_spec (h i <| Set.mem_univ i)).right
#align smul_univ_pi smul_univ_pi
#align vadd_univ_pi vadd_univ_pi

@[to_additive]
theorem smul_pi [Group K] [∀ i, MulAction K (R i)] (r : K) (S : Set ι) (t : ∀ i, Set (R i)) :
    r • S.pi t = S.pi (r • t) :=
  (Subset.antisymm (smul_pi_subset _ _ _)) fun x h ↦
    ⟨r⁻¹ • x, fun i hiS ↦ mem_smul_set_iff_inv_smul_mem.mp (h i hiS), smul_inv_smul _ _⟩
#align smul_pi smul_pi
#align vadd_pi vadd_pi

theorem smul_pi₀ [GroupWithZero K] [∀ i, MulAction K (R i)] {r : K} (S : Set ι) (t : ∀ i, Set (R i))
    (hr : r ≠ 0) : r • S.pi t = S.pi (r • t) :=
  smul_pi (Units.mk0 r hr) S t
#align smul_pi₀ smul_pi₀


import game.limits.shift_rule_seq

namespace xena --hide

/-
Bounded monotone sequences converge
-/

/- Lemma
It is obvious that a sequence of real numbers is bounded if and only if
the set of its terms is bounded above and bounded below in ℝ. For that
reason you may wish to skip the proof of the following proposition, which
we will use in our proof of the monotone convergence theorem.
-/

theorem seq_bdd_iff_range_bdd (a : ℕ → ℝ) : is_bounded a ↔
is_bdd_above (set.range a) ∧ is_bdd_below (set.range a):=
begin
-- first split the iff
split,
    -- Sequence bounded only if range bounded above and below (→)
    {
    -- let |a n| ≤ B for any n, from def of bounded sequence
    intro hyp,
    cases hyp with B hypB,
    -- now split the conjunction
    split,
        -- first prove set of terms is bounded above
        {
        use B,
        -- let s be any element in our set of terms
        intros s hyp,
        -- by definition of set.range, hyp proves ∃ (k : ℕ), a k = s,
        cases hyp with k hypk,
        specialize hypB k,
        -- establish a simple fact and use linarith
        have fact: a k ≤ |a k|, from le_abs_self (a k),
        linarith,
        },
        -- set of terms is bounded below, similar proof
        {
        use -B,
        intros s hyp,
        cases hyp with k hypk,
        specialize hypB k,
        refine neg_le.mp _,   -- makes goal a litle clearer
        have fact:= neg_le_abs_self (a k),
        linarith,
        }
    },
    -- Sequence bounded if range bounded above and below (←)
    intro hyp,
    -- set up our upper and lower bounds for the range
    cases hyp.left with U hypU,
    cases hyp.right with L hypL,
    -- Use max and abs to define a term B to bound our sequence
    let B := max U (|L|),
    use B,
    -- Now show that this B is a bound
    intro k,
    -- k defines an arbitrary term a k in our sequence
    have fact: a k ∈ set.range a, exact set.mem_range_self k,
    -- we know that U and L are upper and lower bounds for the range
    have Upperbound: a k ≤ U, from hypU (a k) fact,
    have Lowerbound: L ≤ a k, from hypL (a k) fact,
    -- refine unfolds consequences of the `max` function hidden
    -- inside `B` in our goal (I used `suggest` here)
    refine le_max_iff.mpr _,
    -- to prove |a k| ≤ B, we proceed by cases on the sign of a k
    by_cases sign : 0 ≤ a k,
    -- a k is non-negative, so the corresponding bound is U
    {-- so choose `left`
    left,
    have: |a k| = a k, from abs_of_nonneg sign,
    linarith,
    },
    -- a k is negative, so the corresponding bound is |L|
    -- again, prepare simple facts about `abs` and use linarith
    {
    right,
    simp at sign,
    have fact1:= abs_of_neg sign,
    have Lisneg:= lt_of_le_of_lt Lowerbound sign,
    have fact2:= abs_of_neg Lisneg,
    linarith,
    }
end

end xena -- hide


/-
# Proposition world.

## Level 3: `have`.

Say you have a whole bunch of propositions and implications between them,
and your goal is to build a certain proof of a certain proposition.
If it helps, you can build intermediate proofs of other propositions
along the way, using the `have` command. `have q : Q := ...` is the Lean analogue
of saying "We now see that we can prove $Q$, because..."
in the middle of a proof.
It is often not logically necessary, but on the other hand
it is very convenient, for example it can save on notation, or
it can break proofs up into smaller steps.

In the level below, we have a proof of $P$ and we want a proof
of $U$; during the proof we will construct proofs of
of some of the other propositions involved. The diagram of
propositions and implications looks like this pictorially:

![diagram](https://wwwf.imperial.ac.uk/~buzzard/xena/natural_number_game_images/implies_diag.jpg)

and so it's clear how to deduce $U$ from $P$.
Indeed, we could solve this level in one move by typing

`exact l(j(h(p))),`

But let us instead stroll more lazily through the level.
We can start by using the `have` tactic to make a proof of $Q$:

`have q := h(p),`

and then we note that $j(q)$ is a proof of $T$:

`have t : T := j(q),`

(note how we explicitly told Lean what proposition we thought $t$ was
a proof of, with that `: T` thing before the `:=`)
and we could even define $u$ to be $l(t)$:

`have u : U := l(t),`

and then finish the level with

`exact u,`

.
-/

/- Lemma : no-side-bar
In the maze of logical implications above, if $P$ is true then so is $U$.
-/
lemma maze (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=
begin
  have q := h(p),
  have t := j(q),
  have u := l(t),
  exact u,

end

/-
If you solved the level using `have`, then click on the last line of your proof
(you do know you can move your cursor around with the arrow keys
and explore your proof, right?) and note that the local context at that point
is in something like the following mess:

```
P Q R S T U : Prop,
p : P,
h : P → Q,
i : Q → R,
j : Q → T,
k : S → T,
l : T → U,
q : Q,
t : T,
u : U
⊢ U
```

It was already bad enough to start with, and we added three more
terms to it. In level 4 we will learn about the `apply` tactic
which solves the level using another technique, without leaving
so much junk behind.
-/


namespace ex1
    -- Prove these equivalences:
    variables (α : Type) (p q : α → Prop)

    def proof1 : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
    have left : (∀ x, p x ∧ q x) → (∀ x, p x) ∧ (∀ x, q x), from
        assume h : (∀ x, p x ∧ q x),
        and.intro (λ z : α, (h z).left) (λ z : α, (h z).right),
    have right : (∀ x, p x) ∧ (∀ x, q x) → (∀ x, p x ∧ q x), from
        assume h : (∀ x, p x) ∧ (∀ x, q x),
        λ z : α, and.intro (h.left z) (h.right z),
    ⟨left, right⟩

    def proof2 (h₁ : ∀ x, p x → q x) (h₂ : ∀ x, p x) : (∀ x, q x) :=
    λ z : α, (h₁ z) (h₂ z)

    def proof3 (h : (∀ x, p x) ∨ (∀ x, q x)) : ∀ x, p x ∨ q x :=
    λ z : α, or.elim h (λ hp, or.inl $ hp z) (λ hq, or.inr $ hq z)

    example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := @proof1 α p q
    example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := @proof2 α p q
    example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := @proof3 α p q

    -- You should also try to understand why the reverse implication
    -- is not derivable in the last example.
    --
    -- Answer: difference between "for any instance of the type, p or q holds"
    -- (less general, right), and "p holds for any instance of the type, or q
    -- holds for any instance of the type" (more general, left). The xs could be
    -- different instances of α, since they are bound separately.
end ex1

namespace ex2

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

    def proof1 (a : α) : ((∀ x : α, r) ↔ r) :=
    have left: ((∀ x : α, r) → r), from λ hx, hx a,
    have right : (r → (∀ x : α, r)), from λ hr, λ z, hr,
    ⟨left, right⟩

    def proof2 : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
    have left : (∀ x, p x ∨ r) → (∀ x, p x) ∨ r, from
        assume (h : ∀ x, p x ∨ r),
        or.elim (classical.em r)
            (λ hr, or.inr hr)
            (λ hnr, or.intro_left r (
                λ z : α, or.elim (classical.em (p z))
                    (λ hpz, hpz)
                    (λ hnpz, false.elim $ or.elim (h z) (λ hpz, absurd hpz hnpz) (λ hr, absurd hr hnr))
                )),
    have right : (∀ x, p x) ∨ r → (∀ x, p x ∨ r), from
        assume (h : (∀ x, p x) ∨ r),
        λ (z : α), or.elim h (λ hp, or.inl $ hp z) (λ hr, or.inr hr),
    ⟨left, right⟩

    def proof3 : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
    have left : (∀ x, r → p x) → (r → ∀ x, p x), from
        assume (h : ∀ z : α, r → p z),
        λ (hr : r), λ (zz : α), h zz hr,
    have right : (r → ∀ x, p x) → (∀ x, r → p x), from
        assume (h : r → ∀ x, p x),
        λ (z : α), λ (hr :r), (h hr) z,
    ⟨left, right⟩

    example : α → ((∀ x : α, r) ↔ r) := proof1 α r
    example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := proof2 α p r
    example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := proof3 α p r

end ex2

namespace ex3

    variables (men : Type) (barber : men)
    variable  (shaves : men → men → Prop)

    example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
    have h1 : shaves barber barber → ¬ shaves barber barber, from iff.elim_left $ h barber,
    have h2 : ¬ shaves barber barber → shaves barber barber, from iff.elim_right $ h barber,
    have nsbb : ¬shaves barber barber, from λ hsbb : shaves barber barber, absurd hsbb (h1 hsbb),
    have sbb : shaves barber barber, from h2 nsbb,
    absurd sbb nsbb

end ex3

namespace ex4
    namespace hidden

        def divides (m n : ℕ) : Prop := ∃ k, m * k = n

        instance : has_dvd nat := ⟨divides⟩

        def even (n : ℕ) : Prop := 2 ∣ n -- You can enter the '∣' character by typing \mid

        section
            variables m n : ℕ

            #check m ∣ n
            #check m^n
            #check even (m^n + 3)
        end

    end hidden

    def prime (n : ℕ) : Prop := n > 1 ∧ ¬   (∃ m : ℕ, m < n ∧ hidden.divides m n)

    def infinitely_many_primes : Prop := ∀ n : ℕ,
        prime n ∧ (∃ m : ℕ, prime m ∧ n < m)
        ∨ ¬(prime n)

    def Fermat_prime (n : ℕ) : Prop := prime n ∧ n > 2 ∧ (∃ k : ℕ , (2^k + 1) = n)

    def infinitely_many_Fermat_primes : Prop := ∀ n : ℕ,
        (Fermat_prime n ∧ (∃ m : ℕ, Fermat_prime m ∧ m > n))
        ∨ ¬(Fermat_prime n)

    def goldbach_conjecture : Prop := ∀ n : ℕ,
    n < 2
    ∨ ¬(hidden.even n)
    ∨ ∃ a b : ℕ, prime a ∧ prime b ∧ (a + b = n)

    -- Every odd number greater than 5 can be expressed as the sum of three primes. (A prime may be used more than once in the same sum.)
    -- https://en.wikipedia.org/wiki/Goldbach%27s_weak_conjecture
    def Goldbach's_weak_conjecture : Prop := ∀ n : ℕ,
    n < 5
    ∨ hidden.even n
    ∨ (∃ a b c : ℕ, prime a ∧ prime b ∧ prime c ∧ a + b + c = n )

    def Fermat's_last_theorem : Prop := ∀ n : ℕ,
    n ≤ 2
    ∨ ¬(∃ a b c : ℕ, a^n + b^n = c^n)

end ex4

namespace ex5
    open classical

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

    def pikachu (h : ∃ x : α, r) : r :=
    match h with ⟨hx, hr⟩ := hr end

    def raichu (hr : r) : (∃ x : α, r) := exists.intro a hr

    def pichu : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
    have left : (∃ x, p x ∧ r) → (∃ x, p x) ∧ r, from
        assume h : (∃ x, p x ∧ r),
        match h with ⟨hx, h1⟩ :=
            and.intro (⟨hx, h1.left⟩) h1.right
        end,
    have right : (∃ x, p x) ∧ r → (∃ x, p x ∧ r), from
        assume h,
        match h.left with ⟨hx, hpx⟩ :=
            ⟨hx, and.intro hpx h.right⟩
        end,
    ⟨left, right⟩

    def jesse : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
    have left : (∃ x, p x ∨ q x) → (∃ x, p x) ∨ (∃ x, q x),from
        assume ⟨hx, h1⟩,
        or.elim h1 (λ hpx, or.inl ⟨hx, hpx⟩) (λ hqx, or.inr ⟨hx, hqx⟩),
    have right : (∃ x, p x) ∨ (∃ x, q x) → (∃ x, p x ∨ q x), from
        assume h,
        or.elim h (λ ⟨hx, hpx⟩, ⟨hx, or.inl hpx⟩) (λ ⟨hx, hqx⟩, ⟨hx, or.inr hqx⟩),
    ⟨left, right⟩

    -- May require classical reasoning
    def james : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
    have left : (∀ x, p x) → ¬ (∃ x, ¬ p x), from
        assume h1,
        assume h2 : (∃ x, ¬ p x),
        have ¬ (∀ x, p x), from
            match h2 with ⟨hx, hnpx⟩ :=
                absurd (h1 hx) hnpx
            end,
        absurd h1 this,
    have right : ¬ (∃ x, ¬ p x) → (∀ x, p x), from
        assume h1,
        λ hx, by_contradiction (λ hnpx, h1 ⟨hx, hnpx⟩),
    ⟨left, right⟩

    theorem dne {p : Prop} (h : ¬¬p) : p :=
    or.elim (em p)
    (assume hp : p, hp)
    (assume hnp : ¬p, absurd hnp h)

    def team_rocket : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
    have left : (∃ x, p x) → ¬ (∀ x, ¬ p x), from
        assume h1 h2,
        match h1 with ⟨hx, hpx⟩ :=
            absurd hpx (h2 hx)
        end,
    have right : ¬ (∀ x, ¬ p x) → (∃ x, p x), from
        assume h,
        by_contradiction (
            λ hnex,
            have (∀ x, ¬ p x), from (
                λ x, by_contradiction (λ h2, absurd (⟨x, dne h2⟩ : (∃ x, p x)) hnex)
            ),
            absurd this h
        ),
    ⟨left, right⟩

    def prepare_for_trouble : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
    have left : (¬ ∃ x, p x) → (∀ x, ¬ p x), from (
        assume hne,
        λ x, by_cases (λ (hpx : p x), absurd (⟨x, hpx⟩ : ∃ x, p x) hne) (λ hnpx, hnpx)
    ),
    have right : (∀ x, ¬ p x) → (¬ ∃ x, p x), from
        assume h1 h2,
        match h2 with ⟨hx, hpx⟩ := absurd hpx (h1 hx) end,
    ⟨left, right⟩

    def make_it_double : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
    have left : ¬(∀ x, p x) → (∃ x, ¬ p x), from
        assume h,
        by_contradiction (
            λ hnex,
            have (∀ x, p x), from (
                λ hx, or.elim (em $p hx)
                    (λ hphx, hphx)
                    (λ hnphx, absurd (⟨hx, hnphx⟩ : ∃ x, ¬ p x) hnex)
            ),
            absurd this h
        ),
    have right : (∃ x, ¬ p x) → ¬(∀ x, p x), from
        assume h,
        match h with ⟨hx, hnpx⟩ :=
            λ h2, absurd (h2 hx) hnpx
        end,
    ⟨left, right⟩

    def to_protect_the_world : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
    have left : (∀ x, p x → r) → (∃ x, p x) → r, from
        assume h hpx,
        match hpx with ⟨hx, hpx⟩ := h _ hpx end,
    have right : ((∃ x, p x) → r) → (∀ x, p x → r), from
        assume h,
        λ hx hpx, h $ ⟨hx, hpx⟩,
    ⟨left, right⟩

    -- See the book: we need the assumption that α is nonempty here (a)
    def from_devastation : (∃ x, p x → r) ↔ ((∀ x, p x) → r) :=
    have left : (∃ x, p x → r) → ((∀ x, p x) → r), from
        assume h1 h2,
            match h1 with ⟨hx, hpxtor⟩ :=
                hpxtor (h2 hx)
            end,
    have right : ((∀ x : α, p x) → r) → (∃ x : α, p x → r), from
        assume h,
            -- Had too look up that part from the book
            by_cases
                (λ hap : (∀ x : α, p x), ⟨a, λ _hleft, h hap⟩)
                (λ hnap : ¬(∀ x : α, p x),
                    by_contradiction (
                        λ hnex : ¬ ∃ x, p x → r,
                        have hap : ∀ x, p x, from (
                            assume x : α,
                            by_contradiction (
                                assume hnp : ¬ p x,
                                    have hex : ∃ x, p x → r,
                                    from ⟨x, (assume hp, absurd hp hnp)⟩,
                                    show false, from hnex hex
                            )
                        ),
                        show false, from hnap hap
                    )
                ),
    ⟨left, right⟩

    -- See the book: we need the assumption that α is nonempty here (a)
    def to_unite_all_peoples : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
    have left : (∃ x, r → p x) → (r → ∃ x, p x), from
        assume h hr,
        match h with ⟨hx, hrpx⟩ :=
            ⟨hx, hrpx hr⟩
        end,
    have right : (r → ∃ x, p x) → (∃ x, r → p x), from
        assume h,
        by_contradiction (
            λ (hnex : ¬∃ x, r → p x),
            have hx : α, from a,
            have h1 : ∀ x, ¬(r → p x), from λ hx h2, hnex ⟨hx, h2⟩,
            have h2 : ¬∃ x, p x, from (
                assume hn : ∃ x, p x,
                match hn with ⟨hx, hpx⟩ :=
                    absurd (λ hr, hpx) (h1 hx)
                end
            ),
            have h3 : r → ¬∃ x, p x, from λ hr, h2,
            have h4 : r → ∀ x, ¬ p x, from λ hr, forall_not_of_not_exists $ h3 hr,
            have ¬(r → ∃ x, p x), from (
                assume h,
                or.elim (em r)
                    (λ hr,
                    absurd (h hr) (h3 hr)
                    )
                    (λ hnr,
                    have ∃ x, r → p x, from ⟨hx, λ hr, absurd hr hnr⟩,
                    show false, from absurd this hnex
                    )
            ),
            show false, from absurd h this
        ),
    ⟨left, right⟩

    -- =============
    -- === Goals ===
    -- =============

    example : (∃ x : α, r) → r := pikachu α r
    example : r → (∃ x : α, r) := raichu α a r
    example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := pichu α p r
    example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := jesse α p q

    example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := james α p
    example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := team_rocket α p
    example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := prepare_for_trouble α p
    example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := make_it_double α p

    example : (∀ x, p x → r) ↔ (∃ x, p x) → r := to_protect_the_world α p r
    -- See the book: we need the assumption that α is nonempty here (a)
    example : (∃ x, p x → r) ↔ (∀ x, p x) → r := from_devastation α p a r
    example : (∃ x, r → p x) ↔ (r → ∃ x, p x) := to_unite_all_peoples α p a r

end ex5

namespace ex6

    variables (real : Type) [ordered_ring real]
    variables (log exp : real → real)
    variable  log_exp_eq : ∀ x, log (exp x) = x
    variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
    variable  exp_pos    : ∀ x, exp x > 0
    variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

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

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

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

    theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
    log (x * y) = log x + log y :=
    calc
        log (x * y) = log (exp (log x) * exp (log y)) : by rw [exp_log_eq hx, exp_log_eq hy]
                ... = log (exp (log x + log y)) : by rw exp_add
                ... = log x + log y : by rw log_exp_eq

    -- #print log_mul

end ex6

namespace ex7

    #check sub_self

    def sub_is_add_neg (x y : ℤ) : x - y = x + (-y) := eq.refl (x - y)

    def sub_assoc (x y z: ℤ) : (y + x) - z = y + (x - z) :=
    calc
        (y + x) - z = y + x + -z : by rw sub_is_add_neg
                ... = y + (x + -z) : by rw add_assoc
                ... = y + (x - z) : by rw sub_is_add_neg

    -- See chap_5.lean for a shorter, cleaner solution
    example (x : ℤ) : x * 0 = 0 := eq.symm $
    calc
        0   = x - x : eq.symm (sub_self x)
        ... = (1 * x) - x : by rw one_mul
        ... = (x * (1 + 0)) - x : by rw [mul_comm, add_zero]
        ... = (x * 1 + x * 0) - x : by rw mul_add
        ... = x + x * 0 - x : by rw [mul_one]
        ... = (x * 0) + x - x : by rw [add_comm]
        -- "by simp" also works, but I wanted to make sure I know how to prove it manually.
        ... = x * 0 + (x - x) : by rw [sub_assoc]
        ... = x * 0 : by rw [sub_self, add_zero]

end ex7


import data.rat.basic
import data.nat.parity
import tactic.basic

open nat

noncomputable theory -- definitions are allowed to not compute in this file
open_locale classical -- use classical logic in this file

/-!
## Structures and Classes
In this session we will discuss structures together,
and then you can solve the exercises yourself.
Before we start, run the following in a terminal:
```
  cd /path/to/lftcm2020/
  git pull
  leanproject get-mathlib-cache
```
If `git pull` didn't work because you edited one of the files in the repository,
first copy the files to a backup version and then run `git checkout -- .`
(this will remove all changes to files you edited, so be careful!)
### Declaring a Structure
Structures are a way to bundle information together.
For example, the first example below makes a new structure
  `even_natural_number`, which consists of pairs, where the first
  component is a natural number, and the second component is a
  proof that the natural number is even. These are called the *fields* of the structure.
-/
structure even_natural_number : Type :=
  (n : ℕ)
  (even_n : even n)

/-! We can also group propositions together, for example this is a proposition
  stating that `n` is an even cube greater than 100.
  Note that this is a property of a natural number, while the previous structure
  was a natural number with a property "bundled" together. -/
structure is_even_cube_above_100 (n : ℕ) : Prop :=
  (even : even n)
  (is_cube : ∃ k, n = k^3)
  (gt_100 : n > 100)

/-! Here we give the upper bounds for a function `f`. We can omit the type of the structure. -/
structure bounds (f : ℕ → ℕ) :=
  (bound : ℕ)
  (le_bound : ∀ (n : ℕ), f n ≤ bound)

/-! You can use `#print` to print the type and all fields of a structure. -/
#print even_natural_number
#print is_even_cube_above_100
#print bounds

/-!
  ### Exercise 1
  * Define a structure of eventually constant sequences `ℕ → ℕ`. The first field will be
    `seq : ℕ → ℕ`, and the second field will be the statement that `seq` is eventually constant.
  * Define a structure of a type with 2 points that are unequal.
    (hint: omit the type of the structure, Lean might complain if you give it explicitly)
  Lean will not tell you if you got the right definition, but it will complain if you make a syntax
  error. If you are unsure, ask a mentor to check whether your solution is correct.
-/

structure const_seq :=
  (seq : ℕ → ℕ)
  (tends_to : ∃ N v, ∀ n ≥ N, seq n = v)

structure bipoint :=
  (A : Type*)
  (x y : A)
  (neq : x ≠ y)

/-! ### Projections of a structure -/

/-! The field names are declared in the namespace of the structure.
  This means that their names have the form `<structure_name>.<field_name>`. -/
example (n : ℕ) (hn : is_even_cube_above_100 n) : n > 100 :=
is_even_cube_above_100.gt_100 hn

/-! You can also `open` the namespace, to use the abbreviated form.
  We put this `open` command inside a section, so that the namespace
  is closed at the end of the `section`. -/
section
open is_even_cube_above_100
example (n : ℕ) (hn : is_even_cube_above_100 n) : n > 100 :=
gt_100 hn
end

/-! Another useful technique is to use *projection notation*. Instead of writing
`is_even_cube_above_100.even hn` we can write `hn.even`.
  Lean will look at the type of `hn` and see that it is `is_even_cube_above_100 n`.
  Then it looks for the lemma with the name `is_even_cube_above_100.even` and apply it to `hn`. -/
example (n : ℕ) (hn : is_even_cube_above_100 n) : even n :=
hn.even

example (n : ℕ) (hn : is_even_cube_above_100 n) : even n ∧ ∃ k, n = k^3 :=
⟨ hn.even, hn.is_cube ⟩

/-! You can also use `.1`, `.2`, `.3`, ... for the fields of a structure. -/
example (n : ℕ) (hn : is_even_cube_above_100 n) : even n ∧ n > 100 ∧ (∃ k, n = k^3) :=
⟨ hn.1, hn.3, hn.2 ⟩

/-! We could have alternatively stated `is_even_cube_above_100`
  as a conjunction of three statements, as below.
  That gives the same proposition, but doesn't give a name to the three components. -/
def is_even_cube_above_100' (n : ℕ) : Prop :=
even n ∧ (∃ k, n = k^3) ∧ n > 100

/-! If we have a structure that mixes data (elements of types, like `ℕ`, `ℝ`, and so on) and
  properties of the data, we can alternatively declare them using *subtypes*.
  This consists of pairs of a natural number and a proof that the natural number is even. -/
def even_natural_number' : Type :=
{ n : ℕ // even n }

/-! The notation for subtypes is almost the same as the notation for set comprehension.
 Note that `//` is used for subtypes, and `|` is used for sets. -/
def set_of_even_natural_numbers : set ℕ :=
{ n : ℕ | even n }

/-! We can construct objects of a structure using the *anonymous constructor* `⟨...⟩`.
  This can construct an object of any structure, including conjunctions,
  existential statements and subtypes. -/
example : even_natural_number → even_natural_number' :=
λ n, ⟨n.1, n.2⟩

example (n : ℕ) : is_even_cube_above_100 n → is_even_cube_above_100' n :=
λ hn, ⟨hn.even, hn.is_cube, hn.gt_100⟩

/-! An alternative way is to use the *structure notation*. The syntax for this is
  ```
    { structure_name . field1_name := value, field2_name := value, ... }
  ```
  You can prove the fields in any order you want.
-/
example : even_natural_number' → even_natural_number :=
λ n,
{ even_natural_number .
  n      := n.1,
  even_n := n.2 }

/-! The structure name is optional if the structure in question is clear from context. -/
example (n : ℕ) : is_even_cube_above_100' n → is_even_cube_above_100 n :=
λ ⟨h1n, h2n, h3n⟩,
{ even    := h1n,
  is_cube := h2n,
  gt_100  := h3n }

/-!
  ### Exercise 2
  * Define `bounds` (given above) again, but now using a the subtype notation `{ _ : _ // _ }`.
  * Define functions back and forth from the structure `bounds` given above and `bounds` given here.
    Try different variations using the anonymous constructor and the projection notation.
-/
#print bounds

def bounds' (f : ℕ → ℕ) : Type :=
{ n : ℕ // ∀ m : ℕ, f m ≤ n}

example (f : ℕ → ℕ) : bounds f → bounds' f :=
 λ n, ⟨n.1, n.2⟩

/- In the example below, replace the `sorry` by an underscore `_`.
  A small yellow lightbulb will appear. Click it, and then select
  `Generate skeleton for the structure under construction`.
  This will automatically give an outline of the structure for you. -/
example (f : ℕ → ℕ) : bounds' f → bounds f :=
λ n, { bound := n.1,
  le_bound := n.2 }

/-! Before you continue, watch the second pre-recorded video. -/

/-! ### Classes
Classes are special kind of types or propositions that Lean will automatically find inhabitants for.
You can declare a class by giving it the `@[class]` attribute.
As an example, in this section, we will implement square root on natural numbers, that can only be
applied to natural numbers that are squares. -/
@[class] def is_nat_square (n : ℕ) : Prop := ∃k : ℕ, k^2 = n

namespace is_nat_square

/-! Hypotheses with a class as type should be written in square brackets `[...]`.
This tells Lean that they are implicit, and Lean will try to fill them in automatically.
We define the square root as the (unique) number `k` such that `k^2 = n`. Such `k` exists by the
`is_nat_square n` hypothesis. -/
def sqrt (n : ℕ) [hn : is_nat_square n] : ℕ := classical.some hn

prefix `√`:(max+1) := sqrt -- notation for `sqrt`

/-! The following is the defining property of `√n`. Note that when we write `√n`,
Lean will automatically insert the implicit argument `hn` it found it the context.
This is called *type-class inference*.
We mark this lemma with the `@[simp]` attribute to tell `simp` to simplify using this lemma. -/
@[simp] lemma square_sqrt (n : ℕ) [hn : is_nat_square n] : (√n) ^ 2 = n :=
classical.some_spec hn

/-! ### Exercise:
  Fill in all `sorry`s in the remainder of this section.
-/

/-! Prove this lemma. Again we mark it `@[simp]` so that `simp` can simplify
  equalities involving `√`. Also, hypotheses in square brackets do not need a name.
  Hint: use `pow_left_inj` -/
@[simp] lemma sqrt_eq_iff (n k : ℕ) [is_nat_square n] : √n = k ↔ n = k^2 :=
begin
  split,
  { intro h, rw ←h, rw square_sqrt,},
  { intro h, convert (pow_left_inj (by from zero_le √n) (by from zero_le k) (by norm_num : 0 < 2)).mp _,
    rw square_sqrt, from h,}
end

/-! To help type-class inference, we have to tell it that some numbers are always squares.
  Here we show that `n^2` is always a square. We mark it as `instance`, which is like
  `lemma` or `def`, except that it is automatically used by type-class inference. -/
instance square_square (n : ℕ) : is_nat_square (n^2) :=
⟨n, rfl⟩

lemma sqrt_square (n : ℕ) : √(n ^ 2) = n :=
by simp

/-! Instances can depend on other instances: here we show that if `n` and `m` are squares, then
`n * m` is one, too.
When writing `√n`, Lean will use a simple search algorithm to find a proof that `n` is a square, by
repeatedly applying previously declared instances, and arguments in the local context. -/
instance square_mul (n m : ℕ) [is_nat_square n] [is_nat_square m] : is_nat_square (n*m) :=
⟨√n * √m, by simp [mul_pow]⟩

/-! Hint: use `mul_pow` -/
#check mul_pow
lemma sqrt_mul (n m : ℕ) [is_nat_square n] [is_nat_square m] : √(n * m) = √n * √m :=
begin
   simp [mul_pow],
end

/-! Note that Lean automatically inserts the proof that `n * m ^ 2` is a square,
  using the previously declared instances. -/
example (n m : ℕ) [is_nat_square n] : √(n * m ^ 2) = √n * m :=
begin
  simp [mul_pow],
end

/-! Hint: use `nat.le_mul_self` and `pow_two` -/
#check nat.le_mul_self
#check pow_two
lemma sqrt_le (n : ℕ) [is_nat_square n] : √n ≤ n :=
begin
  conv_rhs { rw [←square_sqrt n, pow_two], }, apply nat.le_mul_self,
end

end is_nat_square

/- At this point, feel free do the remaining exercises in any order. -/

/-! ### Exercise: Bijections and equivalences -/

section bijections

open function

variables {α β : Type*}

/-
An important structure is the type of equivalences, which gives an equivalence (bijection)
between two types:
```
structure equiv (α β : Type*) :=
(to_fun    : α → β)
(inv_fun   : β → α)
(left_inv  : left_inverse inv_fun to_fun)
(right_inv : right_inverse inv_fun to_fun)
```
In this section we show that this is the same as the bijections from `α` to `β`.
-/
#print equiv

structure bijection (α β : Type*) :=
  (to_fun : α → β)
  (injective : injective to_fun)
  (surjective : surjective to_fun)

/- We declare a *coercion*. This allows us to treat `f` as a function if `f : bijection α β`. -/
instance : has_coe_to_fun (bijection α β) (λ _, α → β) :=
⟨λ f, f.to_fun⟩

/-! To show that two bijections are equal, it is sufficient that the underlying functions are
  equal on all inputs. We mark it as `@[ext]` so that we can later use the tactic `ext` to show that
  two bijections are equal. -/
@[ext] def bijection.ext {f g : bijection α β} (hfg : ∀ x, f x = g x) : f = g :=
by { cases f, cases g, congr, ext, exact hfg x }

/-! This lemma allows `simp` to reduce the application of a bijection to an argument. -/
@[simp] lemma coe_mk {f : α → β} {h1f : injective f} {h2f : surjective f} {x : α} :
  { bijection . to_fun := f, injective := h1f, surjective := h2f } x = f x := rfl

/- There is a lemma in the library that almost states this.
  You can use the tactic `suggest` to get suggested lemmas from Lean
  (the one you want has `bijective` in the name). -/
def equiv_of_bijection (f : bijection α β) : α ≃ β :=
  equiv.of_bijective f ⟨f.injective, f.surjective⟩

def bijection_of_equiv (f : α ≃ β) : bijection α β :=
  {
    to_fun := f,
    injective := f.injective,
    surjective := f.surjective,
  }

/-! Show that bijections are the same (i.e. equivalent) to equivalences. -/
def bijection_equiv_equiv : bijection α β ≃ (α ≃ β) :=
{
  to_fun := equiv_of_bijection,
  inv_fun := bijection_of_equiv,
  left_inv := by {intro f, ext, simp [bijection_of_equiv, equiv_of_bijection]},
  right_inv := by {intro f, ext, simp [bijection_of_equiv, equiv_of_bijection]},
}
end bijections

/-! ### Exercise: Bundled groups -/

/-! Below is a possible definition of a group in Lean.
  It's not the definition we use use in mathlib. The actual definition uses classes,
  and will be explained in detail in the next session. -/

structure Group :=
  (G : Type*)
  (op : G → G → G)
  (infix * := op) -- temporary notation `*` for `op`, just inside this structure declaration
  (op_assoc' : ∀ (x y z : G), (x * y) * z = x * (y * z))
  (id : G)
  (notation 1 := id) -- temporary notation `1` for `id`, just inside this structure declaration
  (id_op' : ∀ (x : G), 1 * x = x)
  (inv : G → G)
  (postfix ⁻¹ := inv) -- temporary notation `⁻¹` for `inv`, just inside this structure declaration
  (op_left_inv' : ∀ (x : G), x⁻¹ * x = 1)

/-! You can use the `extend` command to define a structure that adds fields
  to one or more existing structures. -/
structure CommGroup extends Group :=
  (infix * := op)
  (op_comm : ∀ (x y : G), x * y = y * x)

/- Here is an example: the rationals form a group under addition. -/
def rat_Group : Group :=
{ G := ℚ,
  op := (+), -- you can put parentheses around an infix operation to talk about the operation itself.
  op_assoc' := add_assoc,
  id := 0,
  id_op' := zero_add,
  inv := λ x, -x,
  op_left_inv' := neg_add_self }

/-- You can extend an object of a structure by using the structure notation and using
  `..<existing object>`. -/
def rat_CommGroup : CommGroup :=
{ G := ℚ, op_comm := add_comm, ..rat_Group }

namespace Group

variables {G : Group} /- Let `G` be a group -/

/- The following line declares that if `G : Group`, then we can also view `G` as a type. -/
instance : has_coe_to_sort Group (Type*) := ⟨Group.G⟩
/- The following lines declare the notation `*`, `⁻¹` and `1` for the fields of `Group`. -/
instance : has_mul G := ⟨G.op⟩
instance : has_inv G := ⟨G.inv⟩
instance : has_one G := ⟨G.id⟩

/- the axioms for groups are satisfied -/
lemma op_assoc (x y z : G) : (x * y) * z = x * (y * z) := G.op_assoc' x y z

lemma id_op (x : G) : 1 * x = x := G.id_op' x

lemma op_left_inv (x : G) : x⁻¹ * x = 1 := G.op_left_inv' x

/- Use the axioms `op_assoc`, `id_op` and `op_left_inv` to prove the following lemma.
  The fields `op_assoc'`, `id_op'` and `op_left_inv'` should not be used directly, nor can you use
  any lemmas from the library about `mul`. -/
lemma eq_id_of_op_eq_self {G : Group} {x : G} : x * x = x → x = 1 :=
begin
  intro h, rw [←id_op x, ←op_left_inv x, op_assoc, h],
end

/- Apply the previous lemma to show that `⁻¹` is also a right-sided inverse. -/
lemma op_right_inv {G : Group} (x : G) : x * x⁻¹ = 1 :=
begin
  apply eq_id_of_op_eq_self,
  rw [op_assoc, ←op_assoc x⁻¹, op_left_inv, id_op],
end

/- we can prove that `1` is also a right identity. -/
lemma op_id {G : Group} (x : G) : x * 1 = x :=
begin
  rw [←op_left_inv x, ←op_assoc, op_right_inv, id_op],
end

/-!
  However, it is inconvenient to use this group instance directly.
  One reason is that to use these group operations we now have to write
  `(x y : rat_Group)` instead of `(x y : ℚ)`.
  That's why in Lean we use classes for algebraic structures,
  explained in the next lecture.
-/

/- show that the cartesian product of two groups is a group. The underlying type will be `G × H`. -/

def prod_Group (G H : Group) : Group :=
{
  G := G × H,
  op := λ p q, (G.op p.1 q.1, H.op p.2 q.2),
  op_assoc' := by { dsimp, intros x y z, ext,
                rw G.op_assoc', rw H.op_assoc',},
  id := (G.id, H.id),
  id_op' := by {dsimp, intro x, ext,
                rw G.id_op', rw H.id_op'},
  inv := λ p, (G.inv p.1, H.inv p.2),
  op_left_inv' := by { dsimp, intro x, ext,
                      rw G.op_left_inv', rw H.op_left_inv',},
}

end Group

/-! ### Exercise: Pointed types -/

structure pointed_type :=
(type : Type*)
(point : type)

namespace pointed_type
variables {A B : pointed_type}

/- The following line declares that if `A : pointed_type`, then we can also view `A` as a type. -/
instance : has_coe_to_sort pointed_type (Type* ):= ⟨pointed_type.type⟩

/- The product of two pointed types is a pointed type.
  The `@[simps point]` is a hint to `simp` that it can unfold the point of this definition. -/
@[simps point]
def prod (A B : pointed_type) : pointed_type :=
{ type := A × B,
  point := (A.point, B.point) }

end pointed_type

structure pointed_map (A B : pointed_type) :=
(to_fun : A → B)
(to_fun_point : to_fun A.point = B.point)

namespace pointed_map

infix ` →. `:25 := pointed_map

variables {A B C D : pointed_type}
variables {h : C →. D} {g : B →. C} {f f₁ f₂ : A →. B}

instance : has_coe_to_fun (A →. B) (λ _, A → B) := ⟨pointed_map.to_fun⟩

@[simp] lemma coe_mk {f : A → B} {hf : f A.point = B.point} {x : A} :
  { pointed_map . to_fun := f, to_fun_point := hf } x = f x := rfl
@[simp] lemma coe_point : f A.point = B.point := f.to_fun_point

@[ext] protected lemma ext (hf₁₂ : ∀ x, f₁ x = f₂ x) : f₁ = f₂ :=
begin
  cases f₁ with f₁ h1, cases f₂ with f₂ h2, congr, ext x, from hf₁₂ x,
end

/-! Below we show that pointed types form a category. -/

def comp (g : B →. C) (f : A →. B) : A →. C :=
{
  to_fun := λ x, g.to_fun (f.to_fun x),
  to_fun_point := by rw [f.to_fun_point, g.to_fun_point],
}

def id : A →. A :=
{
  to_fun := λ x, x,
  to_fun_point := by simp,
}

/-! You can use projection notation for any declaration declared in the same namespace as the
  structure. For example, `g.comp f` means `pointed_map.comp g f` -/
lemma comp_assoc : h.comp (g.comp f) = (h.comp g).comp f :=
begin
  ext x, refl,
end

lemma id_comp : f.comp id = f :=
begin
  ext x, refl,
end

lemma comp_id : id.comp f = f :=
begin
  ext x, refl,
end

/-! Below we show that `A.prod B` (that is, `pointed_type.prod A B`) is a product in the category of
  pointed types. -/

def fst : A.prod B →. A :=
{
  to_fun := λ p, p.1,
  to_fun_point := by {simp [pointed_type.prod],},
}

def snd : A.prod B →. B :=
{
  to_fun := λ p, p.2,
  to_fun_point := by {simp [pointed_type.prod],},
}

def pair (f : C →. A) (g : C →. B) : C →. A.prod B :=
{
  to_fun := λ c, (f.to_fun c, g.to_fun c),
  to_fun_point := by {simp [pointed_type.prod, f.to_fun_point, g.to_fun_point],},
}

lemma fst_pair (f : C →. A) (g : C →. B) : fst.comp (f.pair g) = f :=
begin
  ext x, refl,
end

lemma snd_pair (f : C →. A) (g : C →. B) : snd.comp (f.pair g) = g :=
begin
  ext x, refl,
end

lemma pair_unique (f : C →. A) (g : C →. B) (u : C →. A.prod B) (h1u : fst.comp u = f)
  (h2u : snd.comp u = g) : u = f.pair g :=
begin
  ext x,
  { have : fst (u x) = f x, { rw [←h1u], simpa [comp],}, simpa using this,},
  { have : snd (u x) = g x, { rw [←h2u], simpa [comp],}, simpa using this,},
end

end pointed_map

/-! As an advanced exercise, you can show that the category of pointed type has coproducts.
  For this we need quotients, the basic interface is given with the declarations
  `quot r`: the quotient of the equivalence relation generated by relation `r` on `A`
  `quot.mk r : A → quot r`,
  `quot.sound`
  `quot.lift` (see below)
  -/

#print quot
#print quot.mk
#print quot.sound
#print quot.lift

open sum

/-! We want to define the coproduct of pointed types `A` and `B` as the coproduct `A ⊕ B` of the
  underlying type, identifying the two basepoints.
  First define a relation that *only* relates `inl A.point ~ inr B.point`.
-/
def coprod_rel (A B : pointed_type) : (A ⊕ B) → (A ⊕ B) → Prop :=
  λ x y, x = inl A.point ∧ y = inr B.point

namespace pointed_type

-- @[simps point]

def coprod (A B : pointed_type) : pointed_type :=
{
  type := quot (coprod_rel A B),
  point := quot.mk _ (inl A.point),
}

end pointed_type

namespace pointed_map

variables {A B C D : pointed_type}

def inl : A →. A.coprod B :=
{
  to_fun := λ x, quot.mk _ (inl x),
  to_fun_point := by {refl},
}

def inr : B →. A.coprod B :=
{
  to_fun := quot.mk _ ∘ sum.inr,
  to_fun_point := by { refine (quot.sound _).symm, from ⟨rfl, rfl⟩, },
}

end pointed_map


open nat

inductive ev : ℕ → Prop
| ev_0 : ev 0
| ev_SS : ∀ n : ℕ, ev n → ev (succ (succ n))

open ev

-- Exercise: 1 star (ev_double)
theorem ev_double : ∀ n, ev (2 * n) :=
λ n, nat.rec_on n
  (by rw mul_zero; constructor)
  (λ k ih,
    begin
      rw [two_mul, add_succ, succ_add],
      constructor,
      rwa [←two_mul]
    end)

theorem ev_minus2 : ∀ n, ev n → ev (pred (pred n)) :=
begin
  intros n h,
  cases h with n h₁,
    rwa [pred_zero, pred_zero],
    rwa [pred_succ, pred_succ]
end

-- Exercise: 1 star (SSSSev__even)
theorem SSSSev_even : ∀ n, ev (succ (succ (succ (succ n)))) → ev n :=
begin
  introv h,
  induction n with n' ih,
    constructor,
    cases h with _ h,
    cases h with _ h,
    assumption
end

-- Exercise: 4 stars, advanced (subsequence)
inductive subseq {α : Type} : list α → list α → Prop
| nil : ∀ (l : list α), subseq [] l
| cons₁ : ∀ (x : α) (l₁ l₂ : list α), subseq l₁ l₂ → subseq (x :: l₁) (x :: l₂)
| cons₂ : ∀ (x : α) (l₁ l₂ : list α), subseq l₁ l₂ → subseq l₁ (x :: l₂)

section subseq
variables {α : Type} (l₁ l₂ : list α)

theorem subseq_refl : reflexive (@subseq α) :=
begin
  unfold reflexive,
  intro l,
  induction l with a l' ih,
    constructor,
    exact (subseq.cons₁ a l' l' ih)
end

end subseq


/-
CS 2120 F22 Homework #4. Due Oct 13.
-/

/- #1A [10 points]

Write a formal proposition stating that
logical and (∧) is associative. That is,
for arbitrary propositions, P, Q, and R,
P ∧ (Q ∧ R) is true *iff* (P ∧ Q) ∧ R is,
too. Replace the placeholder (_) with your
answer.
-/

def and_associative : Prop :=
  ∀ (P Q R : Prop),
    (P ∧ Q) ∧ R ↔ P ∧ (Q ∧ R)

/- #1B [10 points]

Give an English language proof. Identify
the inference rules of predicate logic
that you use in your reasoning.
-/

/-
Answer:
-/

/- #1C [5 points]

Give a formal proof of the proposition.
Hint: unfold and_associative to start.
-/

theorem and_assoc_true : and_associative :=
begin
unfold and_associative,
assume P Q R,
apply iff.intro _ _,

-- forward
assume h,

/-
let pq : P ∧ Q := and.elim_left h,
let r : R := and.elim_right h,
let p : P := and.elim_left pq,
let q : Q := and.elim_right pq,
-/

cases h with pq r,
cases pq with p q,

/-
apply and.intro _ _,
cases h with pq r,
cases pq with p q,
exact p,
apply and.intro _ _,
exact and.elim_right(and.elim_left h),
exact (and.elim_right h),
-/

/-
cases h with pq r,
cases pq with p q,
-/
apply and.intro p (and.intro q r),

-- Reverse
assume h,
cases h with p qr,
cases qr with q r,
exact (and.intro (and.intro p q) r),
end

/- #2A [10 points]

Write the proposition that ∨ is associative.,
analogous to the proposition about ∧ in #1.
-/

def or_associative : Prop :=
  ∀ (P Q R : Prop), P ∨ (Q ∨ R) ↔ (P ∨ Q) ∨ R

/- #2B [10 points]

Write an English language proof of it, citing
the specific inference rules you use in your
reasoning.
-/

/- #2C [5 points]

Complete the following formal proof.
-/

theorem or_associative_true : or_associative :=
begin
unfold or_associative,
assume P Q R,

apply iff.intro _ _,

-- forward
assume h,
apply or.elim h _ _,

-- case P
assume p,
apply or.inl _,
exact (or.inl p),

-- case Q or R
assume qr,
apply or.elim qr _ _,

-- case Q
assume q,
apply or.inl _,
exact (or.inr q),

-- case R
assume r,
apply or.inr r,

-- reverse

-- TO DO

end

/- #3A [10 points]
Write a formal statement of the proposition.
-/

def arrow_transitive : Prop :=
  ∀ (P Q R : Prop), (P → Q) → (Q → R) → (P → R)

/- #3B [10 points]

Write an English language proof of the proposition
that for any propositions, X, Y, and X, it's the
case that (X → Y) → (Y → Z) → (X → Z). In other
words, implication is "transitive." Hint: Recall
that if you have a proof of, say, X → Y, and you
have a proof of X, you can derive a proof of Y by
arrow elimination. Think of it as applying a proof
of an implication to a proof of its premise to get
yourself a proof of its conclusion.
-/

/- #3C [5 points].
Write a formal proof of it.
-/

example : arrow_transitive :=
begin
  unfold arrow_transitive,
  assume P Q R,
  assume pq : P → Q,
  assume qr : Q → R,
  assume p : P,
  let q : Q := (pq p),
  let r : R := (qr q),
  -- assumption,
  -- apply r,
  exact r,
end

/- #4
Suppose that if it's raining then the streets
are wet. This problem requires you to prove that
if the streets are not wet then it's not raining.
-/

/- #4A [10 points]

Start by writing the proposition in predicate
logic by completing the following answer.
-/

def contrapositive : Prop :=
  ∀ (Raining Wet : Prop),
    (Raining → Wet) → (¬Raining → ¬Wet)

/-
The proposition defined here isn't valid. It's
one of the classical fallacies, one that we saw
starting with propositional logic. Contrapositive
says if (R → W) → (¬W → ¬R). Consider a concrete
case: If whenever it rains R, the streets are wet
(W), then if the streets are not wet (¬W) then it
must not be raining (¬R).
-/

def contrapositive_corrected : Prop :=
  ∀ (Raining Wet : Prop),
    (Raining → Wet) → (¬Wet → ¬Raining)

/- #4B [10 points].
-/

theorem contrapositive_valid : contrapositive_corrected :=
begin
unfold contrapositive_corrected,
assume R W h,
assume nw,
assume r,
let w := h r,
contradiction,
end

/- #4C [5 points].

Give an English language proof of it.
-/

/- #5. Extra credit.

Complete the following formal proof of the
proposition that if for any proposition P,
P ∨ ¬P is true, then for any propositions,
X and Y, if it's not the case that X or Y
is true then it is the case that ¬X and ¬Y
is true.
-/

theorem demorgan1 :
  (∀ (P : Prop), P ∨ ¬ P) →
    ∀ (X Y : Prop),
      ¬(X ∨ Y) → (¬X ∧ ¬Y) :=
begin
assume em X Y nxory,
cases (em X) with x nx,

-- case where X is true
let xory : X ∨ Y := or.inl x,
contradiction,

-- case where X is false
cases (em Y) with y ny,

  -- case where Y is true
let xory : X ∨ Y := or.inr y,
contradiction,

  -- case where Y is false
apply and.intro nx ny,

end

/- OPTIONAL, NOT NECESSARY FOR MIDTERM EXAM

A comment on or.intro_left and or.intro_right.
In Lean each of these takes two arguments: a
proof of the disjunct -- the proposition on
one side of the ∨ -- that is to be proven true,
*and* it takes as an argument the proposition
that is not being proven true. In applications
of these rules the proposition argument (not
being proven) comes first, while the proof
argument comes second.

The reason is that Lean needs to know what
overall proposition is being proved. From the
proof argument it can infer the proposition
being proved, but it needs the other proposition
as well to know the full (X ∨ Y) disjunction to
be proved.

Here's an example:
-/

example : 0 = 0 ∨ 0 = 1 :=
begin
apply or.intro_left (0 = 1) rfl
/-
The "rfl" serves as a proof of 0=0.
But in addition, as the first argument
to or.intro, we need to provide the
*proposition* that is not being proved.
Here's that's (0 = 1). In contexts
where Lean can infer both disuncts,
you can use the simpler or.inl or
or.inr, each of which just takes one
argument: a proof of the left or of
the right side, respectively.
-/
end


-- vim: ts=2 sw=0 sts=-1 et ai tw=70

import .prime
import .induction

namespace hidden

namespace mynat

def even (m: mynat) := 2 ∣ m
def odd (m: mynat) := ¬even m

variables {m n k p: mynat}

theorem even_zero: even 0 :=
begin
  existsi (0: mynat),
  simp,
end

theorem odd_one: odd 1 :=
begin
  assume he1,
  have h21 := dvd_one he1,
  cases h21,
end

theorem two_only_even_prime: prime m → 2 ∣ m → m = 2 :=
begin
  assume hmpm h2dm,
  cases h2dm with n hn,
  cases m,
  rw zz at *,
  exfalso, from zero_nprime hmpm,
  have hndvds: n ∣ succ m,
    rw hn,
    apply dvd_mul, refl,
  cases hmpm with hsneq1 hdiv,
  have h₂ := hdiv n hndvds,
  cases h₂,
    rw [h₂, one_mul] at hn,
    assumption,
  exfalso,
  rw h₂ at hn,
  have hcancel :=
    mul_cancel_to_one succ_ne_zero,
  cases hcancel hn,
end

theorem even_add_even:
even m → even n → even (m + n) :=
begin
  assume hm hn,
  from dvd_sum hm hn,
end

theorem even_remainder (m k n : mynat):
even m → even n → m + k = n → even k :=
begin
  assume hm hn h,
  from dvd_remainder _ _ _ _ hm hn h,
end

theorem even_add_odd:
even m → odd n → odd (m + n) :=
begin
  assume hm hn heven,
  have : even n, {
    apply even_remainder m n (m + n) hm heven,
    refl,
  },
  contradiction,
end

theorem odd_add_even:
odd m → even n → odd (m + n) :=
begin
  assume hom hen,
  rw add_comm,
  from even_add_odd hen hom,
end

theorem succ_even_is_odd: even m → odd (succ m) :=
begin
  assume hem hesm,
  cases hem with a ha,
  cases hesm with b hb,
  rw ha at hb,
  have he1: even 1, {
    have h2dvda2: 2 ∣ a * 2 := dvd_multiple,
    have h2dvdb2: 2 ∣ b * 2 := dvd_multiple,
    from dvd_remainder _ 1 _ _ h2dvda2 h2dvdb2 hb,
  },
  from odd_one he1,
end

theorem odd_periodic: odd m ↔ odd (m + 2) :=
begin
  split, {
    assume hom hem2,
    from hom (dvd_cancel hem2),
  }, {
    assume hom2 hem,
    from hom2 (dvd_add hem),
  },
end

theorem even_periodic: even m ↔ even (m + 2) :=
begin
  split, {
    assume hem,
    from dvd_add hem,
  }, {
    assume hem2,
    from dvd_cancel hem2,
  },
end

-- is this overkill?
theorem succ_odd_is_even: odd m → even (succ m) :=
begin
  assume hom,
  apply strong_induction  (λ m, odd m → even (succ m)), {
    assume ho0,
    exfalso,
    from ho0 even_zero,
  }, {
    intro n,
    assume h_ih,
    assume hosn,
    cases n, {
      existsi (1: mynat),
      refl,
    }, {
      have hon := odd_periodic.mpr hosn,
      have hesn := h_ih n (le_to_add: n ≤ n + 1) hon,
      from even_periodic.mp hesn,
    },
  },
  assumption,
end

instance even_decidable: ∀ m : mynat, decidable (even m) :=
begin
  intro m,
  induction m with m hm, {
    from is_true even_zero,
  }, {
    cases hm, {
      from is_true (succ_odd_is_even hm),
    }, {
      from is_false (succ_even_is_odd hm),
    },
  },
end

theorem cancel_succ_even: even (succ m) → odd m :=
begin
  assume hesm,
  cases m, {
    exfalso,
    from odd_one hesm,
  }, {
    apply succ_even_is_odd,
    rw even_periodic,
    assumption,
  },
end

theorem cancel_succ_odd: odd (succ m) → even m :=
begin
  assume hosm,
  cases m, {
    from even_zero,
  }, {
    apply succ_odd_is_even,
    rw odd_periodic,
    assumption,
  },
end

theorem odd_periodic_lots: even m → odd (n + m) → odd n :=
begin
  assume hem honm hen,
  from honm (even_add_even hen hem),
end

theorem even_periodic_lots: even m → even (n + m) → even n :=
begin
  assume hem honm,
  cases hem with k hk,
  rw hk at honm,
  rw mul_comm at honm,
  from dvd_cancel_lots honm,
end

theorem odd_add_odd: odd m → odd n → even (m + n) :=
begin
  assume hom hon,
  have hesm := succ_odd_is_even hom,
  have hesn := succ_odd_is_even hon,
  have hesmsn := even_add_even hesm hesn,
  simp at hesmsn,
  rw even_periodic,
  from hesmsn,
end

theorem even_mul: even m → even (m * n) :=
begin
  assume hm,
  cases hm with a ha,
  existsi a * n,
  rw ha,
  ac_refl,
end

theorem even_mul_even: even m → even n → even (m * n) :=
begin
  assume hem _,
  from even_mul hem,
end

theorem odd_mul_odd:
odd m → odd n → odd (m*n) :=
begin
  assume hom hon heven,
  have hesm := succ_odd_is_even hom,
  have hesn := succ_odd_is_even hon,
  have hesmsn := even_mul_even hesm hesn,
  rw mul_succ at hesmsn,
  rw succ_mul at hesmsn,
  rw succ_add at hesmsn,
  have homn := cancel_succ_even hesmsn,
  rw ←add_assoc at homn,
  have hemn: even (m + n), {
    have hesmpsn := even_add_even hesm hesn,
    simp at hesmpsn,
    from even_periodic.mpr hesmpsn,
  },
  rw add_comm m at homn,
  rw add_assoc at homn,
  have homn' := odd_periodic_lots hemn homn,
  from homn' heven,
end

-- basically we can do excluded middle without any of the classical
theorem even_square: even (m * m) → even m :=
begin
  by_cases (even m), {
    assume _,
    assumption,
  }, {
    assume hem2,
    exfalso,
    from odd_mul_odd h h hem2,
  },
end

-- this is awful
theorem sqrt_2_irrational: ¬(m ≠ 0 ∧ ∃ n, n * n = 2 * m * m) :=
begin
  -- for some reason this is a recurring lemma here
  -- is there some way to just do this inline?
  have h20: (2: mynat) ≠ 0, {
    assume h, cases h,
  },
  apply infinite_descent (λ m, m ≠ 0 ∧ ∃ n, n * n = 2 * m * m),
  intro k,
  assume h_desc,
  cases h_desc with hknz h_desc,
  cases h_desc with n hn2k2,
  -- this also comes up a lot
  have hnn0: n ≠ 0, {
    assume hn0,
    simp [hn0] at hn2k2,
    rw mul_comm at hn2k2,
    rw mul_comm 2 at hn2k2,
    from h20 (mul_integral hknz (mul_integral hknz hn2k2.symm)),
  },
  have h2dvdn: 2 ∣ n, {
    have h2dvdn2: 2 ∣ n * n, {
      existsi k * k,
      rw hn2k2,
      ac_refl,
    },
    from even_square h2dvdn2,
  },
  cases h2dvdn with k' hk',
  existsi k',
  split, split, {
    assume hk'0,
    simp [hk'0] at hk',
    from hnn0 hk',
  }, {
    rw hk' at hn2k2,
    existsi k,
    apply mul_cancel h20,
    rw [←mul_assoc, ←hn2k2],
    rw mul_comm 2 _,
    conv {
      to_rhs,
      rw mul_assoc,
      congr,
      rw mul_comm,
    },
  }, {
    conv at hn2k2 {
      rw hk',
      congr,
        rw mul_comm k',
        rw mul_assoc,
        skip,
      rw mul_assoc,
    },
    have h₂ := mul_cancel h20 hn2k2,
    conv at h₂ {
      to_lhs,
      rw [mul_comm, mul_assoc],
    },
    suffices : k'*k' < k*k, {
      apply lt_sqrt this,
    },
    -- TODO: write a separate theorem here
    assume hk2k'2,
    cases hk2k'2 with d hd,
    rw hd at h₂,
    have hk2e0: k * k = 0, {
      have h211: (2: mynat) = 1 + 1, refl,
      rw [h211, add_mul, one_mul, add_assoc] at h₂,
      have h' := add_cancel_to_zero h₂.symm,
      rw [add_comm, add_assoc] at h',
      from add_integral h',
    },
    from hknz (mul_integral hknz hk2e0),
  },
end

end mynat

end hidden


/-
We can import definitions from another
file. Here we import our definitions from
the mynat.lean file. The dot (.) tells
Lean to look for that file in the same
directory  as this file.
-/
import .mynat

/-
Open the mynat namespace (in that file)
so that we don't have to prefix names
with mynat.
-/
open mynat

-- Create a namespace for this file
namespace my_list_adt

/-
We now introduce a type of "lists that
contain objects of some other type, T."
For example, an object of type "my_list
ℕ" would represent a list of value of
type ℕ, while an object of type "my_list
bool" would represent a list of values
of type bool. Here's the "inductive"
declaration. Notice that, in constrast
to nat and bool, this declaration has
a parameter, T.
-/

inductive my_list (T: Type) : Type

/-
Now think about the type of my_list. Its
type is Type → Type. We call my_list a
type constructor or a polymorphic type.
It takes a type as an argument and then
returns a type, specialized for elements
of the given type, as a result.

Generic types in Java and template types
in C++ similarly take type parameters and
yield new types specialized for handling
of values of the specified argument type.

Now we give the constructors for our
polymorphic type. The first one, my_nil,
is a constant term of type (my_list T).
We will interpret it as representing the
"empty list of values of type T.""
-/

| nil: my_list

/-
And here's the interesting part. We now
provide my_cons as a constructor used to
produce a bigger list from a given list
by tacking a new value onto its front.

The constructor takes a value, h (short
for "head"), of type T, the value to be
tacked on; and then it takes a value, t
(short for tail), the smaller list onto
which h will be tacked. The result is a
new my_list, represented by the term,
(my_cons h t), which we interpret as the
list starting with h as the value at its
head, wand ith the whole smaller list,
t, as its tail (the rest of the list).
-/

| cons: T → my_list → my_list

open my_list

/-
EXAMPLES:
* list of mynat
* list of ℕ
* list of bool
-/

-- some lists of mynat values

def empty_mynat_list : my_list mynat :=
    (nil mynat) -- []

#reduce empty_mynat_list

def zero_mynat_list :=
    (cons zero empty_mynat_list) -- [0]

#reduce zero_mynat_list

def one_mynat_list :=
    (cons one zero_mynat_list) -- [1,0]

#reduce one_mynat_list

def two_mynat_list :=
    (cons two one_mynat_list) -- [2,1,0]

-- A list of ℕ values! [2,1,0]

def two_nat_list :=
    (cons 2
    (cons 1
    (cons 0
    (nil ℕ))))

#reduce two_nat_list

-- A list of bool values [tt,ff,tt]

def a_bool_list :=
    (cons tt
    (cons ff
    (cons tt
    (nil bool))))

/-
Adding functions to our algebra
-/

-- If list is empty return true else false
def isNil { T : Type } (l : my_list T) : bool :=
    match l with
    | (nil T) := tt
    | _ := ff
    end

#reduce isNil a_bool_list
#reduce isNil empty_mynat_list

/-
Note that T is an implicit parameter here. Lean
can infer T from l.
-/

-- Length of l. A recursive function.
def length : ∀ { T : Type }, my_list T → ℕ
| _ (nil T) := 0
| _ (cons h t) := 1 + (length t)

/-
In the pattern matches here, Lean requires
that we match on both arguments, but we do
not want to give a new name to T, so we use
_ as a wildcard. We can then use the T that
is declared on the first line as a value in
the pattern for the nil list.
-/

#reduce length empty_mynat_list
#reduce length a_bool_list

-- Append two lists

def append :
    ∀ { T : Type },
        my_list T → my_list T → my_list T
| _ (nil T) l2 := l2
| _ (cons h t) l2 := cons h (append t l2)

#reduce a_bool_list
#reduce append a_bool_list a_bool_list

/-
PROOFS!
-/

-- Here's one, no induction needed
theorem nil_append_left_zero :
    ∀ { T : Type },
    ∀ l2 : my_list T,
    append (nil T) l2 = l2 :=
begin
intro T,
intro l2,
-- simplify using rules for append
simp [append],
end

-- But this requires induction
theorem nil_append_right_zero :
    ∀ { T : Type },
    ∀ l1 : my_list T,
    append l1 (nil T) = l1
:=
begin
intro T,
intro l1,
induction l1,

-- base case
simp [append],

-- inductive case
simp [append],
assumption,
end

-- A desired property of append!

theorem append_length :
    ∀ { T : Type },
    ∀ l1 l2 : my_list T,
    length (append l1 l2) =
    (length l1) + (length l2) :=
begin
intros T l1 l2,
--cases l1 with h l1' --no work!
induction l1 with h l1 ih, -- need ih

/-
base case: simplify using
definitions of length, append
-/
simp [append, length],

-- inductive case

-- simplify goal as usual
simp [append, length],

-- critical: rewrite using ih!!!
rw ih,

/-
See if Lean can figure out to
figure out to apply commutativity
of addition.
-/
simp,

-- yay, qed!
end

end my_list_adt


-- Math 52: Cheatsheet

--------------------------------
-- BASIC GOAL TRANSFORMATIONS --
--------------------------------

-- Conjunctive Goal
-- Use `split`:
example (P Q : Prop) : P ∧ Q :=
begin
split,
-- you can use braces to separate the two resulting goals
{ sorry },
{ sorry },
end

-- Conditional Goal
-- Use `intro`:
example (P Q : Prop) : P → Q :=
begin
intro H, -- you can give the hypothesis any name you want
sorry,
end

-- Universal Goal
-- Use `intro`:
example (U : Type) (P : U → Prop) : ∀ (x : U), P x :=
begin
intro x, -- you can rename the variable x if necessary
sorry,
end

-- Existential Goal
-- Use `existsi`:
example (U : Type) (P : U → Prop) : ∃ (x : U), P x :=
begin
existsi (sorry : U), -- you need to figure out what to put in
sorry,
end

---------------------------------
-- BASIC GIVEN TRANSFORMATIONS --
---------------------------------

-- Conjunctive Hypothesis
-- Use `cases`:
example (P Q R : Prop) (H : P ∧ Q) : R :=
begin
cases H with H₁ H₂,
sorry,
end

-- Disjunctive Hypothesis
-- Use `cases`:
example (P Q R : Prop) (H : P ∨ Q) : R :=
begin
cases H with H₁ H₂,
-- you can use braces to separate the two resulting goals.
{ sorry },
{ sorry },
end

-- Existential Hypothesis
-- Use `cases`:
example (U : Type) (P : U → Prop) (R : Prop)
  (H : ∃ (x : U), P x) : R :=
begin
cases H with x Hx, -- you can use any name you want for x
sorry,
end

-----------------------
-- COMMON IDENTITIES --
-----------------------

#check add_assoc -- (a + b) + c = a + (b + c)
#check add_comm -- a + b = b + a
#check add_zero -- a + 0 = a
#check zero_add -- 0 + a = a
#check mul_assoc -- (a * b) * c = a * (b * c)
#check mul_comm -- a * b = b * a
#check mul_one -- a * 1 = a
#check one_mul -- 1 * a = a
#check mul_zero -- a * 0 = 0
#check zero_mul -- 0 * a = 0
#check add_mul -- (a + b) * c = a * c + b * c
#check mul_add -- a * (b + c) = a * b + a * c


import lib.m154

open m154
/-
Négations, raisonnements par l'absurde et contraposées.

Cette feuille introduit les principes logiques et commandes Lean liées
aux négations d'énoncés. Elle introduit de nombreuses nouvelles commandes :
`Montrons une contradiction`, `Supposons par l'absurde`, `On contrapose`,
`On discute selon que` et `On pousse la négation`.
Il est donc important de bien s'accrocher à son aide-mémoire Lean.

On introduit l'idée de contradiction mathématique ou absurdité mathématique,
sous la forme d'un énoncé spécial appelé « Faux » et noté `false` par Lean.
Par définition, cet énoncé n'a pas de démonstration.

Par conséquent, Faux entraîne n'importe quel autre énoncé : pour tout énoncé P,
« Faux ⇒ P » est vrai : « si Faux alors P » ne coûte rien puisque Faux n'est
pas vrai. Une autre façon d'y penser est de se dire, comme Lean le fait,
qu'une démonstration de « Faux ⇒ P » est une machine qui transforme toute
démonstration de Faux en démonstration de P, et la machine qui ne fait rien
convient car nous n'avons rien à lui donner en entrée.

Les logiciens aiment appeler cette implication de son nom latin
« ex falso quod libet » (du faux découle tout ce que l'on veut).
La commande pour invoquer ce principe est `Montrons une contradiction`.
-/

-- Montrons que si Faux alors 0 = 1
example : false → 0 = 1 :=
begin
  -- Supposons Faux
  Supposons h : false,
  -- On veut montrer 0 = 1. Ex falso quod libet, donc il suffit de montrer Faux.
  Montrons une contradiction,
  -- Or c'est ce que nous avons supposé.
  On conclut par h,
end

/-
L'exemple précédent suggère que la définition de Faux n'est pas très utile.
Mais c'est sur elle que va s'appuyer la définition de la négation.
Si P est un énoncé, sa négation est l'énoncé « non P » défini comme
« P ⇒ Faux». Les logiciens et Lean le notent `¬ P` (mais en maths quotidiennes
on n'utilise pas de notation ici).

Ainsi l'affirmation « non P » se lit : « Si P était vrai, on aurait une
contradiction ». Par exemple, la définition de « a ≠ b » est « non (a = b) ».

On peut montrer que « non P » est vrai si et seulement si « P ⇔ Faux » est vrai,
mais en pratique c'est vraiment la définition de « non P » qui est directement
utile.
-/

-- Soit x un réel. Montrons que « non x < x ».
lemma non_strictement_inferieur_soi {x : ℝ} : ¬ x < x :=
begin
  -- Suppons x < x et démontrons une contradiction.
  Supposons hyp : x < x,
  -- L'hypothèse x < x signifie que x ≤ x et x ≠ x
  On réécrit via lt_iff_le_and_ne dans hyp,
  -- en particulier x ≠ x
  Par hyp on obtient (hyp_inf : x ≤ x) (hyp_non : x ≠ x),
  -- (l'autre condition ne servira pas).
  On oublie hyp_inf, -- La commande "On oublie"" oublie une hypothèse,
  -- Lean n'en a pas besoin, c'est juste pour nous clarifier les idées.
  -- Par définition de ≠, l'hypothèse hyp_non signifie que, pour obtenir une
  -- contradiction, il suffit de montrer que x = x.
  On reformule hyp_non en x = x → false,
  -- (La commande "On reformule" transforme une hypothèse en un énoncé
  --  équivalent par définition, Lean n'en a pas besoin ici, c'est juste
  --  pour nous)
  Par hyp_non il suffit de montrer que x = x,
  -- Or cela découle de la réflexivité de l'égalité.
  On calcule,
end

-- Soit n un entier. On suppose que n est pair et que n n'est pas pair.
-- Montrons alors que 0 = 1.
example (n : ℤ) (h_pair : pair n) (h_non_pair : ¬ pair n) : 0 = 1 :=
begin
  sorry
end

/-
Pour la suite, on rappelle les définitions suivantes :

`def pair (n : ℤ) := ∃ k, n = 2*k`
`def impair (n : ℤ) := ∃ k, n = 2*k + 1`

et on a les deux lemmes :

`pair_ou_impair (n : ℤ) : pair n ∨ impair n`
`non_pair_et_impair (n : ℤ) : ¬ (pair n ∧ impair n)`
-/

-- Sans utiliser la définition de pair et impair, mais en utilisant les
-- deux lemmes, montrons qu'un nombre n'est pas pair ssi il est impair.
lemma non_pair_ssi (n : ℤ) : ¬ pair n ↔ impair n :=
begin
  sorry
end

/-
Muni de la définition de la négation, on montre facilement que
tout énoncé P implique sa double négation « non non P ».

En rajoutant l'axiome du tiers exclu, qui affirme que « P ou non P » est vrai
pour tout énoncé P, on montre facilement la réciproque : « non non P »
implique P.

Au final on a alors l'équivalence entre « non non P » et P, une propriété
connue sous le nom de « principe d'élimination des doubles négations ».

L'implication « non non P ⇒ P » est la base du raisonnement par l'absurde :
pour montrer P, il suffit de montrer « non non P », c'est-à-dire
« non P ⇒ Faux » donc il suffit de supposer « non P » et de démontrer Faux.
En pratique on ne décompose pas ce petit raisonnement et on écrit directement
« Par l'absurde, supposons non P » ou « Supposons par l'absurde non P ».
Dans Lean on écrit `Supposons par l'absurde Hyp : ¬ P`,
qui transforme le but P en false et ajoute au contexte l'hypothèse Hyp : ¬ P.
-/

/-
Reprenons une démonstration de la feuille 8, l'unicité de la limite.
On ne peut pas démontrer ce résultat sans utiliser l'axiome du tiers exclu
quelque part. Dans la feuille 8, cette utilisation était cachée dans le lemme

`egal_si_abs_eps (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y`

(dont on démontrera une variante plus bas à l'aide du tiers exclu).
-/
example (u : ℕ → ℝ) (l l' : ℝ) : limite_suite u l → limite_suite u l' → l = l' :=
begin
  -- Supposons que u tende vers l et vers l'
  Supposons (hl : limite_suite u l) (hl' : limite_suite u l'),
  -- Supposons par l'absurde que « non (l = l') », c'est à dire l ≠ l'.
  Supposons par l'absurde H : l ≠ l',
  -- En particulier |l-l'| > 0
  Fait ineg : |l - l'| > 0,
    -- (la démonstration ci-dessous n'est pas importante, il faut juste noter
    -- qu'elle fait bien intervenir l'hypothèse H)
    On réécrit via pos_abs,
    On conclut par sub_ne_zero_of_ne appliqué à H,
  -- On peut donc appliquer l'hypothèse de convergence vers l à ε = |l'-l|/4
  -- pour obtenir N tel que ∀ n ≥ N, |u n - l| ≤ |l - l'|/4.
  Fait quart_pos : |l - l'|/4 > 0,
     On conclut par ineg,
  Par hl appliqué à [|l - l'|/4, quart_pos] on obtient N
      tel que hN : ∀ n ≥ N, |u n - l| ≤ |l - l'| / 4,
  -- On obtient de même N' tel que ∀ n ≥ N', |u n - l'| ≤ |l - l'|/4.
  Par hl' appliqué à [|l - l'|/4, quart_pos] on obtient N'
      tel que hN' : ∀ n ≥ N', |u n - l'| ≤ |l - l'| / 4,
  -- Ainsi, pour l'indice N₀ = max(N, N'), on a |u N₀ - l| ≤ |l - l'|/4
  Posons N₀ := max N N', -- la commande « Posons » n'est jamais indispensable
                         -- mais elle économise quelques caractères.
  Par hN appliqué à [N₀, inferieur_max_gauche N N']
     on obtient hN₁ : |u N₀ - l| ≤ |l - l'| / 4,
  -- et |u N₀ - l'| ≤ |l - l'|/4.
  Par hN' appliqué à [N₀, inferieur_max_droite N N']
     on obtient hN'₁ : |u N₀ - l'| ≤ |l - l'| / 4,

  -- On démontre alors par calcul que |l - l'| < |l - l'|
  Fait clef : |l - l'| < |l - l'|,
    calc
    |l - l'| ≤ |l - u N₀| + |u N₀ - l'|   : by On applique ineg_triangle
         ... = |u N₀ - l| + |u N₀ - l'|   : by On réécrit via abs_diff
         ... ≤ |l - l'|/4 + |l - l'|/4    : by On combine [hN₁, hN'₁]
         ... = |l - l'|/2                 : by On calcule
         ... < |l - l'|                   : by On conclut par ineg,
  -- ce qui est absurde.
  On conclut par non_strictement_inferieur_soi appliqué à clef,
end

/-
Une autre incarnation très utile de l'axiome du tiers exclu est le principe
de contraposition : pour démontrer « P ⇒ Q », il suffit de démontrer
« non Q ⇒ non P ».
-/

-- En utilisant un raisonnement par l'absurde, montrer le principe
-- de contraposition
example (P Q : Prop) (h : ¬ Q → ¬ P) : P → Q :=
begin
  sorry
end

/-
En fait la réciproque du principe de contraposition est vraie aussi (et se
démontre sans même utiliser l'axiome du tiers exclu). On a donc
(P ⇒ Q) ⇔ (non Q ⇒ non P)

On prendra bien garde à ne pas confondre :
  * la contraposée de « P ⇒ Q » qui est « non Q ⇒ non P »
  * la réciproque de « P ⇒ Q » qui est « Q ⇒ P ».

En général la réciproque d'une implication n'a aucun lien logique avec
l'implication de départ.

Comme pour le raisonnement par l'absurde, le principe de contraposition n'est
pas redécomposé à chaque fois, on se contente d'écrire `On contrapose` dans Lean
et « Montrons la contraposée » ou « Par contraposition, il suffit de montrer
que » ou quelque chose d'analogue sur papier.
-/

example (P Q : Prop) (h : ¬ Q → ¬ P) : P → Q :=
begin
  On contrapose,
  On conclut par h,
end

-- Dans l'exercice suivant, on raisonnera par contraposition pour une
-- des implications, et on utilisera les définitions de pair et impair ainsi
-- que le lemme `non_pair_ssi (n : ℤ ): ¬ pair n ↔ impair n` démontré plus
-- haut.
example (n : ℤ) : pair (n^2) ↔ pair n :=
begin
  sorry
end

/-
On termine ce tour d'horizon du tiers exclu en signalant qu'il est parfois utile
d'utiliser l'axiome du tiers exclu sous sa forme d'origine : pour tout énoncé P,
soit P est vrai soit ¬ P est vrai. Plutôt que d'invoquer cet énoncé puis de faire une
disjonction de cas à l'aide de la commande `On discute en utilisant`, Lean introduit
le raccourci

`On discute selon que P,`

qui combine les deux étapes et crée directement deux branches de la
démonstration : une dans laquelle il faut montrer `P → but initial` et
l'autre dans laquelle il faut montrer `¬ P → but initial`.

Dans l'exemple suivant, il n'est pas utile de retenir les lemmes concernant
la valeur absolue, on se contentera d'en observer les effets.
-/

example (x y : ℝ) : |x + y| ≤ |x| + |y| :=
begin
  Fait hx : x ≤ |x|,
    On applique le_abs_self,
  Fait hx' : -x ≤ |x|,
    On applique neg_le_abs_self,
  Fait hy : y ≤ |y|,
    On applique le_abs_self,
  Fait hy' : -y ≤ |y|,
    On applique neg_le_abs_self,

  On discute selon que 0 ≤ x + y,
    Supposons h : 0 ≤ x + y,
    calc |x + y| = x + y : abs_of_nonneg h
          ...    ≤ |x| + |y| : by On combine [hx, hy],
  Supposons h : ¬ 0 ≤ x + y,
  On réécrit via not_le dans h qui devient x + y < 0,
  calc |x + y| = -(x + y) : abs_of_neg h
           ... = -x + (-y) : by On calcule
           ... ≤ |x| + |y| : by On combine [hx', hy'],
end

example (n : ℤ) : pair (n*(n+1)) :=
begin
  sorry
end

/-
Il est crucial de comprendre les négations d'énoncés comportant des
quantificateurs. Dans l'exercice suivant, on utilisera seulement la
définition de la négation.
-/

example (n : ℤ) : ¬ (∃ k, n = 2*k) ↔ ∀ k, n ≠ 2*k :=
begin
  sorry
end

/-
L'exercice précédent cache en fait un résultat complètement général :
Pour tout prédicat P, `(¬ ∃ x, P x) ↔ (∀ x, ¬ P x)`, et la démonstration
n'est pas plus difficile que dans l'exercice précédent.

De façon analogue, `(¬ ∀ x, P x) ↔ (∃ x, ¬ P x)`. La démonstration est
plus délicate, et nécessite le tiers exclu pour une implication.

En pratique on ne redémontre pas constamment ces règles de négation des énoncés
quantifiés (les démonstrations ne sont même pas si simples !), on les connait
par cœur.
Dans Lean on utilise `On pousse la négation` pour pousser les négations le plus
possible vers la droite (parfois elles disparaissent complètement
si l'énoncé le plus à droite a une négation qui s'exprime bien,
par exemple si c'est une inégalité).
-/

def paire (f : ℝ → ℝ) := ∀ x, f (-x) = f x

-- Montrons que la fonction x ↦ 2x n'est pas paire.
example : ¬ paire (fct x ↦ 2*x) :=
begin
  On déplie paire, -- On notera que, pour une fois, cette ligne de dépliage
                   -- est importante car « On pousse la négation» ne déplie pas les définitions.
  On pousse la négation,
  Montrons que 42 convient,
  Supposons hyp,
  On conclut par hyp, -- Il faut avouer que cette ligne est un peu étrange, mais la commande `On conclut par`
                      -- est capable de détecter ce type de contradiction dans une hypothèse
end

example (f : ℝ → ℝ) : ¬ paire f ↔ ∃ x, f (-x) ≠ f x :=
begin
  sorry
end

def majoree (f : ℝ → ℝ) := ∃ M, ∀ x, f x ≤ M

-- La fonction identité, x ↦ x, n'est pas majorée.
example : ¬ majoree (fct x ↦ x) :=
begin
  sorry
end
/-
La combinaison « contraposition puis pousser la négation » est tellement courante
que la commande `On contrapose,` essaie automatiquement de pousser la négation après
la contraposition, comme vous le constaterez dans l'exercice suivant qui est la variante
promise de egal_si_abs_eps.
-/

example (x : ℝ) : (∀ ε > 0, x ≤ ε) → x ≤ 0 :=
begin
  sorry
end

/-
Dans l'exercice suivant, on pourra utiliser le lemme
`eq_or_lt_of_le : a ≤ b → a = b ∨ a < b`
Ainsi, en ayant l'hypothèse `hxy : x ≤ y`, la commande
`On discute en utilisant eq_or_lt_of_le hxy` permet de scinder
la discussion en deux branches, l'une supposant x = y et l'autre x < y.
-/

example (f : ℝ → ℝ) : (∀ x y, x < y → f x < f y) ↔ (∀ x y, (x ≤ y ↔ f x ≤ f y)) :=
begin
  sorry
end


import mynat.definition -- Imports the natural numbers.

/- Here's what you get from the import:

1) The following data:
  * a type called `mynat`
  * a term `0 : mynat`, interpreted as the number zero.
  * a function `succ : mynat → mynat`, with `succ n` interpreted as "the number after n".
  * Usual numerical notation 0,1,2,3,4,5 etc.

2) The following axioms:
  * `zero_ne_succ : ∀ (a : mynat), zero ≠ succ(a)`, the statement that zero isn't a successor.
  -- this ensures that there is more than one natural number.
  * `succ_inj : ∀ {a b : mynat}, succ(a) = succ(b) → a = b`, the statement that
     if succ(a) = succ(b) then a = b.
  -- this ensures that there are infinitely many natural numbers.

3) The principle of mathematical induction.

  * In practice this means that if you have `n : mynat` then you can use the tactic `induction n`.

4) A few useful extra things:

  * The theorem `one_eq_succ_zero : 1 = succ 0`
  * The theorem `ne_iff_implies_false : a ≠ b ↔ (a = b) → false`

-/

import mynat.add -- definition of addition

/- Here's what you get from the import:

1) The following data:
  * a function called mynat.add, and notation a + b for this function

2) The following axioms:

  * `add_zero : ∀ a : mynat, a + 0 = a`
  * `add_succ : ∀ a b : mynat, a + succ(b) = succ(a + b)`

These axiom between them tell you how to work out a + x for every x; use induction on x to
reduce to the case either `x = 0` or `x = succ b`, and then use `add_zero` or `add_succ` appropriately.
-/

namespace mynat

-- Summary:

-- Naturals:
-- 1) 0 and succ are constants
-- 2) succ_inj and zero_ne_succ are axioms
-- 3) Induction works.

-- Addition:
-- 1) add_zero and add_succ are the axioms
-- 2) notation is a + b

/-
 Collectibles in this level:

add_comm_monoid -- collectible_02
  add_monoid [zero_add] -- collectible_01
    (has_zero)
    add_semigroup [add_assoc]
      (has_add)
  add_comm_semigroup [add_comm]
    add_semigroup (see above)
-/

-- ADDITION WORLD

--Level 1 :
lemma zero_add (n : mynat) : 0 + n = n :=
begin [nat_num_game]
  -- On fait une induction sur n :
  induction n with d hd,

  -- Le cas de base :
  rw add_zero,
  refl,

  -- Le cas d'induction :
  rw add_succ,
  rw hd,
  refl,

end

--Level 2 :
lemma add_assoc (a b c : mynat) : (a + b) + c = a + (b + c) :=
begin [nat_num_game]
  -- On fait une induction sur c :
  induction c with d hd,

  -- Le cas de base :
  rw add_zero,
  rw add_zero,
  refl,

  -- Le cas d'induction :
  rw add_succ,
  rw add_succ,
  rw add_succ,
  rw hd,
  refl,
end

-- first point: needs add_assoc, zero_add, add_zero
def collectible_01 : add_monoid mynat := by structure_helper
--#print axioms collectible_01 -- prove you got this by uncommenting

-- proving add_comm immediately is still tricky; trying it
-- reveals a natural intermediate lemma which we prove first.

--Level 3 :
lemma succ_add (a b : mynat) : succ a + b = succ (a + b) :=
begin [nat_num_game]
  -- On fait une induction sur b :
  induction b with n hn,

  -- Le cas de base :
  rw add_zero,
  rw add_zero,
  refl,

  -- Le cas d'induction :
  rw add_succ,
  rw add_succ,
  rw hn,
  refl,
end

--Level 4 :
lemma add_comm (a b : mynat) : a + b = b + a :=
begin [nat_num_game]
  -- On fait une induction sur b :
  induction b with n hn,

  -- Le cas de base :
  rw zero_add,
  rw add_zero,
  refl,

  -- Le cas d'induction :
  rw add_succ,
  rw succ_add,
  rw hn,
  refl,
end

-- level up
def collectible_02 : add_comm_monoid mynat := by structure_helper
--#print axioms collectible_02

-- no more collectibles beyond this point in this file, however
-- stuff below is used in other collectibles in other files.

--Level 5 :
theorem succ_eq_add_one (n : mynat) : succ n = n + 1 :=
begin [nat_num_game]
  -- Il suffit d'utiliser l'axiome '1 = succ 0' puis de simplifier :
  rw one_eq_succ_zero,
  rw add_succ,
  rw add_zero,
  refl,
end

--Level 6 :
lemma add_right_comm (a b c : mynat) : a + b + c = a + c + b :=
begin [nat_num_game]
  --Une combinaison d'associativité et de commutativité :
  rw add_assoc,
  rw add_comm b c,
  rw add_assoc,
  refl,
end

-- ADVANCED ADDITION WORLD

--Level 1 :
theorem succ_inj' {a b : mynat} (hs : succ(a) = succ(b)) :  a = b :=
begin [nat_num_game]
  apply succ_inj,
  exact hs,
end

--Level 2 :
theorem succ_succ_inj {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=
begin [nat_num_game]
  apply succ_inj,
  apply succ_inj,
  exact h,
end

--Level 3 :
theorem succ_eq_succ_of_eq {a b : mynat} : a = b → succ(a) = succ(b) :=
begin [nat_num_game]
  intro h,
  rw h,
end

-- Level 4 :
theorem succ_eq_succ_iff (a b : mynat) : succ a = succ b ↔ a = b :=
begin [nat_num_game]
  split,

  -- →
  exact succ_inj,

  -- ←
  exact succ_eq_succ_of_eq,
end

--Level 5 :
theorem add_right_cancel ⦃a b c : mynat⦄ : a + b = c + b → a = c :=
begin [nat_num_game]
  intro h,

  -- On fait une induction sur t :
  induction b with n hn,

  -- Le cas de base :
  repeat {rw add_zero at h},
  exact h,

  -- Le cas d'induction :
  apply hn,
  repeat {rw add_succ at h},
  apply succ_inj,
  exact h,
end

--Level 6 :
theorem add_left_cancel ⦃ a b c : mynat⦄ : a + b = a + c → b = c :=
begin [nat_num_game]
  --On utilise la commutativité de l'addition pour se ramener au cas précédent :
  rw add_comm,
  rw add_comm a c,
  intro h,
  exact add_right_cancel h,
end

--Level 7 :
theorem add_right_cancel_iff (t a b : mynat) :  a + t = b + t ↔ a = b :=
begin [nat_num_game]
  split,

  intro h,
  exact add_right_cancel h,

  cc,
end

-- this is used for antisymmetry of ≤
--Level 8 :
lemma eq_zero_of_add_right_eq_self {{a b : mynat}} : a + b = a → b = 0 :=
begin [nat_num_game]
  intro h,
  exact add_left_cancel h,
end

--Level 9 :
theorem succ_ne_zero : ∀ {{a : mynat}}, succ a ≠ 0 :=
begin [nat_num_game]
  intro a,
  symmetry,
  exact zero_ne_succ a,
end

-- now used for antisymmetry of ≤
--Level 10 :
lemma add_left_eq_zero {{a b : mynat}} : a + b = 0 → b = 0 :=
begin [nat_num_game]
  intro H,
  --On fait une distinction de cas 'b = 0' ou 'b = succ(d)' :
  cases b with d,

  --Cas 'b = 0' :
  refl,

  --Cas 'b = succ(d)' :
  rw add_succ at H,
  exfalso,
  exact succ_ne_zero H,
end

--Level 11 :
lemma add_right_eq_zero {{a b : mynat}} : a + b = 0 → a = 0 :=
begin [nat_num_game]
  intro h,
  rw add_comm at h,
  exact add_left_eq_zero h,
end

--Level 12 :
theorem add_one_eq_succ (d : mynat) : d + 1 = succ d :=
begin [nat_num_game]
  symmetry,
  refl,
end

def ne_succ_self (n : mynat) : n ≠ succ n :=
begin [nat_num_game]
  -- On fait une induction sur n :
  induction n with d hd,

  -- Le cas de base :
  exact zero_ne_succ 0,

  -- Le cas d'induction :
  intro h,
  apply hd,
  apply succ_inj,
  exact h,
end

end mynat


import .love10_denotational_semantics_demo

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

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Monotonicity

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

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

/-! 1.2. Prove its cousin. -/

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

/-! ## Question 2: Regular Expressions

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

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

Informally, the semantics of regular expressions is as follows:

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

Notice the rough correspondence with a WHILE language:

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

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

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

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

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

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

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

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

end LoVe