import order.antichain

universes u v

open set

class has_involution (α : Type u) [preorder α] :=
(invo' : α ≃o αᵒᵈ)
(is_involutive : ∀ x, invo' (invo' x) = x)

namespace has_involution

variables {α : Type u} {a b x y : α} {s : set α}

def invo [preorder α] [has_involution α] : (α → α) := λ a, invo' a

postfix `ᵒ`:(max +1) := invo

section preorder

variables [preorder α] [has_involution α]

@[simp] lemma invo_invo (x : α) : xᵒᵒ = x := is_involutive x
lemma invo_le_iff : xᵒ ≤ yᵒ ↔ y ≤ x := invo'.le_iff_le
lemma invo_le (hxy : x ≤ y) : yᵒ ≤ xᵒ :=  invo_le_iff.2 hxy
lemma le_of_invo_le (hx : xᵒ ≤ yᵒ) : y ≤ x :=
  by {rw [←invo_invo y, ←invo_invo x], exact invo_le hx}
lemma le_invo_comm : x ≤ yᵒ ↔ y ≤ xᵒ := by rw [←invo_le_iff, invo_invo]
lemma invo_le_comm : xᵒ ≤ y ↔ yᵒ ≤ x := by rw [←invo_le_iff, invo_invo]
lemma invo_inj {x y : α} (h : xᵒ = yᵒ) : x = y := invo'.injective h

lemma invo_lt_iff : xᵒ < yᵒ ↔ y < x := by {apply @order_iso.lt_iff_lt α αᵒᵈ}
lemma lt_invo_comm : x < yᵒ ↔ y < xᵒ := by rw [←invo_lt_iff, invo_invo]
lemma invo_lt_comm : xᵒ < y ↔ yᵒ < x := by rw [←invo_lt_iff, invo_invo]

