-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar eue si
--    |x + 3| < 5
-- entonces
--    -8 < x < 2
-- ----------------------------------------------------------------------

import data.real.basic

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

example
  (x y : ℝ)
  : abs (x + 3) < 5 → -8 < x ∧ x < 2 :=
begin
  rw abs_lt,
  intro h,
  split,
   linarith,
  linarith,
end

-- Prueba
-- ======

/-
x y : ℝ
⊢ abs (x + 3) < 5 → -8 < x ∧ x < 2
  >> rw abs_lt,
⊢ -5 < x + 3 ∧ x + 3 < 5 → -8 < x ∧ x < 2
  >> intro h,
h : -5 < x + 3 ∧ x + 3 < 5
⊢ -8 < x ∧ x < 2
  >> split,
| ⊢ -8 < x
  >>  linarith,
⊢ x < 2
  >> linarith,
no goals
-/

-- Comentario: El lema usado es
-- + abs_lt: abs a < b ↔ -b < a ∧ a < b

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

example
  (x y : ℝ)
  : abs (x + 3) < 5 → -8 < x ∧ x < 2 :=
begin
  rw abs_lt,
  intro h,
  split; linarith,
end

-- Comentario: La composición (split; linarith) aplica split y a
-- continuación le aplica linarith a cada subojetivo.


import .love02_backward_proofs_demo

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

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Question 1: Connectives and Quantifiers

1.1. Carry out the following proofs using basic tactics.

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

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

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

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
begin
  intros hg hb ha,
  apply hg,
  exact ha,
  exact hb
end

lemma proj_1st (a : Prop) :
  a → a → a :=
begin
  intros ha ha',
  exact ha
end

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

lemma proj_2nd (a : Prop) :
  a → a → a :=
begin
  intros ha ha',
  exact ha'
end

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
begin
  intros hg ha hf hb,
  apply hg,
  exact ha,
  exact hb
end

/-! 1.2. Prove the contraposition rule using basic tactics. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
begin
  intros hab hnb ha,
  apply hnb,
  apply hab,
  apply ha
end

/-! 1.3. Prove the distributivity of `∀` over `∧` using basic tactics.

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

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

/-! ## Question 2: Natural Numbers

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

#check mul

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

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

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

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
begin
  induction' m,
  { simp [mul, mul_zero] },
  { simp [mul, mul_succ, ih],
    cc }
end

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
begin
  induction' n,
  { refl },
  { simp [mul, mul_add, ih] }
end

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

lemma add_mul (l m n : ℕ) :
  mul (add l m) n = add (mul n l) (mul n m) :=
begin
  rw mul_comm _ n,
  rw mul_add
end

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

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

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

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

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

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

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

Hint: You will need `or.elim` and `false.elim`. You can use
`rw excluded_middle` to unfold the definition of `excluded_middle`,
and similarly for `peirce`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
begin
  rw excluded_middle,
  rw peirce,
  intro hem,
  intros a b haba,
  apply or.elim (hem a),
  { intro,
    assumption },
  { intro hna,
    apply haba,
    intro ha,
    apply false.elim,
    apply hna,
    assumption }
end

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

lemma dn_of_peirce :
  peirce → double_negation :=
begin
  rw peirce,
  rw double_negation,
  intros hpeirce a hnna,
  apply hpeirce a false,
  intro hna,
  apply false.elim,
  apply hnna,
  exact hna
end

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

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end backward_proofs

end LoVe


/-
Justin Ngo
jmn4fms
4/12/20
Sullivan 2102-001
-/

import .satisfiability
import .rules_of_reasoning

/-
CS2102 Exam #2: Propositional Logic
-/

/-
#1. Define a predicate function, is_satisfiable: pExp → bool
that returns true iff the given proposition is satisfiable.
Hint: Model your answer on our definition of is_valid. You
may need to define one or more helper functions. You should
test your solution, but we will only grade your definition.
Please write test cases in a separate file. Do not submit
that file.
-/

-- Answer here

open pExp

