import .love01_definitions_and_statements_demo

/- # LoVe Demo 3: Forward Proofs

When developing a proof, often it makes sense to work __forward__: to start with
what we already know and proceed step by step towards our goal. Lean's
structured proofs and raw proof terms are two style that support forward
reasoning. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace forward_proofs

/- ## Structured Constructs

Structured proofs are syntactic sugar sprinkled on top of Lean's
__proof terms__.

The simplest kind of structured proof is the name of a lemma, possibly with
arguments. -/

lemma add_comm (m n : ℕ) :
  add m n = add n m :=
sorry

lemma add_comm_zero_left (n : ℕ) :
  add 0 n = add n 0 :=
add_comm 0 n

lemma add_comm_zero_left₂ (n : ℕ) :
  add 0 n = add n 0 :=
by exact add_comm 0 n

/- `fix` and `assume` move `∀`-quantified variables and assumptions from the
goal into the local context. They can be seen as structured versions of the
`intros` tactic.

`show` repeats the goal to prove. It is useful as documentation or to rephrase
the goal (up to computation). -/

lemma fst_of_two_props :
  ∀a b : Prop, a → b → a :=
fix a b : Prop,
assume ha : a,
assume hb : b,
show a, from
  ha

lemma fst_of_two_props₂ (a b : Prop) (ha : a) (hb : b) :
  a :=
show a, from
  begin
    exact ha
  end

lemma fst_of_two_props₃ (a b : Prop) (ha : a) (hb : b) :
  a :=
ha

/- `have` proves an intermediate lemma, which can refer to the local context. -/

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
have hb : b :=
  hab ha,
have hc : c :=
  hbc hb,
show c, from
  hc

lemma prop_comp₂ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
show c, from
  hbc (hab ha)

/- ## Forward Reasoning about Connectives and Quantifiers -/

lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
assume hab : a ∧ b,
have ha : a :=
  and.elim_left hab,
have hb : b :=
  and.elim_right hab,
show b ∧ a, from
  and.intro hb ha

lemma or_swap (a b : Prop) :
  a ∨ b → b ∨ a :=
assume hab : a ∨ b,
show b ∨ a, from
  or.elim hab
    (assume ha : a,
     show b ∨ a, from
       or.intro_right b ha)
    (assume hb : b,
     show b ∨ a, from
       or.intro_left a hb)

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

lemma nat_exists_double_iden :
  ∃n : ℕ, double n = n :=
exists.intro 0
  (show double 0 = 0, from
     by refl)

lemma nat_exists_double_iden₂ :
  ∃n : ℕ, double n = n :=
exists.intro 0 (by refl)

lemma modus_ponens (a b : Prop) :
  (a → b) → a → b :=
assume hab : a → b,
assume ha : a,
show b, from
  hab ha

lemma not_not_intro (a : Prop) :
  a → ¬¬ a :=
assume ha : a,
assume hna : ¬ a,
show false, from
  hna ha

lemma forall.one_point {α : Type} (t : α) (p : α → Prop) :
  (∀x, x = t → p x) ↔ p t :=
iff.intro
  (assume hall : ∀x, x = t → p x,
   show p t, from
     begin
       apply hall t,
       refl
     end)
  (assume hp : p t,
   fix x,
   assume heq : x = t,
   show p x, from
     begin
       rw heq,
       exact hp
     end)

lemma beast_666 (beast : ℕ) :
  (∀n, n = 666 → beast ≥ n) ↔ beast ≥ 666 :=
forall.one_point _ _

#print beast_666

lemma exists.one_point {α : Type} (t : α) (p : α → Prop) :
  (∃x : α, x = t ∧ p x) ↔ p t :=
iff.intro
  (assume hex : ∃x, x = t ∧ p x,
   show p t, from
     exists.elim hex
       (fix x,
        assume hand : x = t ∧ p x,
        show p t, from
          by cc))
  (assume hp : p t,
   show ∃x : α, x = t ∧ p x, from
     exists.intro t
       (show t = t ∧ p t, from
          by cc))

/- ## Calculational Proofs

In informal mathematics, we often use transitive chains of equalities,
inequalities, or equivalences (e.g., `a ≥ b ≥ c`). In Lean, such calculational
proofs are supported by `calc`.

Syntax:

    calc      _term₀_
        _op₁_ _term₁_ :
      _proof₁_
    ... _op₂_ _term₂_ :
      _proof₂_
     ⋮
    ... _opN_ _termN_ :
      _proofN_ -/

lemma two_mul_example (m n : ℕ) :
  2 * m + n = m + n + m :=
calc  2 * m + n
    = (m + m) + n :
  by rw two_mul
... = m + n + m :
  by cc

/- `calc` saves some repetition, some `have` labels, and some transitive
reasoning: -/

lemma two_mul_example₂ (m n : ℕ) :
  2 * m + n = m + n + m :=
have h₁ : 2 * m + n = (m + m) + n :=
  by rw two_mul,
have h₂ : (m + m) + n = m + n + m :=
  by cc,
show _, from
  eq.trans h₁ h₂

/- ## Forward Reasoning with Tactics

The `have`, `let`, and `calc` structured proof commands are also available as a
tactic. Even in tactic mode, it can be useful to state intermediate results and
definitions in a forward fashion.

Observe that the syntax for the tactic `let` is slightly different than for the
structured proof command `let`, with `,` instead of `in`. -/

lemma prop_comp₃ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
begin
  intro ha,
  have hb : b :=
    hab ha,
  let c' := c,
  have hc : c' :=
    hbc hb,
  exact hc
end

/- ## Dependent Types

Dependent types are the defining feature of the dependent type theory family of
logics.

Consider a function `pick` that take a number `n : ℕ` and that returns a number
between 0 and `n`. Conceptually, `pick` has a dependent type, namely

    `(n : ℕ) → {i : ℕ // i ≤ n}`

We can think of this type as a `ℕ`-indexed family, where each member's type may
depend on the index:

    `pick n : {i : ℕ // i ≤ n}`

But a type may also depend on another type, e.g., `list` (or `λα, list α`) and
`λα, α → α`.

A term may depend on a type, e.g., `λα, λx : α, x` (a polymorphic identity
function).

Of course, a term may also depend on a term.

Unless otherwise specified, a __dependent type__ means a type depending on a
term. This is what we mean when we say that simple type theory does not support
dependent types.