lemma image_invo_eq_preimage_invo : invo '' s = invo ⁻¹' s :=
ext (λ x, ⟨by {rintro ⟨x',hx',rfl⟩, rwa [←invo_invo x'] at hx'}, λ h, ⟨xᵒ, ⟨h, invo_invo x⟩⟩⟩)

@[simp] lemma invo_invo_image : invo '' (invo '' s) = s :=
by {rw image_invo_eq_preimage_invo, apply invo'.to_equiv.preimage_image _}

lemma mem_image_invo {x : α} {s : set α} : x ∈ invo '' s ↔ xᵒ ∈ s :=
by {rw image_invo_eq_preimage_invo, refl}

lemma mem_image_invo' {x : α} {P : α → Prop} : (invo '' P) x ↔ P xᵒ := mem_image_invo

lemma mem_preimage_invo' {x : α} {P : α → Prop} : (invo ⁻¹' P) x ↔ P xᵒ :=
by rw [←image_invo_eq_preimage_invo, mem_image_invo']

lemma image_antichain (hs : is_antichain (≤) s) : is_antichain (≤) (invo '' s) :=
begin
  rintros _ ⟨a,has, rfl⟩ _ ⟨b,hbs,rfl⟩ hab hle,
  exact hs hbs has (λ h, hab (by rw h)) (invo_le_iff.mp hle),
end

lemma preimage_antichain (hs : is_antichain (≤) s) : is_antichain (≤) (invo ⁻¹' s) :=
λ a ha b hb hab hle, hs hb ha (λ h, hab (invo_inj h.symm)) (invo_le_iff.mpr hle)

@[simp] lemma preimage_Icc : invo ⁻¹' (Icc x y) = Icc yᵒ xᵒ :=
set.ext (λ x, by {simp only [mem_preimage, mem_Icc], rw [and_comm, invo_le_comm, le_invo_comm]})

@[simp] lemma preimage_Iic : invo ⁻¹' (Iic x) = Ici xᵒ :=
set.ext (λ a, by simpa only [mem_preimage, mem_Iic, mem_Ici] using invo_le_comm)

@[simp] lemma preimage_Ici : invo ⁻¹' (Ici x) = Iic xᵒ :=
set.ext (λ a, by simpa only [mem_preimage, mem_Iic, mem_Ici] using le_invo_comm)

@[simp] lemma image_Icc : invo '' (Icc x y) = Icc yᵒ xᵒ :=
by rw [image_invo_eq_preimage_invo, preimage_Icc]

@[simp] lemma image_Iic : invo '' (Iic x) = Ici xᵒ :=
by rw [image_invo_eq_preimage_invo, preimage_Iic]

@[simp] lemma image_Ici : invo '' (Ici x) = Iic xᵒ :=
by rw [image_invo_eq_preimage_invo, preimage_Ici]

end preorder

section lattice

variables [lattice α] [has_involution α]

lemma invo_sup : (a ⊔ b)ᵒ = aᵒ ⊓ bᵒ := @order_iso.map_sup α αᵒᵈ _ _ _ _ _
lemma invo_inf : (a ⊓ b)ᵒ = aᵒ ⊔ bᵒ := @order_iso.map_inf α αᵒᵈ _ _ _ _ _

end lattice

section boolean_algebra

variables [boolean_algebra α]

instance of_boolean_algebra : has_involution α := ⟨order_iso.compl α, compl_compl⟩

lemma invo_eq_compl (x : α): xᵒ = xᶜ := rfl

end boolean_algebra

end has_involution


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

import algebra.char_p.invertible
import data.mv_polynomial.variables
import data.mv_polynomial.comm_ring
import data.mv_polynomial.expand
import data.zmod.basic

/-!
# Witt polynomials

To endow `witt_vector p R` with a ring structure,
we need to study the so-called Witt polynomials.

Fix a base value `p : ℕ`.
The `p`-adic Witt polynomials are an infinite family of polynomials
indexed by a natural number `n`, taking values in an arbitrary ring `R`.
The variables of these polynomials are represented by natural numbers.
The variable set of the `n`th Witt polynomial contains at most `n+1` elements `{0, ..., n}`,
with exactly these variables when `R` has characteristic `0`.

These polynomials are used to define the addition and multiplication operators
on the type of Witt vectors. (While this type itself is not complicated,
the ring operations are what make it interesting.)

When the base `p` is invertible in `R`, the `p`-adic Witt polynomials
form a basis for `mv_polynomial ℕ R`, equivalent to the standard basis.

## Main declarations

* `witt_polynomial p R n`: the `n`-th Witt polynomial, viewed as polynomial over the ring `R`
* `X_in_terms_of_W p R n`: if `p` is invertible, the polynomial `X n` is contained in the subalgebra
  generated by the Witt polynomials. `X_in_terms_of_W p R n` is the explicit polynomial,
  which upon being bound to the Witt polynomials yields `X n`.
* `bind₁_witt_polynomial_X_in_terms_of_W`: the proof of the claim that
  `bind₁ (X_in_terms_of_W p R) (W_ R n) = X n`
* `bind₁_X_in_terms_of_W_witt_polynomial`: the converse of the above statement

## Notation

In this file we use the following notation

* `p` is a natural number, typically assumed to be prime.
* `R` and `S` are commutative rings
* `W n` (and `W_ R n` when the ring needs to be explicit) denotes the `n`th Witt polynomial

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

open mv_polynomial
open finset (hiding map)
open finsupp (single)

open_locale big_operators

local attribute [-simp] coe_eval₂_hom

variables (p : ℕ)
variables (R : Type*) [comm_ring R]

/-- `witt_polynomial p R n` is the `n`-th Witt polynomial
with respect to a prime `p` with coefficients in a commutative ring `R`.
It is defined as:

`∑_{i ≤ n} p^i X_i^{p^{n-i}} ∈ R[X_0, X_1, X_2, …]`. -/
noncomputable def witt_polynomial (n : ℕ) : mv_polynomial ℕ R :=
∑ i in range (n+1), monomial (single i (p ^ (n - i))) (p ^ i)

lemma witt_polynomial_eq_sum_C_mul_X_pow (n : ℕ) :
  witt_polynomial p R n = ∑ i in range (n+1), C (p ^ i : R) * X i ^ (p ^ (n - i)) :=
begin
  apply sum_congr rfl,
  rintro i -,
  rw [monomial_eq, finsupp.prod_single_index],
  rw pow_zero,
end

/-! We set up notation locally to this file, to keep statements short and comprehensible.
This allows us to simply write `W n` or `W_ ℤ n`. -/

-- Notation with ring of coefficients explicit
localized "notation `W_` := witt_polynomial p"   in witt
-- Notation with ring of coefficients implicit
localized "notation `W`  := witt_polynomial p _" in witt

open_locale witt
open mv_polynomial
/- The first observation is that the Witt polynomial doesn't really depend on the coefficient ring.
If we map the coefficients through a ring homomorphism, we obtain the corresponding Witt polynomial
over the target ring. -/
section
variables {R} {S : Type*} [comm_ring S]

@[simp] lemma map_witt_polynomial (f : R →+* S) (n : ℕ) :
  map f (W n) = W n :=
begin
  rw [witt_polynomial, ring_hom.map_sum, witt_polynomial, sum_congr rfl],
  intros i hi,
  rw [map_monomial, ring_hom.map_pow, ring_hom.map_nat_cast],
end

variables (R)

@[simp] lemma constant_coeff_witt_polynomial [hp : fact p.prime] (n : ℕ) :
  constant_coeff (witt_polynomial p R n) = 0 :=
begin
  simp only [witt_polynomial, ring_hom.map_sum, constant_coeff_monomial],
  rw [sum_eq_zero],
  rintro i hi,
  rw [if_neg],
  rw [finsupp.single_eq_zero],
  exact ne_of_gt (pow_pos hp.1.pos _)
end

@[simp] lemma witt_polynomial_zero : witt_polynomial p R 0 = X 0 :=
by simp only [witt_polynomial, X, sum_singleton, range_one, pow_zero]

@[simp] lemma witt_polynomial_one : witt_polynomial p R 1 = C ↑p * X 1 + (X 0) ^ p :=
by simp only [witt_polynomial_eq_sum_C_mul_X_pow, sum_range_succ_comm, range_one,
    sum_singleton, one_mul, pow_one, C_1, pow_zero]

lemma aeval_witt_polynomial {A : Type*} [comm_ring A] [algebra R A] (f : ℕ → A) (n : ℕ) :
  aeval f (W_ R n) = ∑ i in range (n+1), p^i * (f i) ^ (p ^ (n-i)) :=
by simp [witt_polynomial, alg_hom.map_sum, aeval_monomial, finsupp.prod_single_index]

/--
Over the ring `zmod (p^(n+1))`, we produce the `n+1`st Witt polynomial
by expanding the `n`th witt polynomial by `p`.
-/
@[simp] lemma witt_polynomial_zmod_self (n : ℕ) :
  W_ (zmod (p ^ (n + 1))) (n + 1) = expand p (W_ (zmod (p^(n + 1))) n) :=
begin
  simp only [witt_polynomial_eq_sum_C_mul_X_pow],
  rw [sum_range_succ, ← nat.cast_pow, char_p.cast_eq_zero (zmod (p^(n+1))) (p^(n+1)), C_0, zero_mul,
      add_zero, alg_hom.map_sum, sum_congr rfl],
  intros k hk,
  rw [alg_hom.map_mul, alg_hom.map_pow, expand_X, alg_hom_C, ← pow_mul, ← pow_succ],
  congr,
  rw mem_range at hk,
  rw [add_comm, nat.add_sub_assoc (nat.lt_succ_iff.mp hk), ← add_comm],
end

section p_prime
-- in fact, `0 < p` would be sufficient
variables [hp : fact p.prime]
include hp

lemma witt_polynomial_vars [char_zero R] (n : ℕ) :
  (witt_polynomial p R n).vars = range (n + 1) :=
begin
  have : ∀ i, (monomial (finsupp.single i (p ^ (n - i))) (p ^ i : R)).vars = {i},
  { intro i,
    rw vars_monomial_single,
    { rw ← pos_iff_ne_zero,
      apply pow_pos hp.1.pos },
    { rw [← nat.cast_pow, nat.cast_ne_zero],
      apply ne_of_gt,
      apply pow_pos hp.1.pos i } },
  rw [witt_polynomial, vars_sum_of_disjoint],
  { simp only [this, int.nat_cast_eq_coe_nat, bUnion_singleton_eq_self], },
  { simp only [this, int.nat_cast_eq_coe_nat],
    intros a b h,
    apply singleton_disjoint.mpr,
    rwa mem_singleton, },
end

lemma witt_polynomial_vars_subset (n : ℕ) :
  (witt_polynomial p R n).vars ⊆ range (n + 1) :=
begin
  rw [← map_witt_polynomial p (int.cast_ring_hom R), ← witt_polynomial_vars p ℤ],
  apply vars_map,
end

end p_prime

end

/-!

## Witt polynomials as a basis of the polynomial algebra

If `p` is invertible in `R`, then the Witt polynomials form a basis
of the polynomial algebra `mv_polynomial ℕ R`.
The polynomials `X_in_terms_of_W` give the coordinate transformation in the backwards direction.
-/

/-- The `X_in_terms_of_W p R n` is the polynomial on the basis of Witt polynomials
that corresponds to the ordinary `X n`. -/
noncomputable def X_in_terms_of_W [invertible (p : R)] :
  ℕ → mv_polynomial ℕ R
| n := (X n - (∑ i : fin n,
  have _ := i.2, (C (p^(i : ℕ) : R) * (X_in_terms_of_W i)^(p^(n-i))))) * C (⅟p ^ n : R)

lemma X_in_terms_of_W_eq [invertible (p : R)] {n : ℕ} :
  X_in_terms_of_W p R n =
    (X n - (∑ i in range n, C (p^i : R) * X_in_terms_of_W p R i ^ p ^ (n - i))) * C (⅟p ^ n : R) :=
by { rw [X_in_terms_of_W, ← fin.sum_univ_eq_sum_range] }

@[simp] lemma constant_coeff_X_in_terms_of_W [hp : fact p.prime] [invertible (p : R)] (n : ℕ) :
  constant_coeff (X_in_terms_of_W p R n) = 0 :=
begin
  apply nat.strong_induction_on n; clear n,
  intros n IH,
  rw [X_in_terms_of_W_eq, mul_comm, ring_hom.map_mul, ring_hom.map_sub, ring_hom.map_sum,
    constant_coeff_C, sum_eq_zero],
  { simp only [constant_coeff_X, sub_zero, mul_zero] },
  { intros m H,
    rw mem_range at H,
    simp only [ring_hom.map_mul, ring_hom.map_pow, constant_coeff_C, IH m H],
    rw [zero_pow, mul_zero],
    apply pow_pos hp.1.pos, }
end

@[simp] lemma X_in_terms_of_W_zero [invertible (p : R)] :
  X_in_terms_of_W p R 0 = X 0 :=
by rw [X_in_terms_of_W_eq, range_zero, sum_empty, pow_zero, C_1, mul_one, sub_zero]

section p_prime
variables [hp : fact p.prime]
include hp

lemma X_in_terms_of_W_vars_aux (n : ℕ) :
  n ∈ (X_in_terms_of_W p ℚ n).vars ∧
  (X_in_terms_of_W p ℚ n).vars ⊆ range (n + 1) :=
begin
  apply nat.strong_induction_on n, clear n,
  intros n ih,
  rw [X_in_terms_of_W_eq, mul_comm, vars_C_mul, vars_sub_of_disjoint, vars_X, range_succ,
      insert_eq],
  swap 3, { apply nonzero_of_invertible },
  work_on_goal 0 {
    simp only [true_and, true_or, eq_self_iff_true,
      mem_union, mem_singleton],
    intro i,
    rw [mem_union, mem_union],
    apply or.imp id },
  work_on_goal 1 { rw [vars_X, singleton_disjoint] },
  all_goals {
    intro H,
    replace H := vars_sum_subset _ _ H,
    rw mem_bUnion at H,
    rcases H with ⟨j, hj, H⟩,
    rw vars_C_mul at H,
    swap,
    { apply pow_ne_zero, exact_mod_cast hp.1.ne_zero },
    rw mem_range at hj,
    replace H := (ih j hj).2 (vars_pow _ _ H),
    rw mem_range at H },
  { rw mem_range,
    exact lt_of_lt_of_le H hj },
  { exact lt_irrefl n (lt_of_lt_of_le H hj) },
end

lemma X_in_terms_of_W_vars_subset (n : ℕ) :
  (X_in_terms_of_W p ℚ n).vars ⊆ range (n + 1) :=
(X_in_terms_of_W_vars_aux p n).2

end p_prime

lemma X_in_terms_of_W_aux [invertible (p : R)] (n : ℕ) :
  X_in_terms_of_W p R n * C (p^n : R) =
  X n - ∑ i in range n, C (p^i : R) * (X_in_terms_of_W p R i)^p^(n-i) :=
by rw [X_in_terms_of_W_eq, mul_assoc, ← C_mul, ← mul_pow, inv_of_mul_self, one_pow, C_1, mul_one]

@[simp] lemma bind₁_X_in_terms_of_W_witt_polynomial [invertible (p : R)] (k : ℕ) :
  bind₁ (X_in_terms_of_W p R) (W_ R k) = X k :=
begin
  rw [witt_polynomial_eq_sum_C_mul_X_pow, alg_hom.map_sum],
  simp only [alg_hom.map_pow, C_pow, alg_hom.map_mul, alg_hom_C],
  rw [sum_range_succ_comm, nat.sub_self, pow_zero, pow_one, bind₁_X_right,
      mul_comm, ← C_pow, X_in_terms_of_W_aux],
  simp only [C_pow, bind₁_X_right, sub_add_cancel],
end

@[simp] lemma bind₁_witt_polynomial_X_in_terms_of_W [invertible (p : R)] (n : ℕ) :
  bind₁ (W_ R) (X_in_terms_of_W p R n) = X n :=
begin
  apply nat.strong_induction_on n,
  clear n, intros n H,
  rw [X_in_terms_of_W_eq, alg_hom.map_mul, alg_hom.map_sub, bind₁_X_right, alg_hom_C,
      alg_hom.map_sum],
  have : W_ R n - ∑ i in range n, C (p ^ i : R) * (X i) ^ p ^ (n - i) = C (p ^ n : R) * X n,
  by simp only [witt_polynomial_eq_sum_C_mul_X_pow, nat.sub_self, sum_range_succ_comm,
    pow_one, add_sub_cancel, pow_zero],
  rw [sum_congr rfl, this],
  { -- this is really slow for some reason
    rw [mul_right_comm, ← C_mul, ← mul_pow, mul_inv_of_self, one_pow, C_1, one_mul] },
  { intros i h,
    rw mem_range at h,
    simp only [alg_hom.map_mul, alg_hom.map_pow, alg_hom_C, H i h] },
end


/-
Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro
-/
import data.nat.order.basic
import data.set.basic
import algebra.ring.divisibility
import algebra.group_with_zero.divisibility

/-!
# Further lemmas about the natural numbers

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

The distinction between this file and `data.nat.order.basic` is not particularly clear.
They are separated by now to minimize the porting requirements for tactics during the transition to
mathlib4. After `data.rat.order` has been ported, please feel free to reorganize these two files.
-/

universes u v

variables {m n k : ℕ}
namespace nat

/-! ### Sets -/

instance subtype.order_bot (s : set ℕ) [decidable_pred (∈ s)] [h : nonempty s] :
  order_bot s :=
{ bot := ⟨nat.find (nonempty_subtype.1 h), nat.find_spec (nonempty_subtype.1 h)⟩,
  bot_le := λ x, nat.find_min' _ x.2 }

instance subtype.semilattice_sup (s : set ℕ) :
  semilattice_sup s :=
{ ..subtype.linear_order s,
  ..linear_order.to_lattice }

lemma subtype.coe_bot {s : set ℕ} [decidable_pred (∈ s)]
  [h : nonempty s] : ((⊥ : s) : ℕ) = nat.find (nonempty_subtype.1 h) := rfl

lemma set_eq_univ {S : set ℕ} : S = set.univ ↔ 0 ∈ S ∧ ∀ k : ℕ, k ∈ S → k + 1 ∈ S :=
⟨by rintro rfl; simp, λ ⟨h0, hs⟩, set.eq_univ_of_forall (set_induction h0 hs)⟩

/-! ### `div` -/

protected lemma lt_div_iff_mul_lt {n d : ℕ} (hnd : d ∣ n) (a : ℕ) : a < n / d ↔ d * a < n :=
begin
  rcases d.eq_zero_or_pos with rfl | hd0, { simp [zero_dvd_iff.mp hnd] },
  rw [←mul_lt_mul_left hd0, ←nat.eq_mul_of_div_eq_right hnd rfl],
end

lemma div_eq_iff_eq_of_dvd_dvd {n x y : ℕ} (hn : n ≠ 0) (hx : x ∣ n) (hy : y ∣ n) :
  n / x = n / y ↔ x = y :=
begin
  split,
  { intros h,
    rw ←mul_right_inj' hn,
    apply nat.eq_mul_of_div_eq_left (dvd_mul_of_dvd_left hy x),
    rw [eq_comm, mul_comm, nat.mul_div_assoc _ hy],
    exact nat.eq_mul_of_div_eq_right hx h },
  { intros h, rw h },
end

protected lemma div_eq_zero_iff {a b : ℕ} (hb : 0 < b) : a / b = 0 ↔ a < b :=
⟨λ h, by rw [← mod_add_div a b, h, mul_zero, add_zero]; exact mod_lt _ hb,
  λ h, by rw [← mul_right_inj' hb.ne', ← @add_left_cancel_iff _ _ _ (a % b), mod_add_div,
    mod_eq_of_lt h, mul_zero, add_zero]⟩

protected lemma div_eq_zero {a b : ℕ} (hb : a < b) : a / b = 0 :=
(nat.div_eq_zero_iff $ (zero_le a).trans_lt hb).mpr hb

/-! ### `mod`, `dvd` -/

@[simp] protected theorem dvd_one {n : ℕ} : n ∣ 1 ↔ n = 1 :=
⟨eq_one_of_dvd_one, λ e, e.symm ▸ dvd_rfl⟩

@[simp] protected theorem not_two_dvd_bit1 (n : ℕ) : ¬ 2 ∣ bit1 n :=
by { rw [bit1, nat.dvd_add_right two_dvd_bit0, nat.dvd_one], cc }

/-- A natural number `m` divides the sum `m + n` if and only if `m` divides `n`.-/
@[simp] protected lemma dvd_add_self_left {m n : ℕ} :
  m ∣ m + n ↔ m ∣ n :=
nat.dvd_add_right (dvd_refl m)

/-- A natural number `m` divides the sum `n + m` if and only if `m` divides `n`.-/
@[simp] protected lemma dvd_add_self_right {m n : ℕ} :
  m ∣ n + m ↔ m ∣ n :=
nat.dvd_add_left (dvd_refl m)

-- TODO: update `nat.dvd_sub` in core
lemma dvd_sub' {k m n : ℕ} (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n :=
begin
  cases le_total n m with H H,
  { exact dvd_sub H h₁ h₂ },
  { rw tsub_eq_zero_iff_le.mpr H,
    exact dvd_zero k },
end

lemma succ_div : ∀ (a b : ℕ), (a + 1) / b =
  a / b + if b ∣ a + 1 then 1 else 0
| a     0     := by simp
| 0     1     := by simp
| 0     (b+2) := have hb2 : b + 2 > 1, from dec_trivial,
  by simp [ne_of_gt hb2, div_eq_of_lt hb2]
| (a+1) (b+1) := begin
  rw [nat.div_def], conv_rhs { rw nat.div_def },
  by_cases hb_eq_a : b = a + 1,
  { simp [hb_eq_a, le_refl] },
  by_cases hb_le_a1 : b ≤ a + 1,
  { have hb_le_a : b ≤ a, from le_of_lt_succ (lt_of_le_of_ne hb_le_a1 hb_eq_a),
    have h₁ : (0 < b + 1 ∧ b + 1 ≤ a + 1 + 1),
      from ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a1⟩,
    have h₂ : (0 < b + 1 ∧ b + 1 ≤ a + 1),
      from ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a⟩,
    have dvd_iff : b + 1 ∣ a - b + 1 ↔  b + 1 ∣ a + 1 + 1,
    { rw [nat.dvd_add_iff_left (dvd_refl (b + 1)),
        ← add_tsub_add_eq_tsub_right a 1 b, add_comm (_ - _), add_assoc,
        tsub_add_cancel_of_le (succ_le_succ hb_le_a), add_comm 1] },
    have wf : a - b < a + 1, from lt_succ_of_le tsub_le_self,
    rw [if_pos h₁, if_pos h₂, add_tsub_add_eq_tsub_right, ← tsub_add_eq_add_tsub hb_le_a,
      by exact have _ := wf, succ_div (a - b),
      add_tsub_add_eq_tsub_right],
    simp [dvd_iff, succ_eq_add_one, add_comm 1, add_assoc] },
  { have hba : ¬ b ≤ a,
      from not_le_of_gt (lt_trans (lt_succ_self a) (lt_of_not_ge hb_le_a1)),
    have hb_dvd_a : ¬ b + 1 ∣ a + 2,
      from λ h, hb_le_a1 (le_of_succ_le_succ (le_of_dvd (succ_pos _) h)),
    simp [hba, hb_le_a1, hb_dvd_a], }
end

lemma succ_div_of_dvd {a b : ℕ} (hba : b ∣ a + 1) :
  (a + 1) / b = a / b + 1 :=
by rw [succ_div, if_pos hba]

lemma dvd_iff_div_mul_eq (n d : ℕ) : d ∣ n ↔ n / d * d = n :=
⟨λ h, nat.div_mul_cancel h, λ h, dvd.intro_left (n / d) h⟩

lemma dvd_iff_le_div_mul (n d : ℕ) : d ∣ n ↔ n ≤ n / d * d :=
((dvd_iff_div_mul_eq _ _).trans le_antisymm_iff).trans (and_iff_right (div_mul_le_self n d))

lemma dvd_iff_dvd_dvd (n d : ℕ) : d ∣ n ↔ ∀ k : ℕ, k ∣ d → k ∣ n :=
⟨λ h k hkd, dvd_trans hkd h, λ h, h _ dvd_rfl⟩

lemma dvd_div_of_mul_dvd {a b c : ℕ} (h : a * b ∣ c) : b ∣ c / a :=
if ha : a = 0 then
  by simp [ha]
else
  have ha : 0 < a, from nat.pos_of_ne_zero ha,
  have h1 : ∃ d, c = a * b * d, from h,
  let ⟨d, hd⟩ := h1 in
  have h2 : c / a = b * d, from nat.div_eq_of_eq_mul_right ha (by simpa [mul_assoc] using hd),
  show ∃ d, c / a = b * d, from ⟨d, h2⟩

@[simp] lemma dvd_div_iff {a b c : ℕ} (hbc : c ∣ b) : a ∣ b / c ↔ c * a ∣ b :=
⟨λ h, mul_dvd_of_dvd_div hbc h, λ h, dvd_div_of_mul_dvd h⟩

@[simp]
lemma div_div_div_eq_div : ∀ {a b c : ℕ} (dvd : b ∣ a) (dvd2 : a ∣ c), (c / (a / b)) / b = c / a
| 0 _ := by simp
| (a + 1) 0 := λ _ dvd _, by simpa using dvd
| (a + 1) (c + 1) :=
have a_split : a + 1 ≠ 0 := succ_ne_zero a,
have c_split : c + 1 ≠ 0 := succ_ne_zero c,
λ b dvd dvd2,
begin
  rcases dvd2 with ⟨k, rfl⟩,
  rcases dvd with ⟨k2, pr⟩,
  have k2_nonzero : k2 ≠ 0 := λ k2_zero, by simpa [k2_zero] using pr,
  rw [nat.mul_div_cancel_left k (nat.pos_of_ne_zero a_split), pr,
    nat.mul_div_cancel_left k2 (nat.pos_of_ne_zero c_split), nat.mul_comm ((c + 1) * k2) k,
    ←nat.mul_assoc k (c + 1) k2, nat.mul_div_cancel _ (nat.pos_of_ne_zero k2_nonzero),
    nat.mul_div_cancel _ (nat.pos_of_ne_zero c_split)],
end

/-- If a small natural number is divisible by a larger natural number,
the small number is zero. -/
lemma eq_zero_of_dvd_of_lt {a b : ℕ} (w : a ∣ b) (h : b < a) : b = 0 :=
nat.eq_zero_of_dvd_of_div_eq_zero w
  ((nat.div_eq_zero_iff (lt_of_le_of_lt (zero_le b) h)).elim_right h)

@[simp] lemma mod_div_self (m n : ℕ) : m % n / n = 0 :=
begin
  cases n,
  { exact (m % 0).div_zero },
  { exact nat.div_eq_zero (m.mod_lt n.succ_pos) }
end

/-- `n` is not divisible by `a` iff it is between `a * k` and `a * (k + 1)` for some `k`. -/
lemma not_dvd_iff_between_consec_multiples (n : ℕ) {a : ℕ} (ha : 0 < a) :
  (∃ k : ℕ, a * k < n ∧ n < a * (k + 1)) ↔ ¬ a ∣ n :=
begin
  refine ⟨λ ⟨k, hk1, hk2⟩, not_dvd_of_between_consec_multiples hk1 hk2,
          λ han, ⟨n/a, ⟨lt_of_le_of_ne (mul_div_le n a) _, lt_mul_div_succ _ ha⟩⟩⟩,
  exact mt (dvd.intro (n/a)) han,
end

/-- Two natural numbers are equal if and only if they have the same multiples. -/
lemma dvd_right_iff_eq {m n : ℕ} : (∀ a : ℕ, m ∣ a ↔ n ∣ a) ↔ m = n :=
⟨λ h, dvd_antisymm ((h _).mpr dvd_rfl) ((h _).mp dvd_rfl), λ h n, by rw h⟩

/-- Two natural numbers are equal if and only if they have the same divisors. -/
lemma dvd_left_iff_eq {m n : ℕ} : (∀ a : ℕ, a ∣ m ↔ a ∣ n) ↔ m = n :=
⟨λ h, dvd_antisymm ((h _).mp dvd_rfl) ((h _).mpr dvd_rfl), λ h n, by rw h⟩

/-- `dvd` is injective in the left argument -/
lemma dvd_left_injective : function.injective ((∣) : ℕ → ℕ → Prop) :=
λ m n h, dvd_right_iff_eq.mp $ λ a, iff_of_eq (congr_fun h a)

lemma div_lt_div_of_lt_of_dvd {a b d : ℕ} (hdb : d ∣ b) (h : a < b) : a / d < b / d :=
by { rw nat.lt_div_iff_mul_lt hdb, exact lt_of_le_of_lt (mul_div_le a d) h }

end nat


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.basic
import algebra.lie.subalgebra
import algebra.lie.submodule
import algebra.algebra.subalgebra.basic

/-!
# Lie algebras of associative algebras

This file defines the Lie algebra structure that arises on an associative algebra via the ring
commutator.

Since the linear endomorphisms of a Lie algebra form an associative algebra, one can define the
adjoint action as a morphism of Lie algebras from a Lie algebra to its linear endomorphisms. We
make such a definition in this file.

## Main definitions

 * `lie_algebra.of_associative_algebra`
 * `lie_algebra.of_associative_algebra_hom`
 * `lie_module.to_endomorphism`
 * `lie_algebra.ad`
 * `linear_equiv.lie_conj`
 * `alg_equiv.to_lie_equiv`

## Tags

lie algebra, ring commutator, adjoint action
-/

universes u v w w₁ w₂

section of_associative

variables {A : Type v} [ring A]

namespace ring

/-- The bracket operation for rings is the ring commutator, which captures the extent to which a
ring is commutative. It is identically zero exactly when the ring is commutative. -/
@[priority 100]
instance : has_bracket A A := ⟨λ x y, x*y - y*x⟩

lemma lie_def (x y : A) : ⁅x, y⁆ = x*y - y*x := rfl

end ring

lemma commute_iff_lie_eq {x y : A} : commute x y ↔ ⁅x, y⁆ = 0 := sub_eq_zero.symm

lemma commute.lie_eq {x y : A} (h : commute x y) : ⁅x, y⁆ = 0 := sub_eq_zero_of_eq h

namespace lie_ring

/-- An associative ring gives rise to a Lie ring by taking the bracket to be the ring commutator. -/
@[priority 100]
instance of_associative_ring : lie_ring A :=
{ add_lie      := by simp only [ring.lie_def, right_distrib, left_distrib,
    sub_eq_add_neg, add_comm, add_left_comm, forall_const, eq_self_iff_true, neg_add_rev],
  lie_add      := by simp only [ring.lie_def, right_distrib, left_distrib,
    sub_eq_add_neg, add_comm, add_left_comm, forall_const, eq_self_iff_true, neg_add_rev],
  lie_self     := by simp only [ring.lie_def, forall_const, sub_self],
  leibniz_lie  := λ x y z, by { repeat { rw ring.lie_def, }, noncomm_ring, } }

lemma of_associative_ring_bracket (x y : A) : ⁅x, y⁆ = x*y - y*x := rfl

@[simp] lemma lie_apply {α : Type*} (f g : α → A) (a : α) : ⁅f, g⁆ a = ⁅f a, g a⁆ := rfl

end lie_ring

section associative_module

variables {M : Type w} [add_comm_group M] [module A M]

/-- We can regard a module over an associative ring `A` as a Lie ring module over `A` with Lie
bracket equal to its ring commutator.

Note that this cannot be a global instance because it would create a diamond when `M = A`,
specifically we can build two mathematically-different `has_bracket A A`s:
 1. `@ring.has_bracket A _` which says `⁅a, b⁆ = a * b - b * a`
 2. `(@lie_ring_module.of_associative_module A _ A _ _).to_has_bracket` which says `⁅a, b⁆ = a • b`
    (and thus `⁅a, b⁆ = a * b`)

See note [reducible non-instances] -/
@[reducible]
def lie_ring_module.of_associative_module : lie_ring_module A M :=
{ bracket     := (•),
  add_lie     := add_smul,
  lie_add     := smul_add,
  leibniz_lie :=
    by simp [lie_ring.of_associative_ring_bracket, sub_smul, mul_smul, sub_add_cancel], }

local attribute [instance] lie_ring_module.of_associative_module

lemma lie_eq_smul (a : A) (m : M) : ⁅a, m⁆ = a • m := rfl

end associative_module

section lie_algebra

variables {R : Type u} [comm_ring R] [algebra R A]

/-- An associative algebra gives rise to a Lie algebra by taking the bracket to be the ring
commutator. -/
@[priority 100]
instance lie_algebra.of_associative_algebra : lie_algebra R A :=
{ lie_smul := λ t x y,
    by rw [lie_ring.of_associative_ring_bracket, lie_ring.of_associative_ring_bracket,
           algebra.mul_smul_comm, algebra.smul_mul_assoc, smul_sub], }

local attribute [instance] lie_ring_module.of_associative_module

section associative_representation

variables {M : Type w} [add_comm_group M] [module R M] [module A M] [is_scalar_tower R A M]

/-- A representation of an associative algebra `A` is also a representation of `A`, regarded as a
Lie algebra via the ring commutator.

See the comment at `lie_ring_module.of_associative_module` for why the possibility `M = A` means
this cannot be a global instance. -/
def lie_module.of_associative_module : lie_module R A M :=
{ smul_lie := smul_assoc,
  lie_smul := smul_algebra_smul_comm }

instance module.End.lie_ring_module : lie_ring_module (module.End R M) M :=
lie_ring_module.of_associative_module

instance module.End.lie_module : lie_module R (module.End R M) M :=
lie_module.of_associative_module

end associative_representation

namespace alg_hom

variables {B : Type w} {C : Type w₁} [ring B] [ring C] [algebra R B] [algebra R C]
variables (f : A →ₐ[R] B) (g : B →ₐ[R] C)

/-- The map `of_associative_algebra` associating a Lie algebra to an associative algebra is
functorial. -/
def to_lie_hom : A →ₗ⁅R⁆ B :=
 { map_lie' := λ x y, show f ⁅x,y⁆ = ⁅f x,f y⁆,
     by simp only [lie_ring.of_associative_ring_bracket, alg_hom.map_sub, alg_hom.map_mul],
  ..f.to_linear_map, }

instance : has_coe (A →ₐ[R] B) (A →ₗ⁅R⁆ B) := ⟨to_lie_hom⟩

@[simp] lemma to_lie_hom_coe : f.to_lie_hom = ↑f := rfl

@[simp]

lemma to_lie_hom_apply (x : A) : f.to_lie_hom x = f x := rfl

@[simp] lemma to_lie_hom_id : (alg_hom.id R A : A →ₗ⁅R⁆ A) = lie_hom.id := rfl

@[simp] lemma to_lie_hom_comp : (g.comp f : A →ₗ⁅R⁆ C) = (g : B →ₗ⁅R⁆ C).comp (f : A →ₗ⁅R⁆ B) := rfl

lemma to_lie_hom_injective {f g : A →ₐ[R] B}
  (h : (f : A →ₗ⁅R⁆ B) = (g : A →ₗ⁅R⁆ B)) : f = g :=
by { ext a, exact lie_hom.congr_fun h a, }

end alg_hom

end lie_algebra

end of_associative

section adjoint_action

variables (R : Type u) (L : Type v) (M : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]

/-- A Lie module yields a Lie algebra morphism into the linear endomorphisms of the module.

See also `lie_module.to_module_hom`. -/
@[simps] def lie_module.to_endomorphism : L →ₗ⁅R⁆ module.End R M :=
{ to_fun    := λ x,
  { to_fun    := λ m, ⁅x, m⁆,
    map_add'  := lie_add x,
    map_smul' := λ t, lie_smul t x, },
  map_add'  := λ x y, by { ext m, apply add_lie, },
  map_smul' := λ t x, by { ext m, apply smul_lie, },
  map_lie'  := λ x y, by { ext m, apply lie_lie, }, }

/-- The adjoint action of a Lie algebra on itself. -/
def lie_algebra.ad : L →ₗ⁅R⁆ module.End R L := lie_module.to_endomorphism R L L

@[simp] lemma lie_algebra.ad_apply (x y : L) : lie_algebra.ad R L x y = ⁅x, y⁆ := rfl

@[simp] lemma lie_module.to_endomorphism_module_End :
  lie_module.to_endomorphism R (module.End R M) M = lie_hom.id :=
by { ext g m, simp [lie_eq_smul], }

lemma lie_subalgebra.to_endomorphism_eq (K : lie_subalgebra R L) {x : K} :
  lie_module.to_endomorphism R K M x = lie_module.to_endomorphism R L M x :=
rfl

@[simp] lemma lie_subalgebra.to_endomorphism_mk (K : lie_subalgebra R L) {x : L} (hx : x ∈ K) :
  lie_module.to_endomorphism R K M ⟨x, hx⟩ = lie_module.to_endomorphism R L M x :=
rfl

variables {R L M}

namespace lie_submodule

open lie_module

variables {N : lie_submodule R L M} {x : L}

lemma coe_map_to_endomorphism_le :
  (N : submodule R M).map (lie_module.to_endomorphism R L M x) ≤ N :=
begin
  rintros n ⟨m, hm, rfl⟩,
  exact N.lie_mem hm,
end

variables (N x)

lemma to_endomorphism_comp_subtype_mem (m : M) (hm : m ∈ (N : submodule R M)) :
  (to_endomorphism R L M x).comp (N : submodule R M).subtype ⟨m, hm⟩ ∈ (N : submodule R M) :=
by simpa using N.lie_mem hm

@[simp] lemma to_endomorphism_restrict_eq_to_endomorphism
  (h := N.to_endomorphism_comp_subtype_mem x) :
  (to_endomorphism R L M x).restrict h = to_endomorphism R L N x :=
by { ext, simp [linear_map.restrict_apply], }

end lie_submodule

open lie_algebra

lemma lie_algebra.ad_eq_lmul_left_sub_lmul_right (A : Type v) [ring A] [algebra R A] :
  (ad R A : A → module.End R A) = linear_map.mul_left R - linear_map.mul_right R :=
by { ext a b, simp [lie_ring.of_associative_ring_bracket], }

lemma lie_subalgebra.ad_comp_incl_eq (K : lie_subalgebra R L) (x : K) :
  (ad R L ↑x).comp (K.incl : K →ₗ[R] L) = (K.incl : K →ₗ[R] L).comp (ad R K x) :=
begin
  ext y,
  simp only [ad_apply, lie_hom.coe_to_linear_map, lie_subalgebra.coe_incl, linear_map.coe_comp,
    lie_subalgebra.coe_bracket, function.comp_app],
end

end adjoint_action

/-- A subalgebra of an associative algebra is a Lie subalgebra of the associated Lie algebra. -/
def lie_subalgebra_of_subalgebra (R : Type u) [comm_ring R] (A : Type v) [ring A] [algebra R A]
  (A' : subalgebra R A) : lie_subalgebra R A :=
{ lie_mem' := λ x y hx hy, by
  { change ⁅x, y⁆ ∈ A', change x ∈ A' at hx, change y ∈ A' at hy,
    rw lie_ring.of_associative_ring_bracket,
    have hxy := A'.mul_mem hx hy,
    have hyx := A'.mul_mem hy hx,
    exact submodule.sub_mem A'.to_submodule hxy hyx, },
  ..A'.to_submodule }

namespace linear_equiv

variables {R : Type u} {M₁ : Type v} {M₂ : Type w}
variables [comm_ring R] [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]
variables (e : M₁ ≃ₗ[R] M₂)

/-- A linear equivalence of two modules induces a Lie algebra equivalence of their endomorphisms. -/
def lie_conj : module.End R M₁ ≃ₗ⁅R⁆ module.End R M₂ :=
{ map_lie' := λ f g, show e.conj ⁅f, g⁆ = ⁅e.conj f, e.conj g⁆,
    by simp only [lie_ring.of_associative_ring_bracket, linear_map.mul_eq_comp, e.conj_comp,
                  linear_equiv.map_sub],
  ..e.conj }

@[simp] lemma lie_conj_apply (f : module.End R M₁) : e.lie_conj f = e.conj f := rfl

@[simp] lemma lie_conj_symm : e.lie_conj.symm = e.symm.lie_conj := rfl

end linear_equiv

namespace alg_equiv

variables {R : Type u} {A₁ : Type v} {A₂ : Type w}
variables [comm_ring R] [ring A₁] [ring A₂] [algebra R A₁] [algebra R A₂]
variables (e : A₁ ≃ₐ[R] A₂)

/-- An equivalence of associative algebras is an equivalence of associated Lie algebras. -/
def to_lie_equiv : A₁ ≃ₗ⁅R⁆ A₂ :=
{ to_fun   := e.to_fun,
  map_lie' := λ x y, by simp [lie_ring.of_associative_ring_bracket],
  ..e.to_linear_equiv }

@[simp] lemma to_lie_equiv_apply (x : A₁) : e.to_lie_equiv x = e x := rfl

@[simp] lemma to_lie_equiv_symm_apply (x : A₂) : e.to_lie_equiv.symm x = e.symm x := rfl

end alg_equiv


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.set.intervals.monotone
import topology.algebra.order.monotone_continuity
import topology.urysohns_bounded

/-!
# Tietze extension theorem

In this file we prove a few version of the Tietze extension theorem. The theorem says that a
continuous function `s → ℝ` defined on a closed set in a normal topological space `Y` can be
extended to a continuous function on the whole space. Moreover, if all values of the original
function belong to some (finite or infinite, open or closed) interval, then the extension can be
chosen so that it takes values in the same interval. In particular, if the original function is a
bounded function, then there exists a bounded extension of the same norm.

The proof mostly follows https://ncatlab.org/nlab/show/Tietze+extension+theorem. We patch a small
gap in the proof for unbounded functions, see
`exists_extension_forall_exists_le_ge_of_closed_embedding`.

## Implementation notes

We first prove the theorems for a closed embedding `e : X → Y` of a topological space into a normal
topological space, then specialize them to the case `X = s : set Y`, `e = coe`.

## Tags

Tietze extension theorem, Urysohn's lemma, normal topological space
-/

variables {X Y : Type*} [topological_space X] [topological_space Y] [normal_space Y]

open metric set filter
open_locale bounded_continuous_function topological_space
noncomputable theory

namespace bounded_continuous_function

/-- One step in the proof of the Tietze extension theorem. If `e : C(X, Y)` is a closed embedding
of a topological space into a normal topological space and `f : X →ᵇ ℝ` is a bounded continuous
function, then there exists a bounded continuous function `g : Y →ᵇ ℝ` of the norm `∥g∥ ≤ ∥f∥ / 3`
such that the distance between `g ∘ e` and `f` is at most `(2 / 3) * ∥f∥`. -/
lemma tietze_extension_step (f : X →ᵇ ℝ) (e : C(X, Y)) (he : closed_embedding e) :
  ∃ g : Y →ᵇ ℝ, ∥g∥ ≤ ∥f∥ / 3 ∧ dist (g.comp_continuous e) f ≤ (2 / 3) * ∥f∥ :=
begin
  have h3 : (0 : ℝ) < 3 := by norm_num1,
  have h23 : 0 < (2 / 3 : ℝ) := by norm_num1,
  -- In the trivial case `f = 0`, we take `g = 0`
  rcases eq_or_ne f 0 with (rfl|hf), { use 0, simp },
  replace hf : 0 < ∥f∥ := norm_pos_iff.2 hf,
  /- Otherwise, the closed sets `e '' (f ⁻¹' (Iic (-∥f∥ / 3)))` and `e '' (f ⁻¹' (Ici (∥f∥ / 3)))`
  are disjoint, hence by Urysohn's lemma there exists a function `g` that is equal to `-∥f∥ / 3`
  on the former set and is equal to `∥f∥ / 3` on the latter set. This function `g` satisfies the
  assertions of the lemma. -/
  have hf3 : -∥f∥ / 3 < ∥f∥ / 3, from (div_lt_div_right h3).2 (left.neg_lt_self hf),
  have hc₁ : is_closed (e '' (f ⁻¹' (Iic (-∥f∥ / 3)))),
    from he.is_closed_map _ (is_closed_Iic.preimage f.continuous),
  have hc₂ : is_closed (e '' (f ⁻¹' (Ici (∥f∥ / 3)))),
    from he.is_closed_map _ (is_closed_Ici.preimage f.continuous),
  have hd : disjoint (e '' (f ⁻¹' (Iic (-∥f∥ / 3)))) (e '' (f ⁻¹' (Ici (∥f∥ / 3)))),
  { refine disjoint_image_of_injective he.inj (disjoint_preimage _ _),
    rwa [Iic_disjoint_Ici, not_le] },
  rcases exists_bounded_mem_Icc_of_closed_of_le hc₁ hc₂ hd hf3.le with ⟨g, hg₁, hg₂, hgf⟩,
  refine ⟨g, _, _⟩,
  { refine (norm_le $ div_nonneg hf.le h3.le).mpr (λ y, _),
    simpa [real.norm_eq_abs, abs_le, neg_div] using hgf y },
  { refine (dist_le $ mul_nonneg h23.le hf.le).mpr (λ x, _),
    have hfx : -∥f∥ ≤ f x ∧ f x ≤ ∥f∥,
      by simpa only [real.norm_eq_abs, abs_le] using f.norm_coe_le_norm x,
    cases le_total (f x) (-∥f∥ / 3) with hle₁ hle₁,
    { calc |g (e x) - f x| = -∥f∥ / 3 - f x:
        by rw [hg₁ (mem_image_of_mem _ hle₁), abs_of_nonneg (sub_nonneg.2 hle₁)]
      ... ≤ (2 / 3) * ∥f∥ : by linarith },
    { cases le_total (f x) (∥f∥ / 3) with hle₂ hle₂,
      { simp only [neg_div] at *,
        calc dist (g (e x)) (f x) ≤ |g (e x)| + |f x| : dist_le_norm_add_norm _ _
        ... ≤ ∥f∥ / 3 + ∥f∥ / 3 :
          add_le_add (abs_le.2 $ hgf _) (abs_le.2 ⟨hle₁, hle₂⟩)
        ... = (2 / 3) * ∥f∥ : by linarith },
      { calc |g (e x) - f x| = f x - ∥f∥ / 3 :
          by rw [hg₂ (mem_image_of_mem _ hle₂), abs_sub_comm, abs_of_nonneg (sub_nonneg.2 hle₂)]
        ... ≤ (2 / 3) * ∥f∥ : by linarith } } }
end

/-- **Tietze extension theorem** for real-valued bounded continuous maps, a version with a closed
embedding and bundled composition. If `e : C(X, Y)` is a closed embedding of a topological space
into a normal topological space and `f : X →ᵇ ℝ` is a bounded continuous function, then there exists
a bounded continuous function `g : Y →ᵇ ℝ` of the same norm such that `g ∘ e = f`. -/
lemma exists_extension_norm_eq_of_closed_embedding' (f : X →ᵇ ℝ) (e : C(X, Y))
  (he : closed_embedding e) :
  ∃ g : Y →ᵇ ℝ, ∥g∥ = ∥f∥ ∧ g.comp_continuous e = f :=
begin
  /- For the proof, we iterate `tietze_extension_step`. Each time we apply it to the difference
  between the previous approximation and `f`. -/
  choose F hF_norm hF_dist using λ f : X →ᵇ ℝ, tietze_extension_step f e he,
  set g : ℕ → Y →ᵇ ℝ := λ n, (λ g, g + F (f - g.comp_continuous e))^[n] 0,
  have g0 : g 0 = 0 := rfl,
  have g_succ : ∀ n, g (n + 1) = g n + F (f - (g n).comp_continuous e),
    from λ n, function.iterate_succ_apply' _ _ _,
  have hgf : ∀ n, dist ((g n).comp_continuous e) f ≤ (2 / 3) ^ n * ∥f∥,
  { intro n, induction n with n ihn,
    { simp [g0] },
    { rw [g_succ n, add_comp_continuous, ← dist_sub_right, add_sub_cancel', pow_succ, mul_assoc],
      refine (hF_dist _).trans (mul_le_mul_of_nonneg_left _ (by norm_num1)),
      rwa ← dist_eq_norm' } },
  have hg_dist : ∀ n, dist (g n) (g (n + 1)) ≤ 1 / 3 * ∥f∥ * (2 / 3) ^ n,
  { intro n,
    calc dist (g n) (g (n + 1)) = ∥F (f - (g n).comp_continuous e)∥ :
      by rw [g_succ, dist_eq_norm', add_sub_cancel']
    ... ≤ ∥f - (g n).comp_continuous e∥ / 3 : hF_norm _
    ... = (1 / 3) * dist ((g n).comp_continuous e) f :
      by rw [dist_eq_norm', one_div, div_eq_inv_mul]
    ... ≤ (1 / 3) * ((2 / 3) ^ n * ∥f∥) :
      mul_le_mul_of_nonneg_left (hgf n) (by norm_num1)
    ... = 1 / 3 * ∥f∥ * (2 / 3) ^ n : by ac_refl },
  have hg_cau : cauchy_seq g, from cauchy_seq_of_le_geometric _ _ (by norm_num1) hg_dist,
  have : tendsto (λ n, (g n).comp_continuous e) at_top (𝓝 $ (lim at_top g).comp_continuous e),
    from ((continuous_comp_continuous e).tendsto _).comp hg_cau.tendsto_lim,
  have hge : (lim at_top g).comp_continuous e = f,
  { refine tendsto_nhds_unique this (tendsto_iff_dist_tendsto_zero.2 _),
    refine squeeze_zero (λ _, dist_nonneg) hgf _,
    rw ← zero_mul (∥f∥),
    refine (tendsto_pow_at_top_nhds_0_of_lt_1 _ _).mul tendsto_const_nhds; norm_num1 },
  refine ⟨lim at_top g, le_antisymm _ _, hge⟩,
  { rw [← dist_zero_left, ← g0],
    refine (dist_le_of_le_geometric_of_tendsto₀ _ _ (by norm_num1)
      hg_dist hg_cau.tendsto_lim).trans_eq _,
    field_simp [show (3 - 2 : ℝ) = 1, by norm_num1] },
  { rw ← hge, exact norm_comp_continuous_le _ _ }
end

/-- **Tietze extension theorem** for real-valued bounded continuous maps, a version with a closed
embedding and unbundled composition. If `e : C(X, Y)` is a closed embedding of a topological space
into a normal topological space and `f : X →ᵇ ℝ` is a bounded continuous function, then there exists
a bounded continuous function `g : Y →ᵇ ℝ` of the same norm such that `g ∘ e = f`. -/
lemma exists_extension_norm_eq_of_closed_embedding (f : X →ᵇ ℝ) {e : X → Y}
  (he : closed_embedding e) :
  ∃ g : Y →ᵇ ℝ, ∥g∥ = ∥f∥ ∧ g ∘ e = f :=
begin
  rcases exists_extension_norm_eq_of_closed_embedding' f ⟨e, he.continuous⟩ he with ⟨g, hg, rfl⟩,
  exact ⟨g, hg, rfl⟩
end

/-- **Tietze extension theorem** for real-valued bounded continuous maps, a version for a closed
set. If `f` is a bounded continuous real-valued function defined on a closed set in a normal
topological space, then it can be extended to a bounded continuous function of the same norm defined
on the whole space. -/
lemma exists_norm_eq_restrict_eq_of_closed {s : set Y} (f : s →ᵇ ℝ) (hs : is_closed s) :
  ∃ g : Y →ᵇ ℝ, ∥g∥ = ∥f∥ ∧ g.restrict s = f :=
exists_extension_norm_eq_of_closed_embedding' f ((continuous_map.id _).restrict s)
  (closed_embedding_subtype_coe hs)

/-- **Tietze extension theorem** for real-valued bounded continuous maps, a version for a closed
embedding and a bounded continuous function that takes values in a non-trivial closed interval.
See also `exists_extension_forall_mem_of_closed_embedding` for a more general statement that works
for any interval (finite or infinite, open or closed).

If `e : X → Y` is a closed embedding and `f : X →ᵇ ℝ` is a bounded continuous function such that
`f x ∈ [a, b]` for all `x`, where `a ≤ b`, then there exists a bounded continuous function
`g : Y →ᵇ ℝ` such that `g y ∈ [a, b]` for all `y` and `g ∘ e = f`. -/
lemma exists_extension_forall_mem_Icc_of_closed_embedding (f : X →ᵇ ℝ) {a b : ℝ} {e : X → Y}
  (hf : ∀ x, f x ∈ Icc a b) (hle : a ≤ b) (he : closed_embedding e) :
  ∃ g : Y →ᵇ ℝ, (∀ y, g y ∈ Icc a b) ∧ g ∘ e = f :=
begin
  rcases exists_extension_norm_eq_of_closed_embedding (f - const X ((a + b) / 2)) he
    with ⟨g, hgf, hge⟩,
  refine ⟨const Y ((a + b) / 2) + g, λ y, _, _⟩,
  { suffices : ∥f - const X ((a + b) / 2)∥ ≤ (b - a) / 2,
      by simpa [real.Icc_eq_closed_ball, add_mem_closed_ball_iff_norm]
        using (norm_coe_le_norm g y).trans (hgf.trans_le this),
    refine (norm_le $ div_nonneg (sub_nonneg.2 hle) zero_le_two).2 (λ x, _),
    simpa only [real.Icc_eq_closed_ball] using hf x },
  { ext x,
    have : g (e x) = f x - (a + b) / 2 := congr_fun hge x,
    simp [this] }
end

/-- **Tietze extension theorem** for real-valued bounded continuous maps, a version for a closed
embedding. Let `e` be a closed embedding of a nonempty topological space `X` into a normal
topological space `Y`. Let `f` be a bounded continuous real-valued function on `X`. Then there
exists a bounded continuous function `g : Y →ᵇ ℝ` such that `g ∘ e = f` and each value `g y` belongs
to a closed interval `[f x₁, f x₂]` for some `x₁` and `x₂`.  -/
lemma exists_extension_forall_exists_le_ge_of_closed_embedding [nonempty X] (f : X →ᵇ ℝ) {e : X → Y}
  (he : closed_embedding e) :
  ∃ g : Y →ᵇ ℝ, (∀ y, ∃ x₁ x₂, g y ∈ Icc (f x₁) (f x₂)) ∧ g ∘ e = f :=
begin
  inhabit X,
  -- Put `a = ⨅ x, f x` and `b = ⨆ x, f x`
  obtain ⟨a, ha⟩ : ∃ a, is_glb (range f) a,
    from ⟨_, is_glb_cinfi (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).1⟩,
  obtain ⟨b, hb⟩ : ∃ b, is_lub (range f) b,
    from ⟨_, is_lub_csupr (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).2⟩,
  -- Then `f x ∈ [a, b]` for all `x`
  have hmem : ∀ x, f x ∈ Icc a b, from λ x, ⟨ha.1 ⟨x, rfl⟩, hb.1 ⟨x, rfl⟩⟩,
  -- Rule out the trivial case `a = b`
  have hle : a ≤ b := (hmem default).1.trans (hmem default).2,
  rcases hle.eq_or_lt with (rfl|hlt),
  { have : ∀ x, f x = a, by simpa using hmem,
    use const Y a, simp [this, function.funext_iff] },
  -- Put `c = (a + b) / 2`. Then `a < c < b` and `c - a = b - c`.
  set c := (a + b) / 2,
  have hac : a < c := left_lt_add_div_two.2 hlt,
  have hcb : c < b := add_div_two_lt_right.2 hlt,
  have hsub : c - a = b - c, by { simp only [c], field_simp, ring },
  /- Due to `exists_extension_forall_mem_Icc_of_closed_embedding`, there exists an extension `g`
  such that `g y ∈ [a, b]` for all `y`. However, if `a` and/or `b` do not belong to the range of
  `f`, then we need to ensure that these points do not belong to the range of `g`. This is done
  in two almost identical steps. First we deal with the case `∀ x, f x ≠ a`. -/
  obtain ⟨g, hg_mem, hgf⟩ : ∃ g : Y →ᵇ ℝ, (∀ y, ∃ x, g y ∈ Icc (f x) b) ∧ g ∘ e = f,
  { rcases exists_extension_forall_mem_Icc_of_closed_embedding f hmem hle he
      with ⟨g, hg_mem, hgf⟩,
    -- If `a ∈ range f`, then we are done.
    rcases em (∃ x, f x = a) with ⟨x, rfl⟩|ha',
    { exact ⟨g, λ y, ⟨x, hg_mem _⟩, hgf⟩ },
    /- Otherwise, `g ⁻¹' {a}` is disjoint with `range e ∪ g ⁻¹' (Ici c)`, hence there exists a
    function `dg : Y → ℝ` such that `dg ∘ e = 0`, `dg y = 0` whenever `c ≤ g y`, `dg y = c - a`
    whenever `g y = a`, and `0 ≤ dg y ≤ c - a` for all `y`.  -/
    have hd : disjoint (range e ∪ g ⁻¹' (Ici c)) (g ⁻¹' {a}),
    { refine disjoint_union_left.2 ⟨_, disjoint_preimage _ _⟩,
      { rintro _ ⟨⟨x, rfl⟩, rfl : g (e x) = a⟩,
        exact ha' ⟨x, (congr_fun hgf x).symm⟩ },
      { exact set.disjoint_singleton_right.2 hac.not_le } },
    rcases exists_bounded_mem_Icc_of_closed_of_le
      (he.closed_range.union $ is_closed_Ici.preimage g.continuous)
      (is_closed_singleton.preimage g.continuous) hd (sub_nonneg.2 hac.le)
      with ⟨dg, dg0, dga, dgmem⟩,
    replace hgf : ∀ x, (g + dg) (e x) = f x,
    { intro x, simp [dg0 (or.inl $ mem_range_self _), ← hgf] },
    refine ⟨g + dg, λ y, _, funext hgf⟩,
    { have hay : a < (g + dg) y,
      { rcases (hg_mem y).1.eq_or_lt with rfl|hlt,
        { refine (lt_add_iff_pos_right _).2 _,
          calc 0 < c - g y : sub_pos.2 hac
             ... = dg y    : (dga rfl).symm },
        { exact hlt.trans_le ((le_add_iff_nonneg_right _).2 $ (dgmem y).1) } },
      rcases ha.exists_between hay with ⟨_, ⟨x, rfl⟩, hax, hxy⟩,
      refine ⟨x, hxy.le, _⟩,
      cases le_total c (g y) with hc hc,
      { simp [dg0 (or.inr hc), (hg_mem y).2] },
      { calc g y + dg y ≤ c + (c - a) : add_le_add hc (dgmem _).2
                    ... = b           : by rw [hsub, add_sub_cancel'_right] } } },
  /- Now we deal with the case `∀ x, f x ≠ b`. The proof is the same as in the first case, with
  minor modifications that make it hard to deduplicate code. -/
  choose xl hxl hgb using hg_mem,
  rcases em (∃ x, f x = b) with ⟨x, rfl⟩|hb',
  { exact ⟨g, λ y, ⟨xl y, x, hxl y, hgb y⟩, hgf⟩ },
  have hd : disjoint (range e ∪ g ⁻¹' (Iic c)) (g ⁻¹' {b}),
  { refine disjoint_union_left.2 ⟨_, disjoint_preimage _ _⟩,
    { rintro _ ⟨⟨x, rfl⟩, rfl : g (e x) = b⟩,
      exact hb' ⟨x, (congr_fun hgf x).symm⟩ },
    { exact set.disjoint_singleton_right.2 hcb.not_le } },
  rcases exists_bounded_mem_Icc_of_closed_of_le
    (he.closed_range.union $ is_closed_Iic.preimage g.continuous)
    (is_closed_singleton.preimage g.continuous) hd (sub_nonneg.2 hcb.le)
    with ⟨dg, dg0, dgb, dgmem⟩,
  replace hgf : ∀ x, (g - dg) (e x) = f x,
  { intro x, simp [dg0 (or.inl $ mem_range_self _), ← hgf] },
  refine ⟨g - dg, λ y, _, funext hgf⟩,
  { have hyb : (g - dg) y < b,
    { rcases (hgb y).eq_or_lt with rfl|hlt,
      { refine (sub_lt_self_iff _).2 _,
        calc 0 < g y - c : sub_pos.2 hcb
           ... = dg y    : (dgb rfl).symm },
      { exact ((sub_le_self_iff _).2 (dgmem _).1).trans_lt hlt } },
    rcases hb.exists_between hyb with ⟨_, ⟨xu, rfl⟩, hyxu, hxub⟩,
    cases lt_or_le c (g y) with hc hc,
    { rcases em (a ∈ range f) with ⟨x, rfl⟩|ha',
      { refine ⟨x, xu, _, hyxu.le⟩,
        calc f x = c - (b - c) : by rw [← hsub, sub_sub_cancel]
             ... ≤ g y - dg y  : sub_le_sub hc.le (dgmem _).2 },
      { have hay : a < (g - dg) y,
        { calc a = c - (b - c)   : by rw [← hsub, sub_sub_cancel]
             ... < g y - (b - c) : sub_lt_sub_right hc _
             ... ≤ g y - dg y    : sub_le_sub_left (dgmem _).2 _ },
        rcases ha.exists_between hay with ⟨_, ⟨x, rfl⟩, ha, hxy⟩,
        exact ⟨x, xu, hxy.le, hyxu.le⟩ } },
    { refine ⟨xl y, xu, _, hyxu.le⟩,
      simp [dg0 (or.inr hc), hxl] } },
end

/-- **Tietze extension theorem** for real-valued bounded continuous maps, a version for a closed
embedding. Let `e` be a closed embedding of a nonempty topological space `X` into a normal
topological space `Y`. Let `f` be a bounded continuous real-valued function on `X`. Let `t` be
a nonempty convex set of real numbers (we use `ord_connected` instead of `convex` to automatically
deduce this argument by typeclass search) such that `f x ∈ t` for all `x`. Then there exists
a bounded continuous real-valued function `g : Y →ᵇ ℝ` such that `g y ∈ t` for all `y` and
`g ∘ e = f`. -/
lemma exists_extension_forall_mem_of_closed_embedding (f : X →ᵇ ℝ) {t : set ℝ} {e : X → Y}
  [hs : ord_connected t] (hf : ∀ x, f x ∈ t) (hne : t.nonempty) (he : closed_embedding e) :
  ∃ g : Y →ᵇ ℝ, (∀ y, g y ∈ t) ∧ g ∘ e = f :=
begin
  casesI is_empty_or_nonempty X,
  { rcases hne with ⟨c, hc⟩,
    refine ⟨const Y c, λ y, hc, funext $ λ x, is_empty_elim x⟩ },
  rcases exists_extension_forall_exists_le_ge_of_closed_embedding f he with ⟨g, hg, hgf⟩,
  refine ⟨g, λ y, _, hgf⟩,
  rcases hg y with ⟨xl, xu, h⟩,
  exact hs.out (hf _) (hf _) h
end

/-- **Tietze extension theorem** for real-valued bounded continuous maps, a version for a closed
set. Let `s` be a closed set in a normal topological space `Y`. Let `f` be a bounded continuous
real-valued function on `s`. Let `t` be a nonempty convex set of real numbers (we use
`ord_connected` instead of `convex` to automatically deduce this argument by typeclass search) such
that `f x ∈ t` for all `x : s`. Then there exists a bounded continuous real-valued function
`g : Y →ᵇ ℝ` such that `g y ∈ t` for all `y` and `g.restrict s = f`. -/
lemma exists_forall_mem_restrict_eq_of_closed {s : set Y} (f : s →ᵇ ℝ) (hs : is_closed s)
  {t : set ℝ} [ord_connected t] (hf : ∀ x, f x ∈ t) (hne : t.nonempty) :
  ∃ g : Y →ᵇ ℝ, (∀ y, g y ∈ t) ∧ g.restrict s = f :=
begin
  rcases exists_extension_forall_mem_of_closed_embedding f hf hne (closed_embedding_subtype_coe hs)
    with ⟨g, hg, hgf⟩,
  exact ⟨g, hg, fun_like.coe_injective hgf⟩
end

end bounded_continuous_function

namespace continuous_map

/-- **Tietze extension theorem** for real-valued continuous maps, a version for a closed
embedding. Let `e` be a closed embedding of a nonempty topological space `X` into a normal
topological space `Y`. Let `f` be a continuous real-valued function on `X`. Let `t` be a nonempty
convex set of real numbers (we use `ord_connected` instead of `convex` to automatically deduce this
argument by typeclass search) such that `f x ∈ t` for all `x`. Then there exists a continuous
real-valued function `g : C(Y, ℝ)` such that `g y ∈ t` for all `y` and `g ∘ e = f`. -/
lemma exists_extension_forall_mem_of_closed_embedding (f : C(X, ℝ)) {t : set ℝ} {e : X → Y}
  [hs : ord_connected t] (hf : ∀ x, f x ∈ t) (hne : t.nonempty) (he : closed_embedding e) :
  ∃ g : C(Y, ℝ), (∀ y, g y ∈ t) ∧ g ∘ e = f :=
begin
  have h : ℝ ≃o Ioo (-1 : ℝ) 1 := order_iso_Ioo_neg_one_one ℝ,
  set F : X →ᵇ ℝ :=
  { to_fun := coe ∘ (h ∘ f),
    continuous_to_fun := continuous_subtype_coe.comp (h.continuous.comp f.continuous),
    map_bounded' := bounded_range_iff.1 ((bounded_Ioo (-1 : ℝ) 1).mono $
      forall_range_iff.2 $ λ x, (h (f x)).2) },
  set t' : set ℝ := (coe ∘ h) '' t,
  have ht_sub : t' ⊆ Ioo (-1 : ℝ) 1 := image_subset_iff.2 (λ x hx, (h x).2),
  haveI : ord_connected t',
  { constructor, rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ z hz,
    lift z to Ioo (-1 : ℝ) 1 using (Icc_subset_Ioo (h x).2.1 (h y).2.2 hz),
    change z ∈ Icc (h x) (h y) at hz, rw [← h.image_Icc] at hz,
    rcases hz with ⟨z, hz, rfl⟩,
    exact ⟨z, hs.out hx hy hz, rfl⟩ },
  have hFt : ∀ x, F x ∈ t', from λ x, mem_image_of_mem _ (hf x),
  rcases F.exists_extension_forall_mem_of_closed_embedding hFt (hne.image _) he
    with ⟨G, hG, hGF⟩,
  set g : C(Y, ℝ) := ⟨h.symm ∘ cod_restrict G _ (λ y, ht_sub (hG y)), h.symm.continuous.comp $
    continuous_subtype_mk _ G.continuous⟩,
  have hgG : ∀ {y a}, g y = a ↔ G y = h a,
    from λ y a, h.to_equiv.symm_apply_eq.trans subtype.ext_iff,
  refine ⟨g, λ y, _, _⟩,
  { rcases hG y with ⟨a, ha, hay⟩,
    convert ha,
    exact hgG.2 hay.symm },
  { ext x, exact hgG.2 (congr_fun hGF _) }
end

/-- **Tietze extension theorem** for real-valued continuous maps, a version for a closed
embedding. Let `e` be a closed embedding of a nonempty topological space `X` into a normal
topological space `Y`. Let `f` be a continuous real-valued function on `X`. Then there exists a
continuous real-valued function `g : C(Y, ℝ)` such that `g ∘ e = f`. -/
lemma exists_extension_of_closed_embedding (f : C(X, ℝ)) (e : X → Y) (he : closed_embedding e) :
  ∃ g : C(Y, ℝ), g ∘ e = f :=
(exists_extension_forall_mem_of_closed_embedding f (λ x, mem_univ _) univ_nonempty he).imp $
  λ g, and.right

/-- **Tietze extension theorem** for real-valued continuous maps, a version for a closed set. Let
`s` be a closed set in a normal topological space `Y`. Let `f` be a continuous real-valued function
on `s`. Let `t` be a nonempty convex set of real numbers (we use `ord_connected` instead of `convex`
to automatically deduce this argument by typeclass search) such that `f x ∈ t` for all `x : s`. Then
there exists a continuous real-valued function `g : C(Y, ℝ)` such that `g y ∈ t` for all `y` and
`g.restrict s = f`. -/
lemma exists_restrict_eq_forall_mem_of_closed {s : set Y} (f : C(s, ℝ)) {t : set ℝ}
  [ord_connected t] (ht : ∀ x, f x ∈ t) (hne : t.nonempty) (hs : is_closed s) :
  ∃ g : C(Y, ℝ), (∀ y, g y ∈ t) ∧ g.restrict s = f :=
let ⟨g, hgt, hgf⟩ := exists_extension_forall_mem_of_closed_embedding f ht hne
  (closed_embedding_subtype_coe hs)
in ⟨g, hgt, coe_injective hgf⟩

/-- **Tietze extension theorem** for real-valued continuous maps, a version for a closed set. Let
`s` be a closed set in a normal topological space `Y`. Let `f` be a continuous real-valued function
on `s`. Then there exists a continuous real-valued function `g : C(Y, ℝ)` such that
`g.restrict s = f`. -/
lemma exists_restrict_eq_of_closed {s : set Y} (f : C(s, ℝ)) (hs : is_closed s) :
  ∃ g : C(Y, ℝ), g.restrict s = f :=
let ⟨g, hg, hgf⟩ := exists_restrict_eq_forall_mem_of_closed f (λ _, mem_univ _) univ_nonempty hs
in ⟨g, hgf⟩

end continuous_map


import tactic.nth_rewrite.default
import tactic.ring

-- Define a custom type N of natural numbers
inductive N : Type
| Z : N
| S : N → N

reserve infix `+`:75
reserve infix `*`:76
reserve infix `ㅅ`:100

notation `Z` := N.Z
notation `S` := N.S

def add : N → N → N :=
begin
    intros a b,
    induction a with n IH,
        exact b,

        exact S (IH),
end
notation (name := N.add) a `+` b := add a b

def mul : N → N → N :=
begin
    intros a b,
    induction a with n IH,
        exact Z,

        exact (b + IH),
end
notation (name := N.mul) a `*` b := mul a b

theorem apply_to_both_side_of_eq {α : Type} {a b : α} (h : a = b) (f : α → α) : f a = f b :=
begin
    rw h,
end

notation (name := apply_to_both_side_of_eq) a `ㅅ` b := apply_to_both_side_of_eq a b

theorem not_to_not {α : Type} {a b c d : α} (h : a = b ↔ c = d) : a ≠ b ↔ c ≠ d :=
begin
    split,
        intros h1 h2,
        apply h1,
        rw ← h at h2,
        exact h2,

        intros h1 h2,
        apply h1,
        rw h at h2,
        exact h2,
end

-- Start of the proof

axioms
    (PA1 : ∀ n : N  ,      Z ≠ S n)
    (PA2 : ∀ m n : N,      S m = S n → m = n)
    (PA3 : ∀ n : N,        n + Z = n)
    (PA4 : ∀ m n : N,      m + S n = S (m + n))
    (PA5 : ∀ n : N,        n * Z = Z)
    (PA6 : ∀ m n : N,      m * S n = (m * n) + m)
    (PA7 : ∀ h : N → Prop, (h(Z) ∧ ∀ n : N, h(n) → h(S n)) → ∀ n : N, h(n))

theorem S_nonzero : ∀ n : N, Z ≠ S n := PA1
theorem S_inj : ∀ m n : N, S m = S n → m = n := PA2
theorem right_identity_add_Z : ∀ x : N, x + Z = x := PA3
theorem S_right_associative : ∀ x y : N, x + S y = S (x + y) := PA4
theorem right_sink_mul_Z : ∀ x : N, x * Z = Z := PA5
theorem S_right_distributive : ∀ x y : N, x * S y = (x * y) + x := PA6
theorem S_induction : ∀ h : N → Prop, (h(Z) ∧ ∀ n : N, h(n) → h(S n)) → ∀ n : N, h(n) := PA7

lemma S_iff_both_sides : ∀ m n : N, S m = S n ↔ m = n :=
begin
    intros m n,
    split,
        exact PA2 m n,

        intro h,
        rw h,
end

theorem PT8 : ∀ x : N, Z + x = x :=
begin
    intro x,
    apply S_induction (λ n, Z + n = n),
    split,
        exact PA3 Z,

        intros n IH,
        calc Z + S n = S (Z + n) : by rw PA4
                 ... = S n       : by rw IH,
end
theorem left_identity_add_Z : ∀ x : N, Z + x = x := PT8

theorem PT9 : ∀ x y : N, S x + y = S (x + y) :=
begin
    intros x y,
    apply S_induction (λ n, S x + n = S (x + n)),
    split,
        calc S x + Z = S x              : by rw PA3
                ... = S (x + Z)         : by rw PA3,

        intros n IH,
        calc S x + S n = S (S x + n)    : by rw PA4
                ... = S (S (x + n))     : by rw IH
                ... = S (x + S n)       : by rw PA4,
end
theorem S_left_associative : ∀ x y : N, S x + y = S (x + y) := PT9

lemma swap_s_add : ∀ x y : N, (S x) + y = x + (S y) :=
begin
    intros x y,
    calc (S x) + y = S (x + y)  : by rw PT9
               ... = x + (S y)  : by rw PA4,
end

theorem PT10 : ∀ x y : N, x + y = y + x :=
begin
    intros x y,
    apply S_induction (λ n, x + n = n + x),
    split,
        calc x + Z = x              : by rw PA3
               ... = Z + x          : by rw PT8,

        intros n IH,
        calc x + S n = S (x + n)    : by rw PA4
                 ... = S (n + x)    : by rw IH
                 ... = S n + x      : by rw PT9,
end
theorem add_commutative : ∀ x y : N, x + y = y + x := PT10

theorem PT11 : ∀ x y z : N, (x + y) + z = x + (y + z) :=
begin
    intros x y z,
    apply S_induction (λ n, (x + y) + n = x + (y + n)),
    split,
        calc (x + y) + Z = x + y                : by rw PA3
                     ... = x + (y + Z)          : by rw PA3,

        intros n IH,
        calc (x + y) + S n = S ((x + y) + n)    : by rw PA4
                       ... = S (x + (y + n))    : by rw IH
                       ... = x + S (y + n)      : by rw ← PA4
                       ... = x + (y + S n)      : by rw ← PA4,
end
theorem add_associative : ∀ x y z : N, (x + y) + z = x + (y + z) := PT11

theorem PT12 : ∀ x : N, Z * x = Z :=
begin
    intro x,
    apply S_induction (λ n, Z * n = Z),
    split,
        exact PA5 Z,

        intros n IH,
        calc Z * S n = (Z * n) + Z  : by rw PA6
                 ... = Z + Z        : by rw IH
                 ... = Z            : by rw PA3,
end
theorem left_sink_mul_Z : ∀ x : N, Z * x = Z := PT12

theorem PT13 : ∀ x y : N, (S x) * y = (x * y) + y :=
begin
    intros x y,
    apply S_induction (λ n, (S x) * n = (x * n) + n),
    split,
        calc (S x) * Z = Z              : by rw PA5
                   ... = Z + Z          : by rw PA3
                   ... = (x * Z) + Z    : by rw PA5,

        intros n IH,
        calc (S x) * (S n) = (S x) * n + (S x)      : by rw PA6
                       ... = x * n + n + (S x)      : by rw IH
                       ... = x * n + (n + (S x))    : by rw PT11
                       ... = x * n + (S n + x)      : by rw swap_s_add
                       ... = x * n + (x + S n)      : by nth_rewrite 1 PT10
                       ... = x * n + x + S(n)       : by rw ← PT11
                       ... = x * (S n) + (S n)      : by rw PA6,
end
theorem S_left_distribute : ∀ x y : N, (S x) * y = (x * y) + y := PT13

theorem PT14 : ∀ x y : N, x * y = y * x :=
begin
    intros x y,
    apply S_induction (λ n, x * n = n * x),
    split,
        calc x * Z = Z                  : by rw PA5
               ... = Z * x              : by rw PT12,

        intros n IH,
        calc x * S n = x * n + x        : by rw PA6
                 ... = n * x + x        : by rw IH
                 ... = S n * x          : by rw PT13,
end
theorem mul_commutative : ∀ x y : N, x * y = y * x := PT14

theorem PT15 : ∀ x y z : N, x * (y + z) = x * y + x * z :=
begin
    intros x y z,
    apply S_induction (λ n, x * (y + n) = x * y + x * n),
    split,

        calc x * (y + Z) = x * y            : by rw PA3
                     ... = x * y + Z        : by rw PA3
                     ... = x * y + x * Z    : by rw PA5 x,

        intros n IH,
        calc x * (y + S n) = x * (S y + n)                  : by rw swap_s_add
                       ... = x * (S (y + n))                : by rw PT9
                       ... = x * (y + n) + x                : by rw PA6
                       ... = x * y + x * n + x              : by rw IH
                       ... = x * y + (x * n + x)            : by rw PT11 (x * y) (x * n) x
                       ... = x * y + x * S n                : by rw ← PA6,
end
theorem left_distribute_mul : ∀ x y z : N, x * (y + z) = x * y + x * z := PT15

theorem PT16 : ∀ x y z : N, (x + y) * z = x * z + y * z :=
begin
    intros x y z,
    apply S_induction (λ n, (x + y) * n = x * n + y * n),
    split,

        calc (x + y) * Z = Z                               : by rw PA5
                     ... = Z + Z                           : by rw PA3
                     ... = x * Z + Z                       : by rw PA5
                     ... = x * Z + y * Z                   : by rw [PA5, PA5],

        intros n IH,
        calc (x + y) * S n = (x + y) * n + (x + y)         : by rw PA6
                       ... = (x * n + y * n) + (x + y)     : by rw ← IH
                       ... = x * n + (y * n + x) + y       : by rw [← PT11, PT11 (x * n) (y * n) x]
                       ... = x * n + (x + y * n) + y       : by rw PT10 x (y * n)
                       ... = (x * n + x) + (y * n + y)     : by rw [PT11 (x * n) (x + (y * n)) y, PT11 x (y * n) y, PT11 (x * n) x ((y * n) + y)]
                       ... = (x * S n) + (y * S n)         : by rw [← PA6 x , ← PA6 y],
end
theorem right_distribute_mul : ∀ x y z : N, (x + y) * z = x * z + y * z := PT16

theorem PT17 : ∀ x y z : N, x * (y * z) = (x * y) * z :=
begin
    intros x y z,
    apply S_induction (λ n, x * (y * n) = (x * y) * n),
    split,

        calc x * (y * Z) = Z            : by rw [PA5, PA5]
                     ... = (x * y) * Z  : by rw PA5,

        intros n IH,
        calc x * (y * S n) = x * (y * n + y)        : by rw PA6
                       ... = x * (y * n) + x * y    : by rw PT15
                       ... = (x * y) * n + x * y    : by rw IH
                       ... = (x * y) * S n          : by rw PA6,
end
theorem mul_associative : ∀ x y z : N, x * (y * z) = (x * y) * z := PT17

theorem PT18 : ∀ x y z : N, x + z = y + z → x = y :=
begin
    intros x y z,
    apply S_induction (λ n, x + n = y + n → x = y),
    split,

        intro H,
        rw [PA3 x, PA3 y] at H,
        exact H,

        intros n IH H,
        apply IH,                       clear IH,
        rw [PA4, PA4] at H,
        exact PA2 (x + n) (y + n) H,
end

theorem right_cancel_add_iff : ∀ x y z : N, x + y = z + y ↔ x = z :=
begin
    intros x y z,
    split,
        exact PT18 x z y,
        intro H,
        rw H,
end

lemma left_cancel_add_iff : ∀ x y z : N, x + y = x + z ↔ y = z :=
begin
    intros x y z,
    split;
    intros H,
        rw [PT10 x y, PT10 x z] at H,
        exact PT18 y z x H,
        rw H,
end

theorem PT19 : ∀ x : N, x + S Z = S x :=
begin
    intro x,
    rw [PA4],
    rw [PA3],
end
theorem add_one : ∀ x : N, x + S Z = S x := PT19

theorem PT20 : ∀ x : N, x * S Z = x :=
begin
    intro x,
    rw [PA6],
    rw [PA5],
    rw [PT8],
end
theorem mul_one_ : ∀ x : N, x * S Z = x := PT20

theorem PT21 : ∀ x : N, x * S (S Z) = x + x :=
begin
    intro x,
    rw [PA6],
    rw [PT20],
end
theorem mul_two_ : ∀ x : N, x * S (S Z) = x + x := PT21

theorem PT22 : ∀ x y : N, x + y = Z → (x = Z ∧ y = Z) :=
begin
    intros x y,
    apply S_induction (λ n, x + n = Z → (x = Z ∧ n = Z)),
    split,
        intros H,
        split,
            rw [PA3] at H,
            exact H,
            refl,

        intros a IH H,              clear IH,
        exfalso,
        rw [PA4] at H,
        have succ_nonzero := (PA1 (x + a)).symm,
        contradiction,
end
theorem add_to_zero : ∀ x y : N, x + y = Z → (x = Z ∧ y = Z) := PT22

theorem add_to_zero_iff : ∀ x y : N, x + y = Z ↔ (x = Z ∧ y = Z) :=
begin
    intros x y,
    split,
        exact PT22 x y,

        intro H,
        rcases H with ⟨ rfl, rfl ⟩,
        exact PA3 Z,
end

theorem PT23 : ∀ x y : N, x ≠ Z → (x * y = Z → y = Z) :=
begin
    intros x y,
    apply S_induction (λ n, x ≠ Z → (x * n = Z → n = Z)),
    split,
        intros x_nonzero H2,
        refl,

        intros n IH x_nonzero x_mul_zero,       clear IH,
        exfalso,
        apply x_nonzero,                        clear x_nonzero,
        rw [PA6] at x_mul_zero,
        exact (PT22 (x * n) x x_mul_zero).2,
end
theorem mul_to_zero : ∀ x y : N, x ≠ Z → (x * y = Z → y = Z) := PT23

theorem mul_to_zero_iff : ∀ x y : N, x ≠ Z → (x * y = Z ↔ y = Z) :=
begin
    intros x y x_nonzero,
    split;
    intro H,
        exact PT23 x y x_nonzero H,             clear x_nonzero,
        rw H,
        exact PA5 x,
end

lemma nonzero_nonzero_mul_nonzero : ∀ x y : N, x ≠ Z → y ≠ Z → x * y ≠ Z :=
begin
    intros x y H1 H2 H3,
    apply H2,
    exact mul_to_zero _ _ H1 H3,
end

theorem PT24 : ∀ x y : N, x + y = S Z → (x = Z ∧ y = S Z) ∨ (x = S Z ∧ y = Z) :=
begin
    intros x y,
    apply S_induction (λ n, n + y = S Z → (n = Z ∧ y = S Z) ∨ (n = S Z ∧ y = Z)),
    split,
    {
        intros H,
        left,
        split,
            refl,

            rw [PT8] at H,
            exact H,
    },
    {
        intros n IH H,                                  clear IH,
        right,
        rw [PT9] at H,
        have ny_zero := (PA2 _ _ H),                    clear H,
        cases PT22 _ _ ny_zero with n_zero y_zero,      clear ny_zero,
        exact ⟨by rw n_zero, y_zero⟩,
    },
end
theorem add_to_one : ∀ x y : N, x + y = S Z → (x = Z ∧ y = S Z) ∨ (x = S Z ∧ y = Z) := PT24

theorem PT25 : ∀ x y : N, x * y = S Z → x = S Z ∧ y = S Z :=
begin
    intros x y,
    apply S_induction (λ n, n * y = S Z → n = S Z ∧ y = S Z),
    split,
    {
        intros H,
        exfalso,
        apply PA1 Z,
        rw [PT12 _] at H,
        exact H,
    },
    {
        intros n IH H,
        rw [PT13] at H,
        cases (PT24 _ _ H) with H1 H1;
        cases H1 with ny_zero y_1;                              clear H IH,
        {
            refine ⟨ _, y_1 ⟩,
            rw [S_iff_both_sides],
            rw [y_1] at ny_zero,                                  clear y_1,
            rw [PT20] at ny_zero,
            exact ny_zero,
        },
        {
            exfalso,
            rw [y_1] at ny_zero,                                clear y_1,
            rw [PA5] at ny_zero,
            have one_nonzero := PA1 Z,
            contradiction,
        },
    },
end
theorem mul_to_one : ∀ x y : N, x * y = S Z → x = S Z ∧ y = S Z := PT25

theorem PT26 : ∀ x : N, x ≠ Z → ∃ y : N, x = S y :=
begin
    intros x,
    apply S_induction (λ n, n ≠ Z → ∃ y : N, n = S y),
    split,
    {
        intros H,
        exfalso,
        contradiction,
    },
    {
        intros n IH H,
        use n,
    },
end
theorem exists_pred : ∀ x : N, x ≠ Z → ∃ y : N, x = S y := PT26

theorem PT27 : ∀ x y z : N, z ≠ Z → (x * z = y * z → x = y) :=
begin
    intros x y z,
    revert x,
    apply S_induction (λ n, ∀ x : N, z ≠ Z → (x * z = n * z → x = n)),
    split,
    {
        intros x z_nonzero xz_zero,
        rw [PT12] at xz_zero,
        rw [mul_commutative] at xz_zero,
        rw [mul_to_zero_iff _ _ z_nonzero] at xz_zero,
        exact xz_zero,
    },
    {
        intros n IH x z_nonzero xz_Snz,
        by_cases x = Z,
        {
            exfalso,
            rw h at xz_Snz,                                     clear h IH,
            rw [PT12] at xz_Snz,
            have Snz_zero : S n * z = Z := xz_Snz.symm,         clear xz_Snz,
            have Sn_nonzero := (PA1 n).symm,
            rw [mul_to_zero_iff _ _ Sn_nonzero] at Snz_zero,
            contradiction,
        },
        {
            rcases (PT26 _ h) with ⟨ w, rfl ⟩,                    clear h,
            rw [PT13, PT13] at xz_Snz,
            rw [right_cancel_add_iff] at xz_Snz,
            specialize IH w z_nonzero xz_Snz,
            rw IH,
        },
    },
end
theorem right_cancel_mul : ∀ x y z : N, z ≠ Z → (x * z = y * z → x = y) := PT27

lemma right_cancel_mul_iff : ∀ x y z : N, z ≠ Z → (x * z = y * z ↔ x = y) :=
begin
    intros x y z z_nonzero,
    split,
    {
        exact right_cancel_mul x y z z_nonzero,
    },
    {
        intros H,
        rw H,
    },
end

lemma left_cancel_mul_iff : ∀ x y z : N, z ≠ Z → (z * x = z * y ↔ x = y) :=
begin
    intros x y z z_nonzero,
    rw [mul_commutative, mul_commutative z y],
    exact right_cancel_mul_iff x y z z_nonzero,
end

theorem PT28 : ∀ x : N, x ≠ Z ∧ x ≠ S Z → ∃ y : N, x = S (S y) :=
begin
    intros x,
    apply S_induction (λ n, n ≠ Z ∧ n ≠ S Z → ∃ y : N, n = S (S y)),
    split,
    {
        intros H,
        exfalso,
        cases H with Z_nonzero one_nonzero,                                         clear one_nonzero,
        contradiction,
    },
    {
        intros n IH H,
        cases H with Sn_nonzero Sn_not_one,                                         clear Sn_nonzero,
        by_cases (n = S Z),
            use Z,
            rw [h],

            rw [not_to_not (S_iff_both_sides _ _)] at Sn_not_one,
            rcases IH ⟨ Sn_not_one, h ⟩ with ⟨ z, rfl ⟩,                            clear IH h Sn_not_one,
            use (S z),
    },
end

lemma Z_only_right_identity_add : ∀ x y : N, x + y = x → y = Z :=
begin
    intros x y H,
    nth_rewrite 1 [← right_identity_add_Z x] at H,
    rw [left_cancel_add_iff] at H,
    exact H,
end

lemma right_identity_add_iff_Z : ∀ x y : N, x + y = x ↔ y = Z :=
begin
    intros x y,
    split,
    {
        exact Z_only_right_identity_add x y,
    },
    {
        intros H,
        rw H,
        exact PA3 x,
    },
end

lemma x_add_y_add_z_eq_x_imp_y_and_z_zero : ∀ x y z : N, x + y + z = x → y = Z ∧ z = Z :=
begin
    intros x y z H,
    rw [add_associative] at H,
    rw [right_identity_add_iff_Z] at H,
    rw [add_to_zero_iff] at H,
    exact H,
end

-- theorem PT29 : ∀ n m : ℕ, n ≠ m → n' ≠ m'
-- theorem PT30 : ∀ n m : ℕ, n' + m' = (n + m)' ∧ n' * m' = (n * m)'

reserve infix `<`:50
reserve infix `≤`:50

def le (x y : N) := ∃ z : N, x + z = y
def lt (x y : N) := ∃ z : N, x + z = y ∧ z ≠ Z

notation (name := le) x ` ≤ ` y := le x y
notation (name := lt) x ` < ` y := lt x y

lemma eq_imp_le : ∀ x y : N, x = y → x ≤ y :=
begin
    intros x y H,
    use Z,
    rw H,
    rw PA3,
end

lemma lt_imp_le : ∀ x y : N, x < y → x ≤ y :=
begin
    intros x y H,
    rcases H with ⟨ z, H1, H2 ⟩,
    use z,
    exact H1,
end

lemma le_imp_nlt : ∀ x y : N, x ≤ y → ¬ y < x :=
begin
    intros x y,
    apply S_induction (λ n, n ≤ y → ¬ y < n),
    split,
    {
        intros H H1,
        rcases H1 with ⟨ a, Ha, a_nonzero ⟩, clear H,
        cases add_to_zero y a Ha with y_zero a_zero, clear Ha,
        exact a_nonzero a_zero,
    },
    {
        intros n IH Sn_le_y y_lt_Sn, clear IH,
        rcases y_lt_Sn with ⟨ a, Ha, a_nonzero ⟩,
        rw ← Ha at Sn_le_y, clear Ha,
        cases Sn_le_y with b hb,
        cases x_add_y_add_z_eq_x_imp_y_and_z_zero _ _ _ hb with a_zero b_zero, clear hb,
        exact a_nonzero a_zero
    },
end

lemma le_Z_iff_eq_Z : ∀ x : N, x ≤ Z ↔ x = Z :=
begin
    intros x,
    split;
    intro H,
    {
        rcases H with ⟨ z, H1 ⟩,
        rw [add_to_zero_iff] at H1,
        exact H1.1,
    },
    {
        use Z,
        rw H,
        exact PA3 Z,
    },
end

-- proved here for convenience
theorem PT56 : ∀ x : N, ¬ x < Z :=
begin
    intros x x_lt_Z,
    rcases x_lt_Z with ⟨ a, ha, a_nonzero ⟩,
    cases add_to_zero _ _ ha with y_zero a_zero, clear ha,
    exact a_nonzero a_zero,
end
theorem nlt_Z : ∀ x : N, x < Z → false := PT56

lemma left_cancel_add_le_iff : ∀ x y z : N, x + y ≤ x + z ↔ y ≤ z :=
begin
    intros x y z,
    split,
    {
        intros H,
        rcases H with ⟨ a, Ha ⟩,
        use a,
        rw [add_associative] at Ha,
        rw left_cancel_add_iff x (y+a) z at Ha,
        exact Ha,
    },
    {
        intros H,
        rcases H with ⟨ a, Ha ⟩,
        use a,
        rw [add_associative],
        rw [Ha],
    },
end

lemma right_cancel_add_le_iff : ∀ x y z : N, x + y ≤ z + y ↔ x ≤ z :=
begin
    intros x y z,
    rw [add_commutative x y, add_commutative z y],
    exact left_cancel_add_le_iff _ _ _,
end

lemma left_cancel_add_lt_iff : ∀ x y z : N, x + y < x + z ↔ y < z :=
begin
    intros x y z,
    split,
    {
        intros H,
        rcases H with ⟨ a, Ha, a_nonzero ⟩,
        use a,
        split,
            rw [add_associative] at Ha,
            rw [left_cancel_add_iff x (y+a) z] at Ha,
            exact Ha,

            exact a_nonzero,
    },
    {
        intros H,
        rcases H with ⟨ a, rfl, a_nonzero ⟩,
        use a,
        split,
            rw [add_associative],
            exact a_nonzero,
    },
end

lemma right_cancel_add_lt_iff : ∀ x y z : N, x + y < z + y ↔ x < z :=
begin
    intros x y z,
    rw [add_commutative x y, add_commutative z y],
    exact left_cancel_add_lt_iff _ _ _,
end

theorem PT31 : ∀ x : N, ¬  x < x :=
begin
    intros x H,
    rcases H with ⟨ a, ha, a_nonzero ⟩,
    rw [right_identity_add_iff_Z _ _] at ha,
    exact a_nonzero ha,
end
theorem lt_irreflexive : ∀ x : N, x < x → false := PT31

theorem PT32 : ∀ x y z : N, x < y ∧ y < z → x < z :=
begin
    intros x y z H,
    rcases H with ⟨ a, b, hb, b_nonzero ⟩,
    rcases a with ⟨ a, ha, a_nonzero ⟩,

    use (a + b),
    split,
        rw [← add_associative x a b, ha, hb],

        intro ab_zero,
        cases add_to_zero _ _ ab_zero with a_zero b_zero,       clear ab_zero,
        exact a_nonzero a_zero,
end
theorem lt_transitive : ∀ x y z : N, x < y ∧ y < z → x < z := PT32

theorem PT33 : ∀ x y : N, x < y → ¬ y < x :=
begin
    intros x y H1 H2,
    rcases H1 with ⟨ a, ha, a_nonzero ⟩,
    rcases H2 with ⟨ b, hb, b_nonzero ⟩,

    rw [← ha] at hb,
    cases x_add_y_add_z_eq_x_imp_y_and_z_zero _ _ _ hb with a_zero b_zero,
    exact a_nonzero a_zero,
end
theorem lt_nonsym : ∀ x y : N, x < y → y < x → false := PT33

theorem PT34 : ∀ x y z : N, x < y → x + z < y + z :=
begin
    intros x y z,
    exact (right_cancel_add_lt_iff x z y).mpr,
end
theorem N_right_add_lt : ∀ x y z : N, x < y → x + z < y + z := PT34

theorem PT35 : ∀ x : N, x ≤ x :=
begin
    intro x,
    use Z,
    exact PA3 _,
end
theorem le_reflexive : ∀ x : N, x ≤ x := PT35

theorem PT36 : ∀ x y z : N, x ≤ y ∧ y ≤ z → x ≤ z :=
begin
    intros x y z H,
    rcases H with ⟨ ⟨ a, rfl ⟩, ⟨ b, rfl ⟩ ⟩,
    use (a + b),
    rw [← add_associative x a b],
end
theorem le_transitive : ∀ x y z : N, x ≤ y ∧ y ≤ z → x ≤ z := PT36

theorem PT37 : ∀ x y z : N, x ≤ y → x + z ≤ y + z :=
begin
    intros x y z,
    exact (right_cancel_add_le_iff x z y).mpr,
end
theorem N_right_add_le : ∀ x y z : N, x ≤ y → x + z ≤ y + z := PT37

theorem PT38 : ∀ x y z : N, x ≤ y ∧ y < z → x < z :=
begin
    intros x y z H,
    rcases H with ⟨ ⟨ a, rfl ⟩, ⟨ b, rfl, b_nonzero ⟩ ⟩,

    use (a+b),
    split,
        rw [← add_associative x a b],

        intro ab_nonzero,
        cases (add_to_zero _ _ ab_nonzero) with a_zero b_zero,
        exact b_nonzero b_zero,
end

theorem PT39 : ∀ x : N, Z ≤ x :=
begin
    intro x,
    use x,
    exact PT8 _,
end
theorem zero_le_ : ∀ x : N, Z ≤ x := PT39

theorem PT40 : ∀ x : N, Z < S x :=
begin
    intro x,
    use S x,
    split,
        rw [PT8],
        exact (PA1 x).symm,
end
theorem zero_lt_S : ∀ x : N, Z < S x := PT40

theorem PT41 : ∀ x y : N, x < y ↔ S x ≤ y :=
begin
    intros x y,
    split;
    intro H,
    {
        rcases H with ⟨ a, rfl, a_nonzero ⟩,
        rcases PT26 a a_nonzero with ⟨ b, rfl ⟩,                clear a_nonzero,
        use b,
        exact swap_s_add _ _,
    },
    {
        rcases H with ⟨ a, rfl ⟩,
        use S a,
        split,
            rw swap_s_add x a,

            exact (PA1 a).symm,
    }

end
theorem lt_iff_S_le : ∀ x y : N, x < y ↔ S x ≤ y := PT41

theorem PT42 : ∀ x y : N, x ≤ y ↔ x < S y :=
begin
    intros x y,
    split;
    intro H,
    {
        rcases H with ⟨ a, rfl ⟩,

        use S a,
        split,
            rw [PA4 x a],
            exact (PA1 a).symm,
    },
    {
        rcases H with ⟨ a, ha, a_nonzero ⟩,
        rcases PT26 a a_nonzero with ⟨ b, rfl ⟩,                clear a_nonzero,
        use b,
        rw [PA4] at ha,
        rw [S_iff_both_sides] at ha,
        exact ha,
    },
end
theorem le_iff_S_lt : ∀ x y : N, x ≤ y ↔ x < S y := PT42

theorem PT43 : ∀ x : N, x < S x :=
begin
    intro x,
    use S Z,
    split,
        exact PT19 x,
        exact (PA1 Z).symm,
end
theorem lt_S_self : ∀ x : N, x < S x := PT43

-- theorem PT44 : ∀ n : ℕ, n' < (n + 1)'

-- A copy of PT51 because I need it for PT45 and doesn't depend on anything but PT8.
theorem PT51 : ∀ x : N, x ≠ Z → Z < x :=
begin
    intros x H,
    use x,
    split,
        exact PT8 _,
        exact H,
end
theorem nonzero_imp_lt : ∀ x : N, x ≠ Z → Z < x := PT51

theorem PT45 : ∀ x y : N, x ≠ y → x < y ∨ y < x :=
begin
    intros x y, revert x,
    apply PA7 (λ n, ∀ x : N, x ≠ n → x < n ∨ n < x),
    split,
    {
        intros x x_nonzero,
        right,
        exact PT51 x x_nonzero,
    },
    {
        intros n IH x x_neq_Sn,
        by_cases x_eq_Z : x = Z,
        {
            left,
            rw x_eq_Z,
            exact PT40 n,
        },
        {
          rcases exists_pred x x_eq_Z with ⟨ z, rfl ⟩,
          rw not_to_not (S_iff_both_sides z n) at x_neq_Sn,
          specialize IH z x_neq_Sn,
          cases IH;
          have := PT34 _ _ (S Z) IH,
          {
            left,
            rw [add_one, add_one] at this,
            exact this,
          },
          {
            right,
            rw [add_one, add_one] at this,
            exact this,
          },
        },
    },
end
theorem N_lt_or_gt : ∀ x y : N, x ≠ y → x < y ∨ y < x := PT45

theorem PT46 : ∀ x y : N, x < y ∨ x = y ∨ y < x :=
begin
    intros x y,
    by_cases H : x = y,
        right,
        left,
        exact H,

        cases (N_lt_or_gt x y H),
            left,
            exact h,

            right,
            right,
            exact h,
end
theorem lt_or_eq_or_gt : ∀ x y : N, x < y ∨ x = y ∨ y < x := PT46

theorem PT47 : ∀ x y : N, x ≤ y ∨ y ≤ x :=
begin
    intros x y,
    by_cases H : x = y,
    {
        left,
        rw H,
        exact le_reflexive _,
    },
    {
        cases N_lt_or_gt x y H,
        {
            left,
            exact lt_imp_le _ _ h,
        },
        {
            right,
            exact lt_imp_le _ _ h,
        },
    },
end
theorem le_or_le : ∀ x y : N, x ≤ y ∨ y ≤ x := PT47

theorem PT48 : ∀ x y : N, x ≤ x + y :=
begin
    intros x y,
    use y,
end

theorem le_add_right_N : ∀ x y z : N, x ≤ y → x ≤ y + z :=
begin
    intros x y z H,
    rcases H with ⟨ a, rfl ⟩,
    use a + z,
    rw [add_associative],
end

lemma le_add_left_N : ∀ x y z : N, x ≤ y → x ≤ z + y :=
begin
    intros x y z H,
    rcases H with ⟨ a, rfl ⟩,
    use z + a,
    rw [← add_associative, ← add_associative, add_commutative x z],
end

theorem PT49 : ∀ x y : N, y ≠ Z → x < x + y :=
begin
    intros x y H,
    use y,
    split,
        refl,
        exact H,
end
theorem lt_add_right_N : ∀ x y : N, y ≠ Z → x < x + y := PT49

lemma lt_add_left_N : ∀ x y : N, y ≠ Z → x < y + x :=
begin
    intros x y H,
    use y,
    split,
        rw [add_commutative],
        exact H,
end

theorem PT50 : ∀ x y : N, y ≠ Z → x ≤ x * y :=
begin
    intros x y H,
    rcases PT26 y H with ⟨ a, rfl ⟩,
    use x * a,
    rw [PA6],
    exact PT10 x (x*a),
end
theorem N_mul_right_le : ∀ x y : N, y ≠ Z → x ≤ x * y := PT50

-- PT51 is defined above just before PT45.
-- theorem PT51 : ∀ x : N, x ≠ Z → Z < x :=
-- begin
--     intros x H,
--     use x,
--     split,
--         exact PT8 _,
--         exact H,
-- end
-- theorem nonzero_imp_lt : ∀ x : N, x ≠ Z → Z < x := PT51

lemma nonzero_iff_lt : ∀ x : N, x ≠ Z ↔ Z < x :=
begin
    intro x,
    split,
        exact PT51 x,

        intros H x_zero,
        rw x_zero at H,                     clear x_zero,
        exact lt_irreflexive _ H,
end

theorem PT52 : ∀ x y : N, Z < x ∧ Z < y → Z < x * y :=
begin
    intros x y H,
    rw [← nonzero_iff_lt, ← nonzero_iff_lt] at H,
    rw [← nonzero_iff_lt],
    rcases H with ⟨ a_nonzero, y_nonzero ⟩,
    exact nonzero_nonzero_mul_nonzero _ _ a_nonzero y_nonzero,
end
theorem N_pos_mul_pos : ∀ x y : N, Z < x ∧ Z < y → Z < x * y := PT52

theorem PT53 : ∀ x y : N, x ≠ Z ∧ S Z < y → x < x * y :=
begin
    intros x y H,
    rcases H with ⟨ x_nonzero, ⟨ b, rfl, b_nonzero ⟩ ⟩,
    rw [left_distribute_mul],
    rw [mul_one_],
    apply lt_add_right_N,
    exact nonzero_nonzero_mul_nonzero _ _ x_nonzero b_nonzero,
end
theorem N_nonzero_mul_pos : ∀ x y : N, x ≠ Z ∧ S Z < y → x < x * y := PT53

theorem PT54 : ∀ x y z : N, z ≠ Z → (x < y ↔ x * z < y * z) :=
begin
    intros x y z Sn_nonzero,
    split,
    {
        intro H,
        rcases H with ⟨ a, rfl, a_nonzero ⟩,
        rw [right_distribute_mul],
        apply lt_add_right_N,
        exact nonzero_nonzero_mul_nonzero _ _ a_nonzero Sn_nonzero,
    },
    {
        intro H,                                                                    clear Sn_nonzero,
        cases PT46 x y,
            {
                exact h,
            },
            exfalso,
            rcases h with ⟨ rfl, rfl ⟩,
            {
                exact PT31 (x * z) H,
            },
            {
                rcases H with ⟨ b, hb, b_nonzero ⟩,
                rcases h with ⟨ a, rfl, a_nonzero ⟩,                                clear a_nonzero,
                rw [ right_distribute_mul, add_associative] at hb,
                have azb_zero := Z_only_right_identity_add _ _ hb,                  clear hb,
                cases add_to_zero _ _ azb_zero with az_zero b_zero,                 clear azb_zero,
                exact b_nonzero b_zero,
            },
    },
end
theorem N_right_cancel_mul_lt : ∀ x y z : N, z ≠ Z → (x < y ↔ x * z < y * z) := PT54

theorem PT55 : ∀ x y z : N, z ≠ Z → (x ≤ y ↔ x * z ≤ y * z) :=
begin
    intros x y z Sn_nonzero,
    split,
    {
        intro x_le_y,
        rcases x_le_y with ⟨ a, rfl ⟩,
        rw [right_distribute_mul],
        apply PT48,
    },
    {
        intro H,
        cases PT47 x y,
            exact h,

            rcases h with ⟨ a, rfl ⟩,
            rw [(PA3 (y*z)).symm]       at H,
            rw [right_distribute_mul]   at H,
            rw [left_cancel_add_le_iff] at H,
            rw [le_Z_iff_eq_Z]          at H,
            rw [mul_commutative]        at H,
            have a_zero := mul_to_zero _ _ Sn_nonzero H,        clear Sn_nonzero H,
            rw a_zero,                                          clear a_zero,
            rw [PA3],
            exact (PT35 y),
    },
end
theorem N_right_cancel_mul_le : ∀ x y z : N, z ≠ Z → (x ≤ y ↔ x * z ≤ y * z) := PT55

-- Proved at the start of ≤ & < section.
-- theorem PT56 : ∀ x : N, x < Z → false :=
-- begin
--     intros x x_lt_Z,
--     rcases x_lt_Z with ⟨ a, ha, a_nonzero ⟩,
--     cases add_to_zero _ _ ha with y_zero a_zero, clear ha,
--     exact a_nonzero a_zero,
-- end
-- theorem nlt_Z : ∀ x : N, x < Z → false := PT56

theorem PT57 : ∀ x y : N, x ≤ y ∧ y ≤ x → x = y :=
begin
    intros x y H,
    rcases H with ⟨ ⟨ a, ha ⟩, ⟨ b, hb ⟩ ⟩,

    rw [← ha] at hb,
    rcases x_add_y_add_z_eq_x_imp_y_and_z_zero _ _ _ hb with ⟨ rfl, rfl ⟩ , clear hb,
    rw [PA3] at ha,
    exact ha,
end
theorem le_antisymmetric : ∀ x y : N, x ≤ y ∧ y ≤ x → x = y := PT57

-- theorem PT58 : ∀ n : ℕ, x = Z ∨ x = S Z ∨ x = S (S Z) ∨ ... ∨ x = n' ↔ x ≤ n'

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

reserve infix ` | ` : 50
def divisible (x y : N) := ∃ z : N, y = x * z
notation x ` | ` y := divisible x y

theorem PT59 : ∀ x : N, x | x :=
begin
    intro x,
    use S Z,
    rw [mul_one_],
end
theorem N_divides_self : ∀ x : N, x | x := PT59

theorem PT60 : ∀ x : N, S Z | x :=
begin
    intro x,
    use x,
    rw [mul_commutative],
    rw [mul_one_],
end
theorem N_one_divides : ∀ x : N, S Z | x := PT60

theorem PT61 : ∀ x : N, x | Z :=
begin
    intro x,
    use Z,
    rw [PA5],
end
theorem N_divides_zero : ∀ x : N, x | Z := PT61

theorem PT62 : ∀ x y z : N, x | y ∧ y | z → x | z :=
begin
    intros x y z H,
    rcases H with ⟨ ⟨ a, rfl ⟩, ⟨ b, rfl ⟩ ⟩,
    use a * b,
    rw [mul_associative],
end
theorem N_divides_trans : ∀ x y z : N, x | y ∧ y | z → x | z := PT62

theorem PT63 : ∀ x y : N, y ≠ Z ∧ x | y → x ≤ y :=
begin
    intros x y H,
    rcases H with ⟨ xa_nonzero, ⟨ a, rfl ⟩ ⟩,

    have a_nonzero : a ≠ Z,
    {
        intro a_zero,
        rw a_zero at xa_nonzero,    clear a_zero,
        rw [PA5] at xa_nonzero,
        contradiction,
    },

    exact PT50 x a a_nonzero,
end
theorem N_divides_imp_le : ∀ x y : N, y ≠ Z ∧ x | y → x ≤ y := PT63

theorem PT64 : ∀ x y : N, x | y ∧ y | x → x = y :=
begin
    intros x y H,
    rcases H with ⟨ ⟨ a, ha ⟩, ⟨ b, rfl ⟩ ⟩,
    rw [← mul_associative] at ha,
    by_cases y_zero : y = Z,
    {
        rw [y_zero],         clear y_zero ha,
        rw [PT12],
    },
    {
        nth_rewrite 0 [← mul_one_ y] at ha,
        rw [left_cancel_mul_iff _ _ _ y_zero] at ha,
        cases mul_to_one _ _ ha.symm with b_one a_one,                              clear ha a_one,
        rw [b_one],                                                                 clear b_one,
        exact PA3 y,
    },
end
theorem N_divides_antisymm : ∀ x y : N, x | y ∧ y | x → x = y := PT64

theorem PT65 : ∀ x y z : N, x | y → x | y*z :=
begin
    intros x y z H,
    rcases H with ⟨ a, rfl ⟩,
    use a * z,
    rw [mul_associative],
end
theorem N_divides_mul : ∀ x y z : N, x | y → x | y*z := PT65

theorem PT66 : ∀ x y z : N, x | y ∧ x | z → x | y + z :=
begin
    intros x y z H,
    rcases H with ⟨ ⟨ a, rfl ⟩, ⟨ b, rfl ⟩ ⟩,
    use a + b,
    rw [← left_distribute_mul],
end
theorem N_divides_add : ∀ x y z : N, x | y ∧ x | z → x | y + z := PT66

theorem PT67_induction_part : ∀ x y : N, y ≠ Z → (∃ u v : N, (x = y * u + v ∧ v < y)) :=
begin
    intros x y y_nonzero,
    revert x,
    apply S_induction (λ n : N, (∃ u v : N, (n = y * u + v ∧ v < y ))),
    split,
    {
        use Z,
        use Z,
        split,
            rw [PA5],
            rw [PA3],

            exact PT51 y y_nonzero,
    },
    {
        intros x IH,
        rcases IH with ⟨ u, v, H, v_lt_y  ⟩,
        have three_options := PT46 (S v) y,
        cases three_options,
        {
            use u,                                              clear v_lt_y y_nonzero,
            use S v,
            refine ⟨ _, three_options ⟩,                        clear three_options,
            rw [H],                                             clear H x,
            rw [← PA4],
        },
        cases three_options,
        {
            use S u,                                            clear v_lt_y,
            use Z,
            refine ⟨ _, (PT51 y y_nonzero) ⟩,
            rw [H],                                             clear H y_nonzero x,
            rw [PA6],
            rw [PA3],
            rw [← PA4],
            rw [three_options],
        },
        {
            exfalso,                                            clear y_nonzero H x u,
            rw [← PT42] at three_options,
            apply (le_imp_nlt y v three_options),               clear three_options,
            exact v_lt_y,
        },
    },
end

lemma PT67_uniqueness_part : ∀ x y : N, y ≠ Z → (∀ u v u1 v1 : N, (x = y * u + v ∧ v < y) → (x = y * u1 + v1 ∧ v1 < y) → (u = u1 ∧ v = v1)) :=
begin
    intros x y y_nonzero u v u1 v1 uv_qr' u1v1_qr',
    rcases uv_qr' with ⟨ uv_qr, v_lt_y ⟩,
    rcases u1v1_qr' with ⟨ u1v1_qr, v1_lt_y ⟩,
    rw u1v1_qr at uv_qr,                                                            clear u1v1_qr x,

    by_cases h' : u = u1,
    {
        refine ⟨ h', _ ⟩,
        rw [← h'] at uv_qr,
        rw [left_cancel_add_iff] at uv_qr,
        rw uv_qr,
    },
    exfalso,                                                                        clear y_nonzero,
    cases (PT45 _ _ h') with h h;                                                   clear h';
    rcases h with ⟨ w, rfl, w_nonzero ⟩;
    rw [left_distribute_mul] at uv_qr;
    rw [add_associative] at uv_qr;
    rw [left_cancel_add_iff] at uv_qr;
    have y_le_yw : y ≤ y * w := PT50 y w w_nonzero;                                 clear w_nonzero,
    {
        have y_le_ywv1 : y ≤ y * w + v1 := le_add_right_N y (y * w) v1 y_le_yw,     clear y_le_yw v1_lt_y u,
        rw [uv_qr] at y_le_ywv1,                                                    clear uv_qr w v1,
        apply (le_imp_nlt y v y_le_ywv1),                                           clear y_le_ywv1,
        exact v_lt_y,
    },
    {
        have y_le_ywv : y ≤ y * w + v := le_add_right_N y (y * w) v y_le_yw,        clear y_le_yw v_lt_y u1,
        rw [← uv_qr] at y_le_ywv,                                                   clear uv_qr w v,
        apply (le_imp_nlt y v1 y_le_ywv),                                           clear y_le_ywv,
        exact v1_lt_y,
    },
end

theorem PT67 : ∀ x y : N, y ≠ Z → (∃ u v : N, (x = y * u + v ∧ v < y ∧ ∀ u1 v1 : N, (x = y * u1 + v1 ∧ v1 < y) → (u = u1 ∧ v = v1))) :=
begin
    intros x y y_nonzero,
    have H_induction := PT67_induction_part x y y_nonzero,
    rcases H_induction with ⟨ u, v, H, v_lt_y ⟩,
    use u,
    use v,
    refine ⟨ H, v_lt_y, _ ⟩,
    {
        intros u1 v1 H1,
        exact PT67_uniqueness_part x y y_nonzero u v u1 v1 (and.intro H v_lt_y) H1,
    },
end