def foldr_or' : list bool → bool
| [] := ff
| (h::t) := bor h (foldr_or' t)

def is_satisfiable (e : pExp) : bool :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    let rs := map_pEval_over_interps e is in
        foldr_or' rs

/-
#2. Clearly the propositions in rules_of_reasoning.lean that
are valid are also satisfiable. But what about the following?
Apply your satisfiability predicate function to decide whether
or not each of the following formulae is satisfiable or not.
Write an "#eval is_satisfiable e" command for each expression.

A. The "fallacies" in that file (the ones that aren't valid).

B. The proposition, pFalse.

C. The following propositions:

1. P ∧ ¬ P
2. P ∨ ¬ P
3. = (¬x1 ∨ x2) ∧ (¬x2 ∨ x3 ∨ ¬x4) ∧ (x1 ∨ x2 ∨ x3 ∨ ¬x4)

Note that for 3. you will have to define four new variables.
Call them x1, x2, x3, and x4.
-/

-- Answers here
-- A.
#eval is_satisfiable true_imp
#eval is_satisfiable affirm_consequence
#eval is_satisfiable affirm_disjunct
#eval is_satisfiable deny_antecedent

--B.
#eval is_satisfiable pFalse

--C.
#eval is_satisfiable (P ∧ ¬ P)
#eval is_satisfiable (P ∨ ¬ P)

def x1 := pVar (var.mk 0)
def x2 := pVar (var.mk 1)
def x3 := pVar (var.mk 2)
def x4 := pVar (var.mk 3)
#eval is_satisfiable ((¬x1 ∨ x2) ∧ (¬x2 ∨ x3 ∨ ¬x4) ∧ (x1 ∨ x2 ∨ x3 ∨ ¬x4))

/-
3. In the previous problems, you defined a satisfiability
predicate function that returns true or false depending on
whether a given formula is satisfiable or not. Often we will
want to know not only whether there exists a solution but an
actual example of a solution, if there is one. Define a function
called sat_solver : pExp → option (var → bool) that returns a
satisfying interpretation (as "some interpretation") if there
is one, or "none" otherwise. Hint: Model your solution on our
validity checker.

1. First compute the list of interpretations for
a given expression, e,
2. then reduce that list to a value of type
option (var → bool).
3. Evaluate e under each interpretation in
the list until either (A) you find one, call it i, for which e
evaluates to true, or until you reach the empty list, empty
handed.
-/

-- Answer here

def i := pEval

def itr_find : (list bool) → (option (var → bool))
| [] := none
| (h :: t) := match h with
                | ff := option.some i
                -- option.some interp
                | _ := itr_find t
                end

def sat_solver (e : pExp) : option (var → bool) :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    let rs := map_pEval_over_interps e is in
    let x :=  itr_find rs in
        foldr_and rs

/-
3.4. determine if there is at least one interpretation of a proposition
that makes a certain proposition true,
and if so return that interpretation
-/

def itr_find' : (list bool) → (option (var → bool))
| [] := none
| (h :: t) := match h with
                | tt := option.some i
                -- option.some interp
                | _ := itr_find t
                end

def sat_solver' (e : pExp) : option (var → bool) :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    let rs := map_pEval_over_interps e is in
    let x :=  itr_find' rs in
        foldr_and rs

/-
4. Define a predicate function, is_unsatisfiable : pExp → bool,
that takes a propositional logic formula, e, and returns true
iff e is unsatisfiable. Hint: Easy. Build on what you have.
-/

-- Answer here
def foldr_or'' : list bool → bool
| [] := ff
| (h::t) := bor h (foldr_or'' t)

def is_unsatisfiable (e : pExp) : bool :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    let rs := map_pEval_over_interps e is in
    let x := foldr_or'' rs in
        not x

/-
5. Given a propositional logic expression, e, and an incorrect
claim that it's valid, we often want to produce a counter-example
to that claim. Such a counter example is an interpretation under
which the expression is not true. Equivalently, a counterexample
is an interpretation under which the *negation* of the expression
*is* true.

Define a function, counterexample : pExp → option (var → bool),
that takes any expression e and returns either a counterexample
(as "some interpretation") or "none" if there isn't one. Hint:
given e, try to find a model for the expression, ¬ e.
-/

-- Answer here
-- option is a type, look at notes on polymorphism
def counterexample : pExp → option (var → bool)

def counter (e : pExp) : option (var → bool) :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    let rs := map_pEval_over_interps e is in
    let x :=  counterexample rs in
        foldr_and rs

/-
6. Give an English language example for every valid rule of
reasoning in rules_of_reasoning.lean, and also give an English
language counter-example for each fallacy.

For example, for the rule, P >> Q >> P ∧ Q, you could say,
"If the ball is red then if (in addition to that) the box
is blue, then (in this context) the ball is red AND the box
is blue." It will be easiest is you re-use the same words
for P, Q, and R, in all of your examples. E.g., P means "the
ball is red", Q means "the box is blue", etc.

Copy the contents of rules_of_reasoning.lean into this comment
block and under each rule give your English language sentence.

P: Ball is red
Q: Box is blue
R: Cake is sweet

def true_intro : pExp := pTrue
- The ball is a ball

def false_elim := pFalse >> P
- If the ball is not a ball, then the ball is red

def true_imp := pTrue >> P
- If there is a ball, then the ball is red
- Not always true because not all balls are red

def and_intro := P >> Q >> P ∧ Q
- If the ball is red, then if the box is blue, then the ball
is red and the box is blue

def and_elim_left := P ∧ Q >> P
- If the ball is red and the box is blue, then the ball is red

def and_elim_right := P ∧ Q >> Q
- If the ball is red and the box is blue, then the box is blue

def or_intro_left := P >> P ∨ Q
- If the ball is red, then the ball is red or the box is blue

def or_intro_right := Q >> P ∨ Q
- If the box is blue, then the ball is red or the box is blue

def or_elim := P ∨ Q >> (P >> R) >> (Q >> R) >> R
- If the ball is red or the box is blue, then, if the ball is red
then the cake is sweet, then, if the box is blue then the cake is sweet,
then the cake is sweet

def iff_intro := (P >> Q) >> (Q >> P) >> (P ↔ Q)
- If the ball is red then the box is blue, then, if the box is blue
then the ball is red, then, the ball is red implies the box is blue
(a red ball implies a blue box)

def iff_intro' := (P >> Q) ∧ (Q >> P) >> (P ↔ Q)
- If the ball is red then the box is blue, and if the box is blue
then the ball is red, then the ball is red implies
the box is blue (a red ball implies a blue box)

def iff_elim_left := (P ↔ Q) >> (P >> Q)
- If the ball is red implies the box is blue, then if the
ball is red then the box is blue

def iff_elim_right := (P ↔ Q) >> (Q >> P)
- If the ball is red implies the box is blue, then if the box
is blue then the ball is red

def arrow_elim := (P >> Q) >> (P >> Q)
- If the ball is red then the box is blue, then, if the ball
is red then the box is blue

def resolution := (P ∨ Q) >> (¬ Q ∨ R) >> (P ∨ R)
- If the ball is red or the box is blue, then, if the box is not
blue or the cake is sweet, then the ball is red or the cake is sweet

def unit_resolution := (P ∨ Q) >> ((¬ Q) >> P)
- If the ball is red or the box is blue, then, if the box is not blue
then the ball is red

def syllogism := (P >> Q) >> (Q >> R) >> (P >> R)
- If the box is red then the ball is blue, then, if the ball is blue
then the cake is sweet, then if the box is red then the cake is sweet

def modus_tollens := (P >> Q) >> (¬ Q >> ¬ P)
- If the box is red then the ball is blue, then, if the ball is not blue
then the box is not red

def neg_elim := (¬ ¬ P) >> P
- If the box is not red and that is not true, then the box is red.

def excluded_middle := P ∨ (¬ P)
- The box is red or the box is not red

def neg_intro := (P >> pFalse) >> (¬ P)
- If the box is red then the box is not a box,
then the box is not red

-----
P: It is raining outside
Q: The streets are wet

def affirm_consequence := (P >> Q) >> (Q >> P)
- If it is raining outside then the streets are wet, then, if the streets
are wet it is raining outside
- Not always true because the streets can be wet without it having to rain
-- if it is NOT raining outside, then the streets can be wet = TRUE
-- if the streets are wet, then it is NOT raining outside = FALSE
-- true >> false = false

def affirm_disjunct := (P ∨ Q) >> (P >> ¬ Q)
- If it is raining outside or the streets are wet, then, if it is raining
outside then the streets are not wet
- Not always true becuase if it is raining the streets can be wet
-- if it is raining outside OR the streets are wet = TRUE
-- if if its raining outside, then the streets are NOT wet = FALSE
-- true >> false = false

def deny_antecedent := (P >> Q) >> (¬ P >> ¬ Q)
- If it is raining outside then the streets are wet, then, if it
is not raining outside then the streets are not wet
- Not always true because the streets can be wet for other reasons
besides rain
-- if it is raining outside  the streets are wet = TRUE
-- if it is NOT raining outside, then the streets can NOT be wet = FALSE
-- true >> false = false

-/


class group (G : Type u) :=
  (id : G)
  (inv : G → G)
  (binop : G → G → G)
  binop_assoc : ∀ (a b c : G), binop (binop a b) c = binop a (binop b c)
  id_binop : ∀ (a : G), binop id a = a
  binop_left_inv (a : G) : binop (inv a) a = id

attribute [simp] group.id_binop group.binop_left_inv
infixl : 75 "⊙" => group.binop
variable {S : Type u} [group S]

namespace group

@[simp] theorem binop_left_cancel (a b c : S) (h1 : a ⊙ b = a ⊙ c) : b = c :=
calc b = id ⊙ b := by rw [id_binop b]
     _ = ((inv a) ⊙ a) ⊙ b := by rw [binop_left_inv]
     _ = (inv a) ⊙ (a ⊙ b) := by rw [binop_assoc]
     _ = (inv a) ⊙ (a ⊙ c) := by rw [h1]
     _ = ((inv a) ⊙ a) ⊙ c := by rw [binop_assoc]
     _ = id ⊙ c := by rw [binop_left_inv]
     _ = c := by rw [id_binop]

theorem binop_eq_of_eq_inv_binop (a x y : S) (h1 : x = (inv a) ⊙ y) : a ⊙ x = y := by
apply binop_left_cancel (inv a)
rw [← binop_assoc,binop_left_inv,id_binop]
exact h1

@[simp] theorem binop_id (a : S) : a ⊙ id = a := by
apply binop_eq_of_eq_inv_binop
rw [binop_left_inv]

@[simp] theorem binop_right_inv (a : S) : a ⊙ (inv a) = id := by
apply binop_eq_of_eq_inv_binop
rw [binop_id]

@[simp] theorem inv_binop_cancel_left (a b : S) : (inv a) ⊙ (a ⊙ b) = b := by
rw [← binop_assoc]
simp

@[simp] theorem binop_inv_cancel_left (a b : S) : a ⊙ ((inv a) ⊙ b) = b := by
rw [← binop_assoc]
simp

@[simp] theorem inv_binop (a b : S) : inv (a ⊙ b) = (inv b) ⊙ (inv a) := by
rw [← id_binop (inv b), binop_assoc]
rw [← binop_left_inv (a ⊙ b),binop_assoc]
rw [binop_assoc]
simp

@[simp] theorem id_inv : inv id = (id : S) := by
rw [← binop_id (inv id)]
rw [binop_left_inv]

@[simp] theorem inv_inv (a : S) : inv (inv a) = a := by
apply binop_left_cancel (inv a)
simp

class abelian_group (A : Type u) extends group A :=
  binop_comm : ∀ (a b : A), binop a b = binop b a

namespace abelian_group
variable (K : Type u) [abelian_group K]

@[simp] theorem group_commutator_eq_id (a b : K) : (inv a) ⊙ (inv b) ⊙ a ⊙ b = id := by
rw [← binop_comm a, ← binop_assoc a]
simp


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad
-/
prelude
import init.data.nat.basic init.data.nat.div init.meta init.algebra.functions
universes u

namespace nat
attribute [pre_smt] nat_zero_eq_zero

/-! addition -/
/-* Let $n, m$ be natural numbers, then $n + m = m + n$. *-/
protected lemma add_comm : ∀ n m : ℕ, n + m = m + n
| n 0     := eq.symm (nat.zero_add n)
| n (m+1) :=
  suffices succ (n + m) = succ (m + n), from
    eq.symm (succ_add m n) ▸ this,
  congr_arg succ (add_comm n m)

/-* Let $n, m, k$ be natural numbers, then $(n + m) + k = n + (m + k)$. *-/
protected lemma add_assoc : ∀ n m k : ℕ, (n + m) + k = n + (m + k)
| n m 0        := rfl
| n m (succ k) := by rw [add_succ, add_succ, add_assoc]; refl

/-* Let $n, m, k$ be natural numbers, then $n + (m + k) = m + (n + k)$. *-/
protected lemma add_left_comm : ∀ (n m k : ℕ), n + (m + k) = m + (n + k) :=
left_comm nat.add nat.add_comm nat.add_assoc

/-* Let $n, m, k$ be natural numbers, then $n + m = n + k$ implies $m = k$. *-/
protected lemma add_left_cancel : ∀ {n m k : ℕ}, n + m = n + k → m = k
| 0        m k := by simp [nat.zero_add] {contextual := tt}
| (succ n) m k := λ h,
  have n+m = n+k, by { simp [succ_add] at h, assumption },
  add_left_cancel this

/-* Let $n, m, k$ be natural numbers, and $n + m = k + m$, then $n = k$. *-/
protected lemma add_right_cancel {n m k : ℕ} (h : n + m = k + m) : n = k :=
have m + n = m + k, by rwa [nat.add_comm n m, nat.add_comm k m] at h,
nat.add_left_cancel this

/-* Let $n$ be a natrual number, then $succ n \neq 0$. *-/
lemma succ_ne_zero (n : ℕ) : succ n ≠ 0 :=
assume h, nat.no_confusion h

/-* Let $n$ be a natural number, then the succession of $n$ does not equal to $n$. *-/
lemma succ_ne_self : ∀ n : ℕ, succ n ≠ n
| 0     h := absurd h (nat.succ_ne_zero 0)
| (n+1) h := succ_ne_self n (nat.no_confusion h (λ h, h))

/-* $1 \neq 0$ *-/
protected lemma one_ne_zero : 1 ≠ (0 : ℕ) :=
assume h, nat.no_confusion h

/-* $0 \neq 1$ *-/
protected lemma zero_ne_one : 0 ≠ (1 : ℕ) :=
assume h, nat.no_confusion h

/-* Let $n, m$ be natural numebrs, then $n + m = 0$ implies $n = 0$. *-/
protected lemma eq_zero_of_add_eq_zero_right : ∀ {n m : ℕ}, n + m = 0 → n = 0
| 0     m := by simp [nat.zero_add]
| (n+1) m := λ h,
  begin
    exfalso,
    rw [add_one, succ_add] at h,
    apply succ_ne_zero _ h
  end

/-* Let $n, m$ be natural numbers, and $n + m = 0$, then $m = 0$. *-/
protected lemma eq_zero_of_add_eq_zero_left {n m : ℕ} (h : n + m = 0) : m = 0 :=
@nat.eq_zero_of_add_eq_zero_right m n (nat.add_comm n m ▸ h)

/-* Let $n, m, k$ be natural numbers, then $n + m + k = n + k + m$. *-/
protected theorem add_right_comm : ∀ (n m k : ℕ), n + m + k = n + k + m :=
right_comm nat.add nat.add_comm nat.add_assoc

/-* Let $n, m$ be natural numbers, and $n + m = 0$, then $n = 0$ and $m = 0$. *-/

/-! multiplication -/
/-* $n * 0 = 0$ *-/
protected lemma mul_zero (n : ℕ) : n * 0 = 0 :=
rfl

/-* Let $n, m$ be natural numbers, then $n$ times the succession of $m$ equals to $n * m + n$. *-/
lemma mul_succ (n m : ℕ) : n * succ m = n * m + n :=
rfl

/-* $0 * n = 0$. *-/
protected theorem zero_mul : ∀ (n : ℕ), 0 * n = 0
| 0        := rfl
| (succ n) := by rw [mul_succ, zero_mul]

private meta def sort_add :=
`[simp [nat.add_assoc, nat.add_comm, nat.add_left_comm]]

/-* Let $n, m$ be natural numbers, then the succession of $n$ times $m$ equals to $(n * m) + m$. *-/
lemma succ_mul : ∀ (n m : ℕ), (succ n) * m = (n * m) + m
| n 0        := rfl
| n (succ m) :=
  begin
    simp [mul_succ, add_succ, succ_mul n m],
    sort_add
  end

/-* Let $n, m, k$ be natural numbers, then $(n + m) * k = n * k + m * k$. *-/
protected lemma right_distrib : ∀ (n m k : ℕ), (n + m) * k = n * k + m * k
| n m 0        := rfl
| n m (succ k) :=
  begin simp [mul_succ, right_distrib n m k], sort_add end

/-* Let $n, m, k$ be natural numbers, then $n * (m + k) = n * m + n * k$. *-/
protected lemma left_distrib : ∀ (n m k : ℕ), n * (m + k) = n * m + n * k
| 0        m k := by simp [nat.zero_mul]
| (succ n) m k :=
  begin simp [succ_mul, left_distrib n m k], sort_add end

/-* Let $n, m$ be natural numbers, then $n * m = m * n$. *-/
protected lemma mul_comm : ∀ (n m : ℕ), n * m = m * n
| n 0        := by rw [nat.zero_mul, nat.mul_zero]
| n (succ m) := by simp [mul_succ, succ_mul, mul_comm n m]

/-* Let $n, m, k$ be natural numbers, then $(n * m) * k = n * (m * k)$. *-/
protected lemma mul_assoc : ∀ (n m k : ℕ), (n * m) * k = n * (m * k)
| n m 0        := rfl
| n m (succ k) := by simp [mul_succ, nat.left_distrib, mul_assoc n m k]

/-* Let $n$ be a natural number, then $n * 1 = n$. *-/
protected lemma mul_one : ∀ (n : ℕ), n * 1 = n := nat.zero_add

/-* Let $n$ be a natural number, then $1 * n = n$. *-/
protected lemma one_mul (n : ℕ) : 1 * n = n :=
by rw [nat.mul_comm, nat.mul_one]

/-* Let $n, m$ be natural numbers, then the succession of $n$ plus m equals to $n$ plus the succession of $m$. *-/
theorem succ_add_eq_succ_add (n m : ℕ) : succ n + m = n + succ m :=
by simp [succ_add, add_succ]

/-* Let $n, m$ be natural numbers, then $n * m = 0$ implies $n = 0$ or $m = 0$. *-/
theorem eq_zero_of_mul_eq_zero : ∀ {n m : ℕ}, n * m = 0 → n = 0 ∨ m = 0
| 0        m := λ h, or.inl rfl
| (succ n) m :=
  begin
    rw succ_mul, intro h,
    exact or.inr (nat.eq_zero_of_add_eq_zero_left h)
  end

/-! properties of inequality -/
/-* Let $n, m$ be natural numbers, and $n = m$, then $n \leq m$. *-/
protected lemma le_of_eq {n m : ℕ} (p : n = m) : n ≤ m :=
p ▸ less_than_or_equal.refl

/-* Let $n, m$ be natural numbers, and $n \leq m$, then $n \leq succ m$. *-/
lemma le_succ_of_le {n m : ℕ} (h : n ≤ m) : n ≤ succ m :=
nat.le_trans h (le_succ m)

/-* Let $n, m$ be natural numbers, and the succession of $n$ is lower or equal to $m$, then $n \leq m$. *-/
lemma le_of_succ_le {n m : ℕ} (h : succ n ≤ m) : n ≤ m :=
nat.le_trans (le_succ n) h

/-* Let $n, m$ be natrual numbers, and $n < m$, then $n \leq m$. *-/
protected lemma le_of_lt {n m : ℕ} (h : n < m) : n ≤ m :=
le_of_succ_le h

/-* Let $n, m$ be natural numbers, then $n < m$ implies $n$ is lower than the succession of $m$. *-/
lemma lt.step {n m : ℕ} : n < m → n < succ m := less_than_or_equal.step

/-* Let $n$ be a natural number, then $n = 0$ or $0 < n$. *-/
protected lemma eq_zero_or_pos (n : ℕ) : n = 0 ∨ 0 < n :=
by {cases n, exact or.inl rfl, exact or.inr (succ_pos _)}

/-* Let $n$ be a natural number, then $n \leq 0$ implies $0 < n$. *-/
protected lemma pos_of_ne_zero {n : nat} : n ≠ 0 → 0 < n :=
or.resolve_left n.eq_zero_or_pos

/-* Let $n, m, k$ be natural numbers and $n < m$, then $m < k$ implies $n < k$. *-/
protected lemma lt_trans {n m k : ℕ} (h₁ : n < m) : m < k → n < k :=
nat.le_trans (less_than_or_equal.step h₁)

/-* Let $n, m, k$ be natural numbers, and $n \leq m$, then $m < k$ implies $n < k$. *-/
protected lemma lt_of_le_of_lt {n m k : ℕ} (h₁ : n ≤ m) : m < k → n < k :=
nat.le_trans (succ_le_succ h₁)

/-* Let $n$ be a natural number, then $n$ is lower than the succession of $n$. *-/
lemma lt.base (n : ℕ) : n < succ n := nat.le_refl (succ n)

lemma lt_succ_self (n : ℕ) : n < succ n := lt.base n

/-* Let $n, m$ be natural numbers, and $n \leq m$, then $m \leq n$ implies $n = m$. *-/
protected lemma le_antisymm {n m : ℕ} (h₁ : n ≤ m) : m ≤ n → n = m :=
less_than_or_equal.cases_on h₁ (λ a, rfl) (λ a b c, absurd (nat.lt_of_le_of_lt b c) (nat.lt_irrefl n))

/-* Let $a, b$ be natural numbers, then $a < b$ or $b \leq a$. *-/
protected lemma lt_or_ge : ∀ (a b : ℕ), a < b ∨ b ≤ a
| a 0     := or.inr a.zero_le
| a (b+1) :=
  match lt_or_ge a b with
  | or.inl h := or.inl (le_succ_of_le h)
  | or.inr h :=
    match nat.eq_or_lt_of_le h with
    | or.inl h1 := or.inl (h1 ▸ lt_succ_self b)
    | or.inr h1 := or.inr h1
    end
  end

/-* Let $m, n$ be natural numbers, then $m \leq n$ or $n \leq m$. *-/
protected lemma le_total {m n : ℕ} : m ≤ n ∨ n ≤ m :=
or.imp_left nat.le_of_lt (nat.lt_or_ge m n)

/-* Let $m, n$ be natural numbers, and $m \leq n$, then $m \neq n$ implies $m < n$. *-/
protected lemma lt_of_le_and_ne {m n : ℕ} (h1 : m ≤ n) : m ≠ n → m < n :=
or.resolve_right (or.swap (nat.eq_or_lt_of_le h1))

/-* Let $m, n$ be natural numbers, then $m < n$ if and only if $m \leq n$ and $\not n \leq m$. *-/
protected lemma lt_iff_le_not_le {m n : ℕ} : m < n ↔ (m ≤ n ∧ ¬ n ≤ m) :=
⟨λ hmn, ⟨nat.le_of_lt hmn, λ hnm, nat.lt_irrefl _ (nat.lt_of_le_of_lt hnm hmn)⟩,
 λ ⟨hmn, hnm⟩, nat.lt_of_le_and_ne hmn (λ heq, hnm (heq ▸ nat.le_refl _))⟩

instance : linear_order ℕ :=
{ le := nat.less_than_or_equal,
  le_refl := @nat.le_refl,
  le_trans := @nat.le_trans,
  le_antisymm := @nat.le_antisymm,
  le_total := @nat.le_total,
  lt := nat.lt,
  lt_iff_le_not_le := @nat.lt_iff_le_not_le,
  decidable_lt               := nat.decidable_lt,
  decidable_le               := nat.decidable_le,
  decidable_eq               := nat.decidable_eq }

/-* Let $n$ be non-positive natural number, then $n = 0$. *-/
protected lemma eq_zero_of_le_zero {n : nat} (h : n ≤ 0) : n = 0 :=
le_antisymm h n.zero_le

/-* Let $a, b$ be natural numbers, then $a < b$ implies that the succession of $a$ is lower than the succession of $b$. *-/
lemma succ_lt_succ {a b : ℕ} : a < b → succ a < succ b :=
succ_le_succ

/-* Let $a, b$ be natural unmbers, then the succession of $a$ is lower thant $b$ implies $a < b$. *-/
lemma lt_of_succ_lt {a b : ℕ} : succ a < b → a < b :=
le_of_succ_le

/-* Let $a, b$ be natural numbers, then succ $a$ $<$ succ $b$ implies $a < b$. *-/
lemma lt_of_succ_lt_succ {a b : ℕ} : succ a < succ b → a < b :=
le_of_succ_le_succ

lemma pred_lt_pred : ∀ {n m : ℕ}, n ≠ 0 → n < m → pred n < pred m
| 0         _       h₁ h := absurd rfl h₁
| n         0       h₁ h := absurd h n.not_lt_zero
| (succ n) (succ m) _  h := lt_of_succ_lt_succ h

/-* Let $a, b$ be natural numbers, and the succession of $a$ is lower or equal to $b$, then $a < b$. *-/
lemma lt_of_succ_le {a b : ℕ} (h : succ a ≤ b) : a < b := h

/-* Let $a, b$ be natural numbers and $a < b$, then then succession of $a$ is lower or equal to $b$. *-/
lemma succ_le_of_lt {a b : ℕ} (h : a < b) : succ a ≤ b := h

/-* Let $n, k$ be natural numbers, then $n \leq n + k$. *-/
protected lemma le_add_right : ∀ (n k : ℕ), n ≤ n + k
| n 0     := nat.le_refl n
| n (k+1) := le_succ_of_le (le_add_right n k)

/-* Let $n, m$ be natural numbers, then $n \leq m + n$. *-/
protected lemma le_add_left (n m : ℕ): n ≤ m + n :=
nat.add_comm n m ▸ n.le_add_right m

/-* Let $n, m$ be natural numbers, then $n \leq m$ implies that there exists a natural number $k$ such that $n + k = m$. *-/
lemma le.dest : ∀ {n m : ℕ}, n ≤ m → ∃ k, n + k = m
| n _ less_than_or_equal.refl := ⟨0, rfl⟩
| n _ (less_than_or_equal.step h) :=
  match le.dest h with
  | ⟨w, hw⟩ := ⟨succ w, hw ▸ add_succ n w⟩
  end

/-* Let $n, m, k$ be natural numbers, and $n + k = m$, then $n \leq m$. *-/
protected lemma le.intro {n m k : ℕ} (h : n + k = m) : n ≤ m :=
h ▸ n.le_add_right k

/-* Let $n, m, k$ be natural numbers, and $n \leq m$, then $k + n \leq k + m$. *-/
protected lemma add_le_add_left {n m : ℕ} (h : n ≤ m) (k : ℕ) : k + n ≤ k + m :=
match le.dest h with
| ⟨w, hw⟩ := @le.intro _ _ w begin rw [nat.add_assoc, hw] end
end

/-* Let $n, m, k$ be natural numbers, and $n \leq m$, then $n + k \leq m + k$. *-/
protected lemma add_le_add_right {n m : ℕ} (h : n ≤ m) (k : ℕ) : n + k ≤ m + k :=
begin rw [nat.add_comm n k, nat.add_comm m k], apply nat.add_le_add_left h end

/-* Let $k, n, m$ be natural numbers, and $k + n \leq k + m$, then $n \leq m$. *-/
protected lemma le_of_add_le_add_left {k n m : ℕ} (h : k + n ≤ k + m) : n ≤ m :=
match le.dest h with
| ⟨w, hw⟩ := @le.intro _ _ w
  begin
    rw [nat.add_assoc] at hw,
    apply nat.add_left_cancel hw
  end
end

/-* Let $k, n, m$ be natural numbers, $n + k \leq m + k$ implies $n \leq m$. *-/
protected lemma le_of_add_le_add_right {k n m : ℕ} : n + k ≤ m + k → n ≤ m :=
begin
  rw [nat.add_comm _ k, nat.add_comm _ k],
  apply nat.le_of_add_le_add_left
end

/-* Let $k, n, m$ be natural numbers, then $n + k \leq m + k$ if and only if $n \leq m$. *-/
protected lemma add_le_add_iff_le_right (k n m : ℕ) : n + k ≤ m + k ↔ n ≤ m :=
  ⟨ nat.le_of_add_le_add_right , assume h, nat.add_le_add_right h _ ⟩

/-* Let $k, n, m$ be natural numbers, and $k + n < k + m$ then $n < m$. *-/
protected theorem lt_of_add_lt_add_left {k n m : ℕ} (h : k + n < k + m) : n < m :=
let h' := nat.le_of_lt h in
nat.lt_of_le_and_ne
  (nat.le_of_add_le_add_left h')
  (λ heq, nat.lt_irrefl (k + m) begin rw heq at h, assumption end)

/-* Let $a, b, c$ be natural numbers, and $a + b < c + b$, then $a < c$. *-/
protected lemma lt_of_add_lt_add_right {a b c : ℕ} (h : a + b < c + b) : a < c :=
nat.lt_of_add_lt_add_left $
show b + a < b + c, by rwa [nat.add_comm b a, nat.add_comm b c]

/-* Let $n, m, k$ be natural numbers, and $n < m$, then $k + n < k + m$. *-/
protected lemma add_lt_add_left {n m : ℕ} (h : n < m) (k : ℕ) : k + n < k + m :=
lt_of_succ_le (add_succ k n ▸ nat.add_le_add_left (succ_le_of_lt h) k)

/-* Let $n, m, k$ be natural numbers, then $n + k < m + k$. *-/
protected lemma add_lt_add_right {n m : ℕ} (h : n < m) (k : ℕ) : n + k < m + k :=
nat.add_comm k m ▸ nat.add_comm k n ▸ nat.add_lt_add_left h k

/-* Let $n, k$ be natural numbers and $0 < k$, then $n < n + k$. *-/
protected lemma lt_add_of_pos_right {n k : ℕ} (h : 0 < k) : n < n + k :=
nat.add_lt_add_left h n

/-* Let $n, k$ be natural numbers and $0 < k$, then $n < k + n$. *-/
protected lemma lt_add_of_pos_left {n k : ℕ} (h : 0 < k) : n < k + n :=
by rw nat.add_comm; exact nat.lt_add_of_pos_right h

/-* Let $a, b, c, d$ be natural numbers where $a < b$ and $c < d$, then $a + c < b + d$. *-/
protected lemma add_lt_add {a b c d : ℕ} (h₁ : a < b) (h₂ : c < d) : a + c < b + d :=
lt_trans (nat.add_lt_add_right h₁ c) (nat.add_lt_add_left h₂ b)

/-* Let $a, b, c, d$ be natural numbers where $a \leq b$ and $c \leq d$, then $a + c \leq b + d$. *-/
protected lemma add_le_add {a b c d : ℕ} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d :=
le_trans (nat.add_le_add_right h₁ c) (nat.add_le_add_left h₂ b)

/-* $0 < 1$. *-/
protected lemma zero_lt_one : 0 < (1:nat) :=
zero_lt_succ 0

/-* Let $n, m, k$ be natural numbers, and $n \leq m$, then $k * n \leq k * m$. *-/
protected lemma mul_le_mul_left {n m : ℕ} (k : ℕ) (h : n ≤ m) : k * n ≤ k * m :=
match le.dest h with
| ⟨l, hl⟩ :=
  have k * n + k * l = k * m, by rw [← nat.left_distrib, hl],
  le.intro this
end

/-* Let $n, m, k$ be natural numbers, and $n \leq m$, then $n * k \leq m * k$. *-/
protected lemma mul_le_mul_right {n m : ℕ} (k : ℕ) (h : n ≤ m) : n * k ≤ m * k :=
nat.mul_comm k m ▸ nat.mul_comm k n ▸ k.mul_le_mul_left h

/-* Let $n, m, k$ be natural numbers, where $n < m$ and $0 < k$, then $k * n < k * m$. *-/
protected lemma mul_lt_mul_of_pos_left {n m k : ℕ} (h : n < m) (hk : 0 < k) : k * n < k * m :=
nat.lt_of_lt_of_le (nat.lt_add_of_pos_right hk)
  (mul_succ k n ▸ nat.mul_le_mul_left k (succ_le_of_lt h))

/-* Let $n, m, k$ be natural numbers, where $n < m$ and $0 < k$, then $n * k < m * k$. *-/
protected lemma mul_lt_mul_of_pos_right {n m k : ℕ} (h : n < m) (hk : 0 < k) : n * k < m * k :=
nat.mul_comm k m ▸ nat.mul_comm k n ▸ nat.mul_lt_mul_of_pos_left h hk

/-* Let $a, b, c$ be natural numbers, where $c * a \leq c * b$ and $0 < c$, then $a \leq b$. *-/
protected lemma le_of_mul_le_mul_left {a b c : ℕ} (h : c * a ≤ c * b) (hc : 0 < c) : a ≤ b :=
not_lt.1
  (assume h1 : b < a,
   have h2 : c * b < c * a, from nat.mul_lt_mul_of_pos_left h1 hc,
   not_le_of_gt h2 h)

/-* Let $m, n$ be natural numbers, then $m$ is lower than the succession of $n$ implies $m < n$. *-/
lemma le_of_lt_succ {m n : nat} : m < succ n → m ≤ n :=
le_of_succ_le_succ

/-* Let $m, k, n$ be natural numbers where $0 < n$ and $n * m = n * k$, then $m = k$. *-/
protected theorem eq_of_mul_eq_mul_left {m k n : ℕ} (Hn : 0 < n) (H : n * m = n * k) : m = k :=
le_antisymm (nat.le_of_mul_le_mul_left (le_of_eq H) Hn)
            (nat.le_of_mul_le_mul_left (le_of_eq H.symm) Hn)

/-* Let $a, b$ be positive natural numbers, then $0 < a * b$. *-/
protected lemma mul_pos {a b : ℕ} (ha : 0 < a) (hb : 0 < b) : 0 < a * b :=
have h : 0 * b < a * b, from nat.mul_lt_mul_of_pos_right ha hb,
by rwa nat.zero_mul at h

theorem le_succ_of_pred_le {n m : ℕ} : pred n ≤ m → n ≤ succ m :=
nat.cases_on n less_than_or_equal.step (λ a, succ_le_succ)

theorem le_lt_antisymm {n m : ℕ} (h₁ : n ≤ m) (h₂ : m < n) : false :=
nat.lt_irrefl n (nat.lt_of_le_of_lt h₁ h₂)

theorem lt_le_antisymm {n m : ℕ} (h₁ : n < m) (h₂ : m ≤ n) : false :=
le_lt_antisymm h₂ h₁

protected theorem lt_asymm {n m : ℕ} (h₁ : n < m) : ¬ m < n :=
le_lt_antisymm (nat.le_of_lt h₁)

protected def lt_ge_by_cases {a b : ℕ} {C : Sort u} (h₁ : a < b → C) (h₂ : b ≤ a → C) : C :=
decidable.by_cases h₁ (λ h, h₂ (or.elim (nat.lt_or_ge a b) (λ a, absurd a h) (λ a, a)))

protected def lt_by_cases {a b : ℕ} {C : Sort u} (h₁ : a < b → C) (h₂ : a = b → C)
  (h₃ : b < a → C) : C :=
nat.lt_ge_by_cases h₁ (λ h₁,
  nat.lt_ge_by_cases h₃ (λ h, h₂ (nat.le_antisymm h h₁)))

/-* Let $a, b$ be natural numbers, then $a < b$ or $a = b$ or $b < a$. *-/
protected theorem lt_trichotomy (a b : ℕ) : a < b ∨ a = b ∨ b < a :=
nat.lt_by_cases (λ h, or.inl h) (λ h, or.inr (or.inl h)) (λ h, or.inr (or.inr h))

/-* Let $a, b$ be natural numbers and $\not a < b$, then $a = b$ or $b < a$. *-/
protected theorem eq_or_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ∨ b < a :=
(nat.lt_trichotomy a b).resolve_left hnlt

theorem lt_succ_of_lt {a b : nat} (h : a < b) : a < succ b := le_succ_of_le h

lemma one_pos : 0 < 1 := nat.zero_lt_one

/-* Let $a, b, c$ be natural numbers where $a \leq b$, then $c * a \leq c * b$. *-/
protected lemma mul_le_mul_of_nonneg_left {a b c : ℕ} (h₁ : a ≤ b) : c * a ≤ c * b :=
begin
  by_cases hba : b ≤ a, { simp [le_antisymm hba h₁] },
  by_cases hc0 : c ≤ 0, { simp [le_antisymm hc0 c.zero_le, nat.zero_mul] },
  exact (le_not_le_of_lt
    (nat.mul_lt_mul_of_pos_left (lt_of_le_not_le h₁ hba) (lt_of_le_not_le c.zero_le hc0))).left,
end

/-* Let $a, b, c$ be natural numbers where $a \leq b$, then $a * c \leq b * c$. *-/
protected lemma mul_le_mul_of_nonneg_right {a b c : ℕ} (h₁ : a ≤ b) : a * c ≤ b * c :=
begin
  by_cases hba : b ≤ a, { simp [le_antisymm hba h₁] },
  by_cases hc0 : c ≤ 0, { simp [le_antisymm hc0 c.zero_le, nat.mul_zero] },
  exact (le_not_le_of_lt
    (nat.mul_lt_mul_of_pos_right (lt_of_le_not_le h₁ hba) (lt_of_le_not_le c.zero_le hc0))).left,
end

/-* Let $a, b, c, d$ be natural numbers where $a < c$, $b \leq d$ and $0 < b$, then $a * b < c * d$. *-/
protected lemma mul_lt_mul {a b c d : ℕ} (hac : a < c) (hbd : b ≤ d) (pos_b : 0 < b) :
  a * b < c * d :=
calc
  a * b < c * b : nat.mul_lt_mul_of_pos_right hac pos_b
    ... ≤ c * d : nat.mul_le_mul_of_nonneg_left hbd

/-* Let $a, b, c, d$ be natural numbers where $a \leq c$, $b < d$ and $0 < c$, then $a * b < c * d$. *-/
protected lemma mul_lt_mul' {a b c d : ℕ} (h1 : a ≤ c) (h2 : b < d) (h3 : 0 < c) :
       a * b < c * d :=
calc
   a * b ≤ c * b : nat.mul_le_mul_of_nonneg_right h1
     ... < c * d : nat.mul_lt_mul_of_pos_left h2 h3

-- TODO: there are four variations, depending on which variables we assume to be nonneg
/-* Let $a, b, c, d$ be natural numbers where $a \leq c$ and $b \leq d$, then $a * b \leq c * d$. *-/
protected lemma mul_le_mul {a b c d : ℕ} (hac : a ≤ c) (hbd : b ≤ d) : a * b ≤ c * d :=
calc
  a * b ≤ c * b : nat.mul_le_mul_of_nonneg_right hac
    ... ≤ c * d : nat.mul_le_mul_of_nonneg_left hbd

/-! bit0/bit1 properties -/

protected lemma bit1_eq_succ_bit0 (n : ℕ) : bit1 n = succ (bit0 n) :=
rfl

protected lemma bit1_succ_eq (n : ℕ) : bit1 (succ n) = succ (succ (bit1 n)) :=
eq.trans (nat.bit1_eq_succ_bit0 (succ n)) (congr_arg succ (nat.bit0_succ_eq n))

protected lemma bit1_ne_one : ∀ {n : ℕ}, n ≠ 0 → bit1 n ≠ 1
| 0     h h1 := absurd rfl h
| (n+1) h h1 := nat.no_confusion h1 (λ h2, absurd h2 (succ_ne_zero _))

protected lemma bit0_ne_one : ∀ n : ℕ, bit0 n ≠ 1
| 0     h := absurd h (ne.symm nat.one_ne_zero)
| (n+1) h :=
  have h1 : succ (succ (n + n)) = 1, from succ_add n n ▸ h,
  nat.no_confusion h1
    (λ h2, absurd h2 (succ_ne_zero (n + n)))

/-* Let $n$ be a natural number, then $n + n \neq 1$. *-/
protected lemma add_self_ne_one : ∀ (n : ℕ), n + n ≠ 1
| 0     h := nat.no_confusion h
| (n+1) h :=
  have h1 : succ (succ (n + n)) = 1, from succ_add n n ▸ h,
  nat.no_confusion h1 (λ h2, absurd h2 (nat.succ_ne_zero (n + n)))

protected lemma bit1_ne_bit0 : ∀ (n m : ℕ), bit1 n ≠ bit0 m
| 0     m     h := absurd h (ne.symm (nat.add_self_ne_one m))
| (n+1) 0     h :=
  have h1 : succ (bit0 (succ n)) = 0, from h,
  absurd h1 (nat.succ_ne_zero _)
| (n+1) (m+1) h :=
  have h1 : succ (succ (bit1 n)) = succ (succ (bit0 m)), from
    nat.bit0_succ_eq m ▸ nat.bit1_succ_eq n ▸ h,
  have h2 : bit1 n = bit0 m, from
    nat.no_confusion h1 (λ h2', nat.no_confusion h2' (λ h2'', h2'')),
  absurd h2 (bit1_ne_bit0 n m)

protected lemma bit0_ne_bit1 : ∀ (n m : ℕ), bit0 n ≠ bit1 m :=
λ n m : nat, ne.symm (nat.bit1_ne_bit0 m n)

protected lemma bit0_inj : ∀ {n m : ℕ}, bit0 n = bit0 m → n = m
| 0     0     h := rfl
| 0     (m+1) h := by contradiction
| (n+1) 0     h := by contradiction
| (n+1) (m+1) h :=
  have succ (succ (n + n)) = succ (succ (m + m)),
  by { unfold bit0 at h, simp [add_one, add_succ, succ_add] at h,
       have aux : n + n = m + m := h, rw aux },
  have n + n = m + m, by iterate { injection this with this },
  have n = m, from bit0_inj this,
  by rw this

protected lemma bit1_inj : ∀ {n m : ℕ}, bit1 n = bit1 m → n = m :=
λ n m h,
have succ (bit0 n) = succ (bit0 m), begin simp [nat.bit1_eq_succ_bit0] at h, rw h end,
have bit0 n = bit0 m, by injection this,
nat.bit0_inj this

protected lemma bit0_ne {n m : ℕ} : n ≠ m → bit0 n ≠ bit0 m :=
λ h₁ h₂, absurd (nat.bit0_inj h₂) h₁

protected lemma bit1_ne {n m : ℕ} : n ≠ m → bit1 n ≠ bit1 m :=
λ h₁ h₂, absurd (nat.bit1_inj h₂) h₁

protected lemma zero_ne_bit0 {n : ℕ} : n ≠ 0 → 0 ≠ bit0 n :=
λ h, ne.symm (nat.bit0_ne_zero h)

protected lemma zero_ne_bit1 (n : ℕ) : 0 ≠ bit1 n :=
ne.symm (nat.bit1_ne_zero n)

protected lemma one_ne_bit0 (n : ℕ) : 1 ≠ bit0 n :=
ne.symm (nat.bit0_ne_one n)

protected lemma one_ne_bit1 {n : ℕ} : n ≠ 0 → 1 ≠ bit1 n :=
λ h, ne.symm (nat.bit1_ne_one h)

protected lemma one_lt_bit1 : ∀ {n : nat}, n ≠ 0 → 1 < bit1 n
| 0        h := by contradiction
| (succ n) h :=
  begin
    rw nat.bit1_succ_eq,
    apply succ_lt_succ,
    apply zero_lt_succ
  end

protected lemma one_lt_bit0 : ∀ {n : nat}, n ≠ 0 → 1 < bit0 n
| 0        h := by contradiction
| (succ n) h :=
  begin
    rw nat.bit0_succ_eq,
    apply succ_lt_succ,
    apply zero_lt_succ
  end

protected lemma bit0_lt {n m : nat} (h : n < m) : bit0 n < bit0 m :=
nat.add_lt_add h h

protected lemma bit1_lt {n m : nat} (h : n < m) : bit1 n < bit1 m :=
succ_lt_succ (nat.add_lt_add h h)

protected lemma bit0_lt_bit1 {n m : nat} (h : n ≤ m) : bit0 n < bit1 m :=
lt_succ_of_le (nat.add_le_add h h)

protected lemma bit1_lt_bit0 : ∀ {n m : nat}, n < m → bit1 n < bit0 m
| n 0        h := absurd h n.not_lt_zero
| n (succ m) h :=
  have n ≤ m, from le_of_lt_succ h,
  have succ (n + n) ≤ succ (m + m), from succ_le_succ (nat.add_le_add this this),
  have succ (n + n) ≤ succ m + m, {rw succ_add, assumption},
  show succ (n + n) < succ (succ m + m), from lt_succ_of_le this

protected lemma one_le_bit1 (n : ℕ) : 1 ≤ bit1 n :=
show 1 ≤ succ (bit0 n), from
succ_le_succ (bit0 n).zero_le

protected lemma one_le_bit0 : ∀ (n : ℕ), n ≠ 0 → 1 ≤ bit0 n
| 0     h := absurd rfl h
| (n+1) h :=
  suffices 1 ≤ succ (succ (bit0 n)), from
    eq.symm (nat.bit0_succ_eq n) ▸ this,
  succ_le_succ (bit0 n).succ.zero_le

/-! successor and predecessor -/

@[simp]
lemma pred_zero : pred 0 = 0 :=
rfl

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

/-* Let $n$ be natural, then $n + 1 \leq 0$. *-/
theorem add_one_ne_zero (n : ℕ) : n + 1 ≠ 0 := succ_ne_zero _

theorem eq_zero_or_eq_succ_pred (n : ℕ) : n = 0 ∨ n = succ (pred n) :=
by cases n; simp

/-* Let $n$ be a non-zero natural number, then there exists a natural number $k$ such hat $n$ is the succession of $k$. *-/
theorem exists_eq_succ_of_ne_zero {n : ℕ} (H : n ≠ 0) : ∃k : ℕ, n = succ k :=
⟨_, (eq_zero_or_eq_succ_pred _).resolve_left H⟩

def discriminate {B : Sort u} {n : ℕ} (H1: n = 0 → B) (H2 : ∀m, n = succ m → B) : B :=
by induction h : n; [exact H1 h, exact H2 _ h]

/-* 1 is the succession of 0. *-/
theorem one_succ_zero : 1 = succ 0 := rfl

theorem pred_inj : ∀ {a b : nat}, 0 < a → 0 < b → nat.pred a = nat.pred b → a = b
| (succ a) (succ b) ha hb h := have a = b, from h, by rw this
| (succ a) 0        ha hb h := absurd hb (lt_irrefl _)
| 0        (succ b) ha hb h := absurd ha (lt_irrefl _)
| 0        0        ha hb h := rfl

/-! subtraction

Many lemmas are proven more generally in mathlib `algebra/order/sub` -/

@[simp] protected lemma zero_sub : ∀ a : ℕ, 0 - a = 0
| 0     := rfl
| (a+1) := congr_arg pred (zero_sub a)

lemma sub_lt_succ (a b : ℕ) : a - b < succ a :=
lt_succ_of_le (a.sub_le b)

protected theorem sub_le_sub_right {n m : ℕ} (h : n ≤ m) : ∀ k, n - k ≤ m - k
| 0        := h
| (succ z) := pred_le_pred (sub_le_sub_right z)

/-* $n - 0 = n$. *-/
@[simp]
protected theorem sub_zero (n : ℕ) : n - 0 = n :=
rfl

theorem sub_succ (n m : ℕ) : n - succ m = pred (n - m) :=
rfl

theorem succ_sub_succ (n m : ℕ) : succ n - succ m = n - m :=
succ_sub_succ_eq_sub n m

protected theorem sub_self : ∀ (n : ℕ), n - n = 0
| 0        := by rw nat.sub_zero
| (succ n) := by rw [succ_sub_succ, sub_self n]

/- TODO(Leo): remove the following ematch annotations as soon as we have
   arithmetic theory in the smt_stactic -/
/-* Let $n, k, m$ be natural numbers, then $(n + k) - (m + k) = n - m$. *-/
@[ematch_lhs]
protected theorem add_sub_add_right : ∀ (n k m : ℕ), (n + k) - (m + k) = n - m
| n 0        m := by rw [nat.add_zero, nat.add_zero]
| n (succ k) m := by rw [add_succ, add_succ, succ_sub_succ, add_sub_add_right n k m]

/-* Let $k, n, m$ be natural numbers, then $(k + n) - (k + m) = n - m$. *-/
@[ematch_lhs]
protected theorem add_sub_add_left (k n m : ℕ) : (k + n) - (k + m) = n - m :=
by rw [nat.add_comm k n, nat.add_comm k m, nat.add_sub_add_right]

/-* Let $n, m$ be natural, then $n + m - m = n$. *-/
@[ematch_lhs]
protected theorem add_sub_cancel (n m : ℕ) : n + m - m = n :=
suffices n + m - (0 + m) = n, from
  by rwa [nat.zero_add] at this,
by rw [nat.add_sub_add_right, nat.sub_zero]

/-* Let $n, m$ be natural, then $n + m - n = m$. *-/
@[ematch_lhs]
protected theorem add_sub_cancel_left (n m : ℕ) : n + m - n = m :=
show n + m - (n + 0) = m, from
by rw [nat.add_sub_add_left, nat.sub_zero]

/-* Let $n, m, k$ be natural numbers, then $n - m - k = n - (m + k)$. *-/
protected theorem sub_sub : ∀ (n m k : ℕ), n - m - k = n - (m + k)
| n m 0        := by rw [nat.add_zero, nat.sub_zero]
| n m (succ k) := by rw [add_succ, nat.sub_succ, nat.sub_succ, sub_sub n m k]

/-* Let $n, m, k$ be natural numbers where $k \leq m$ and $n - k \leq m - k$ then $n \leq m$. *-/
protected theorem le_of_le_of_sub_le_sub_right {n m k : ℕ}
  (h₀ : k ≤ m)
  (h₁ : n - k ≤ m - k)
: n ≤ m :=
begin
  revert k m,
  induction n with n ; intros k m h₀ h₁,
  { exact m.zero_le },
  { cases k with k,
    { apply h₁ },
    cases m with m,
    { cases not_succ_le_zero _ h₀ },
    { simp [succ_sub_succ] at h₁,
      apply succ_le_succ,
      apply n_ih _ h₁,
      apply le_of_succ_le_succ h₀ }, }
end

/-* Let $n, m, k$ be natural numbers and $k \leq m$, then $n - k \leq m - k$ if and only if $n \leq m$. *-/
protected theorem sub_le_sub_right_iff (n m k : ℕ)
  (h : k ≤ m)
: n - k ≤ m - k ↔ n ≤ m :=
⟨ nat.le_of_le_of_sub_le_sub_right h , assume h, nat.sub_le_sub_right h k ⟩

/-* Let $n, m$ be natural numbers, then $n - (n + m) = 0$. *-/
protected theorem sub_self_add (n m : ℕ) : n - (n + m) = 0 :=
show (n + 0) - (n + m) = 0, from
by rw [nat.add_sub_add_left, nat.zero_sub]

/-* Let $n, y, k$ be natural numbers, and $k \leq y$, then $x + k \leq y$ if and only if $x \leq y - k$. *-/
protected theorem add_le_to_le_sub (x : ℕ) {y k : ℕ}
  (h : k ≤ y)
: x + k ≤ y ↔ x ≤ y - k :=
by rw [← nat.add_sub_cancel x k, nat.sub_le_sub_right_iff _ _ _ h, nat.add_sub_cancel]

/-* Let $a, b$ be natural numbers satisfying $0 < a \leq b$, then $b - a < b$. *-/
protected lemma sub_lt_of_pos_le (a b : ℕ) (h₀ : 0 < a) (h₁ : a ≤ b)
: b - a < b :=
begin
  apply nat.sub_lt _ h₀,
  apply lt_of_lt_of_le h₀ h₁
end

protected theorem sub_one (n : ℕ) : n - 1 = pred n :=
rfl

theorem succ_sub_one (n : ℕ) : succ n - 1 = n :=
rfl

theorem succ_pred_eq_of_pos : ∀ {n : ℕ}, 0 < n → succ (pred n) = n
| 0 h        := absurd h (lt_irrefl 0)
| (succ k) h := rfl

/-* Let $n, m$ be natural numbers where $n \leq m$, then $n - m = 0$. *-/
protected theorem sub_eq_zero_of_le {n m : ℕ} (h : n ≤ m) : n - m = 0 :=
exists.elim (nat.le.dest h)
  (assume k, assume hk : n + k = m, by rw [← hk, nat.sub_self_add])

/-* Let $n, m$ be natural numbers where $n - m = 0$, then $n \leq m$. *-/
protected theorem le_of_sub_eq_zero : ∀{n m : ℕ}, n - m = 0 → n ≤ m
| n 0 H := begin rw [nat.sub_zero] at H, simp [H] end
| 0 (m+1) H := (m + 1).zero_le
| (n+1) (m+1) H := nat.add_le_add_right
  (le_of_sub_eq_zero begin simp [nat.add_sub_add_right] at H, exact H end) _

/-* Let $n, m$ be natural numbers, then $n - m = 0$ if and only if $n \leq m$. *-/
protected theorem sub_eq_zero_iff_le {n m : ℕ} : n - m = 0 ↔ n ≤ m :=
⟨nat.le_of_sub_eq_zero, nat.sub_eq_zero_of_le⟩

/-* Let $n, m$ be natural numbers where $n \leq m$, then $n + (m - n) = m$. *-/
protected theorem add_sub_of_le {n m : ℕ} (h : n ≤ m) : n + (m - n) = m :=
exists.elim (nat.le.dest h)
  (assume k, assume hk : n + k = m,
    by rw [← hk, nat.add_sub_cancel_left])

protected theorem sub_add_cancel {n m : ℕ} (h : m ≤ n) : n - m + m = n :=
by rw [nat.add_comm, nat.add_sub_of_le h]

protected theorem add_sub_assoc {m k : ℕ} (h : k ≤ m) (n : ℕ) : n + m - k = n + (m - k) :=
exists.elim (nat.le.dest h)
  (assume l, assume hl : k + l = m,
    by rw [← hl, nat.add_sub_cancel_left, nat.add_comm k, ← nat.add_assoc, nat.add_sub_cancel])

protected lemma sub_eq_iff_eq_add {a b c : ℕ} (ab : b ≤ a) : a - b = c ↔ a = c + b :=
⟨assume c_eq, begin rw [c_eq.symm, nat.sub_add_cancel ab] end,
  assume a_eq, begin rw [a_eq, nat.add_sub_cancel] end⟩

protected lemma lt_of_sub_eq_succ {m n l : ℕ} (H : m - n = nat.succ l) : n < m :=
not_le.1
  (assume (H' : n ≥ m), begin simp [nat.sub_eq_zero_of_le H'] at H, contradiction end)

protected theorem sub_le_sub_left {n m : ℕ} (k) (h : n ≤ m) : k - m ≤ k - n :=
by induction h; [refl, exact le_trans (pred_le _) h_ih]

theorem succ_sub_sub_succ (n m k : ℕ) : succ n - m - succ k = n - m - k :=
by rw [nat.sub_sub, nat.sub_sub, add_succ, succ_sub_succ]

protected theorem sub.right_comm (m n k : ℕ) : m - n - k = m - k - n :=
by rw [nat.sub_sub, nat.sub_sub, nat.add_comm]

theorem succ_sub {m n : ℕ} (h : n ≤ m) : succ m - n = succ (m - n) :=
exists.elim (nat.le.dest h)
  (assume k, assume hk : n + k = m,
    by rw [← hk, nat.add_sub_cancel_left, ← add_succ, nat.add_sub_cancel_left])

protected theorem sub_pos_of_lt {m n : ℕ} (h : m < n) : 0 < n - m :=
have 0 + m < n - m + m, begin rw [nat.zero_add, nat.sub_add_cancel (le_of_lt h)], exact h end,
nat.lt_of_add_lt_add_right this

protected theorem sub_sub_self {n m : ℕ} (h : m ≤ n) : n - (n - m) = m :=
(nat.sub_eq_iff_eq_add (nat.sub_le _ _)).2 (nat.add_sub_of_le h).symm

protected theorem sub_add_comm {n m k : ℕ} (h : k ≤ n) : n + m - k = n - k + m :=
(nat.sub_eq_iff_eq_add (nat.le_trans h (nat.le_add_right _ _))).2
  (by rwa [nat.add_right_comm, nat.sub_add_cancel])

theorem sub_one_sub_lt {n i} (h : i < n) : n - 1 - i < n :=
begin
  rw nat.sub_sub,
  apply nat.sub_lt,
  apply lt_of_lt_of_le (nat.zero_lt_succ _) h,
  rw nat.add_comm,
  apply nat.zero_lt_succ
end

theorem mul_pred_left : ∀ (n m : ℕ), pred n * m = n * m - m
| 0        m := by simp [nat.zero_sub, pred_zero, nat.zero_mul]
| (succ n) m := by rw [pred_succ, succ_mul, nat.add_sub_cancel]

theorem mul_pred_right (n m : ℕ) : n * pred m = n * m - n :=
by rw [nat.mul_comm, mul_pred_left, nat.mul_comm]

protected theorem mul_sub_right_distrib : ∀ (n m k : ℕ), (n - m) * k = n * k - m * k
| n 0        k := by simp [nat.sub_zero, nat.zero_mul]
| n (succ m) k := by rw [nat.sub_succ, mul_pred_left, mul_sub_right_distrib, succ_mul, nat.sub_sub]

protected theorem mul_sub_left_distrib (n m k : ℕ) : n * (m - k) = n * m - n * k :=
by rw [nat.mul_comm, nat.mul_sub_right_distrib, nat.mul_comm m n, nat.mul_comm n k]

protected theorem mul_self_sub_mul_self_eq (a b : nat) : a * a - b * b = (a + b) * (a - b) :=
by rw [nat.mul_sub_left_distrib, nat.right_distrib, nat.right_distrib, nat.mul_comm b a, nat.add_comm (a*a) (a*b),
       nat.add_sub_add_left]

theorem succ_mul_succ_eq (a b : nat) : succ a * succ b = a * b + a + b + 1 :=
begin
  rw [← add_one, ← add_one],
  simp [nat.right_distrib, nat.left_distrib, nat.add_left_comm, nat.mul_one, nat.one_mul, nat.add_assoc],
end

/-! min -/

protected lemma zero_min (a : ℕ) : min 0 a = 0 :=
min_eq_left a.zero_le

protected lemma min_zero (a : ℕ) : min a 0 = 0 :=
min_eq_right a.zero_le

-- Distribute succ over min
theorem min_succ_succ (x y : ℕ) : min (succ x) (succ y) = succ (min x y) :=
have f : x ≤ y → min (succ x) (succ y) = succ (min x y), from λp,
  calc min (succ x) (succ y)
              = succ x         : if_pos (succ_le_succ p)
          ... = succ (min x y) : congr_arg succ (eq.symm (if_pos p)),
have g : ¬ (x ≤ y) → min (succ x) (succ y) = succ (min x y), from λp,
  calc min (succ x) (succ y)
              = succ y         : if_neg (λeq, p (pred_le_pred eq))
          ... = succ (min x y) : congr_arg succ (eq.symm (if_neg p)),
decidable.by_cases f g

theorem sub_eq_sub_min (n m : ℕ) : n - m = n - min n m :=
if h : n ≥ m then by rewrite [min_eq_right h]
else by rewrite [nat.sub_eq_zero_of_le (le_of_not_ge h), min_eq_left (le_of_not_ge h), nat.sub_self]

@[simp] protected theorem sub_add_min_cancel (n m : ℕ) : n - m + min n m = n :=
by rw [sub_eq_sub_min, nat.sub_add_cancel (min_le_left n m)]

/-! induction principles -/

def two_step_induction {P : ℕ → Sort u} (H1 : P 0) (H2 : P 1)
    (H3 : ∀ (n : ℕ) (IH1 : P n) (IH2 : P (succ n)), P (succ (succ n))) : Π (a : ℕ), P a
| 0               := H1
| 1               := H2
| (succ (succ n)) := H3 _ (two_step_induction _) (two_step_induction _)

def sub_induction {P : ℕ → ℕ → Sort u} (H1 : ∀m, P 0 m)
   (H2 : ∀n, P (succ n) 0) (H3 : ∀n m, P n m → P (succ n) (succ m)) : Π (n m : ℕ), P n m
| 0        m        := H1 _
| (succ n) 0        := H2 _
| (succ n) (succ m) := H3 _ _ (sub_induction n m)

protected def strong_rec_on {p : nat → Sort u} (n : nat) (h : ∀ n, (∀ m, m < n → p m) → p n) : p n :=
suffices ∀ n m, m < n → p m, from this (succ n) n (lt_succ_self _),
begin
  intros n, induction n with n ih,
    {intros m h₁, exact absurd h₁ m.not_lt_zero},
    {intros m h₁,
      apply or.by_cases (decidable.lt_or_eq_of_le (le_of_lt_succ h₁)),
        {intros, apply ih, assumption},
        {intros, subst m, apply h _ ih}}
end

protected lemma strong_induction_on {p : nat → Prop} (n : nat) (h : ∀ n, (∀ m, m < n → p m) → p n) : p n :=
nat.strong_rec_on n h

protected lemma case_strong_induction_on {p : nat → Prop} (a : nat)
  (hz : p 0)
  (hi : ∀ n, (∀ m, m ≤ n → p m) → p (succ n)) : p a :=
nat.strong_induction_on a $ λ n,
  match n with
  | 0     := λ _, hz
  | (n+1) := λ h₁, hi n (λ m h₂, h₁ _ (lt_succ_of_le h₂))
  end

/-! mod -/

private lemma mod_core_congr {x y f1 f2} (h1 : x ≤ f1) (h2 : x ≤ f2) :
  nat.mod_core y f1 x = nat.mod_core y f2 x :=
begin
  cases y, { cases f1; cases f2; refl },
  induction f1 with f1 ih generalizing x f2, { cases h1, cases f2; refl },
  cases x, { cases f1; cases f2; refl },
  cases f2, { cases h2 },
  refine if_congr iff.rfl _ rfl,
  simp only [succ_sub_succ],
  exact ih
    (le_trans (nat.sub_le _ _) (le_of_succ_le_succ h1))
    (le_trans (nat.sub_le _ _) (le_of_succ_le_succ h2))
end

lemma mod_def (x y : nat) : x % y = if 0 < y ∧ y ≤ x then (x - y) % y else x :=
begin
  cases x, { cases y; refl },
  cases y, { refl },
  refine if_congr iff.rfl (mod_core_congr _ _) rfl; simp [nat.sub_le]
end

@[simp] lemma mod_zero (a : nat) : a % 0 = a :=
begin
  rw mod_def,
  have h : ¬ (0 < 0 ∧ 0 ≤ a),
  simp [lt_irrefl],
  simp [if_neg, h]
end

lemma mod_eq_of_lt {a b : nat} (h : a < b) : a % b = a :=
begin
  rw mod_def,
  have h' : ¬(0 < b ∧ b ≤ a),
  simp [not_le_of_gt h],
  simp [if_neg, h']
end

@[simp] lemma zero_mod (b : nat) : 0 % b = 0 :=
begin
  rw mod_def,
  have h : ¬(0 < b ∧ b ≤ 0),
  {intro hn, cases hn with l r, exact absurd (lt_of_lt_of_le l r) (lt_irrefl 0)},
  simp [if_neg, h]
end

lemma mod_eq_sub_mod {a b : nat} (h : b ≤ a) : a % b = (a - b) % b :=
or.elim b.eq_zero_or_pos
  (λb0, by rw [b0, nat.sub_zero])
  (λh₂, by rw [mod_def, if_pos (and.intro h₂ h)])

lemma mod_lt (x : nat) {y : nat} (h : 0 < y) : x % y < y :=
begin
  induction x using nat.case_strong_induction_on with x ih,
  { rw zero_mod, assumption },
  { by_cases h₁ : succ x < y,
    { rwa [mod_eq_of_lt h₁] },
    { have h₁ : succ x % y = (succ x - y) % y := mod_eq_sub_mod (not_lt.1 h₁),
      have : succ x - y ≤ x := le_of_lt_succ (nat.sub_lt (succ_pos x) h),
      have h₂ : (succ x - y) % y < y := ih _ this,
      rwa [← h₁] at h₂ } }
end

@[simp] theorem mod_self (n : nat) : n % n = 0 :=
by rw [mod_eq_sub_mod (le_refl _), nat.sub_self, zero_mod]

@[simp] lemma mod_one (n : ℕ) : n % 1 = 0 :=
have n % 1 < 1, from (mod_lt n) (succ_pos 0),
nat.eq_zero_of_le_zero (le_of_lt_succ this)

lemma mod_two_eq_zero_or_one (n : ℕ) : n % 2 = 0 ∨ n % 2 = 1 :=
match n % 2, @nat.mod_lt n 2 dec_trivial with
| 0,   _ := or.inl rfl
| 1,   _ := or.inr rfl
| k+2, h := absurd h dec_trivial
end

theorem mod_le (x y : ℕ) : x % y ≤ x :=
or.elim (lt_or_le x y)
  (λxlty, by rw mod_eq_of_lt xlty; refl)
  (λylex, or.elim y.eq_zero_or_pos
    (λy0, by rw [y0, mod_zero]; refl)
    (λypos, le_trans (le_of_lt (mod_lt _ ypos)) ylex))

@[simp] theorem add_mod_right (x z : ℕ) : (x + z) % z = x % z :=
by rw [mod_eq_sub_mod (nat.le_add_left _ _), nat.add_sub_cancel]

@[simp] theorem add_mod_left (x z : ℕ) : (x + z) % x = z % x :=
by rw [nat.add_comm, add_mod_right]

@[simp] theorem add_mul_mod_self_left (x y z : ℕ) : (x + y * z) % y = x % y :=
by {induction z with z ih, rw [nat.mul_zero, nat.add_zero], rw [mul_succ, ← nat.add_assoc, add_mod_right, ih]}

@[simp] theorem add_mul_mod_self_right (x y z : ℕ) : (x + y * z) % z = x % z :=
by rw [nat.mul_comm, add_mul_mod_self_left]

@[simp] theorem mul_mod_right (m n : ℕ) : (m * n) % m = 0 :=
by rw [← nat.zero_add (m*n), add_mul_mod_self_left, zero_mod]

@[simp] theorem mul_mod_left (m n : ℕ) : (m * n) % n = 0 :=
by rw [nat.mul_comm, mul_mod_right]

theorem mul_mod_mul_left (z x y : ℕ) : (z * x) % (z * y) = z * (x % y) :=
if y0 : y = 0 then
  by rw [y0, nat.mul_zero, mod_zero, mod_zero]
else if z0 : z = 0 then
  by rw [z0, nat.zero_mul, nat.zero_mul, nat.zero_mul, mod_zero]
else x.strong_induction_on $ λn IH,
  have y0 : y > 0, from nat.pos_of_ne_zero y0,
  have z0 : z > 0, from nat.pos_of_ne_zero z0,
  or.elim (le_or_lt y n)
    (λyn, by rw [
        mod_eq_sub_mod yn,
        mod_eq_sub_mod (nat.mul_le_mul_left z yn),
        ← nat.mul_sub_left_distrib];
      exact IH _ (nat.sub_lt (lt_of_lt_of_le y0 yn) y0))
    (λyn, by rw [mod_eq_of_lt yn, mod_eq_of_lt (nat.mul_lt_mul_of_pos_left yn z0)])

theorem mul_mod_mul_right (z x y : ℕ) : (x * z) % (y * z) = (x % y) * z :=
by rw [nat.mul_comm x z, nat.mul_comm y z, nat.mul_comm (x % y) z]; apply mul_mod_mul_left

theorem cond_to_bool_mod_two (x : ℕ) [d : decidable (x % 2 = 1)]
: cond (@to_bool (x % 2 = 1) d) 1 0 = x % 2 :=
begin
  by_cases h : x % 2 = 1,
  { simp! [*] },
  { cases mod_two_eq_zero_or_one x; simp! [*, nat.zero_ne_one]; contradiction }
end

theorem sub_mul_mod (x k n : ℕ) (h₁ : n*k ≤ x) : (x - n*k) % n = x % n :=
begin
  induction k with k,
  { rw [nat.mul_zero, nat.sub_zero] },
  { have h₂ : n * k ≤ x,
    { rw [mul_succ] at h₁,
      apply nat.le_trans _ h₁,
      apply nat.le_add_right _ n },
    have h₄ : x - n * k ≥ n,
    { apply @nat.le_of_add_le_add_right (n*k),
      rw [nat.sub_add_cancel h₂],
      simp [mul_succ, nat.add_comm] at h₁, simp [h₁] },
    rw [mul_succ, ← nat.sub_sub, ← mod_eq_sub_mod h₄, k_ih h₂] }
end

/-! div -/

private lemma div_core_congr {x y f1 f2} (h1 : x ≤ f1) (h2 : x ≤ f2) :
  nat.div_core y f1 x = nat.div_core y f2 x :=
begin
  cases y, { cases f1; cases f2; refl },
  induction f1 with f1 ih generalizing x f2, { cases h1, cases f2; refl },
  cases x, { cases f1; cases f2; refl },
  cases f2, { cases h2 },
  refine if_congr iff.rfl _ rfl,
  simp only [succ_sub_succ],
  refine congr_arg (+1) _,
  exact ih
    (le_trans (nat.sub_le _ _) (le_of_succ_le_succ h1))
    (le_trans (nat.sub_le _ _) (le_of_succ_le_succ h2))
end

lemma div_def (x y : nat) : x / y = if 0 < y ∧ y ≤ x then (x - y) / y + 1 else 0 :=
begin
  cases x, { cases y; refl },
  cases y, { refl },
  refine if_congr iff.rfl (congr_arg (+1) _) rfl,
  refine div_core_congr _ _; simp [nat.sub_le]
end

lemma mod_add_div (m k : ℕ)
: m % k + k * (m / k) = m :=
begin
  apply nat.strong_induction_on m,
  clear m,
  intros m IH,
  cases decidable.em (0 < k ∧ k ≤ m) with h h',
  -- 0 < k ∧ k ≤ m
  { have h' : m - k < m,
    { apply nat.sub_lt _ h.left,
      apply lt_of_lt_of_le h.left h.right },
    rw [div_def, mod_def, if_pos h, if_pos h],
    simp [nat.left_distrib, IH _ h', nat.add_comm, nat.add_left_comm],
    rw [nat.add_comm, ← nat.add_sub_assoc h.right, nat.mul_one, nat.add_sub_cancel_left] },
  -- ¬ (0 < k ∧ k ≤ m)
  { rw [div_def, mod_def, if_neg h', if_neg h', nat.mul_zero, nat.add_zero] },
end

@[simp] protected lemma div_one (n : ℕ) : n / 1 = n :=
have n % 1 + 1 * (n / 1) = n, from mod_add_div _ _,
by { rwa [mod_one, nat.zero_add, nat.one_mul] at this }

@[simp] protected lemma div_zero (n : ℕ) : n / 0 = 0 :=
begin rw [div_def], simp [lt_irrefl] end

@[simp] protected lemma zero_div (b : ℕ) : 0 / b = 0 :=
eq.trans (div_def 0 b) $ if_neg (and.rec not_le_of_gt)

protected lemma div_le_of_le_mul {m n : ℕ} : ∀ {k}, m ≤ k * n → m / k ≤ n
| 0        h := by simp [nat.div_zero, n.zero_le]
| (succ k) h :=
  suffices succ k * (m / succ k) ≤ succ k * n, from nat.le_of_mul_le_mul_left this (zero_lt_succ _),
  calc
    succ k * (m / succ k) ≤ m % succ k + succ k * (m / succ k) : nat.le_add_left _ _
                      ... = m                                  : by rw mod_add_div
                      ... ≤ succ k * n                         : h

protected lemma div_le_self : ∀ (m n : ℕ), m / n ≤ m
| m 0        := by simp [nat.div_zero, m.zero_le]
| m (succ n) :=
  have m ≤ succ n * m, from calc
    m  = 1 * m      : by rw nat.one_mul
   ... ≤ succ n * m : m.mul_le_mul_right (succ_le_succ n.zero_le),
  nat.div_le_of_le_mul this

lemma div_eq_sub_div {a b : nat} (h₁ : 0 < b) (h₂ : b ≤ a) : a / b = (a - b) / b + 1 :=
begin
  rw [div_def a, if_pos],
  split ; assumption
end

lemma div_eq_of_lt {a b : ℕ} (h₀ : a < b) : a / b = 0 :=
begin
  rw [div_def a, if_neg],
  intro h₁,
  apply not_le_of_gt h₀ h₁.right
end

-- this is a Galois connection
--   f x ≤ y ↔ x ≤ g y
-- with
--   f x = x * k
--   g y = y / k
theorem le_div_iff_mul_le (x y : ℕ) {k : ℕ} (Hk : 0 < k) : x ≤ y / k ↔ x * k ≤ y :=
begin
  -- Hk is needed because, despite div being made total, y / 0 := 0
  --     x * 0 ≤ y ↔ x ≤ y / 0
  --   ↔ 0 ≤ y ↔ x ≤ 0
  --   ↔ true ↔ x = 0
  --   ↔ x = 0
  revert x,
  apply nat.strong_induction_on y _,
  clear y,
  intros y IH x,
  cases lt_or_le y k with h h,
  -- base case: y < k
  { rw [div_eq_of_lt h],
    cases x with x,
    { simp [nat.zero_mul, y.zero_le] },
    { simp [succ_mul, not_succ_le_zero, nat.add_comm],
      apply lt_of_lt_of_le h,
      apply nat.le_add_right } },
  -- step: k ≤ y
  { rw [div_eq_sub_div Hk h],
    cases x with x,
    { simp [nat.zero_mul, nat.zero_le] },
    { have Hlt : y - k < y,
      { apply nat.sub_lt_of_pos_le ; assumption },
      rw [ ← add_one
         , nat.add_le_add_iff_le_right
         , IH (y - k) Hlt x
         , add_one
         , succ_mul, nat.add_le_to_le_sub _ h ]
     } }
end

theorem div_lt_iff_lt_mul (x y : ℕ) {k : ℕ} (Hk : 0 < k) : x / k < y ↔ x < y * k :=
begin
  simp [← not_le],
  apply not_iff_not_of_iff,
  apply le_div_iff_mul_le _ _ Hk
end

theorem sub_mul_div (x n p : ℕ) (h₁ : n*p ≤ x) : (x - n*p) / n = x / n - p :=
begin
  cases nat.eq_zero_or_pos n with h₀ h₀,
  { rw [h₀, nat.div_zero, nat.div_zero, nat.zero_sub] },
  { induction p with p,
    { rw [nat.mul_zero, nat.sub_zero, nat.sub_zero] },
    { have h₂ : n*p ≤ x,
      { transitivity,
        { apply nat.mul_le_mul_left, apply le_succ },
        { apply h₁ } },
      have h₃ : x - n * p ≥ n,
      { apply nat.le_of_add_le_add_right,
        rw [nat.sub_add_cancel h₂, nat.add_comm],
        rw [mul_succ] at h₁,
        apply h₁ },
      rw [sub_succ, ← p_ih h₂],
      rw [@div_eq_sub_div (x - n*p) _ h₀ h₃],
      simp [add_one, pred_succ, mul_succ, nat.sub_sub] } }
end

theorem div_mul_le_self : ∀ (m n : ℕ), m / n * n ≤ m
| m 0        := by simp [m.zero_le, nat.zero_mul]
| m (succ n) := (le_div_iff_mul_le _ _ (nat.succ_pos _)).1 (le_refl _)

@[simp] theorem add_div_right (x : ℕ) {z : ℕ} (H : 0 < z) : (x + z) / z = succ (x / z) :=
by rw [div_eq_sub_div H (nat.le_add_left _ _), nat.add_sub_cancel]

@[simp] theorem add_div_left (x : ℕ) {z : ℕ} (H : 0 < z) : (z + x) / z = succ (x / z) :=
by rw [nat.add_comm, add_div_right x H]

@[simp] theorem mul_div_right (n : ℕ) {m : ℕ} (H : 0 < m) : m * n / m = n :=
by {induction n; simp [*, mul_succ, nat.mul_zero] }

@[simp] theorem mul_div_left (m : ℕ) {n : ℕ} (H : 0 < n) : m * n / n = m :=
by rw [nat.mul_comm, mul_div_right _ H]

protected theorem div_self {n : ℕ} (H : 0 < n) : n / n = 1 :=
let t := add_div_right 0 H in by rwa [nat.zero_add, nat.zero_div] at t

theorem add_mul_div_left (x z : ℕ) {y : ℕ} (H : 0 < y) : (x + y * z) / y = x / y + z :=
begin
  induction z with z ih,
  { rw [nat.mul_zero, nat.add_zero, nat.add_zero] },
  { rw [mul_succ, ← nat.add_assoc, add_div_right _ H, ih], refl }
end

theorem add_mul_div_right (x y : ℕ) {z : ℕ} (H : 0 < z) : (x + y * z) / z = x / z + y :=
by rw [nat.mul_comm, add_mul_div_left _ _ H]

protected theorem mul_div_cancel (m : ℕ) {n : ℕ} (H : 0 < n) : m * n / n = m :=
let t := add_mul_div_right 0 m H in by rwa [nat.zero_add, nat.zero_div, nat.zero_add] at t

protected theorem mul_div_cancel_left (m : ℕ) {n : ℕ} (H : 0 < n) : n * m / n = m :=
by rw [nat.mul_comm, nat.mul_div_cancel _ H]

protected theorem div_eq_of_eq_mul_left {m n k : ℕ} (H1 : 0 < n) (H2 : m = k * n) :
  m / n = k :=
by rw [H2, nat.mul_div_cancel _ H1]

protected theorem div_eq_of_eq_mul_right {m n k : ℕ} (H1 : 0 < n) (H2 : m = n * k) :
  m / n = k :=
by rw [H2, nat.mul_div_cancel_left _ H1]

protected theorem div_eq_of_lt_le {m n k : ℕ}
  (lo : k * n ≤ m) (hi : m < succ k * n) :
  m / n = k :=
have npos : 0 < n, from n.eq_zero_or_pos.resolve_left $ λ hn,
  by rw [hn, nat.mul_zero] at hi lo; exact absurd lo (not_le_of_gt hi),
le_antisymm
  (le_of_lt_succ ((nat.div_lt_iff_lt_mul _ _ npos).2 hi))
  ((nat.le_div_iff_mul_le _ _ npos).2 lo)

theorem mul_sub_div (x n p : ℕ) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) :=
begin
  have npos : 0 < n := n.eq_zero_or_pos.resolve_left (λ n0,
    by rw [n0, nat.zero_mul] at h₁; exact nat.not_lt_zero _ h₁),
  apply nat.div_eq_of_lt_le,
  { rw [nat.mul_sub_right_distrib, nat.mul_comm],
    apply nat.sub_le_sub_left,
    exact (div_lt_iff_lt_mul _ _ npos).1 (lt_succ_self _) },
  { change succ (pred (n * p - x)) ≤ (succ (pred (p - x / n))) * n,
    rw [succ_pred_eq_of_pos (nat.sub_pos_of_lt h₁),
        succ_pred_eq_of_pos (nat.sub_pos_of_lt _)],
    { rw [nat.mul_sub_right_distrib, nat.mul_comm],
      apply nat.sub_le_sub_left, apply div_mul_le_self },
    { apply (div_lt_iff_lt_mul _ _ npos).2, rwa nat.mul_comm } }
end

protected theorem div_div_eq_div_mul (m n k : ℕ) : m / n / k = m / (n * k) :=
begin
  cases k.eq_zero_or_pos with k0 kpos, {rw [k0, nat.mul_zero, nat.div_zero, nat.div_zero]},
  cases n.eq_zero_or_pos with n0 npos, {rw [n0, nat.zero_mul, nat.div_zero, nat.zero_div]},
  apply le_antisymm,
  { apply (le_div_iff_mul_le _ _ (nat.mul_pos npos kpos)).2,
    rw [nat.mul_comm n k, ← nat.mul_assoc],
    apply (le_div_iff_mul_le _ _ npos).1,
    apply (le_div_iff_mul_le _ _ kpos).1,
    refl },
  { apply (le_div_iff_mul_le _ _ kpos).2,
    apply (le_div_iff_mul_le _ _ npos).2,
    rw [nat.mul_assoc, nat.mul_comm n k],
    apply (le_div_iff_mul_le _ _ (nat.mul_pos kpos npos)).1,
    refl }
end

protected theorem mul_div_mul {m : ℕ} (n k : ℕ) (H : 0 < m) : m * n / (m * k) = n / k :=
by rw [← nat.div_div_eq_div_mul, nat.mul_div_cancel_left _ H]

lemma div_lt_self {n m : nat} : 0 < n → 1 < m → n / m < n :=
begin
  intros h₁ h₂,
  have m_pos : 0 < m, { apply lt_trans _ h₂, comp_val },
  suffices : 1 * n < m * n, {
    rw [nat.one_mul, nat.mul_comm] at this,
    exact iff.mpr (nat.div_lt_iff_lt_mul n n m_pos) this
  },
  exact nat.mul_lt_mul h₂ (le_refl _) h₁
end

/-! dvd -/

protected theorem dvd_mul_right (a b : ℕ) : a ∣ a * b := ⟨b, rfl⟩

protected theorem dvd_trans {a b c : ℕ} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c :=
match h₁, h₂ with
| ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ :=
  ⟨d * e, show c = a * (d * e), by simp [h₃, h₄, nat.mul_assoc]⟩
end

protected theorem eq_zero_of_zero_dvd {a : ℕ} (h : 0 ∣ a) : a = 0 :=
exists.elim h (assume c, assume H' : a = 0 * c, eq.trans H' (nat.zero_mul c))

protected theorem dvd_add {a b c : ℕ} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c :=
  exists.elim h₁ (λ d hd, exists.elim h₂ (λ e he, ⟨d + e, by simp [nat.left_distrib, hd, he]⟩))

protected theorem dvd_add_iff_right {k m n : ℕ} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n :=
⟨nat.dvd_add h, exists.elim h $ λd hd, match m, hd with
| ._, rfl := λh₂, exists.elim h₂ $ λe he, ⟨e - d,
  by rw [nat.mul_sub_left_distrib, ← he, nat.add_sub_cancel_left]⟩
end⟩

protected theorem dvd_add_iff_left {k m n : ℕ} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n :=
by rw nat.add_comm; exact nat.dvd_add_iff_right h

theorem dvd_sub {k m n : ℕ} (H : n ≤ m) (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n :=
(nat.dvd_add_iff_left h₂).2 $ by rw nat.sub_add_cancel H; exact h₁

theorem dvd_mod_iff {k m n : ℕ} (h : k ∣ n) : k ∣ m % n ↔ k ∣ m :=
let t := @nat.dvd_add_iff_left _ (m % n) _ (nat.dvd_trans h (nat.dvd_mul_right n (m / n))) in
by rwa mod_add_div at t

theorem le_of_dvd {m n : ℕ} (h : 0 < n) : m ∣ n → m ≤ n :=
λ⟨k, e⟩, by {
  revert h, rw e, refine k.cases_on _ _,
  exact λhn, absurd hn (lt_irrefl _),
  exact λk _, let t := m.mul_le_mul_left (succ_pos k) in by rwa nat.mul_one at t }

theorem dvd_antisymm : Π {m n : ℕ}, m ∣ n → n ∣ m → m = n
| m        0        h₁ h₂ := nat.eq_zero_of_zero_dvd h₂
| 0        n        h₁ h₂ := (nat.eq_zero_of_zero_dvd h₁).symm
| (succ m) (succ n) h₁ h₂ := le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂)

theorem pos_of_dvd_of_pos {m n : ℕ} (H1 : m ∣ n) (H2 : 0 < n) : 0 < m :=
nat.pos_of_ne_zero $ λm0, by rw m0 at H1; rw nat.eq_zero_of_zero_dvd H1 at H2; exact lt_irrefl _ H2

theorem eq_one_of_dvd_one {n : ℕ} (H : n ∣ 1) : n = 1 :=
le_antisymm (le_of_dvd dec_trivial H) (pos_of_dvd_of_pos H dec_trivial)

theorem dvd_of_mod_eq_zero {m n : ℕ} (H : n % m = 0) : m ∣ n :=
⟨n / m, by { have t := (mod_add_div n m).symm, rwa [H, nat.zero_add] at t }⟩

theorem mod_eq_zero_of_dvd {m n : ℕ} (H : m ∣ n) : n % m = 0 :=
exists.elim H (λ z H1, by rw [H1, mul_mod_right])

theorem dvd_iff_mod_eq_zero (m n : ℕ) : m ∣ n ↔ n % m = 0 :=
⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩

instance decidable_dvd : @decidable_rel ℕ (∣) :=
λm n, decidable_of_decidable_of_iff (by apply_instance) (dvd_iff_mod_eq_zero _ _).symm

protected theorem mul_div_cancel' {m n : ℕ} (H : n ∣ m) : n * (m / n) = m :=
let t := mod_add_div m n in by rwa [mod_eq_zero_of_dvd H, nat.zero_add] at t

protected theorem div_mul_cancel {m n : ℕ} (H : n ∣ m) : m / n * n = m :=
by rw [nat.mul_comm, nat.mul_div_cancel' H]

protected theorem mul_div_assoc (m : ℕ) {n k : ℕ} (H : k ∣ n) : m * n / k = m * (n / k) :=
or.elim k.eq_zero_or_pos
  (λh, by rw [h, nat.div_zero, nat.div_zero, nat.mul_zero])
  (λh, have m * n / k = m * (n / k * k) / k, by rw nat.div_mul_cancel H,
       by rw[this, ← nat.mul_assoc, nat.mul_div_cancel _ h])

theorem dvd_of_mul_dvd_mul_left {m n k : ℕ} (kpos : 0 < k) (H : k * m ∣ k * n) : m ∣ n :=
exists.elim H (λl H1, by rw nat.mul_assoc at H1; exact ⟨_, nat.eq_of_mul_eq_mul_left kpos H1⟩)

theorem dvd_of_mul_dvd_mul_right {m n k : ℕ} (kpos : 0 < k) (H : m * k ∣ n * k) : m ∣ n :=
by rw [nat.mul_comm m k, nat.mul_comm n k] at H; exact dvd_of_mul_dvd_mul_left kpos H

/-! iterate -/

def iterate {α : Sort u} (op : α → α) : ℕ → α → α
 | 0        a := a
 | (succ k) a := iterate k (op a)

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

/-! find -/

section find
parameter {p : ℕ → Prop}

private def lbp (m n : ℕ) : Prop := m = n + 1 ∧ ∀ k ≤ n, ¬p k

parameters [decidable_pred p] (H : ∃n, p n)

private def wf_lbp : well_founded lbp :=
⟨let ⟨n, pn⟩ := H in
suffices ∀m k, n ≤ k + m → acc lbp k, from λa, this _ _ (nat.le_add_left _ _),
λm, nat.rec_on m
  (λk kn, ⟨_, λy r, match y, r with ._, ⟨rfl, a⟩ := absurd pn (a _ kn) end⟩)
  (λm IH k kn, ⟨_, λy r, match y, r with ._, ⟨rfl, a⟩ := IH _ (by rw nat.add_right_comm; exact kn) end⟩)⟩

protected def find_x : {n // p n ∧ ∀m < n, ¬p m} :=
@well_founded.fix _ (λk, (∀n < k, ¬p n) → {n // p n ∧ ∀m < n, ¬p m}) lbp wf_lbp
(λm IH al, if pm : p m then ⟨m, pm, al⟩ else
    have ∀ n ≤ m, ¬p n, from λn h, or.elim (decidable.lt_or_eq_of_le h) (al n) (λe, by rw e; exact pm),
    IH _ ⟨rfl, this⟩ (λn h, this n $ nat.le_of_succ_le_succ h))
0 (λn h, absurd h (nat.not_lt_zero _))

/--
If `p` is a (decidable) predicate on `ℕ` and `hp : ∃ (n : ℕ), p n` is a proof that
there exists some natural number satisfying `p`, then `nat.find hp` is the
smallest natural number satisfying `p`. Note that `nat.find` is protected,
meaning that you can't just write `find`, even if the `nat` namespace is open.

The API for `nat.find` is:

* `nat.find_spec` is the proof that `nat.find hp` satisfies `p`.
* `nat.find_min` is the proof that if `m < nat.find hp` then `m` does not satisfy `p`.
* `nat.find_min'` is the proof that if `m` does satisfy `p` then `nat.find hp ≤ m`.
-/
protected def find : ℕ := nat.find_x.1

protected theorem find_spec : p nat.find := nat.find_x.2.left

protected theorem find_min : ∀ {m : ℕ}, m < nat.find → ¬p m := nat.find_x.2.right

protected theorem find_min' {m : ℕ} (h : p m) : nat.find ≤ m :=
le_of_not_lt (λ l, find_min l h)

end find

end nat


/- Homework 1.3: Basics — More Logic and Proofs -/

/- Question 1: Logical connectives -/

/- 1.1. Prove the following property about double negation.

Hint: Notice and exploit the similarity with the weak Peirce law from the exercises. Also, you will
need the elimination rule for `false` at a key point. -/

lemma herman (p : Prop) : ¬¬ (¬¬ p → p) :=
begin
  dunfold not,
  intro ph,
  apply ph,
  intro lh,
  apply false.elim,
  apply lh,
  intro kh,
  apply ph,
  intro sh,
  assumption
end

/- 1.2. Prove the missing link in our chain of classical axiom implications.

Hint: You will need to apply the double negation hypothesis for `p ∨ ¬ p`. You will also need the
left and right introduction rules for `or` at some point.
-/

def excluded_middle := ∀p : Prop, p ∨ ¬ p
def peirce := ∀p q : Prop, ((p → q) → p) → p
def double_negation := ∀p : Prop, ¬¬ p → p

lemma dn_imp_em : double_negation → excluded_middle :=
begin
  intros ph qh,
  apply ph,
  intro lh,
  apply false.elim,
  apply ph,
  intro sh,
  apply false.elim,
  apply lh,
  apply or.inr,
  intro th,
  apply lh,
  apply or.inl,
  assumption
end

-- these are copied from the exercise; there is no need to prove them again
lemma em_imp_peirce : excluded_middle → peirce :=
begin
  intros ex p,
  intros a b,
  apply or.elim,
  apply ex,
  intro c,
  apply c,
  intro d,
  apply b,
  intro p,
  apply false.elim,
  apply d,
  assumption
end

lemma peirce_imp_dn : peirce → double_negation :=
begin
  intros p not q,
  apply p,
  intro s,
  apply false.elim,
  apply q,
  apply s,
  apply p not,
  intro l,
  apply l,
  apply false.elim,
  apply q,
  intro sh,
  apply p,
  intro lh,
  apply s,
  apply lh,
  apply s,
  assumption,
  assumption,
  assumption
end

/- 1.3. We have proved three of the six possible implications between `excluded_middle`, `peirce`,
and `double_negation`. State and prove the three missing implications, exploiting the three theorems
we have already proved. -/

lemma dn_em_imp : excluded_middle → double_negation :=
begin
  intros a b c,
  apply em_imp_peirce,
  intro l,
  apply or.elim,
  apply a,
  intro l,
  apply l,
  intro notl,
  apply or.intro_right,
  intro l,
  apply notl,
  apply or.intro_left,
  assumption,
  intro k,
  apply k,
  apply or.elim,
  apply a,
  apply k,
  intro notb,
  apply false.elim,
  apply c,
  assumption
end

lemma imp_em_peirce :  peirce → excluded_middle :=
begin
  intros a b,
  apply dn_em_imp,
  intro l,
  apply a,
  intro s,
  apply or.inl,
  apply s,
  apply dn_imp_em,
  intro newl,
  intro double,
  apply a,
  intro b,
  apply false.elim,
  apply double,
  apply b,
  apply false.elim,
  apply double,
  intro s,
  apply double,
  apply b,
  assumption,
  intro s,
  apply s,
  apply or.inr,
  intro l,
  apply s,
  apply or.inl,
  assumption
end

-- lemma peirce_dn_imp :  double_negation → peirce:=
-- begin
-- intros a b c,
-- intro s,
-- apply peirce_imp_dn,
-- intro ex,
-- intros l q,
-- apply q,
-- intro ex,

-- end
/- Question 2: Predicate logic -/

/- 2.1. Prove the distributivity of `∀` over `∧` using `intro(s)`, `apply`, and `exact`. -/

example {α} (p q : α → Prop) :
 (∀x, p x ∧ q x) ↔  (∀x, p x) ∧ (∀x, q x) :=
begin
  apply iff.intro,
  intro ph,
  apply and.intro,
  intro sh,
  apply and.elim,
  apply ph,
  exact sh,
  intros lh qh,
  exact lh,
  intro eh,
  apply and.elim,
  apply ph,
  exact eh,
  intros ah bh,
  exact bh,
  intros newph newsh,
  apply and.intro,
  apply and.elim,
  apply newph,
  intros newph newsh,
  apply newph,
  apply and.elim,
  apply newph,
  intros qh yh,
  apply yh
end

/- 2.2. Redo the above proof, this time using structured proofs (with `assume`, `have`, and `show`)
for the two subcases emerging from the introduction rule for `↔`. -/

example {α} (p q : α → Prop) : (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
begin
  apply iff.intro,
  assume hpq,
  apply and.intro,
  assume ah,
  have b := and.left (hpq ah),
  show p ah, from b,
  assume bh,
  have c := and.right (hpq bh),
  show q bh, from c,
  assume hpq,
  assume dh,
  apply and.intro,
  have e := and.left hpq dh,
  show p dh, from e,
  have f := and.right hpq dh,
  show q dh, from f
end

/- Question 3: The reverse of a list, revisited -/

def reverse {α} : list α → list α
| []        := []
| (x :: xs) := reverse xs ++ [x]

-- taken from lecture 1.2
lemma reverse_append {α} : ∀xs ys : list α, reverse (xs ++ ys) = reverse ys ++ reverse xs:=
begin
  intro s,
  induction s,
  simp[reverse],
  simp[reverse],
  intro l,
  rw[s_ih],
  simp
end

/- 3.1. Prove the induction step in the proof below using the **calculational style**, following
this proof sketch:

  reverse (reverse (x :: xs))
=     { by definition of `reverse` }
  reverse (reverse xs ++ [x])
=     { using the lemma `reverse_append` }
  reverse [x] ++ reverse (reverse xs)
=     { by the induction hypothesis }
  reverse [x] ++ xs
=     { by definition of `++` and `reverse` }
  [x] ++ xs
=     { by definition of `++` }
  x :: xs
-/

lemma reverse_reverse {α} : ∀xs : list α, reverse (reverse xs) = xs
| [] := by refl
| (x :: xs) :=
calc reverse  (reverse (x :: xs))
      =       x::xs                                 :     by simp[reverse, reverse_append, reverse, reverse_reverse xs]
  ... =       reverse (reverse xs ++ [x])           :     by simp[reverse_append, reverse, reverse_reverse xs]
  ... =       reverse [x] ++ reverse (reverse xs)   :     by simp[reverse, reverse_append]
  ... =       reverse [x] ++ xs                     :     by simp[reverse, reverse_reverse xs]
  ... =       [x] ++ xs                             :     by simp[reverse]
  ... =       x :: xs                               :     by simp[reverse]

/- 3.2 (**optional bonus**). Lean's library includes an operation called `list.reverse`. Its
implementation is optimized to be tail-recursive, by means of an accumulator. Prove that the
optimized `list.reverse` behaves in the same way as our simple `reverse` implementation.

To see the definition of `list.reverse`, hover over its name below while holding the Control or
Command key pressed and click the name.
-/

#check list.reverse

lemma list_reverse_eq_reverse {α} : ∀xs : list α, list.reverse xs = reverse xs
| [] := by refl
| (x :: xs) :=
begin
simp[reverse],
simp[list.reverse],
simp[list.reverse_core],
induction xs,
simp[reverse, list.reverse_core],
simp[reverse,list.reverse_core],
simp[list.reverse],

end


import game.series.tempLevel02
variable X : Type --hide

namespace xena

/-
Idea 03: comparison test
-/

/- Lemma
Suppose $0 ≤ a_n ≤ b_n$ for all n ∈ ℕ. If $∑ b_n$ converges
then $∑ a_n$ converges and $∑ a_n ≤ ∑ b_n$.
-/

theorem comparison_test (a b : ℕ → ℝ)
(h1 : ∀ (n : ℕ), 0 ≤ a n)
(h2 : ∀ (n : ℕ), a n ≤ b n) :
series_converges b → series_converges a :=

begin

--introduce hyp that series over b converges, with sum S
intro hyp,

-- we will use the following fact later
-- our converging sequence of partials must be bounded
have fact := bounded_if_convergent (seq_partials_over b) hyp,

cases hyp with S hypS,

    --show that partial sums over a are all positive
    have fact1: ∀ k : ℕ, (0 ≤ kth_partial_sum a k),
    unfold kth_partial_sum, -- just making finset explicit
    intro k,

        have fact2: ∀ x ∈ (finset.range (k + 1)), 0 ≤ a x,
        intros x hx,
        specialize h1 x, exact h1,

    apply finset.sum_nonneg,
    exact fact2,

    --show that nth partial sum over a ≤ nth partial sum over b
    have fact3: ∀ k : ℕ,
    kth_partial_sum a k ≤ kth_partial_sum b k,
    intro k,

        have fact4: ∀ x ∈ (finset.range (k + 1)), a x ≤ b x,
        intros x hx,
        specialize h2 x, exact h2,

    apply finset.sum_le_sum,
    exact fact4,

-- Although we know that our series over b converges with sum S
-- we use the fact that the sequence of sums must be bounded
-- by *some* T (i.e. we don't use the fact that S is the supremum)

cases fact with T hypT,
-- hypT is stated in terms of `abs`
-- so our partial sums over b are bounded above
have fact5: ∀ k : ℕ, kth_partial_sum b k ≤ T,
unfold seq_partials_over at hypT,
intro K,
have fact6: kth_partial_sum b K ≤ |kth_partial_sum b K|,
exact le_abs_self (kth_partial_sum b K),
have :=  hypT K,
linarith,
-- so our partial sums over a are bounded above
have fact7 : ∀ k : ℕ, kth_partial_sum a k ≤ T,
intro k, specialize fact3 k, specialize fact5 k, linarith,
-- bdd_mono_converges is the relevant theorem now.
-- but it uses absolute values, so we will need to
-- do a little more work using some facts proved above
refine bdd_mono_converges (seq_partials_over a) _ _,
unfold seq_partials_over,
use T,
intro m,
let fact8 := fact7 m,
refine max_le (fact7 m) _,
have fact9 := fact1 m,
linarith,

unfold is_monotone,
left,
intro n,
unfold seq_partials_over,
let fact10 := finset.sum_range_succ a (n+1),
have fact11 := h1 (n + 1),
unfold kth_partial_sum,
linarith,

end

end xena


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

Definitions and properties of gcd, lcm, and coprime.
-/
import data.nat.basic

namespace nat

/- gcd -/

theorem gcd_dvd (m n : ℕ) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) :=
gcd.induction m n
  (λn, by rw gcd_zero_left; exact ⟨dvd_zero n, dvd_refl n⟩)
  (λm n npos, by rw ←gcd_rec; exact λ ⟨IH₁, IH₂⟩, ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩)

theorem gcd_dvd_left (m n : ℕ) : gcd m n ∣ m := (gcd_dvd m n).left

theorem gcd_dvd_right (m n : ℕ) : gcd m n ∣ n := (gcd_dvd m n).right

theorem dvd_gcd {m n k : ℕ} : k ∣ m → k ∣ n → k ∣ gcd m n :=
gcd.induction m n (λn _ kn, by rw gcd_zero_left; exact kn)
  (λn m mpos IH H1 H2, by rw gcd_rec; exact IH ((dvd_mod_iff H1).2 H2) H1)

theorem gcd_comm (m n : ℕ) : gcd m n = gcd n m :=
dvd_antisymm
  (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n))
  (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m))

theorem gcd_assoc (m n k : ℕ) : gcd (gcd m n) k = gcd m (gcd n k) :=
dvd_antisymm
  (dvd_gcd
    (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_left m n))
    (dvd_gcd (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_right m n)) (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_left n k)))
    (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k)))