In summary, there are four cases for `λx, t` in the calculus of inductive
constructions (cf. Barendregt's `λ`-cube):

Body (`t`) |              | Argument (`x`) | Description
---------- | ------------ | -------------- | ------------------------------
A term     | depending on | a term         | Simply typed `λ`-expression
A type     | depending on | a term         | Dependent type (strictly speaking)
A term     | depending on | a type         | Polymorphic term
A type     | depending on | a type         | Type constructor

Revised typing rules:

    C ⊢ t : (x : σ) → τ[x]    C ⊢ u : σ
    ———————————————————————————————————— App'
    C ⊢ t u : τ[u]

    C, x : σ ⊢ t : τ[x]
    ———————————————————————————————— Lam'
    C ⊢ (λx : σ, t) : (x : σ) → τ[x]

These two rules degenerate to `App` and `Lam` if `x` does not occur in `τ[x]`

Example of `App'`:

    ⊢ pick : (x : ℕ) → {y : ℕ // y ≤ x}    ⊢ 5 : ℕ
    ——————————————————————————————————————————————— App'
    ⊢ pick 5 : {y : ℕ // y ≤ 5}

Example of `Lam'`:

    α : Type, x : α ⊢ x : α
    ——————————————————————————————— Lam or Lam'
    α : Type ⊢ (λx : α, x) : α → α
    ————————————————————————————————————————————— Lam'
    ⊢ (λα : Type, λx : α, x) : (α : Type) → α → α

Regrettably, the intuitive syntax `(x : σ) → τ` is not available in Lean.
Instead, we must write `∀x : σ, τ` to specify a dependent type.

Aliases:

    `σ → τ` := `∀_ : σ, τ`
    `Π`     := `∀`

## The Curry–Howard Correspondence

`→` is used both as the implication symbol and as the type constructor of
functions. Similarly, `∀` is used both as a quantifier and in dependent types.

The two pairs of concepts not only look the same, they are the same, by the PAT
principle:

* PAT = propositions as types;
* PAT = proofs as terms.

This is also called the Curry–Howard correspondence.

Types:

* `σ → τ` is the type of total functions from `σ` to `τ`;
* `∀x : σ, τ[x]` is the dependent function type from `x : σ` to `τ[x]`.

Propositions:

* `P → Q` can be read as "`P` implies `Q`", or as the type of functions mapping
  proofs of `P` to proofs of `Q`.
* `∀x : σ, Q[x]` can be read as "for all `x`, `Q[x]`", or as the type of
  functions mapping values `x` of type `σ` to proofs of `Q[x]`.

Terms:

* A constant is a term.
* A variable is a term.
* `t u` is the application of function `t` to value `u`.
* `λx, t[x]` is a function mapping `x` to `t[x]`.

Proofs:

* A lemma or hypothesis name is a proof.
* `H t`, which instantiates the leading parameter or quantifier of proof `H`'
  statement with term `t`, is a proof.
* `H G`, which discharges the leading assumption of `H`'s statement with
  proof `G`, is a proof.
* `λh : P, H[h]` is a proof of `P → Q`, assuming `H[h]` is a proof of `Q`
  for `h : P`.
* `λx : σ, H[x]` is a proof of `∀x : σ, Q[x]`, assuming `H[x]` is a proof of
  `Q[x]` for `x : σ`. -/

lemma and_swap₃ (a b : Prop) :
  a ∧ b → b ∧ a :=
λhab : a ∧ b, and.intro (and.elim_right hab) (and.elim_left hab)

lemma and_swap₄ (a b : Prop) :
  a ∧ b → b ∧ a :=
begin
  intro hab,
  apply and.intro,
  apply and.elim_right,
  exact hab,
  apply and.elim_left,
  exact hab
end

/- Tactical proofs are reduced to proof terms. -/

#print and_swap₃
#print and_swap₄

end forward_proofs

/- ## Induction by Pattern Matching

By the Curry–Howard correspondence, a proof by induction is the same as a
recursively specified proof term. Thus, as alternative to the `induction'`
tactic, induction can also be done by pattern matching:

 * the induction hypothesis is then available under the name of the lemma we are
   proving;

 * well-foundedness of the argument is often proved automatically. -/

#check reverse

lemma reverse_append {α : Type} :
  ∀xs ys : list α, reverse (xs ++ ys) = reverse ys ++ reverse xs
| []        ys := by simp [reverse]
| (x :: xs) ys := by simp [reverse, reverse_append xs]

lemma reverse_append₂ {α : Type} (xs ys : list α) :
  reverse (xs ++ ys) = reverse ys ++ reverse xs :=
begin
  induction' xs,
  { simp [reverse] },
  { simp [reverse, ih] }
end

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

end LoVe


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

import tactic

/-

# Finite sets

Remember that mathematicians use "set" in two different ways. There is
the generic "collection of stuff" usage, as in "A group is a set equipped with
a multiplication and satisfying these axioms...", for which Lean uses types.
And there's the concept of a *subset*, so we have the collection of stuff
already and want to consider the elements which have some other properties,
for example the subset {1,2,3,4,...,37} of the natural numbers, or the
subset of prime numbers or even numbers or whatever.

Someone on the Discord asked if I would do something about "finite sets",
and because there are two uses of the idea of a set in mathematics, the
first question on my mind is "which kind of finite set?". It seems to me
that the student is interested in finite *subsets* of the naturals and
the reals, so let's talk first about finite subsets.

## Two ways to do finite subsets of a type `X`

### First way: a subset of `X`, which is finite

Let `X` be a type. We've already seen the type `set X` of subsets of `X`,
so one way to let `S` be a finite subset of `X` would be to make a term
`S : set X` and then to have a hypothesis that `S` is finite.
In Lean the predicate which says a set is finite is `set.finite`. So here
is one way of saying "let `S` be a finite subset of `X`":

-/

-- "Let X be a type, let `S` be a subset of `X`, and assume `S` is finite.
-- Then S = S"
example (X : Type) (S : set X) (T : set X)
  (hs : set.finite S) (ht : T.finite) : (S ∪ T).finite :=
begin
  exact hs.union ht, -- set.finite.union
end

/-

But Lean has another way.

### Second way: the type of all finite subsets of X

Lean has a dedicated type whose terms are finite subsets of `X`. It's called `finset X`.

Clearly, for a general infinite type `X`, `set X` and `finset X` are not "the same".
In type theory, *distinct types are disjoint*. That means if we have a term `S : finset X`
then *`S` does not have type `set X`*. A finset is not *equal to* a set. This is the
same phenomenon which says that a natural number in Lean is not *equal to* a real number.
There is a *map* from the natural numbers to the real numbers, and it's a map which
mathematicians don't notice and so it's called a *coercion* and is represented by a little
up-arrow. The same is true here.

If `S : finset X` then you can coerce `S` to `set X`, and this coerced term will be
displayed as `↑S` in Lean, with this arrow meaning "the obvious map from `finset X` to `set X`".

-/

-- let X be a type
variable (X : Type)

example (S : finset X) : (S : set X) = (S : set X) :=
begin
  -- ⊢ ↑S = ↑S
  refl,
end

-- Lean has the theorem that if you start with a finset, then the coerced set is finite.
example (S : finset X) : set.finite (S : set X) :=
begin
  exact set.to_finite S,
end

/-

# Why?

Finite sets are really important in computer science, and they also play a special role in
mathematics: for example you can sum over a finite set in huge generality, whereas if you
want to sum over a general set then you need some metric or topology on the target to make
sense of the notion of convergence. Also finite sets can be handled in constructive mathematics
and the theory is much easier to make computable than a general theory of sets. I'm not
particularly interested in making mathematics more constructive and computable, but other
people are, and this is why we've ended up with a dedicated type for finite sets.

Let's see how to do finite sums in Lean. In mathematics we often sum from 1 to n, but
computer scientists seem to prefer to sum from 0 to n-1. The finset `{0,1,2,...,n-1} : finset ℕ`
has got a name; it's called `finset.range n`. Let's see it in action by proving that
the sum of i^2 from i=0 to n-1 is (some random cubic with 6 in the denominator).

-/

open_locale big_operators -- enable ∑ notation

example (n : ℕ) : ∑ i in finset.range n,
  (i : ℚ)^2 = n * (n - 1) * (2 * n - 1) / 6 :=
begin
  induction n with d hd,
  { -- base case n = 0 will follow by rewriting lemmas such as `∑ i in finset.range 0 f(i) = 0`
    -- and `0 * x = 0` etc, and the simplifier knows all these things.
    simp },
  { -- inductive step
    -- We're summing to `finset.range succ(d)`, and so we next use the lemma saying
    -- that equals the sum over `finset.range d`, plus the last term.
    rw finset.sum_range_succ,
    -- Now we have a sum over finset.range d, which we know the answer to by induction
    rw hd,
    -- Now tidy up (e.g. replace all the `succ d` with `d + 1`)
    simp,
    -- and now it must be an identity in algebra.
    ring,
  }
end

-- If you look through the proof you'll see some ↑; this is because we can't do the
-- algebra calculation in the naturals because subtraction and division are involved,
-- and the definitions of subtraction and division on the naturals in Lean are *pathological*
-- (for example 4 - 5 = 0 and 5 / 2 = 2, because they have to return naturals, so they have to
-- return the wrong answer). So we coerce everything to the rationals first, and then the
-- problem goes away.

-- See if you can can sum the first n cubes.
example (n : ℕ) : ∑ i in finset.range n, (i : ℚ)^3 = n^2 * (n - 1)^2 / 4 :=
begin
  -- same proof works
  induction n with d hd,
  { simp },
  { simp [finset.sum_range_succ, hd],
    ring, },
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.defs
import Mathlib.logic.nontrivial
import Mathlib.PostPort

universes u_4 l u_1 u

namespace Mathlib

/-!
# Typeclasses for groups with an adjoined zero element

This file provides just the typeclass definitions, and the projection lemmas that expose their
members.

## Main definitions

* `group_with_zero`
* `comm_group_with_zero`
-/

-- We have to fix the universe of `G₀` here, since the default argument to

-- `group_with_zero.div'` cannot contain a universe metavariable.

/-- Typeclass for expressing that a type `M₀` with multiplication and a zero satisfies
`0 * a = 0` and `a * 0 = 0` for all `a : M₀`. -/
class mul_zero_class (M₀ : Type u_4)
extends Mul M₀, HasZero M₀
where
  zero_mul : ∀ (a : M₀), 0 * a = 0
  mul_zero : ∀ (a : M₀), a * 0 = 0

@[simp] theorem zero_mul {M₀ : Type u_1} [mul_zero_class M₀] (a : M₀) : 0 * a = 0 :=
  mul_zero_class.zero_mul a

@[simp] theorem mul_zero {M₀ : Type u_1} [mul_zero_class M₀] (a : M₀) : a * 0 = 0 :=
  mul_zero_class.mul_zero a

/-- Predicate typeclass for expressing that `a * b = 0` implies `a = 0` or `b = 0`
for all `a` and `b` of type `G₀`. -/
class no_zero_divisors (M₀ : Type u_4) [Mul M₀] [HasZero M₀]
where
  eq_zero_or_eq_zero_of_mul_eq_zero : ∀ {a b : M₀}, a * b = 0 → a = 0 ∨ b = 0

/-- A type `M` is a “monoid with zero” if it is a monoid with zero element, and `0` is left
and right absorbing. -/
class monoid_with_zero (M₀ : Type u_4)
extends mul_zero_class M₀, monoid M₀
where

/-- A type `M` is a `cancel_monoid_with_zero` if it is a monoid with zero element, `0` is left
and right absorbing, and left/right multiplication by a non-zero element is injective. -/
class cancel_monoid_with_zero (M₀ : Type u_4)
extends monoid_with_zero M₀
where
  mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c
  mul_right_cancel_of_ne_zero : ∀ {a b c : M₀}, b ≠ 0 → a * b = c * b → a = c

theorem mul_left_cancel' {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀} (ha : a ≠ 0) (h : a * b = a * c) : b = c :=
  cancel_monoid_with_zero.mul_left_cancel_of_ne_zero ha h

theorem mul_right_cancel' {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀} (hb : b ≠ 0) (h : a * b = c * b) : a = c :=
  cancel_monoid_with_zero.mul_right_cancel_of_ne_zero hb h

/-- A type `M` is a commutative “monoid with zero” if it is a commutative monoid with zero
element, and `0` is left and right absorbing. -/
class comm_monoid_with_zero (M₀ : Type u_4)
extends comm_monoid M₀, monoid_with_zero M₀
where

/-- A type `M` is a `comm_cancel_monoid_with_zero` if it is a commutative monoid with zero element,
 `0` is left and right absorbing,
  and left/right multiplication by a non-zero element is injective. -/
class comm_cancel_monoid_with_zero (M₀ : Type u_4)
extends comm_monoid_with_zero M₀, cancel_monoid_with_zero M₀
where

/-- A type `G₀` is a “group with zero” if it is a monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`.

Examples include division rings and the ordered monoids that are the
target of valuations in general valuation theory.-/
class group_with_zero (G₀ : Type u)
extends div_inv_monoid G₀, nontrivial G₀, monoid_with_zero G₀
where
  inv_zero : 0⁻¹ = 0
  mul_inv_cancel : ∀ (a : G₀), a ≠ 0 → a * (a⁻¹) = 1

@[simp] theorem inv_zero {G₀ : Type u} [group_with_zero G₀] : 0⁻¹ = 0 :=
  group_with_zero.inv_zero

@[simp] theorem mul_inv_cancel {G₀ : Type u} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) : a * (a⁻¹) = 1 :=
  group_with_zero.mul_inv_cancel a h

/-- A type `G₀` is a commutative “group with zero”
if it is a commutative monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`. -/
class comm_group_with_zero (G₀ : Type u_4)
extends comm_monoid_with_zero G₀, group_with_zero G₀
where


namespace inner
  constant and   : Prop → Prop → Prop
  constant or    : Prop → Prop → Prop
  constant not   : Prop → Prop
  constant implies : Prop → Prop → Prop

  variables p q r : Prop
  -- #check and p q -- Prop
  -- #check or (and p q) r -- Prop
  -- #check implies (and p q) (and q p) -- Prop

  constant Proof : Prop → Type
  constant and_comm : Π p q : Prop,
    Proof (implies (and p q) (and q p))

  -- #check and_comm p q -- Proof (implies (and p q) (and q p))
  constant modus_ponens :
    Π p q : Prop, Proof (implies p q) → Proof p → Proof q
  constant implies_intro :
    Π p q : Prop, (Proof p → Proof q) → Proof (implies p q)

end inner

constants p q : Prop

-- theorem t1 : p → q → p :=
-- assume hp : p,
-- assume hq : q,
-- show p, from hp

theorem t1' (hp : p) (hq : q) : p := hp

axiom hp : p
-- theorem t2 : q → p := t1 hp

theorem t1 : ∀ (p q : Prop), p → q → p :=
λ (p q : Prop) (hp : p) (hq : q), hp

variables p q r s : Prop
-- variable h : r → s

theorem t2 (h₁ : q → r) (h₂ : p → q) : p → r :=
assume h₃ : p,
show r, from h₁ (h₂ h₃)

#check p → q → p ∧ q
#check ¬p → p ↔ false
#check p ∨ q → q ∨ p

example (hp : p) (hq : q) : p ∧ q := and.intro hp hq

#check assume (hp : p) (hq : q), and.intro hp hq
example (h : p ∧ q) : p := and.elim_left h
example (h : p ∧ q) : q := and.elim_right h

example (h : p ∧ q) : q ∧ p := and.intro (and.right h) (and.left h)

example (h : p ∧ q) : q ∧ p := ⟨h.right, h.left⟩

example (hp : p) : p ∨ q := or.intro_left q hp
example (hq : q) : p ∨ q := or.intro_right p hq

example (h : p ∨ q) : q ∨ p :=
h.elim
(assume hp : p, or.inr hp)
(assume hq : q, or.inl hq)

example (hpq : p → q) (hnq : ¬q) : ¬p :=
  assume hp : p,
  show false, from hnq (hpq hp)

example (hp : p) (hnp : ¬p) : q := false.elim (hnp hp)
example (hp : p) (hnp : ¬p) : q := absurd hp hnp

example (hnp : ¬p) (hq : q) (hqp : q → p) : r := absurd (hqp hq) hnp

theorem and_swap : p ∧ q ↔ q ∧ p :=
iff.intro
  (assume h : p ∧ q,
    show q ∧ p, from and.intro (and.right h) (and.left h))
  (assume h : q ∧ p,
    show p ∧ q, from and.intro (and.right h) (and.left h))

variable h : p ∧ q
example : q ∧ p := iff.mp (and_swap p q) h

theorem and_swap' : p ∧ q ↔ q ∧ p :=
  ⟨ λ h, ⟨h.right, h.left⟩, λ h, ⟨h.right, h.left⟩ ⟩

#check and_swap'


/-
0. Read the class notes through Section
3.7, Implication. It is important that
you do this before classes next week, as
we will move somewhat quickly through a
few of these chapters.

To complete the rest of this homework,
solve the problems given as specified,
then save and submit this file.
-/

/-
1.

Show that if you're given proofs
of a = b and c = b you can construct
a proof of a = c. Do it by completing
the following function. Note that we
can use parenthesis to enclose terms
that appear within larger terms. This
is often necessary to make sure that
Lean understands how you want to group
things.
-/

theorem eq_snart { T : Type}
             { a b c: T }
             (ab: a = b)
             (cb: c = b) :
             a = c :=
eq.trans
    ab
    (_)

/-
Now, given the following assumptions, apply
your newly proved inference rule, eq.snart,
to show that Harry = Bob. Yes: Once you've
proved a theorem, you can apply it as if it
were a function, to arguments of the right
types, to get a proof that you need. Try it.
-/

axiom Person : Type
axioms Harry Bob Jose: Person
axioms (hj : Harry = Bob) (jb : Jose = Bob)
example : Harry = Jose := _

/-
2. Use example to assert and then prove that if
a, b, c, and d are nats, and if you have proofs
of a = b, b = c, and c = d, you can construct a
proof of a = d. Put the proof in the placeholder
below.

Hint: Equality propositions are types. Think of
the problem here as one of producing a function
of the specific type. Use lambdas. We've gotten
you started. The first lambda "assumes" that a,
b, c, and d are natural numbers. What's left to
do is to prove a function (yes, start with lambda)
that takes three arguments of the specified kinds
(use lambda to give them names) and that finally
produces a result of the type at the end of the
chain.
-/

theorem transit :
∀ a b c d : ℕ,
    (a = b) → (b = c) → (c = d) → (a = d)
:=
    λ a b c d,
        _

/-
3. In the context of the axioms in the following
namespace, write an exact proof term to prove
that Yuanfang is friendly. Hint #1: Just apply
the relevant inference rule as a function to the
right arguments. Hint #2: The direction in which
an equality is written matters. If, for example,
you have a proof of x = y and you want to apply
an inference rule that requires a proof of y = x,
then you need to find a way to get what you need
from what you have to work with in your context.
-/

axioms Mary Yuanfang : Person
axiom Friendly : Person → Prop
axiom mf : Friendly Mary
axiom yeqm : Yuanfang = Mary
example : Friendly Yuanfang :=
    _

/-
4. The subtitution rule for equality lets
you rewrite proof goals by substituting one
term for another, in a goal, as long as you
already have a proof that the two  terms
are equal. The reasoning is that replacing
one term with another makes no difference to
the truth of a proposition if the two terms
are equal.

Suppose for example that you have a proof,
h, of y = x (yes we can and do give names
to proofs, as we consider them to be values),
and a proof, y1, of y = 1, and that your
goal is to prove (x = 1). You can justify
rewriting this goal as (y = 1), for which
you already have a proof, because you know
that y = x; so making this substitution
doesn't change the truth of the proposition.

In the tactic scripting libraries that Lean
provides, there is a tactic for rewriting a
goal in this way. If h is a proof of x = y,
then the tactic, "rw h" ("rw" is short for
"rewrite") replaces all occurrences of x (the
left side of h) with y (it's right side).

Here's an example.
-/

def foo (x y : ℕ) (y1 : y = 1) (h: x = y) : (x = 1) :=
begin
rewrite h,
exact y1,
end

/-
Use what you just learned to state and prove
the proposition that for any type, T, and for
any objects, a, b, and c, of this type, if
(a = b) and (b = c) then (c = a). Do this by
finishing off the tactic script that follows.
Note that to apply an inference rule within a
tactic script you use the "apply" tactic. Read
the further explanation and hint that follow
before attempting to solve this problem.
-/

def ac (T : Type) (a b c : T)
       (ab : a = b) (bc : b = c)
    : (c = a) :=
begin
_
end

/-
Note that the "foralls" in the natural language
statement are represented in this code *not* by
using  ∀ but by declaring them to be arguments
to our function. If you can write a function of
the specified type then you have in effect proven
that for *any* T and any a, b, c, of type T, if
if you also have a proof of a=b and a proof of
b=c, then a value of type c=a can be constructed
and returned. The reason this is true is that in
Lean all functions are total, as you now recall!

Key hint: The tactic application "rw h" changes
all occurrences of the left side of the equality
h, in the goal, into what's on its right side.
If you want the rewriting to go from right to
left, use "rw<-h". When you're just about done,
don't be surprised if the rewrite tactic applies
rfl automatically.
-/


-- This is an example of how to construct the natural numbers in lean,
-- and how to build up results on them from the most basic of logical
-- postulates.
--
-- As part of lean's built in logic engine I have access to the following
-- operations and axioms:
--
-- Propositions:
--   any proposition has type Prop,
--   any proposiyion p is itself a type
--   a member of the type p is a proof of p
--
-- Implication:
--   given propositions p and q, (p → q) is also a proposition
--   given a proof hp: p, and a proof hpq: p → q then (hpq hp) is a proof
--   of q
--
-- Or:
--   given propositions p,q, (p ∨ q) is also a proposition
--   given a proof hp of p, (or.intro_left q hp) is a proof of (p ∨ q)
--   given a proof hq of q, (or.intro_right p hq) is a proof of (p ∨ q)
--   given a proof hpq of (p ∨ q), a proof hpr of (p → r) and a proof hqr
--     of (q → r) then (or.elim hpq hpr hqr) is a proof of ((p ∨ q) → r)
--
-- And:
--   given propositions p,q, (p ∧ q) is also a proposition
--   given a proof hp of p, and a proof hq or q, (and.intro hp hq) is a proof
--     of (p ∧ q)
--   given a proof hpq of (p ∧ q), (and.elim_left hpq) is a proof of p
--   given a proof hpq of (p ∧ q), (and.elim_right hpq) is a proof of q
--
-- Not:
--   given a proposition p, ¬p is shorthand for the proposition (p → false)
--   given a proof hp of p and a proof hnp of ¬p, (absurd hp hnp) is a proof of any proposition
--   given propositions p and q and a proof h of p → q, (mt h) is a proof of ¬q → ¬p
--
-- Exists:
--   given a type α, and a function p: α → Prop, (∃ x : α, p x) is a proposition
--   given an entity x of type α and a proof hpx of p x, ⟨x, hpx⟩ is a proof of
--     (∃ x : α, p x)
--   given a proof hxp of (∃ x : α, p x) we can bind hxp to get x:α and a proof of p x
--
-- Forall:
--   given a type α and a function p: α → Prop, (∀ x : α, p x) is a proposition
--   a proof of (∀ x : α, p x) is a function hxpx: (α → p x) (ie. a function that
--     maps any element x of α to a proof of p x)
--
-- Assume:
--   given propositions p, q, (assume hp:p, hq) is a proof of p → q provided that hq is a
--     proof of q, which may include references to hp in its definition.
--
-- inductive:
--   We can define a type inductively by definining a number of specific constructors that
--     may or may not themselves take parameters. Any instance of the type must have been
--     constructed using one of the constructors, and if the comnstructor takes parameters
--     then the unique combination of constructor and parameter values is considered to define
--     the element
--   All inductive constructors are injective, so given a proof h: con x = con y we then
--     injection h is a proof that x = y
--   Given any inductive type α and a proof h that two elements constructed using different
--     constructors are equal (α.no_confusion h) is a proof of false
--
-- rec_on:
--   given any inductive type α we may use the function α.rec_on which takes a number of
--     parameters one greater than the number of constructors α has. The first parameter
--     is of type α, the remaining are each of the same type as the constructor they correspond
--     to in order (eg. if a constructor takes no pareters then its corresponding parameter here
--     is of type α, whilst if it takes one then it is a function returnimng α, etc ...)
--     the value of a call to rec_on is then the same as a call to the parameter corresponding to
--     the constructor that constructed the input value with the same parameters as were passed
--     to the constructor.
--
-- equality:
--   for any type α the operator = is already defined, and (a = b) is a proposition.axioms
--   for any type α and any element x : α, rfl is a proof of (x = x).
--   for any type α and any elements x, y: α, eq.sym is a proof of (x = y → y = x)
--   for any type α, elements x y : α, and function p : α → Prop if hxy is a proof that x = y,
--     and hpx is a proof of p x then (eq.subst hxy hpx) is a proof of p y
--   for any type α, elements x y : α, and function p : α → Prop if hxy is a proof that x = y,
--     then (congr.arg p hxy) is a proof that (p x = p y)

-- We begin by defining a new type, natural. (nat is the builtin type, so we want a different
-- name)
inductive natural : Type
| zero : natural
| succ : natural → natural

notation `𝐍` := natural

namespace natural

open natural

instance natural_has_zero : has_zero 𝐍 := ⟨zero⟩
instance natural_has_one : has_one 𝐍 := ⟨succ zero⟩

-- equality is already defined for all types, and includes some of the properties we want for
-- peano's axioms, so I'll quickly prove them.
lemma eq_refl (n : 𝐍): n = n := rfl
lemma eq_sym (x y : 𝐍): x = y → y = x := eq.symm
lemma eq_trans (x y z : 𝐍) (h1: x = y) (h2: y = z): (x = z) := eq.trans ‹x = y› ‹y = z›
-- Peano's 5th is implicit in how = is defined

lemma succ_inj {x y : 𝐍}: x = y ↔ succ x = succ y :=
    iff.intro (
        assume :x = y,
        congr_arg succ ‹x = y›
    ) (
        assume h: succ x = succ y,
        show x = y, by injection h
    )

lemma zero_not_succ  (x : 𝐍):  (succ x ≠ 0) :=
    assume h,
    natural.no_confusion h

-- Now we define addition
-- I originally defined addition the other way round with the first
-- parameter as 0 or succ a, but this is unfortunate. If you do it
-- this way round then (a + 1) = a + succ 0 = succ a + 0 = succ a is
-- definitional, and so can be used in unfolding future definitions
def add : 𝐍 → 𝐍 → 𝐍
    | a  0        := a
    | a  (succ b) := succ (add a b)

instance natural_has_add : has_add 𝐍 := ⟨add⟩

-- And prove some standard additive properties
lemma zero_add_ (x : 𝐍): 0 + x = x :=
    natural.rec_on x (
        show (0 : 𝐍) + 0 = 0, by refl
    ) (
        assume n: 𝐍,
        assume h: 0 + n = n,
        calc
            0 + succ n = succ (0 + n) : by refl
            ...        = succ n       : by rw h
    )
lemma add_zero_ (x : 𝐍): x + 0 = x := by refl

lemma one_add (x : 𝐍): 1 + x = succ x :=
    natural.rec_on x (
        show 1 + 0 = succ 0, by refl
    ) (
        assume n : 𝐍,
        assume h : 1 + n = succ n,
        calc
            1 + (succ n) = succ (1 + n)  : by refl
            ...          = succ (succ n) : by rw h
    )
lemma add_one (x : 𝐍): x + 1 = succ x := by refl

lemma add_asoc (x y z : 𝐍): (x + y) + z = x + (y + z) :=
    natural.rec_on z (
        show (x + y) + 0 = x + (y + 0), by refl
    ) (
        assume n : 𝐍,
        assume h : (x + y) + n = x + (y + n),
        calc
            (x + y) + succ n = succ ((x + y) + n)   : by refl
            ...              = succ (x + (y + n))   : by rw h
            ...              = x + succ (y + n)     : by refl
    )
lemma add_com (x y : 𝐍): x + y = y + x :=
    natural.rec_on y (
        show x + 0 = 0 + x, by rwa [add_zero_, zero_add_]
    ) (
        assume n: 𝐍,
        assume h : x + n = n + x,
        calc
            x + succ n = x + (n + 1)    : by rw add_one
            ...        = (x + n) + 1    : by rw add_asoc
            ...        = (n + x) + 1    : by rw h
            ...        = n + (x + 1)    : by rw add_asoc
            ...        = n + (1 + x)    : by rw [add_one, one_add]
            ...        = (n + 1) + x    : by rw add_asoc
            ...        = (succ n) + x   : by rw add_one
    )

@[simp]
lemma add_rearrange (x y z : 𝐍): (x + y) + z = (x + z) + y := (
    calc
        (x + y) + z = x + (y + z)   : by rw add_asoc
        ...         = x + (z + y)   : by rw add_com y
        ...         = (x + z) + y   : by rw add_asoc
)

lemma zero_sum {x y : 𝐍}: x + y = 0 → x = 0 :=
    match y with
    | 0 := assume h, show x=0, by rw [←add_zero_ x, h]
    | (a+1) := assume h, (
        have (x + a) + 1 = 0, by rw [add_asoc, h],
        absurd this (zero_not_succ (x+a))
    )
    end

lemma add_unchanged_implies_zero {x y : 𝐍}: x + y = y → x = 0 :=
    natural.rec_on y (
        assume h : x + 0 = 0,
        show x = 0, by rw [←add_zero_ x, h]
    ) (
        assume a : 𝐍,
        assume hr: x + a = a → x = 0,
        assume h: x + (a+1) = a+1,
        have (x + a)+1 = a+1, by rw [add_asoc x a 1, h],
        have x + a = a, from iff.elim_right succ_inj this,
        show x = 0, from hr this
    )

-- Now define multiplication
def mult : 𝐍 → 𝐍 → 𝐍
    | a 0       := 0
    | a (b + 1) := a + (mult a b)

instance natural_has_mult : has_mul 𝐍 := ⟨mult⟩

-- And prove some useful results about multiplication
lemma mult_zero (x : 𝐍): x * 0 = 0 := by refl

lemma zero_mult (x : 𝐍): 0 * x = 0 :=
    natural.rec_on x (
        show (0 : 𝐍) * 0 = 0, by refl
    ) (
        assume n : 𝐍,
        assume h : 0 * n = 0,
        calc
            0 * (n + 1) = 0 + 0 * n : by refl
            ...         = 0 + 0     : by rw h
            ...         = 0         : by refl
    )

lemma mult_one (x : 𝐍): x * 1 = x := by refl

lemma one_mult (x : 𝐍): 1 * x = x :=
    natural.rec_on x (
        show (1 : 𝐍) * 0 = 0, by refl
    ) (
        assume n : 𝐍,
        assume h : 1 * n = n,
        calc
            1 * (n + 1) = 1 + (1 * n)  : by refl
            ...         = 1 + n        : by rw h
            ...         = n + 1        : by rw add_com
    )

lemma add_dist_mult (x y z : 𝐍): (x + y) * z = (x * z) + (y * z) :=
    natural.rec_on z (
        show (x + y) * 0 = (x * 0) + (y * 0), by refl
    ) (
        assume n: 𝐍,
        assume h: (x + y) * n = (x * n) + (y * n),
        calc
            (x + y) * (n + 1) = (x + y) + ((x + y) * n)        : by refl
            ...               = (x + y) + ((x * n) + (y * n))  : by rw h
            ...               = (x + (x * n)) + (y + (y * n))  : by rw [←add_asoc (x + y) (x * n), add_asoc x y, add_com y (x * n), ←add_asoc, add_asoc]
    )

lemma mult_dist_add (x y z : 𝐍): x * (y + z) = (x * y) + (x * z) :=
    natural.rec_on z (
        show x * (y + 0) = (x * y) + (x * 0), by refl
    ) (
        assume n: 𝐍,
        assume h: x * (y + n) = (x * y) + (x * n),
        calc
            x * (y + (n + 1)) = x * ((y + n) + 1)        : by rw add_asoc
            ...               = x + (x * (y + n))        : by refl
            ...               = (x * y) + x + (x * n)    : by rw [h, ←add_asoc, add_com (x*y)]
            ...               = (x * y) + (x + (x * n))  : by rw add_asoc
            ...               = (x * y) + (x * (n + 1))  : by refl
    )

lemma mult_asoc (x y z : 𝐍): (x * y) * z = x * (y * z) :=
    natural.rec_on z (
        calc
            (x * y) * 0 = x * (y * 0)  : by refl
    ) (
        assume n: 𝐍,
        assume h: (x * y) * n = x * (y * n),
        calc
            (x * y) * (n + 1) = (x * y) + ((x * y) * n)    : by refl
            ...               = x * (y + (y * n))          : by rw [h, mult_dist_add]
            ...               = x * (y * (n + 1))          : by refl
    )

lemma mult_com (x y : 𝐍): x * y = y * x :=
    natural.rec_on x (
        show 0 * y = y * 0, by rw [zero_mult, mult_zero]
    ) (
        assume n : 𝐍,
        assume h : n * y = y * n,
        calc
            (n + 1) * y = (y * n) + (y * 1)   : by rw [add_dist_mult, one_mult, h, mult_one]
            ...         = y * (n + 1)         : by rw mult_dist_add
    )

-- equality is decidable
lemma succ_ne_zero (n : 𝐍): (n + 1) ≠ 0 :=
    assume h : succ n = 0,
    natural.no_confusion h

lemma zero_ne_succ (n : 𝐍): 0 ≠ (n + 1) :=
    assume h :  0 = succ n,
    natural.no_confusion h

@[reducible]
instance natural_decidable_eq: decidable_eq 𝐍
| 0       0       := is_true (by refl)
| (x + 1) 0       := is_false (succ_ne_zero x)
| 0       (y + 1) := is_false (zero_ne_succ y)
| (x + 1) (y + 1) :=
    match natural_decidable_eq x y with
    | is_true h  := is_true (by rw h)
    | is_false _ := is_false (assume h: succ x = succ y, have x = y, by injection h, absurd ‹x = y› ‹x ≠ y›)
    end

-- This is needed to allow us to represent natural numbers sensibly
-- in messages. It's primarily a convenience for the programmer.
-- This is based on what's done for ℕ in the lean core library

def digit_char (n: 𝐍) : char :=
if n = 0 then '0' else
if n = 1 then '1' else
if n = 2 then '2' else
if n = 3 then '3' else
if n = 4 then '4' else
if n = 5 then '5' else
if n = 6 then '6' else
if n = 7 then '7' else
if n = 8 then '8' else
if n = 9 then '9' else
if n = 0xa then 'a' else
if n = 0xb then 'b' else
if n = 0xc then 'c' else
if n = 0xd then 'd' else
if n = 0xe then 'e' else
if n = 0xf then 'f' else
'*'

def digit_succ (b : 𝐍): list 𝐍 → list 𝐍
| [] := [1]
| (d::ds) :=
    if (d+1) = b then
        0 :: digit_succ ds
    else
        (d+1) :: ds

def to_digits (b : 𝐍): 𝐍 → list 𝐍
| 0     := [0]
| (n+1) := digit_succ b (to_digits n)

def repr (n: 𝐍): string :=
    ((to_digits 10 n).map digit_char).reverse.as_string

instance natural_has_repr: has_repr 𝐍 := ⟨repr⟩

-- inequalities
def le (x y : 𝐍): Prop := ∃ z : 𝐍, z + x = y
instance natural_has_le: has_le 𝐍 := ⟨le⟩

def lt (x y : 𝐍): Prop := (x ≤ y) ∧ (x ≠ y)
instance natural_has_lt: has_lt 𝐍 := ⟨lt⟩

lemma succ_le_succ {x y : 𝐍}: x ≤ y → (x + 1) ≤ (y + 1) :=
    assume ⟨z, (h: z + x = y)⟩,
    suffices z + (x + 1) = y + 1, from ⟨z, this⟩,
    show z + (x + 1) = y + 1, by rw [←add_asoc z x 1, h]

instance le_decidable: ∀ a b : 𝐍, decidable (a ≤ b)
| 0       y        := is_true ⟨y, by refl⟩
| (x + 1) 0        := is_false (
    assume ⟨z, h⟩,
    have (z + x) + 1 = 0, by rw [add_asoc, h],
    have (z + x) + 1 ≠ 0, from succ_ne_zero (z + x),
    absurd ‹(z + x) + 1 = 0› ‹(z + x) + 1 ≠ 0›
)
|  (x+1) (y+1)    :=
    match le_decidable x y with
        | is_true xley := is_true (succ_le_succ xley)
        | is_false xgty := is_false (
            assume ⟨z, (h: z + x + 1 = y + 1)⟩,
            have x ≤ y, from ⟨z, by injection h⟩,
            absurd ‹x ≤ y› xgty
        )
    end

instance lt_decidable: ∀ a b : 𝐍, decidable (a < b) :=
assume a b,
match natural.natural_decidable_eq a b with
| is_true h  := is_false (assume :a < b, absurd h this.right)
| is_false h := (
    match natural.le_decidable a b with
    | is_true hle  := is_true ⟨hle, h⟩
    | is_false hle := is_false (assume :a < b, absurd this.left hle)
    end
)
end

lemma le_zero {x: 𝐍}: x ≤ 0 → x = 0 :=
    match x with
    | 0     := assume h, by refl
    | (a+1) := (
        assume ⟨y, h⟩,
        suffices y + (a+1) ≠ 0, from absurd h this,
        calc
             y + (a+1) = (y + a) + 1 :by rw add_asoc
             ...       ≠ 0           :by apply succ_ne_zero
    )
    end

lemma zero_le (x:𝐍): 0 ≤ x :=
    match x with
    | 0 := ⟨0, by refl⟩
    | (a+1) := ⟨a+1, add_zero_ (a+1)⟩
    end

lemma le_refl (x: 𝐍): x ≤ x := ⟨0, zero_add_ x⟩

lemma le_trans {x y z: 𝐍}: x ≤ y → y ≤ z → x ≤ z :=
    assume ⟨a, _⟩,
    assume ⟨b, _⟩,
    ⟨b+a, show b + a + x = z, by rw [add_asoc, ‹a + x = y›, ‹b + y = z›]⟩

lemma lt_trans {x y z: 𝐍}: x < y → y < z → x < z :=
    assume hxy: x < y,
    assume hyz: y < z,
    suffices x ≠ z, from ⟨le_trans hxy.left hyz.left, this⟩,
    assume h: x = z,
    suffices z = y, from absurd (eq.symm this) hyz.right,
    let ⟨a, (_: a+x=y)⟩ := hxy.left in (
        let ⟨b, (_: b+y=z)⟩ := hyz.left in (
            suffices b = 0, from (
                calc
                    z   = b + y  : by rw ‹b+y=z›
                    ... = 0 + y  : by rw this
                    ... = y      : by rw zero_add_
            ),
            suffices (b + a) = 0, from zero_sum this,
            suffices  x = (b + a) + x, from  add_unchanged_implies_zero (eq.symm this),
            calc
                x   = z            : by assumption
                ... = b + y        : by rw ‹b + y = z›
                ... = b + (a + x)  : by rw ‹a + x = y›
                ... = (b + a) + x  : by rw add_asoc
        )
    )

lemma le_sym_implies_eq {x y :𝐍}: x ≤ y → y ≤ x → x = y :=
    assume ⟨a, _⟩,
    assume ⟨b, _⟩,
    suffices a = 0, from (
    calc
        x          = 0 + x          : by rw zero_add_
        ...        = a + x          : by rw this
        ...        = y              : by rw [‹a + x = y›]
    ),
    suffices a + b = 0, from (zero_sum this),
    suffices (a + b) + x = x, from add_unchanged_implies_zero this,
    calc
        (a + b) + x = (b + a) + x   : by rw add_com a b
        ...         = b + (a + x)   : by rw add_asoc
        ...         = b + y         : by rw [‹a+x = y›]
        ...         = x             : by rw [‹b+y = x›]

lemma le_implies_not_succ {x y : 𝐍}: x ≤ y → x ≠ y+1 :=
    assume h: x ≤ y,
    assume :x = y + 1,
    have y+1 ≤ y, from ‹x = y+1› ▸ ‹x ≤ y›,
    let ⟨z, (_: z + (y + 1) = y)⟩ := this in (
        have (z + 1) + y = y, by rw [add_com, ←add_asoc, add_com y, add_asoc, ‹z + (y+1) = y›],
        have z+1 = 0, from add_unchanged_implies_zero this,
        have z+1 ≠ 0, from succ_ne_zero z,
        absurd ‹z+1 = 0› ‹z+1 ≠ 0›
    )

lemma nz_implies_succ {x : 𝐍}: x ≠ 0 → ∃ y: 𝐍, x = y+1 :=
    match x with
    | 0     := assume :0 ≠ 0, absurd (eq.refl 0) this
    | n + 1 := assume :n + 1 ≠ 0, ⟨n, eq.refl (n+1)⟩
    end

lemma le_implies_lt_succ {x y: 𝐍}: x ≤ y → x < y + 1 :=
    assume ⟨z, (h: z + x = y)⟩,
    suffices z + 1 + x = y + 1, from ⟨⟨z+1, this⟩, le_implies_not_succ ‹x ≤ y›⟩,
    suffices (z + x) + 1 = y + 1, by rw [add_asoc, add_com 1 x, ←add_asoc z x 1, this],
    show (z + x) + 1 = y + 1, from iff.elim_left succ_inj ‹z + x = y›

lemma lt_succ_implies_le {x y: 𝐍}: x < y+1 → x ≤ y :=
    assume ⟨(hle: x ≤ y+1), hne⟩,
    let ⟨z, (h: z + x = y + 1)⟩ := hle in
        if hz: z = 0 then
            have x = y + 1, by rw [←zero_add_ x, ←hz, h],
            absurd this hne
        else
            let ⟨n, (_: z = n+1)⟩ := nz_implies_succ hz in (
                suffices n + x = y, from ⟨n, this⟩,
                suffices n + x + 1 = y + 1, from iff.elim_right succ_inj this,
                calc
                    n + x + 1 = (n + 1) + x   : by simp
                    ...       = y + 1         : by rwa ←‹z = n+1›
            )

lemma gt_implies_succ_gt {x y: 𝐍}: x > y → x+1 > y :=
    assume ⟨(_: y ≤ x), (_: y ≠ x)⟩,
    if h: y = (x+1)
    then
        absurd ‹y = x+1› (le_implies_lt_succ ‹y ≤ x›).right
    else
        ⟨(le_implies_lt_succ ‹y ≤ x›).left, ‹y ≠ x + 1›⟩

lemma ne_succ (x: 𝐍): x ≠ x+1 :=
    natural.rec_on x (
        assume h: 0 = 1,
        natural.no_confusion h
    ) (
        assume n: 𝐍,
        assume h: n ≠ n + 1,
        assume : (n+1) = (n+1) + 1,
        have n = n + 1, from (iff.elim_right succ_inj) this,
        absurd ‹n = n +1› ‹n ≠ n + 1›
    )

lemma lt_implies_succ_le {x y: 𝐍}: x < y → (x+1) ≤ y :=
    assume ⟨⟨z,(_:z+x=y)⟩,(_:x≠y)⟩,
    if h:z = 0 then
        have x = y, by rwa [←zero_add_ x, ←h],
        absurd ‹x = y› ‹x ≠ y›
    else
        let ⟨n, (_: z=n+1)⟩ := (nz_implies_succ h) in (
            have n + 1 + x = y, from ‹z=n+1› ▸ ‹z+x=y›,
            suffices n + (x + 1) = y, from ⟨n, this⟩,
            show n + (x + 1) = y, by rwa [add_com x, ←add_asoc n 1 x]
        )

lemma succ_gt (x : 𝐍): (x+1) > x := ⟨⟨1, add_com 1 x⟩, ne_succ x⟩

lemma lt_succ (x : 𝐍): x < (x+1) := succ_gt x

lemma le_iff_not_gt {x y: 𝐍}: x ≤ y ↔ ¬ (x > y) :=
    iff.intro (
        assume : x≤y,
        assume ⟨(_:y ≤ x), (_: y ≠ x)⟩,
        suffices y = x, from absurd this ‹y≠x›,
        show y = x, from le_sym_implies_eq ‹y ≤ x› ‹x ≤ y›
    ) (
        natural.rec_on x (
            assume h: ¬(0 > y),
            show 0 ≤ y, from zero_le y
        ) (
            assume n: 𝐍,
            assume h: (¬n > y → n ≤ y),
            assume :¬(n+1 > y),
            suffices (n+1)≤y, from (add_one n) ▸ this,
            have ¬n > y, from mt (gt_implies_succ_gt) this,
            have n ≤ y, from h this,
            have n ≠ y, from (
                assume :n = y,
                have n+1 > y, from this ▸ (succ_gt n),
                absurd this ‹¬n+1 > y›
            ),
            lt_implies_succ_le ⟨‹n ≤ y›, ‹n ≠ y›⟩
        )
    )

-- subtraction, of a sort
def pred: 𝐍 → 𝐍
| 0       := 0
| (a + 1) := a

def sub:  𝐍 → 𝐍 → 𝐍
| a 0       := a
| a (b + 1) := pred (sub a b)

instance natural_has_sub: has_sub 𝐍 := ⟨sub⟩

lemma sub_zero (x: 𝐍): x - 0 = x := by refl

lemma zero_sub (x: 𝐍): 0 - x = 0 :=
    natural.rec_on x (
        by refl
    ) (
        assume n: 𝐍,
        assume h: 0 - n = 0,
        calc
            0 - (n+1) = pred (0 - n)  : by refl
            ...       = pred 0        : by rw h
            ...       = 0             : by refl
    )

lemma succ_sub_one (x: 𝐍): (x+1) - 1 = x :=
calc
    (x+1) - 1 = (x+1) - (0+1)     : by rw zero_add_
    ...       = pred ((x+1) - 0)  : by refl
    ...       = pred (x+1)        : by refl
    ...       = x                 : by refl

lemma pred_zero {x : 𝐍}: pred x = 0 → x ≠ 0 → x = 1 :=
    assume h: pred x = 0,
    assume hz: x ≠ 0,
    if hh: x = 0 then
        absurd hh hz
    else
        let ⟨n, (_: x = n + 1)⟩ := nz_implies_succ hz in (
            calc
                x   = n + 1             : by assumption
                ... = (pred (n+1)) + 1  : by refl
                ... = (pred x) + 1      : by rw ‹x = n+1›
                ... = 0 + 1             : by rw h
                ... = 1                 : by rw zero_add_
        )

lemma succ_pred {x: 𝐍}: x ≠ 0 → (pred x) + 1 = x :=
    assume h,
    let ⟨a, h⟩ := nz_implies_succ h in calc
        (pred x) + 1 = (pred (a+1)) + 1   : by rw h
        ...          = a + 1              : by refl
        ...          = x                  : by rw h

lemma pred_add {x y: 𝐍}: x ≠ 0 → (pred x) + y = pred (x + y) :=
    assume h: x ≠ 0,
    let ⟨a, (h: x = a+1)⟩ := nz_implies_succ h in (
        calc
            pred x + y = pred (a+1) + y   : by rw h
            ...        = a + y            : by refl
            ...        = pred (a + y + 1) : by refl
            ...        = pred ((a+1) + y) : by simp
            ...        = pred (x + y)     : by rw h
    )

lemma eq_implies_le {x y: 𝐍}: x = y → x ≤ y := assume h, ⟨0, h ▸ (zero_add_ x)⟩

lemma not_le {x y: 𝐍}: ¬(x ≤ y) ↔ (y < x) :=
    iff.intro (
        natural.rec_on y (
            assume h,
            have x ≠ 0, from assume :x=0, absurd (eq_implies_le this) h,
            suffices 0 ≤ x, from ⟨this, ne.symm ‹x≠0›⟩,
            zero_le x
        ) (
            assume a: 𝐍,
            assume hr: ¬x ≤ a → a < x,
            assume : ¬x ≤ a+1,
            have x ≠ a+1, from assume :x=a+1, absurd (eq_implies_le this) ‹¬x ≤ a+1›,
            suffices a+1 ≤ x, from ⟨this, ne.symm ‹x≠a+1›⟩,
            have x ≤ a → x ≤ a+1, from assume :x≤ a, (le_implies_lt_succ this).left,
            have a < x, from hr (mt ‹x ≤ a → x ≤ a+1› ‹¬(x ≤ a+1)›),
            lt_implies_succ_le ‹a < x›
        )
    ) (
        assume ⟨⟨a, (_: a+y=x)⟩, (_: y ≠ x)⟩,
        assume ⟨b, (_: b+x=y)⟩,
        suffices y=x, from absurd this ‹y≠x›,
        suffices b=0, by rw [←‹b+x=y›, this, zero_add_ x],
        suffices b+a=0, from zero_sum this,
        suffices y = b+a+y, from  add_unchanged_implies_zero (eq.symm this),
        calc
            y   = b+x     : by rw ‹b+x=y›
            ... = b+(a+y) : by rw ‹a+y=x›
            ... = b+a+y   : by rw add_asoc b a y
    )

lemma not_lt {x y: 𝐍}: ¬(x < y) ↔ (y ≤ x) := iff.trans (iff.symm (not_congr (@not_le y x))) (decidable.not_not_iff (y ≤ x))

lemma succ_le_implies_lt {x y: 𝐍}:  (x+1) ≤ y → x < y :=
    assume ⟨z, (h: z + (x+1) = y)⟩,
    have (z + 1) + x = y, by rw [add_asoc z, add_com 1, h],
    suffices x ≠ y, from ⟨⟨(z+1), ‹(z + 1) + x = y›⟩, this⟩,
    assume hc: x = y,
    have y < x+1, from hc ▸ lt_succ x,
    absurd ‹x+1 ≤ y› (iff.elim_right not_le ‹y < x+1›)

lemma diff_zero_can_cancel {x y : 𝐍}: x - y ≠ 0 → (x - y) + y = x :=
    natural.rec_on y (
        assume h: x ≠ 0,
        by refl
    ) (
        assume a: 𝐍,
        assume hr: x - a ≠ 0 → x - a + a = x,
        assume h: x - (a+1) ≠ 0,
        have x - (a+1) = pred (x - a), by refl,
        if hxa: x - a = 0 then
            suffices x - (a+1) = 0, from absurd this h,
            calc
                x - (a+1)  = pred (x - a)  : by refl
                ...        = pred 0        : by rw hxa
                ...        = 0             : by refl
        else
            have hr: x - a + a = x, from hr hxa,
            calc
                x - (a+1) + (a+1) = (pred (x - a)) + (a + 1) : by refl
                ...               = (pred (x - a)) + (1 + a) : by rw add_com a
                ...               = (pred (x - a) + 1) + a   : by rw add_asoc
                ...               = x - a + a                : by rw succ_pred hxa
                ...               = x                        : by assumption
    )

lemma pred_nz {x: 𝐍}: pred x ≠ 0 → x ≠ 0 :=
    assume h: pred x ≠ 0,
    assume hc: x = 0,
    suffices pred x = 0, from absurd this h,
    calc
        pred x = pred 0  : by rw hc
        ...    = 0       : by refl

lemma diff_nz_succ_sub {x y: 𝐍}: x - y ≠ 0 → (x+1) - y = (x - y) + 1 :=
    natural.rec_on y (
        assume :x ≠ 0,
        by refl
    ) (
        assume b,
        assume hr: x - b ≠ 0 → x + 1 - b = x - b + 1,
        assume h: pred (x - b) ≠ 0,
        have h: x - b ≠ 0, from pred_nz h,
        have hr: (x+1) - b = (x - b) + 1, from hr h,
        calc
            (x+1) - (b+1) = pred ((x+1) - b)    : by refl
            ...           = pred ((x - b) + 1)  : by rw hr
            ...           = x - b               : by refl
            ...           = (pred (x - b)) + 1  : by rw succ_pred h
            ...           = (x - (b+1)) + 1     : by refl
    )

lemma diff_zero_of_successors {x y : 𝐍}: (x+1) - (y+1) = 0 → x - y = 0 :=
    assume h: pred ((x+1) - y) = 0,
    if hxy: x - y = 0 then
        hxy
    else
        have hx1: (x+1) - y = (x - y) + 1, from diff_nz_succ_sub hxy,
        suffices pred ((x+1) - y) = x - y, from absurd h ((eq.symm this) ▸ hxy),
        calc
            pred ((x+1) - y) = pred ((x - y) + 1)  : by rw hx1
            ...              = x - y               : by refl

lemma both_diffs_zero_implies_equal {x : 𝐍}: (∀ y : 𝐍, x - y = 0 → y - x = 0 → x = y) :=
    natural.rec_on x (
        assume y: 𝐍,
        assume h1: 0-y=0,
        assume h2: y=0,
        eq.symm h2
    ) (
        assume a: 𝐍,
        assume hr: ∀ (y : 𝐍), a - y = 0 → y - a = 0 → a = y,
        assume y: 𝐍,
        assume h1: (a+1) - y = 0,
        assume h2: y - (a+1) = 0,
        if hyz: y = 0 then
            suffices a+1 = 0, from absurd this (succ_ne_zero a),
            calc
                a+1 = (a+1) - 0   : by refl
                ... = (a+1) - y   : by rw hyz
                ... = 0           : by rw h1
        else
            let ⟨b, (_:y=b+1)⟩ := nz_implies_succ hyz in (
                suffices (a+1) = (b+1), from (eq.symm ‹y=b+1›) ▸ this,
                suffices a = b, from congr_arg succ this,
                have h1: (a+1) - (b+1) = 0, from ‹y=b+1› ▸ h1,
                have h2: (b+1) - (a+1) = 0, from ‹y=b+1› ▸ h2,
                have h1: a - b = 0, from diff_zero_of_successors h1,
                have h2: b - a = 0, from diff_zero_of_successors h2,
                hr b h1 h2
            )
    )

lemma diff_zero {x y : 𝐍}: x - y = 0 → x ≤ y :=
    assume h: x - y = 0,
    if hi: y - x = 0 then
        have x = y, from both_diffs_zero_implies_equal y h hi,
        eq_implies_le ‹x = y›
    else
        suffices (y - x) + x = y, from ⟨y-x, this⟩,
        diff_zero_can_cancel hi

lemma lt_sub_nz {x y: 𝐍}: x < y → y - x ≠ 0 :=
    assume h: x < y,
    assume hc: y - x = 0,
    suffices y ≤ x, from absurd this (iff.elim_right not_le h),
    diff_zero hc

lemma sub_cancel_same {x y : 𝐍}: y ≤ x → (x-y)+y = x :=
    natural.rec_on y (
        assume h: 0 ≤ x,
        by refl
    ) (
        assume n: 𝐍,
        assume hr: n ≤ x → x - n + n = x,
        assume h: n+1 ≤ x,
        have x≠0, from assume :x=0,
            have n+1=0, from le_zero (‹x=0› ▸ h),
            absurd ‹n+1=0› (succ_ne_zero n),
        have n < x, from succ_le_implies_lt h,
        calc
            (x - (n+1)) + (n+1) = (x - (n+1) + n) + 1       : by refl
            ...                 = ((pred (x - n)) + n) + 1  : by refl
            ...                 = (pred ((x - n) + n)) + 1  : by rw pred_add (lt_sub_nz ‹n<x›)
            ...                 = (pred x) + 1              : by rw hr ‹n<x›.left
            ...                 = x                         : by rw succ_pred ‹x≠0›
    )

lemma lt_anti_sym {x y: 𝐍}: x < y ↔ y > x :=
    iff.intro (assume ⟨h,g⟩, ⟨h,g⟩) (assume ⟨h,g⟩, ⟨h,g⟩)

lemma succ_sub {x y: 𝐍}: y ≤ x → (x+1) - y = (x - y) + 1 :=
    natural.rec_on y (
        assume h,
        show (x+1) - 0 = x + 1, by refl
    ) (
        assume a: 𝐍,
        assume h: a ≤ x → (x + 1) - a = (x - a) + 1,
        assume ⟨z,(_:z + (a+1) = x)⟩,
        have a ≤ x, from ⟨z+1, by rwa [add_asoc, add_com 1]⟩,
        have ¬ a > x, from (iff.elim_left le_iff_not_gt) ‹a ≤ x›,
        have ¬ x < a, from mt (iff.elim_left lt_anti_sym) ‹¬a > x›,
        have x ≠ a, from (
            assume :x = a,
            suffices z+1 = 0, from absurd this (succ_ne_zero z),
            suffices (z+1) + a = a, from add_unchanged_implies_zero this,
            calc
                (z+1) + a = z + (1+a)  : by rw add_asoc
                ...       = z + (a+1)  : by rw add_com 1
                ...       = x          : by assumption
                ...       = a          : by assumption
        ),
        have ¬ x ≤ a, from (
            assume :x ≤ a,
            suffices x < a, from absurd this ‹¬x < a›,
            ⟨‹x ≤ a›, ‹x ≠ a›⟩
        ),
        have x - a ≠ 0, from (mt diff_zero) ‹¬x ≤ a›,
        have h: (x + 1) - a = (x - a) + 1, from h ‹a ≤ x›,
        have (x + 1) - (a + 1) = x - a, from
        (
            calc
                (x + 1) - (a + 1) = pred ((x+1) - a)    : by refl
                ...               = pred ((x - a) + 1)  : by rw h
                ...               = x - a               : by refl
        ),
        suffices (x - (a + 1)) + 1 = x - a, from (eq.symm this) ▸ ‹(x + 1) - (a + 1) = x - a›,
        calc
            (x - (a + 1)) + 1 = pred(x - a) + 1   : by refl
            ...               = x - a             : by rw (succ_pred ‹x-a ≠ 0›)
    )

lemma sub_self_zero (x: 𝐍): x - x = 0 :=
    natural.rec_on x (
        by refl
    ) (
        assume n: 𝐍,
        assume h: n - n = 0,
        have n ≤ n, from le_refl n,
        calc
            (n+1) - (n+1) = pred ((n+1) - n)   : by refl
            ...           = pred ((n - n) + 1) : by rw (succ_sub ‹n ≤ n›)
            ...           = pred (0 + 1)       : by rw h
            ...           = pred 1             : by rw zero_add_
            ...           = 0                  : by refl
    )

lemma le_sub_zero {x y: 𝐍}: x ≤ y → x - y = 0 :=
    natural.rec_on y (
        assume h,
        have x - 0 = x, by refl,
        suffices x = 0, from ‹x = 0› ▸ ‹x-0=x›,
        le_zero h
    ) (
        assume n: 𝐍,
        assume hr: x ≤ n → x - n = 0,
        assume h: x ≤ n+1,
        if hh: x=n+1 then
            have (n+1) - (n+1) = 0, from sub_self_zero (n+1),
            show x - (n+1) = 0, from (eq.symm hh) ▸ this
        else
            have h: x ≤ n, from lt_succ_implies_le ⟨h, hh⟩,
            have hr: x - n = 0, from hr h,
            calc
                x - (n+1) = pred (x - n)   : by refl
                ...       = pred 0         : by rw hr
                ...       = 0              : by refl
    )

lemma diff_nz {x y : 𝐍}: x - y ≠ 0 → y < x :=
    assume h: x - y ≠ 0,
    if hle: x ≤ y then
        absurd (le_sub_zero hle) h
    else
        iff.elim_left not_le hle

lemma succ_sub_self_one (x : 𝐍): (x+1) - x = 1 :=
    calc
        (x+1) - x = (x - x) + 1  : by rw succ_sub (eq_implies_le (eq.refl x))
        ...       = 0 + 1        : by rw sub_self_zero
        ...       = 1            : by rw zero_add_

lemma sub_nz_implies_anti_sum_zero {x y : 𝐍}: x - y ≠ 0 → y - x = 0 :=
    assume h: x - y ≠ 0,
    le_sub_zero (diff_nz h).left

lemma le_implies_le_sum {x y z: 𝐍}: x ≤ y → x ≤ z + y :=
    assume ⟨a, (h: a+x = y)⟩,
    suffices z+a+x = z + y, from ⟨z+a, this⟩,
    calc
        z + a + x = z + (a + x)  : by rw add_asoc
        ...       = z + y        : by rw h

lemma add_sub_asoc {x y z : 𝐍}: natural.sub z y = 0 → x + (y - z) = (x + y) - z :=
    assume h: z - y = 0,
    natural.rec_on x (
        calc
            0 + (y - z) = y - z       : by rw zero_add_
            ...         = (0 + y) - z : by rw zero_add_
    ) (
        assume a: 𝐍,
        assume hr: a + (y-z) = (a+y) - z,
        have z ≤ y, from diff_zero h,
        have z ≤ a+y, from le_implies_le_sum ‹z ≤ y›,
        calc
            (a+1) + (y-z) = (a + (y-z)) + 1  : by simp
            ...           = ((a+y) - z) + 1  : by rw hr
            ...           = ((a+y)+1) - z    : by rw succ_sub ‹z ≤ a+y›
            ...           = ((a+1)+y) - z    : by simp
    )

lemma add_cancel_right {x y z : 𝐍}: x + y = z + y → x = z :=
    natural.rec_on y (
        assume h, by assumption
    ) (
        assume b: 𝐍,
        assume hr: x + b = z + b → x = z,
        assume h: x + (b+1) = z + (b+1),
        have h: (x + b) + 1 = (z + b) + 1, by rw [add_asoc x b 1, h, ←add_asoc z b 1],
        have h: x + b = z + b, from iff.elim_right succ_inj h,
        show x = z, from hr h
    )

lemma add_cancel_left {x y z: 𝐍}: x + y = x + z → y = z :=
    assume h: x + y = x + z,
    have h: y + x = z + x, by rw [←add_com x y, h, add_com x z],
    show y = z, from add_cancel_right h

lemma le_add_cancel_left {x y z: 𝐍}:  x + y ≤ x + z ↔ y ≤ z :=
    iff.intro (
        assume ⟨a, (h: a + (x + y) = x + z)⟩,
        suffices a+y = z, from ⟨a, this⟩,
        suffices a+y+x = z+x, from add_cancel_right this,
        show a + y + x = z + x, by rw [add_asoc, ←add_com x y, h, add_com x z]
    ) (
        assume ⟨a, (h: a + y = z)⟩,
        suffices a + (x + y) = (x + z), from ⟨a, this⟩,
        show a + (x + y) = x + z, by rw [add_com x y, ←add_asoc a y x, h, add_com z x]
    )

lemma le_add_cancel_right {x y z: 𝐍}:  x + y ≤ z + y ↔ x ≤ z :=
    iff.intro (
        assume h: x + y ≤ z + y,
        have h: y + x ≤ y + z, from (add_com z y) ▸ (add_com x y) ▸ h,
        iff.elim_left le_add_cancel_left h
    ) (
        assume h: x ≤ z,
        (add_com y z) ▸ (add_com y x) ▸ (iff.elim_right le_add_cancel_left h)
    )

lemma lt_add_cancel_left {x y z: 𝐍}:  x + y < x + z ↔ y < z :=
    iff.intro (
        assume h: x + y < x + z,
        suffices y ≠ z, from ⟨iff.elim_left le_add_cancel_left h.left, this⟩,
        assume hc: y = z,
        suffices x + y = x + z, from absurd this h.right,
        show x + y = x + z, by rw hc
    ) (
        assume h: y < z,
        suffices x + y ≠ x + z, from ⟨iff.elim_right le_add_cancel_left h.left, this⟩,
        assume hc: x + y = x + z,
        suffices y = z, from absurd this h.right,
        add_cancel_left hc
    )

lemma lt_add_cancel_right {x y z: 𝐍}:  x + y < z + y ↔ x < z :=
    iff.intro (
        assume h: x + y < z + y,
        have h: y + x < y + z, from (add_com z y) ▸ (add_com x y) ▸ h,
        iff.elim_left lt_add_cancel_left h
    ) (
        assume h: x < z,
        (add_com y z) ▸ (add_com y x) ▸ (iff.elim_right lt_add_cancel_left h)
    )

lemma sub_cancel_right (x y z: 𝐍): (x+z) - (y+z) = x - y :=
    if hxy: x - y = 0 then
        have h: x ≤ y, from diff_zero hxy,
        have h: x+z ≤ y+z, from iff.elim_right le_add_cancel_right h,
        show (x+z) - (y+z) = x - y, by rw [le_sub_zero h, hxy]
    else
        natural.rec_on z (
            by refl
        ) (
            assume c: 𝐍,
            assume hr: (x + c) - (y + c) = x - y,
            have y < x, from diff_nz hxy,
            have y+c < x+c, from iff.elim_right lt_add_cancel_right ‹y < x›,
            have (x+c) - (y+c) ≠ 0, from lt_sub_nz ‹y+c < x+c›,
            calc
                (x + (c+1)) - (y + (c+1)) = ((x+c) + 1) - ((y+c) + 1)   : by refl
                ...                       = pred (((x+c) + 1) - (y+c))  : by refl
                ...                       = pred (((x+c) - (y+c)) + 1)  : by rw diff_nz_succ_sub ‹(x+c)-(y+c)≠0›
                ...                       = (x+c) - (y+c)               : by refl
                ...                       = x - y                       : by assumption
        )

lemma sub_of_sub (x y z: 𝐍): (x-y)-z = x-(y+z) :=
    natural.rec_on z (
        by refl
    ) (
        assume c: 𝐍,
        assume hr: x - y - c = x - (y + c),
        calc
            (x - y) - (c+1) = pred ((x - y) - c)  : by refl
            ...             = pred (x - (y + c))  : by rw hr
            ...             = x - (y+c+1)         : by refl
    )

lemma mult_nz {x y: 𝐍}: x≠0 → y≠0 → (x*y)≠0 :=
    natural.rec_on y (
        assume hx,
        assume hy,
        absurd (eq.refl 0) hy
    ) (
        assume b: 𝐍,
        assume hr: x ≠ 0 → b ≠ 0 → x * b ≠ 0,
        assume hx: x ≠ 0,
        assume hy: b+1 ≠ 0,
        assume hc: x*(b+1) = 0,
        absurd (zero_sum hc) hx
    )

lemma mult_nz_eq_z_imp_z {x y : 𝐍}: x*y = 0 → y ≠ 0 → x = 0 :=
    assume h: x*y = 0,
    assume hy: y ≠ 0,
    if hx: x = 0 then
        hx
    else
        let ⟨a, hx⟩ := nz_implies_succ hx in (
            let ⟨b, hy⟩ := nz_implies_succ hy in (
                have h: (a+1)*(b+1) = 0, from hx ▸ hy ▸ h,
                have h: (a+1) + ((a+1)*b) = 0, from h,
                have h: ((a+1)*b + a) + 1 = 0, by rw [add_asoc, ←add_com (a+1), h],
                natural.no_confusion h
            )
        )

lemma mult_elim_right {x y z: 𝐍}: y ≠ 0 → x*y = z*y → x = z :=
    assume hy: y ≠ 0,
    suffices ∀ w: 𝐍, x*y = w*y → x = w, from this z,
    natural.rec_on x (
        assume w: 𝐍,
        assume h: 0*y = w*y,
        have h: w*y = 0, by rw [←h, zero_mult],
        eq.symm (mult_nz_eq_z_imp_z h hy)
    ) (
        assume a: 𝐍,
        assume hr: ∀ (w : 𝐍), a * y = w * y → a = w,
        assume v: 𝐍,
        assume h: (a+1)*y = v*y,
        if hv: v=0 then
            have h: (a+1)*y = 0*y, from hv ▸ h,
            have h: (a+1)*y = 0, by rw [h, zero_mult],
            have h: (a+1) = 0, from mult_nz_eq_z_imp_z h hy,
            absurd h (succ_ne_zero a)
        else
            let ⟨b, hv⟩ := nz_implies_succ hv in (
                have h: (a+1) * y = (b+1) * y, from hv ▸ h,
                have h: y*(a+1) = y*(b+1), by rw [mult_com, h, mult_com],
                have h: y + y*a = y + (y*b), from h,
                have h: y*a = y*b, from add_cancel_left h,
                have h: a*y = b*y, by rw [mult_com, h, mult_com],
                have h: a = b, from hr b h,
                show a+1 = v, by rw [h, hv]
            )
    )

lemma ne_implies_lt_or_gt {x y: 𝐍}: x ≠ y → x < y ∨ y < x :=
    assume hnz: x ≠ y,
    if hle: x ≤ y then
        or.intro_left _ ⟨hle, hnz⟩
    else
        or.intro_right _ (iff.elim_left not_le hle)

lemma le_mult_cancel_right__forward {x y z: 𝐍}: x ≤ y → x*z ≤ y*z :=
    assume ⟨a, (h: a+x = y)⟩,
    suffices a*z + x*z = y*z, from ⟨a*z, this⟩,
    calc
        a*z + x*z = (a + x)*z  : by rw add_dist_mult
        ...       = y*z        : by rw h

lemma mult_cancel_right {x y z: 𝐍}: z ≠ 0 → x*z = y*z → x = y :=
    assume hz: z ≠ 0,
    suffices ∀ b: 𝐍, x*z = b*z → x = b, from this y,
    natural.rec_on x (
        assume y : 𝐍,
        assume h: 0*z = y*z,
        have h: y*z = 0, by rw [←h, zero_mult z],
        eq.symm (mult_nz_eq_z_imp_z h hz)
    ) (
        assume a: 𝐍,
        assume hr:  ∀ (b : 𝐍), a * z = b * z → a = b,
        assume y: 𝐍,
        assume h: (a+1) * z = y * z,
        if hy: y=0 then
            have h: (a+1) * z = 0, by rw [h, hy, zero_mult],
            have h: (a+1) = 0, from mult_nz_eq_z_imp_z h hz,
            absurd h (succ_ne_zero a)
        else
            let ⟨b, hy⟩ := nz_implies_succ hy in (
                have h: (a+1)*z = (b+1)*z, from hy ▸ h,
                suffices a = b, from show a + 1 = y, by rw [this, hy],
                suffices z + a*z = z + b*z, from hr b (add_cancel_left this),
                calc
                    z + a*z = z + z*a  : by rw mult_com
                    ...     = z*(a+1)  : by refl
                    ...     = (a+1)*z  : by rw mult_com
                    ...     = (b+1)*z  : by assumption
                    ...     = z*(b+1)  : by rw mult_com
                    ...     = z + z*b  : by refl
                    ...     = z + b*z  : by rw mult_com
            )
    )

lemma lt_mult_cancel_right__forward {x y z: 𝐍}: z ≠ 0 → x < y → x*z < y*z :=
    assume hz: z ≠ 0,
    assume ⟨hle, hne⟩,
    suffices x*z ≠ y*z, from ⟨le_mult_cancel_right__forward hle, this⟩,
    assume hc: x*z = y*z,
    absurd (mult_cancel_right hz hc) hne

lemma le_mult_cancel_right {x y z: 𝐍}: (x ≤ y ∨ z = 0) ↔ x*z ≤ y*z :=
    iff.intro (
        assume h,
        or.elim h (
            le_mult_cancel_right__forward
        ) (
            assume hz: z = 0,
            suffices x*z = y*z, from eq_implies_le this,
            calc
                x * z = x * 0   : by rw hz
                ...   = 0       : by refl
                ...   = y * 0   : by refl
                ...   = y * z   : by rw hz
        )
    ) (
        assume h: x*z ≤ y*z,
        if hc: x ≤ y then
            or.intro_left _ hc
        else
            if hz: z = 0 then
                or.intro_right _ hz
            else
                have hc: y < x, from iff.elim_left not_le hc,
                have hc: y*z < x*z, from lt_mult_cancel_right__forward hz hc,
                absurd h (iff.elim_right not_le hc)
    )

lemma lt_mult_cancel_right {x y z: 𝐍}: (x<y ∧ z≠0) ↔ x*z < y*z :=
    iff.intro (
        assume ⟨hlt, hz⟩,
        lt_mult_cancel_right__forward hz hlt
    ) (
        assume h: x*z < y*z,
        have z ≠ 0, from (
            assume hc: z=0,
            have hc: x*0 < y*0, from hc ▸ h,
            absurd (show x*0 = y*0, by rw [mult_zero, mult_zero]) hc.right
        ),
        if hc: x < y then
            ⟨hc, ‹z≠0›⟩
        else
            have hc: y ≤ x, from iff.elim_left not_lt hc,
            have hc: y*z ≤ x*z, from le_mult_cancel_right__forward hc,
            have hc: ¬(x*z < y*z), from iff.elim_right not_lt hc,
            absurd h hc
    )

lemma sub_dist_mult {x y z: 𝐍}: y ≤ x → (x - y)*z = x*z - y*z :=
    assume h: y ≤ x,
    natural.rec_on z (by refl) (
        assume c: 𝐍,
        assume hr: (x - y) * c = x * c - y * c,
        have y - x = 0, from le_sub_zero h,
        have y*c ≤ x*c, from iff.elim_left le_mult_cancel_right (or.intro_left _ h),
        have y*c - x*c = 0, from le_sub_zero ‹y*c ≤ x*c›,
        calc
            (x - y) * (c+1) =  (x - y) + (x - y)*c    : by refl
            ...             =  (x - y) + (x*c - y*c)  : by rw hr
            ...             =  (x - y) + x*c - y*c    : by rw add_sub_asoc ‹(y*c) - (x*c) = 0›
            ...             =  x*c + (x - y) - y*c    : by rw add_com
            ...             =  (x*c + x) - y - y*c    : by rw add_sub_asoc ‹y - x = 0›
            ...             =  (x*c + x) - (y + y*c)  : by rw sub_of_sub
            ...             =  (x + x*c) - (y + y*c)  : by rw add_com
            ...             =  (x*(c+1)) - (y*(c+1))  : by refl
    )

-- And essentially that's the natural numbers

end natural


-- Límites mediante filtros
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Importar las teorías
-- + Limites_de_sucesiones
-- + topology.instances.real
-- ---------------------------------------------------------------------

import .Limites_de_sucesiones
import topology.instances.real

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombres `filter`.
-- ---------------------------------------------------------------------

open filter

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el contexto `topological_space`
-- ---------------------------------------------------------------------

open_locale topological_space

-- ---------------------------------------------------------------------
-- Ejercicio. Iniciar el espacio de nombres `oculto`-
-- ---------------------------------------------------------------------

namespace oculto

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar
-- ---------------------------------------------------------------------

lemma is_limit_iff_tendsto
  (a : ℕ → ℝ)
  (l : ℝ)
  : is_limit a l ↔ tendsto a at_top (𝓝 l) :=
begin
  rw metric.tendsto_at_top,
  congr',
end

-- this is `is_limit_add`

example
  (a b : ℕ → ℝ)
  (l m : ℝ)
  : is_limit a l → is_limit b m → is_limit (a + b) (l + m) :=
begin
  repeat {rw is_limit_iff_tendsto},
  exact tendsto.add,
end

-- this is `is_limit_mul`

example
  (a b : ℕ → ℝ)
  (l m : ℝ)
  : is_limit a l → is_limit b m → is_limit (a * b) (l * m) :=
begin
  repeat {rw is_limit_iff_tendsto},
  exact tendsto.mul,
end

end oculto


import tactic
/--------------------------------------------------------------------------

Recall that
  ``¬ P`` is ``P → false``,
  ``¬ (¬ P)`` is ``(P → false) → false``, and so on.

Delete the ``sorry,`` below and replace them with a legitimate proof.

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

theorem self_imp_not_not_self (P : Prop) : P → ¬ (¬ P) :=
begin
  sorry,
end

theorem contrapositive (P Q : Prop) : (P → Q) → (¬Q → ¬P) :=
begin
  sorry,
end

example (P : Prop) : ¬ (¬ (¬ P)) → ¬ P :=
begin
  sorry,
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.gcd
import tactic.abel
import data.list.rotate

/-!
# Congruences modulo a natural number

This file defines the equivalence relation `a ≡ b [MOD n]` on the natural numbers,
and proves basic properties about it such as the Chinese Remainder Theorem
`modeq_and_modeq_iff_modeq_mul`.

## Notations

`a ≡ b [MOD n]` is notation for `modeq n a b`, which is defined to mean `a % n = b % n`.

## Tags

modeq, congruence, mod, MOD, modulo
-/

namespace nat

/-- Modular equality. `modeq n a b`, or `a ≡ b [MOD n]`, means
  that `a - b` is a multiple of `n`. -/
@[derive decidable]
def modeq (n a b : ℕ) := a % n = b % n

notation a ` ≡ `:50 b ` [MOD `:50 n `]`:0 := modeq n a b

namespace modeq
variables {n m a b c d : ℕ}

@[refl] protected theorem refl (a : ℕ) : a ≡ a [MOD n] := @rfl _ _

@[symm] protected theorem symm : a ≡ b [MOD n] → b ≡ a [MOD n] := eq.symm

@[trans] protected theorem trans : a ≡ b [MOD n] → b ≡ c [MOD n] → a ≡ c [MOD n] := eq.trans

protected theorem comm : a ≡ b [MOD n] ↔ b ≡ a [MOD n] := ⟨nat.modeq.symm, nat.modeq.symm⟩

theorem modeq_zero_iff : a ≡ 0 [MOD n] ↔ n ∣ a :=
by rw [modeq, zero_mod, dvd_iff_mod_eq_zero]

theorem modeq_iff_dvd : a ≡ b [MOD n] ↔ (n:ℤ) ∣ b - a :=
by rw [modeq, eq_comm, ← int.coe_nat_inj', int.coe_nat_mod, int.coe_nat_mod,
   int.mod_eq_mod_iff_mod_sub_eq_zero, int.dvd_iff_mod_eq_zero]

theorem modeq_of_dvd : (n:ℤ) ∣ b - a → a ≡ b [MOD n] := modeq_iff_dvd.2
theorem dvd_of_modeq : a ≡ b [MOD n] → (n:ℤ) ∣ b - a := modeq_iff_dvd.1

/-- A variant of `modeq_iff_dvd` with `nat` divisibility -/
theorem modeq_iff_dvd' (h : a ≤ b) : a ≡ b [MOD n] ↔ n ∣ b - a :=
by rw [modeq_iff_dvd, ←int.coe_nat_dvd, int.coe_nat_sub h]

theorem mod_modeq (a n) : a % n ≡ a [MOD n] := nat.mod_mod _ _

theorem modeq_of_dvd_of_modeq (d : m ∣ n) (h : a ≡ b [MOD n]) : a ≡ b [MOD m] :=
modeq_of_dvd $ dvd_trans (int.coe_nat_dvd.2 d) (dvd_of_modeq h)

theorem modeq_mul_left' (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD (c * n)] :=
by unfold modeq at *; rw [mul_mod_mul_left, mul_mod_mul_left, h]

theorem modeq_mul_left (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD n] :=
modeq_of_dvd_of_modeq (dvd_mul_left _ _) $ modeq_mul_left' _ h

theorem modeq_mul_right' (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD (n * c)] :=
by rw [mul_comm a, mul_comm b, mul_comm n]; exact modeq_mul_left' c h

theorem modeq_mul_right (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD n] :=
by rw [mul_comm a, mul_comm b]; exact modeq_mul_left c h

theorem modeq_mul (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a * c ≡ b * d [MOD n] :=
(modeq_mul_left _ h₂).trans (modeq_mul_right _ h₁)

theorem modeq_pow (m : ℕ) (h : a ≡ b [MOD n]) : a ^ m ≡ b ^ m [MOD n] :=
begin
  induction m with d hd, {refl},
  rw [pow_succ, pow_succ],
  exact modeq_mul h hd,
end

theorem modeq_add (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a + c ≡ b + d [MOD n] :=
modeq_of_dvd begin
  convert dvd_add (dvd_of_modeq h₁) (dvd_of_modeq h₂) using 1,
  simp [sub_eq_add_neg, add_left_comm, add_comm],
end

theorem modeq_add_cancel_left (h₁ : a ≡ b [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) : c ≡ d [MOD n] :=
begin
  simp only [modeq_iff_dvd] at *,
  convert _root_.dvd_sub h₂ h₁ using 1,
  simp [sub_eq_add_neg],
  abel
end

theorem modeq_add_cancel_right (h₁ : c ≡ d [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) : a ≡ b [MOD n] :=
by rw [add_comm a, add_comm b] at h₂; exact modeq_add_cancel_left h₁ h₂

theorem modeq_of_modeq_mul_left (m : ℕ) (h : a ≡ b [MOD m * n]) : a ≡ b [MOD n] :=
by rw [modeq_iff_dvd] at *; exact dvd.trans (dvd_mul_left (n : ℤ) (m : ℤ)) h

theorem modeq_of_modeq_mul_right (m : ℕ) : a ≡ b [MOD n * m] → a ≡ b [MOD n] :=
mul_comm m n ▸ modeq_of_modeq_mul_left _

theorem modeq_one : a ≡ b [MOD 1] := modeq_of_dvd $ one_dvd _

local attribute [semireducible] int.nonneg

/-- The natural number less than `lcm n m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder' (h : a ≡ b [MOD gcd n m]) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
if hn : n = 0 then ⟨a, begin rw [hn, gcd_zero_left] at h, split, refl, exact h end⟩ else
if hm : m = 0 then ⟨b, begin rw [hm, gcd_zero_right] at h, split, exact h.symm, refl end⟩ else
⟨let (c, d) := xgcd n m in int.to_nat (((n * c * b + m * d * a) / gcd n m) % lcm n m), begin
  rw xgcd_val,
  dsimp [chinese_remainder'._match_1],
  rw [modeq_iff_dvd, modeq_iff_dvd,
    int.to_nat_of_nonneg (int.mod_nonneg _ (int.coe_nat_ne_zero.2 (lcm_ne_zero hn hm)))],
  have hnonzero : (gcd n m : ℤ) ≠ 0 := begin
    norm_cast,
    rw [nat.gcd_eq_zero_iff, not_and],
    exact λ _, hm,
  end,
  have hcoedvd : ∀ t, (gcd n m : ℤ) ∣ t * (b - a) := λ t, dvd_mul_of_dvd_right h.dvd_of_modeq _,
  have := gcd_eq_gcd_ab n m,
  split; rw [int.mod_def, ← sub_add]; refine dvd_add _ (dvd_mul_of_dvd_left _ _); try {norm_cast},
  { rw ← sub_eq_iff_eq_add' at this,
    rw [← this, sub_mul, ← add_sub_assoc, add_comm, add_sub_assoc, ← mul_sub,
      int.add_div_of_dvd_left, int.mul_div_cancel_left _ hnonzero,
      int.mul_div_assoc _ h.dvd_of_modeq, ← sub_sub, sub_self, zero_sub, dvd_neg, mul_assoc],
    exact dvd_mul_right _ _,
    norm_cast, exact dvd_mul_right _ _, },
  { exact dvd_lcm_left n m, },
  { rw ← sub_eq_iff_eq_add at this,
    rw [← this, sub_mul, sub_add, ← mul_sub, int.sub_div_of_dvd, int.mul_div_cancel_left _ hnonzero,
      int.mul_div_assoc _ h.dvd_of_modeq, ← sub_add, sub_self, zero_add, mul_assoc],
    exact dvd_mul_right _ _,
    exact hcoedvd _ },
  { exact dvd_lcm_right n m, },
end⟩

/-- The natural number less than `n*m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder (co : coprime n m) (a b : ℕ) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
chinese_remainder' (by convert modeq_one)

lemma modeq_and_modeq_iff_modeq_mul {a b m n : ℕ} (hmn : coprime m n) :
  a ≡ b [MOD m] ∧ a ≡ b [MOD n] ↔ (a ≡ b [MOD m * n]) :=
⟨λ h, begin
    rw [nat.modeq.modeq_iff_dvd, nat.modeq.modeq_iff_dvd, ← int.dvd_nat_abs,
      int.coe_nat_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd] at h,
    rw [nat.modeq.modeq_iff_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd],
    exact hmn.mul_dvd_of_dvd_of_dvd h.1 h.2
  end,
λ h, ⟨nat.modeq.modeq_of_modeq_mul_right _ h, nat.modeq.modeq_of_modeq_mul_left _ h⟩⟩

lemma coprime_of_mul_modeq_one (b : ℕ) {a n : ℕ} (h : a * b ≡ 1 [MOD n]) : coprime a n :=
nat.coprime_of_dvd' (λ k kp ⟨ka, hka⟩ ⟨kb, hkb⟩, int.coe_nat_dvd.1 begin
  rw [hka, hkb, modeq_iff_dvd] at h,
  cases h with z hz,
  rw [sub_eq_iff_eq_add] at hz,
  rw [hz, int.coe_nat_mul, mul_assoc, mul_assoc, int.coe_nat_mul, ← mul_add],
  exact dvd_mul_right _ _,
end)

end modeq

@[simp] lemma mod_mul_right_mod (a b c : ℕ) : a % (b * c) % b = a % b :=
modeq.modeq_of_modeq_mul_right _ (modeq.mod_modeq _ _)

@[simp] lemma mod_mul_left_mod (a b c : ℕ) : a % (b * c) % c = a % c :=
modeq.modeq_of_modeq_mul_left _ (modeq.mod_modeq _ _)

lemma div_mod_eq_mod_mul_div (a b c : ℕ) : a / b % c = a % (b * c) / b :=
if hb0 : b = 0 then by simp [hb0]
else by rw [← @add_right_cancel_iff _ _ (c * (a / b / c)), mod_add_div, nat.div_div_eq_div_mul,
  ← nat.mul_right_inj (nat.pos_of_ne_zero hb0),← @add_left_cancel_iff _ _ (a % b), mod_add_div,
  mul_add, ← @add_left_cancel_iff _ _ (a % (b * c) % b), add_left_comm,
  ← add_assoc (a % (b * c) % b), mod_add_div, ← mul_assoc, mod_add_div, mod_mul_right_mod]

lemma add_mod_add_ite (a b c : ℕ) :
  (a + b) % c + (if c ≤ a % c + b % c then c else 0) = a % c + b % c :=
have (a + b) % c = (a % c + b % c) % c,
  from nat.modeq.modeq_add (nat.modeq.mod_modeq _ _).symm (nat.modeq.mod_modeq _ _).symm,
if hc0 : c = 0 then by simp [hc0]
else
  begin
    rw this,
    split_ifs,
    { have h2 : (a % c + b % c) / c < 2,
        from nat.div_lt_of_lt_mul (by rw mul_two;
          exact add_lt_add (nat.mod_lt _ (nat.pos_of_ne_zero hc0))
            (nat.mod_lt _ (nat.pos_of_ne_zero hc0))),
      have h0 : 0 <  (a % c + b % c) / c, from nat.div_pos h (nat.pos_of_ne_zero hc0),
      rw [← @add_right_cancel_iff _ _ (c * ((a % c + b % c) / c)), add_comm _ c, add_assoc,
        mod_add_div, le_antisymm (le_of_lt_succ h2) h0, mul_one, add_comm] },
    { rw [nat.mod_eq_of_lt (lt_of_not_ge h), add_zero] }
  end

lemma add_mod_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) :
  (a + b) % c = a % c + b % c :=
 by rw [← add_mod_add_ite, if_neg (not_le_of_lt hc), add_zero]

lemma add_mod_add_of_le_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) :
  (a + b) % c + c = a % c + b % c :=
by rw [← add_mod_add_ite, if_pos hc]

lemma add_div {a b c : ℕ} (hc0 : 0 < c) : (a + b) / c = a / c + b / c +
  if c ≤ a % c + b % c then 1 else 0 :=
begin
  rw [← nat.mul_right_inj hc0, ← @add_left_cancel_iff _ _ ((a + b) % c + a % c + b % c)],
  suffices : (a + b) % c + c * ((a + b) / c) + a % c + b % c =
    a % c + c * (a / c) + (b % c + c * (b / c)) + c * (if c ≤ a % c + b % c then 1 else 0) +
      (a + b) % c,
  { simpa only [mul_add, add_comm, add_left_comm, add_assoc] },
  rw [mod_add_div, mod_add_div, mod_add_div, mul_ite, add_assoc, add_assoc],
  conv_lhs { rw ← add_mod_add_ite },
  simp, ac_refl
end

lemma add_div_eq_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) :
  (a + b) / c = a / c + b / c :=
if hc0 : c = 0 then by simp [hc0]
else by rw [add_div (nat.pos_of_ne_zero hc0), if_neg (not_le_of_lt hc), add_zero]

protected lemma add_div_of_dvd_right {a b c : ℕ} (hca : c ∣ a) :
  (a + b) / c = a / c + b / c :=
if h : c = 0 then by simp [h] else add_div_eq_of_add_mod_lt begin
  rw [nat.mod_eq_zero_of_dvd hca, zero_add],
  exact nat.mod_lt _ (pos_iff_ne_zero.mpr h),
end

protected lemma add_div_of_dvd_left {a b c : ℕ} (hca : c ∣ b) :
  (a + b) / c = a / c + b / c :=
by rwa [add_comm, nat.add_div_of_dvd_right, add_comm]

lemma add_div_eq_of_le_mod_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) (hc0 : 0 < c) :
  (a + b) / c = a / c + b / c + 1 :=
by rw [add_div hc0, if_pos hc]

lemma add_div_le_add_div (a b c : ℕ) : a / c + b / c ≤ (a + b) / c :=
if hc0 : c = 0 then by simp [hc0]
else by rw [nat.add_div (nat.pos_of_ne_zero hc0)]; exact le_add_right _ _

lemma le_mod_add_mod_of_dvd_add_of_not_dvd {a b c : ℕ} (h : c ∣ a + b) (ha : ¬ c ∣ a) :
  c ≤ a % c + b % c :=
by_contradiction $ λ hc,
  have (a + b) % c = a % c + b % c, from add_mod_of_add_mod_lt (lt_of_not_ge hc),
  by simp [dvd_iff_mod_eq_zero, *] at *

lemma odd_mul_odd {n m : ℕ} : n % 2 = 1 → m % 2 = 1 → (n * m) % 2 = 1 :=
by simpa [nat.modeq] using @nat.modeq.modeq_mul 2 n 1 m 1

lemma odd_mul_odd_div_two {m n : ℕ} (hm1 : m % 2 = 1) (hn1 : n % 2 = 1) :
  (m * n) / 2 = m * (n / 2) + m / 2 :=
have hm0 : 0 < m := nat.pos_of_ne_zero (λ h, by simp * at *),
have hn0 : 0 < n := nat.pos_of_ne_zero (λ h, by simp * at *),
(nat.mul_right_inj (show 0 < 2, from dec_trivial)).1 $
by rw [mul_add, two_mul_odd_div_two hm1, mul_left_comm, two_mul_odd_div_two hn1,
  two_mul_odd_div_two (nat.odd_mul_odd hm1 hn1), nat.mul_sub_left_distrib, mul_one,
  ← nat.add_sub_assoc hm0, nat.sub_add_cancel (le_mul_of_one_le_right (nat.zero_le _) hn0)]

lemma odd_of_mod_four_eq_one {n : ℕ} : n % 4 = 1 → n % 2 = 1 :=
by simpa [modeq, show 2 * 2 = 4, by norm_num] using @modeq.modeq_of_modeq_mul_left 2 n 1 2

lemma odd_of_mod_four_eq_three {n : ℕ} : n % 4 = 3 → n % 2 = 1 :=
by simpa [modeq, show 2 * 2 = 4, by norm_num, show 3 % 4 = 3, by norm_num]
  using @modeq.modeq_of_modeq_mul_left 2 n 3 2

end nat

namespace list
variable {α : Type*}

lemma nth_rotate : ∀ {l : list α} {n m : ℕ} (hml : m < l.length),
  (l.rotate n).nth m = l.nth ((m + n) % l.length)
| []     n     m hml := (nat.not_lt_zero _ hml).elim
| l      0     m hml := by simp [nat.mod_eq_of_lt hml]
| (a::l) (n+1) m hml :=
have h₃ : m < list.length (l ++ [a]), by simpa using hml,
(lt_or_eq_of_le (nat.le_of_lt_succ $ nat.mod_lt (m + n)
  (lt_of_le_of_lt (nat.zero_le _) hml))).elim
(λ hml',
  have h₁ : (m + (n + 1)) % ((a :: l : list α).length) =
      (m + n) % ((a :: l : list α).length) + 1,
    from calc (m + (n + 1)) % (l.length + 1) =
      ((m + n) % (l.length + 1) + 1) % (l.length + 1) :
      add_assoc m n 1 ▸ nat.modeq.modeq_add (nat.mod_mod _ _).symm rfl
    ... = (m + n) % (l.length + 1) + 1 : nat.mod_eq_of_lt (nat.succ_lt_succ hml'),
  have h₂ : (m + n) % (l ++ [a]).length < l.length, by simpa [nat.add_one] using hml',
  by rw [list.rotate_cons_succ, nth_rotate h₃, list.nth_append h₂, h₁, list.nth]; simp)
(λ hml',
  have h₁ : (m + (n + 1)) % (l.length + 1) = 0,
    from calc (m + (n + 1)) % (l.length + 1) = (l.length + 1) % (l.length + 1) :
      add_assoc m n 1 ▸ nat.modeq.modeq_add
        (hml'.trans (nat.mod_eq_of_lt (nat.lt_succ_self _)).symm) rfl
    ... = 0 : by simp,
  by rw [list.length, list.rotate_cons_succ, nth_rotate h₃, list.length_append,
    list.length_cons, list.length, zero_add, hml', h₁, list.nth_concat_length]; refl)

lemma rotate_eq_self_iff_eq_repeat [hα : nonempty α] : ∀ {l : list α},
  (∀ n, l.rotate n = l) ↔ ∃ a, l = list.repeat a l.length
| []     := ⟨λ h, nonempty.elim hα (λ a, ⟨a, by simp⟩), by simp⟩
| (a::l) :=
⟨λ h, ⟨a, list.ext_le (by simp) $ λ n hn h₁,
  begin
    rw [← option.some_inj, ← list.nth_le_nth],
    conv {to_lhs, rw ← h ((list.length (a :: l)) - n)},
    rw [nth_rotate hn, nat.add_sub_cancel' (le_of_lt hn),
      nat.mod_self, nth_le_repeat], refl
  end⟩,
  λ ⟨a, ha⟩ n, ha.symm ▸ list.ext_le (by simp)
    (λ m hm h,
      have hm' : (m + n) % (list.repeat a (list.length (a :: l))).length < list.length (a :: l),
        by rw list.length_repeat; exact nat.mod_lt _ (nat.succ_pos _),
      by rw [nth_le_repeat, ← option.some_inj, ← list.nth_le_nth, nth_rotate h, list.nth_le_nth,
        nth_le_repeat]; simp * at *)⟩

end list