@[simp] theorem gcd_one_right (n : ℕ) : gcd n 1 = 1 :=
eq.trans (gcd_comm n 1) $ gcd_one_left n

theorem gcd_mul_left (m n k : ℕ) : gcd (m * n) (m * k) = m * gcd n k :=
gcd.induction n k
  (λk, by repeat {rw mul_zero <|> rw gcd_zero_left})
  (λk n H IH, by rwa [←mul_mod_mul_left, ←gcd_rec, ←gcd_rec] at IH)

theorem gcd_mul_right (m n k : ℕ) : gcd (m * n) (k * n) = gcd m k * n :=
by rw [mul_comm m n, mul_comm k n, mul_comm (gcd m k) n, gcd_mul_left]

theorem gcd_pos_of_pos_left {m : ℕ} (n : ℕ) (mpos : m > 0) : gcd m n > 0 :=
pos_of_dvd_of_pos (gcd_dvd_left m n) mpos

theorem gcd_pos_of_pos_right (m : ℕ) {n : ℕ} (npos : n > 0) : gcd m n > 0 :=
pos_of_dvd_of_pos (gcd_dvd_right m n) npos

theorem eq_zero_of_gcd_eq_zero_left {m n : ℕ} (H : gcd m n = 0) : m = 0 :=
or.elim (eq_zero_or_pos m) id
  (assume H1 : m > 0, absurd (eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1)))

theorem eq_zero_of_gcd_eq_zero_right {m n : ℕ} (H : gcd m n = 0) : n = 0 :=
by rw gcd_comm at H; exact eq_zero_of_gcd_eq_zero_left H

theorem gcd_div {m n k : ℕ} (H1 : k ∣ m) (H2 : k ∣ n) :
  gcd (m / k) (n / k) = gcd m n / k :=
or.elim (eq_zero_or_pos k)
  (λk0, by rw [k0, nat.div_zero, nat.div_zero, nat.div_zero, gcd_zero_right])
  (λH3, nat.eq_of_mul_eq_mul_right H3 $ by rw [
    nat.div_mul_cancel (dvd_gcd H1 H2), ←gcd_mul_right,
    nat.div_mul_cancel H1, nat.div_mul_cancel H2])

theorem gcd_dvd_gcd_of_dvd_left {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd m n ∣ gcd k n :=
dvd_gcd (dvd.trans (gcd_dvd_left m n) H) (gcd_dvd_right m n)

theorem gcd_dvd_gcd_of_dvd_right {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd n m ∣ gcd n k :=
dvd_gcd (gcd_dvd_left n m) (dvd.trans (gcd_dvd_right n m) H)

theorem gcd_dvd_gcd_mul_left (m n k : ℕ) : gcd m n ∣ gcd (k * m) n :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right (m n k : ℕ) : gcd m n ∣ gcd (m * k) n :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_right _ _)

theorem gcd_dvd_gcd_mul_left_right (m n k : ℕ) : gcd m n ∣ gcd m (k * n) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right (m n k : ℕ) : gcd m n ∣ gcd m (n * k) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_right _ _)

theorem gcd_eq_left {m n : ℕ} (H : m ∣ n) : gcd m n = m :=
dvd_antisymm (gcd_dvd_left _ _) (dvd_gcd (dvd_refl _) H)

theorem gcd_eq_right {m n : ℕ} (H : n ∣ m) : gcd m n = n :=
by rw [gcd_comm, gcd_eq_left H]

/- lcm -/

theorem lcm_comm (m n : ℕ) : lcm m n = lcm n m :=
by delta lcm; rw [mul_comm, gcd_comm]

theorem lcm_zero_left (m : ℕ) : lcm 0 m = 0 :=
by delta lcm; rw [zero_mul, nat.zero_div]

theorem lcm_zero_right (m : ℕ) : lcm m 0 = 0 := lcm_comm 0 m ▸ lcm_zero_left m

theorem lcm_one_left (m : ℕ) : lcm 1 m = m :=
by delta lcm; rw [one_mul, gcd_one_left, nat.div_one]

theorem lcm_one_right (m : ℕ) : lcm m 1 = m := lcm_comm 1 m ▸ lcm_one_left m

theorem lcm_self (m : ℕ) : lcm m m = m :=
or.elim (eq_zero_or_pos m)
  (λh, by rw [h, lcm_zero_left])
  (λh, by delta lcm; rw [gcd_self, nat.mul_div_cancel _ h])

theorem dvd_lcm_left (m n : ℕ) : m ∣ lcm m n :=
dvd.intro (n / gcd m n) (nat.mul_div_assoc _ $ gcd_dvd_right m n).symm

theorem dvd_lcm_right (m n : ℕ) : n ∣ lcm m n :=
lcm_comm n m ▸ dvd_lcm_left n m

theorem gcd_mul_lcm (m n : ℕ) : gcd m n * lcm m n = m * n :=
by delta lcm; rw [nat.mul_div_cancel' (dvd.trans (gcd_dvd_left m n) (dvd_mul_right m n))]

theorem lcm_dvd {m n k : ℕ} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k :=
or.elim (eq_zero_or_pos k)
  (λh, by rw h; exact dvd_zero _)
  (λkpos, dvd_of_mul_dvd_mul_left (gcd_pos_of_pos_left n (pos_of_dvd_of_pos H1 kpos)) $
    by rw [gcd_mul_lcm, ←gcd_mul_right, mul_comm n k];
       exact dvd_gcd (mul_dvd_mul_left _ H2) (mul_dvd_mul_right H1 _))

theorem lcm_assoc (m n k : ℕ) : lcm (lcm m n) k = lcm m (lcm n k) :=
dvd_antisymm
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left m (lcm n k)) (dvd.trans (dvd_lcm_left n k) (dvd_lcm_right m (lcm n k))))
    (dvd.trans (dvd_lcm_right n k) (dvd_lcm_right m (lcm n k))))
  (lcm_dvd
    (dvd.trans (dvd_lcm_left m n) (dvd_lcm_left (lcm m n) k))
    (lcm_dvd (dvd.trans (dvd_lcm_right m n) (dvd_lcm_left (lcm m n) k)) (dvd_lcm_right (lcm m n) k)))

/- coprime -/

instance (m n : ℕ) : decidable (coprime m n) := by unfold coprime; apply_instance

theorem coprime.gcd_eq_one {m n : ℕ} : coprime m n → gcd m n = 1 := id

theorem coprime.symm {m n : ℕ} : coprime n m → coprime m n := (gcd_comm m n).trans

theorem coprime_of_dvd {m n : ℕ} (H : ∀ k > 1, k ∣ m → ¬ k ∣ n) : coprime m n :=
or.elim (eq_zero_or_pos (gcd m n))
  (λg0, by rw [eq_zero_of_gcd_eq_zero_left g0, eq_zero_of_gcd_eq_zero_right g0] at H; exact false.elim
    (H 2 dec_trivial (dvd_zero _) (dvd_zero _)))
  (λ(g1 : 1 ≤ _), eq.symm $ (lt_or_eq_of_le g1).resolve_left $ λg2,
    H _ g2 (gcd_dvd_left _ _) (gcd_dvd_right _ _))

theorem coprime_of_dvd' {m n : ℕ} (H : ∀ k, k ∣ m → k ∣ n → k ∣ 1) : coprime m n :=
coprime_of_dvd $ λk kl km kn, not_le_of_gt kl $ le_of_dvd zero_lt_one (H k km kn)

theorem coprime.dvd_of_dvd_mul_right {m n k : ℕ} (H1 : coprime k n) (H2 : k ∣ m * n) : k ∣ m :=
let t := dvd_gcd (dvd_mul_left k m) H2 in
by rwa [gcd_mul_left, H1.gcd_eq_one, mul_one] at t

theorem coprime.dvd_of_dvd_mul_left {m n k : ℕ} (H1 : coprime k m) (H2 : k ∣ m * n) : k ∣ n :=
by rw mul_comm at H2; exact H1.dvd_of_dvd_mul_right H2

theorem coprime.gcd_mul_left_cancel {k : ℕ} (m : ℕ) {n : ℕ} (H : coprime k n) :
   gcd (k * m) n = gcd m n :=
have H1 : coprime (gcd (k * m) n) k,
by rw [coprime, gcd_assoc, H.symm.gcd_eq_one, gcd_one_right],
dvd_antisymm
  (dvd_gcd (H1.dvd_of_dvd_mul_left (gcd_dvd_left _ _)) (gcd_dvd_right _ _))
  (gcd_dvd_gcd_mul_left _ _ _)

theorem coprime.gcd_mul_right_cancel (m : ℕ) {k n : ℕ} (H : coprime k n) :
   gcd (m * k) n = gcd m n :=
by rw [mul_comm m k, H.gcd_mul_left_cancel m]

theorem coprime.gcd_mul_left_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
   gcd m (k * n) = gcd m n :=
by rw [gcd_comm m n, gcd_comm m (k * n), H.gcd_mul_left_cancel n]

theorem coprime.gcd_mul_right_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
   gcd m (n * k) = gcd m n :=
by rw [mul_comm n k, H.gcd_mul_left_cancel_right n]

theorem coprime_div_gcd_div_gcd {m n : ℕ} (H : gcd m n > 0) :
  coprime (m / gcd m n) (n / gcd m n) :=
by delta coprime; rw [gcd_div (gcd_dvd_left m n) (gcd_dvd_right m n), nat.div_self H]

theorem not_coprime_of_dvd_of_dvd {m n d : ℕ} (dgt1 : d > 1) (Hm : d ∣ m) (Hn : d ∣ n) :
  ¬ coprime m n :=
λ (co : gcd m n = 1),
not_lt_of_ge (le_of_dvd zero_lt_one $ by rw ←co; exact dvd_gcd Hm Hn) dgt1

theorem exists_coprime {m n : ℕ} (H : gcd m n > 0) :
  ∃ m' n', coprime m' n' ∧ m = m' * gcd m n ∧ n = n' * gcd m n :=
⟨_, _, coprime_div_gcd_div_gcd H,
  (nat.div_mul_cancel (gcd_dvd_left m n)).symm,
  (nat.div_mul_cancel (gcd_dvd_right m n)).symm⟩

theorem exists_coprime' {m n : ℕ} (H : gcd m n > 0) :
  ∃ g m' n', 0 < g ∧ coprime m' n' ∧ m = m' * g ∧ n = n' * g :=
let ⟨m', n', h⟩ := exists_coprime H in ⟨_, m', n', H, h⟩

theorem coprime.mul {m n k : ℕ} (H1 : coprime m k) (H2 : coprime n k) : coprime (m * n) k :=
(H1.gcd_mul_left_cancel n).trans H2

theorem coprime.mul_right {k m n : ℕ} (H1 : coprime k m) (H2 : coprime k n) : coprime k (m * n) :=
(H1.symm.mul H2.symm).symm

theorem coprime.coprime_dvd_left {m k n : ℕ} (H1 : m ∣ k) (H2 : coprime k n) : coprime m n :=
eq_one_of_dvd_one (by delta coprime at H2; rw ← H2; exact gcd_dvd_gcd_of_dvd_left _ H1)

theorem coprime.coprime_dvd_right {m k n : ℕ} (H1 : n ∣ m) (H2 : coprime k m) : coprime k n :=
(H2.symm.coprime_dvd_left H1).symm

theorem coprime.coprime_mul_left {k m n : ℕ} (H : coprime (k * m) n) : coprime m n :=
H.coprime_dvd_left (dvd_mul_left _ _)

theorem coprime.coprime_mul_right {k m n : ℕ} (H : coprime (m * k) n) : coprime m n :=
H.coprime_dvd_left (dvd_mul_right _ _)

theorem coprime.coprime_mul_left_right {k m n : ℕ} (H : coprime m (k * n)) : coprime m n :=
H.coprime_dvd_right (dvd_mul_left _ _)

theorem coprime.coprime_mul_right_right {k m n : ℕ} (H : coprime m (n * k)) : coprime m n :=
H.coprime_dvd_right (dvd_mul_right _ _)

theorem coprime_one_left : ∀ n, coprime 1 n := gcd_one_left

theorem coprime_one_right : ∀ n, coprime n 1 := gcd_one_right

theorem coprime.pow_left {m k : ℕ} (n : ℕ) (H1 : coprime m k) : coprime (m ^ n) k :=
nat.rec_on n (coprime_one_left _) (λn IH, IH.mul H1)

theorem coprime.pow_right {m k : ℕ} (n : ℕ) (H1 : coprime k m) : coprime k (m ^ n) :=
(H1.symm.pow_left n).symm

theorem coprime.pow {k l : ℕ} (m n : ℕ) (H1 : coprime k l) : coprime (k ^ m) (l ^ n) :=
(H1.pow_left _).pow_right _

theorem coprime.eq_one_of_dvd {k m : ℕ} (H : coprime k m) (d : k ∣ m) : k = 1 :=
by rw [← H.gcd_eq_one, gcd_eq_left d]

theorem exists_eq_prod_and_dvd_and_dvd {m n k : ℕ} (H : k ∣ m * n) :
  ∃ m' n', k = m' * n' ∧ m' ∣ m ∧ n' ∣ n :=
or.elim (eq_zero_or_pos (gcd k m))
  (λg0, ⟨0, n,
    by rw [zero_mul, eq_zero_of_gcd_eq_zero_left g0],
    by rw [eq_zero_of_gcd_eq_zero_right g0]; apply dvd_zero, dvd_refl _⟩)
  (λgpos, let hd := (nat.mul_div_cancel' (gcd_dvd_left k m)).symm in
     ⟨_, _, hd, gcd_dvd_right _ _,
    dvd_of_mul_dvd_mul_left gpos $ by rw [←hd, ←gcd_mul_right]; exact
      dvd_gcd (dvd_mul_right _ _) H⟩)

theorem pow_dvd_pow_iff {a b n : ℕ} (n0 : 0 < n) : a ^ n ∣ b ^ n ↔ a ∣ b :=
begin
  refine ⟨λ h, _, λ h, pow_dvd_pow_of_dvd h _⟩,
  cases eq_zero_or_pos (gcd a b) with g0 g0,
  { simp [eq_zero_of_gcd_eq_zero_right g0] },
  rcases exists_coprime' g0 with ⟨g, a', b', g0', co, rfl, rfl⟩,
  rw [mul_pow, mul_pow] at h,
  replace h := dvd_of_mul_dvd_mul_right (pos_pow_of_pos _ g0') h,
  have := pow_dvd_pow a' n0,
  rw [pow_one, (co.pow n n).eq_one_of_dvd h] at this,
  simp [eq_one_of_dvd_one this]
end

end nat


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-/
open function

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

-- 0031
example (h : surjective (g ∘ f)) : surjective g :=
begin
  intro y,
  specialize h y,
  cases h with a ha,
  use f(a),
  exact ha,
end

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

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


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

## Level 6: `(P → (Q → R)) → ((P → Q) → (P → R))`.

You can solve this level completely just using `intro`, `apply` and `exact`,
but if you want to argue forwards instead of backwards then don't forget
that you can do things like `have j : Q → R := f p` if `f : P → (Q → R)`
and `p : P`. I recommend that you start with `intro f` rather than `intro p`
because even though the goal starts `P → ...`, the brackets mean that
the goal is not the statement that `P` implies anything, it's the statement that
`P ⟹ (Q ⟹ R)` implies something. In fact I'd recommend that you started
with `intros f h p`, which introduces three variables at once.
You then find that your your goal is `⊢ R`. If you try `have j : Q → R := f p`
now then you can `apply j`. Alternatively you can `apply (f p)` directly.
What happens if you just try `apply f`? Can you figure out what just happened? This is a little
`apply` easter egg. Why is it mathematically valid?

## Lemma
If `P` and `Q` and `R` are true/false statements, then
\\((P⟹(Q⟹ R))⟹((P⟹ Q)⟹(P⟹ R))\\).
-/
example (P Q R : Prop) : (P → (Q → R)) → ((P → Q) → (P → R)) := by
  intro f
  intro h
  intro p
  have j : Q → R := f p
  apply j
  apply h
  exact p

/-!
Next up [Level 7](./Level7.lean.md)
-/


import data.real.basic

namespace challenges

-- basic definitions
def upper_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, s ≤ b }
def lower_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, b ≤ s }
def is_least (S : set ℝ) (l : ℝ) : Prop := l ∈ S ∧ l ∈ lower_bounds S
def is_lub (S : set ℝ) (l : ℝ) : Prop := is_least (upper_bounds S) l

/-- A set has at most one least upper bound -/
theorem challenge2 (S : set ℝ) (a b : ℝ) (ha : is_lub S a) (hb : is_lub S b) : a = b :=
begin
  -- One can unfold the definition of is_lub to find out what `ha` actually says:
  unfold is_lub at ha,
  -- one can now unfold the definition of `is_least`:
  unfold is_least at ha,
  -- We discover that `ha` is (by definition) a proof of `P ∧ Q`, with
  -- P := a ∈ upper_bounds S and Q := a ∈ lower_bounds (upper_bounds S).
  -- So we can do cases on this.
  cases ha with ha1 ha2,
  -- We didn't have to do any of that unfolding though.
  cases hb with hb1 hb2,
  -- le_antisymm is the proof that a ≤ b and b ≤ a implies a = b.
  apply le_antisymm,
  -- Now we have two goals.
  { -- a ≤ b follows because a is a lower bound for the upper bounds...
    apply ha2,
    -- ... and b is an upper bound.
    assumption},
  { -- Similarly b is a lower bound for the upper bounds
    apply hb2,
    -- and a is an upper bound.
    assumption},
end

-- Ideas below are by Patrick Massot.

-- another approach with WLOG
theorem challenge2' (S : set ℝ) (a b : ℝ) (ha : is_lub S a) (hb : is_lub S b) : a = b :=
begin
  wlog h : a ≤ b,
  apply le_antisymm h,
  apply hb.right,
  exact ha.left,
end

-- term mode proof (just write the function directly)
theorem challenge2'' (S : set ℝ) (a b : ℝ) (ha : is_lub S a) (hb : is_lub S b) : a = b :=
le_antisymm (ha.2 _ hb.1) (hb.2 _ ha.1)

-- a one-tactic tactic mode proof can be prefixed by `by` instead of begin/end
theorem challenge2''' (S : set ℝ) (a b : ℝ) (ha : is_lub S a) (hb : is_lub S b) : a = b :=
by linarith [hb.2 _ ha.1, ha.2 _ hb.1]

-- a two-tactic tactic mode proof can be made into one tactic with { }
theorem challenge2'''' (S : set ℝ) (a b : ℝ) (ha : is_lub S a) (hb : is_lub S b) : a = b :=
by { wlog h: a ≤ b,  linarith [hb.2 _ ha.1] }

end challenges