import .definitions
import .nat_extra
import .logic_extra

namespace nt

/-
I don't think we need this, but it's easy enough to prove.
This establishes the connection between the two computable properties.
-/

lemma prime_dichotomy {n : ℕ} (h : n ≠ 0 ∧ n ≠ 1) : is_prime n = tt ↔ is_composite n = ff :=
begin
split; intro a,
{ by_cases (n = 0) with h0,
  { from absurd h0 h.left },
  { by_cases (n = 1) with h1,
    { from absurd h1 h.right },
    { simp [h0,h1,is_prime] at a,
      from (to_bool_iff (is_composite n = ff)).1 a
    }
  }
},
{ by_cases (n = 0) with h0,
  { from absurd h0 h.left },
  { by_cases (n = 1) with h1,
    { from absurd h1 h.right },
    { simp [h0,h1,is_prime], apply to_bool_tt, assumption }
  }
}
end

/-
Now establish the connection between the two conceptual properties.
-/

lemma not_composite {n : ℕ} (h : n ≠ 0 ∧ n ≠ 1) : ¬composite n ↔ irreducible n :=
begin
split; intro a,
{
  by_cases (n = 0) with h1,
  { exact absurd h1 h.left },
  { by_cases (n = 1) with h2,
    { exact absurd h2 h.right },
    { delta irreducible, apply and.intro, exact h1, apply and.intro, exact h2,
      { simp [h1, h2, composite] at a,
        have : ∀ x : ℕ, ¬∃ b : ℕ, (¬x = 1 ∧ ¬b = 1 ∧ n = x * b), from forall_not_of_not_exists a,
        assume k : ℕ, have hk : ¬∃ (b : ℕ), ¬k = 1 ∧ ¬b = 1 ∧ n = k * b, from this k,
        intro hkdn, apply dvd.elim hkdn, intro x, intro hnkx,
        by_contradiction, simp [demorgan] at a_1,
        have hx : x ≠ 1, from assume : x = 1,
          have hnk : k = n, by simp [this] at hnkx; exact eq.symm hnkx,
          absurd hnk a_1.left,
        have : ¬k = 1 ∧ ¬x = 1 ∧ n = k*x, by
        begin
          apply and.intro,
            exact a_1.right,
            apply and.intro,
              exact hx,
              exact hnkx
        end,
        have : ∃ b : ℕ, ¬k = 1 ∧ ¬b = 1 ∧ n = k*b, by existsi x; exact this,
        contradiction
      },
    }
  }
},
{
  by_cases (n = 0) with h1,
  { exact absurd h1 h.left },
  { by_cases (n = 1) with h2,
    { exact absurd h2 h.right },
    { simp [h1, h2, irreducible] at a,
      simp [composite, h1],
      by_contradiction,
      cases a_1 with k,
      cases a_1 with b h',
      have hkdiv : k ∣ n, from dvd.intro b (eq.symm h'.right.right),
      have hk1 : k ≠ 1, from h'.left,
      have hkn : k ≠ n, by
      begin
        by_cases (k = n) with hkeqn,
        { have : n = n*b, by rw [hkeqn] at h'; exact h'.right.right,
          have : n*1 = n*b, by simp; exact this,
          have : 1 = b, from nat.eq_of_mul_eq_mul_left (nat.pos_of_ne_zero h.left) this,
          from absurd (eq.symm this) h'.right.left
        },
        { assumption }
      end,
      have hn1 : k = n ∨ k = 1, from (a k) hkdiv,
      have hn1' : ¬(k = n ∨ k = 1), by simp [demorgan]; exact and.intro hkn hk1,
      contradiction
    }
  }
}
end

/-
Build-up to decidability of the 'composite' relation. First show that the
auxillary function for is_composite does the right thing. Then use that to
get the correctness of is_composite itself.
-/

lemma zero_is_zero (n : ℕ) : zero_test n = tt ↔ n = 0 :=
begin
  split; intros;
  by_cases (n = 0);
  simp [zero_test, *],
  delta zero_test at a,
  simp * at *
end

lemma composite_aux_lem {n m : ℕ}
  (h : is_composite_aux n m = tt)
  (hm : m < n) :
  ∃ a : ℕ, ∃ b : ℕ, a ≠ 1 ∧ b ≠ 1 ∧ n = a*b :=
begin
  cases m with m,
  { contradiction },
  { induction m with m ih_1,
    { contradiction },
    { simp [is_composite_aux] at h,
      cases h with hc hz,
      { apply ih_1,
        { assumption },
        { from nat.lt_of_succ_lt hm }
      },
      { simp [zero_is_zero] at hz,
        let a := nat.succ (nat.succ m),
        let b := n/a,
        have hmod : n%a + a*(n/a) = n, from nat.mod_add_div n a,
        have hdiv : a*b = n, by simp [hz,hmod,*] at *,
        have ha : a ≠ 1, from
          assume ha1 : a = 1,
          have hlz : nat.succ m ≤ 0, by simp [nat.succ_inj ha1],
          by simp [nat.not_succ_le_zero] at hlz; contradiction,
        have hb : b ≠ 1, from
          assume hb1 : b = 1,
          have han : a = n, by simp [hb1,nat.mul_one] at hdiv; assumption,
          have haln : a ≠ n, by simp [hm,nat.lt_imp_ne],
          by contradiction,
        existsi a, existsi b, apply and.intro ha,
          { apply and.intro hb, simp [hdiv] }
      }
    }
  }
end

lemma composite_aux_lem2 {a b n : ℕ}
  (ha : a ≠ 1)
  (hb : b ≠ 1)
  (hn : a*b = (nat.succ n)) :
  is_composite_aux (nat.succ n) a = tt :=
begin
  cases a with a,
  { simp [is_composite_aux], simp at hn, contradiction },
  { cases a with a,
    { contradiction },
    { simp [is_composite_aux],
      apply or.intro_right,
      simp [zero_is_zero],
      rw [←hn],
      apply nat.mul_mod_right,
    }
  }
end

lemma composite_aux_lem3 {a m n : ℕ}
  (ha : a ≤ m)
  (hcomp : is_composite_aux n a = tt) :
  is_composite_aux n m = tt :=
begin
  induction m with m ih,
  { simp [nat.eq_zero_of_le_zero ha, is_composite_aux] at hcomp, contradiction },
  { by_cases (a = nat.succ m),
    { rw [←h], assumption },
    { simp [nat.le_ne_succ ha h] at ih,
      cases m with m,
      { simp [is_composite_aux] at ih, contradiction },
      { simp [is_composite_aux], apply or.intro_left, assumption }
    }
  }
end

lemma computable_composite {n : ℕ} : is_composite n = tt ↔ composite n :=
begin
split; intro h,
{ apply and.intro,
  { assume hnz : n = 0, simp [hnz, is_composite] at h, contradiction },
  { cases n with n,
    { contradiction },
    { simp [is_composite] at h,
      cases n with n,
      { contradiction },
      { from composite_aux_lem h nat.lt_succ }
    }
  }
},
{ delta composite at h,
  cases h.right with a ha,
  cases ha with b hab,
  have hnp : n ≠ 0, from h.left,
  cases n with n,
  { contradiction },
  { simp [is_composite],
    have hc : is_composite_aux (nat.succ n) a = tt, from
      composite_aux_lem2 hab.left hab.right.left (eq.symm hab.right.right),
    have : a*b ≠ 0, from hab.right.right ▸ hnp,
    have hnz : a ≠ 0 ∧ b ≠ 0, from nat.no_zero_divisors this,
    have : a = (nat.succ n)/b, from
      eq.symm (nat.div_eq_of_eq_mul_left
                (nat.pos_of_ne_zero hnz.right)
                hab.right.right),
    have haltn : a ≤ (nat.succ n), by simp [nat.div_le_self, this],
    have : a ≠ nat.succ n, from
      assume han : a = nat.succ n,
      have h' : (nat.succ n)*1 = (nat.succ n)*b, from calc
                (nat.succ n)*1 = nat.succ n      : nat.mul_one $ nat.succ n
                           ... = a * b           : by simp [hab.right.right]
                           ... = (nat.succ n)*b  : by rw [han],
      have b = 1, by rw [han] at hnz;
                     simp [nat.eq_of_mul_eq_mul_left (nat.pos_of_ne_zero hnz.left) h'],
      absurd this hab.right.left,
    have ha : a ≤ n, from nat.le_ne_succ haltn this,
    exact composite_aux_lem3 ha hc
  }
}
end

instance decidable_composite : @decidable_pred ℕ composite :=
begin
  intro n, by_cases is_composite n = tt,
  { simp [computable_composite] at h, exact is_true h },
  { simp [computable_composite] at h, exact is_false h }
end

/-
Decidability of 'irreducible' is almost a layup once we have
  (1) the connection between composite and irreducible, i.e. 'not_composite'
  (2) the decidability of composite, i.e. 'computable_composite'
-/

lemma computable_irreducible {n : ℕ} : is_prime n = tt ↔ irreducible n :=
begin
split; intro a,
{
  by_cases (n = 0) with h,
  { simp [h, is_prime] at a, contradiction },
  { by_cases (n = 1) with h1,
    { simp [h1, is_prime] at a, contradiction },
    { simp [h, h1, is_prime] at a,
      -- why was this so hard? (manual application of to_bool_iff)
      have hnic : ¬is_composite n = tt, by simp; exact (to_bool_iff (is_composite n = ff)).1 a,
      have hnc : ¬composite n, from mt (iff.elim_right computable_composite) hnic,
      exact (iff.elim_left (not_composite $ and.intro h h1)) hnc
    }
  }
},
{
  by_cases (n = 0) with h,
  { simp [h, irreducible] at a, contradiction },
  { by_cases (n = 1) with h1,
    { simp [h1, irreducible] at a, contradiction },
    {
      have hnc : ¬composite n, from (iff.elim_right (not_composite $ and.intro h h1)) a,
      have hnic : ¬is_composite n = tt, from mt (iff.elim_left computable_composite) hnc,
      -- why was this so hard? (manual application of to_bool_tt)
      simp [h, h1, is_prime], apply to_bool_tt, simp at hnic, assumption
    }
  }
}
end

instance decidable_irreducible : @decidable_pred ℕ irreducible :=
begin
  intro p, by_cases is_prime p = tt,
  { simp [computable_irreducible] at h, exact is_true h },
  { simp [computable_irreducible] at h, exact is_false h }
end

end nt


/-

Group algebras considered as star algebras.

This is formally parallel to monoid_algebra, but instead of taking finite formal
combinations of the generators, we take L^1 combinations.

In this file we define `group_star_algebra k G := G →₁  k`, and `add_monoid_star_algebra k G`
in the same way, and then define the convolution product on these.

Instead of Haar measure this version uses counting measure

Another way to go: define the co-product G → G × G as a measure on G × G with the same integrable functions
as the product measure.  This has the advantage that we could do it for simple functions.
Note that Haar measure on G × G might not be the product of Haar measures but rather its completion.

-/

import data.monoid_algebra
import linear_algebra.star_algebra
import topology.bases
import measure_theory.measure_space measure_theory.l1_space measure_theory.bochner_integration

import group_theory.presented_group group_theory.order_of_element
import group_theory.free_abelian_group
import algebra.group.hom algebra.group_power
import group_theory.group_action
import group_theory.representation.basic

noncomputable theory
open_locale classical topological_space

open set filter topological_space ennreal emetric measure_theory
open finset finsupp

universes u₁ u₂ u₃
variables (k : Type u₁) (G : Type u₂)

class discrete_group2 (G : Type u₂) extends group G

instance discrete_group2.measurable_space [discrete_group2 G] : measurable_space G := ⊤

instance discrete_group2.measure_space [discrete_group2 G] : measure_space G := ⟨ measure.count ⟩

def discrete_group (G : Type u₂) : Type u₂ := G

instance : measurable_space (discrete_group G) := ⊤

instance : measure_space (discrete_group G) := ⟨ measure.count ⟩

#print discrete_group.measurable_space

-- basic group example is ℤ^n (free abelian group with n generators) with the counting measure

inductive generator : Type
| x

variables a b : generator

def zgroup := discrete_group (free_abelian_group generator)

def zgroup2 : discrete_group2 (multiplicative (free_abelian_group generator)) := { }

#print zgroup2.measurable_space

def gx := free_abelian_group.of generator.x

--def s1 := { g : zgroup2 | g = gx }

section
-- normed_group should be inferable from normed_star_ring
variables [normed_star_ring k] [second_countable_topology k] [measurable_space k] [borel_space k] [opens_measurable_space k]
variables [complete_space k]

lemma measure_insert [discrete_group2 G] (μ : measure G) (s : set G) (hs : is_measurable s) (g : G) (hg: g ∉ s) : μ (insert g s) = μ s + μ {g} :=
begin
  have h1 : is_measurable ({g} : set G) := trivial,
  have hh : disjoint s {g} := by simp [set.disjoint_right,hg],
  have hz : ((insert g s) = (s ∪ {g})) := by simp,
  rw hz,
  apply measure_union hh hs h1,
end

@[simp]
lemma measure_sum {ι : Type*} {α : Type*} [measurable_space α] (f : ι → measure α) (s : set α) (hs : is_measurable s):
  (measure.sum f) s = ∑' i, f i s :=
  by simp only [hs, measure.sum, to_measure_apply, outer_measure.sum_apply, to_outer_measure_apply]

lemma dirac_simp {α : Type*} [discrete_group2 α] (x g : α) : ite (x = g) 1 0 = (measure.dirac x) {g} :=
begin  have h1 : is_measurable ({g} : set α) := trivial,
 simp [h1], by_cases x = g, simp [h], simp [h],
end

lemma check_count [discrete_group2 G] (s : finset G) : ( ↑ s.card = measure.count (↑s : set G)) :=
begin
  unfold measure.count, apply finset.induction_on s, simp,
  intros g s' hs heq,
  simp only [*, coe_insert, card_insert_of_not_mem, nat.cast_add, not_false_iff, nat.cast_one],
  rw measure_insert _ _ ↑ s' , congr, rw measure_sum,
  have hh : (∑' i, ite (i=g) (1:ennreal) 0) = ∑' i : G, (measure.dirac i) {g} ,
    { congr, ext1, apply dirac_simp },
  rw [← hh,tsum_ite_eq], repeat {trivial},
end

lemma hn : normed_space ℝ k := begin sorry end

def right_invariant_measure2 [discrete_group2 G] (f : G →₁ k) (a : G) (hn : normed_space ℝ k) : Prop :=
  (∫ x : G, f.to_fun x) = ∫ x : G, f.to_fun (x*a)

variable {G}

def right_invariant_measure [discrete_group2 G] (μ : measure G) : Prop :=
   ∀ g : G, ∀ s : set G, μ s = μ ((λ h,h*g)⁻¹' s)

lemma discrete_measure_is_right_invariant [discrete_group2 G] : right_invariant_measure (measure.count : measure G) :=
begin unfold right_invariant_measure, unfold measure.count, intros,
   have hs : is_measurable s := trivial,
  let s' := ((λ (h : G), h * g) ⁻¹' s),
  have hs' : is_measurable s' := trivial,
 simp [hs,hs'], symmetry, exact @@tsum_equiv _ _ _ (λ i, ⨆(h : i ∈ s), (1 : ennreal)) (equiv.mul_right g),
end

-- @[derive [star_algebra]]
def group_star_algebra : Type (max u₁ u₂) := G →₁ k

namespace group_star_algebra

variables {k G}
local attribute [reducible] group_star_algebra

section
variables [normed_star_ring k] [second_countable_topology k] [measurable_space k] [borel_space k] [opens_measurable_space k] [group G] [measure_space G]

def nntimes (a b : nnreal) : ennreal := ennreal.of_real (a * b)

/-- The product of `f g : group_star_algebra k G` is the ℓ^1 function
  whose value at `a` is the sum of `f x * g y` over all pairs `x, y`
  such that `x * y = a`. (Think of the group ring of a group.) -/

lemma mul_measurable (f g : G →₁ k) : measurable (λ a : G, (∫ x : G,
  nnreal.to_real_hom ((nnnorm (f.to_fun x)) * (nnnorm (g.to_fun (x⁻¹ * a)))))) :=
begin dunfold measurable,
end

lemma mul_integrable (f g : G →₁ k) : integrable (λ a : G, (∫ x : G,
  nnreal.to_real_hom ((nnnorm (f.to_fun x)) * (nnnorm (g.to_fun (x⁻¹ * a)))))) :=
begin
end

-- lemma mul_convergence (f g : G →₁ k) :  (∫ a : G, (∫ x, ((nnnorm (f.to_fun x)) * (nnnorm (g.to_fun (x⁻¹ * a)))))) <  :=
-- begin
--   -- use Fubini
--   -- use Haar measure to change variables a → x * a
-- end

instance : has_mul (group_star_algebra k G) :=
⟨λf g : G →ₘ k, (λ a : G, (∫ x, (f.to_fun x) * (g.to_fun (x⁻¹ * a))))

lemma mul_def {f g : group_star_algebra k G} :
  f * g = (λ a : G, (∫⁻ x, (f.to_fun x) * (g.to_fun (x⁻¹ * a)))
  :=
rfl


-- Un_numero_entre_dos_enteros_consecutivos_no_es_entero.lean
-- Un número entre dos enteros consecutivos no es entero
-- José A. Alonso Jiménez
-- Sevilla, 10 de agosto de 2021
-- ---------------------------------------------------------------------

import algebra.order.ring
import data.int.cast

lemma num_btw_integers_not_integer
  (R : Type*) [linear_ordered_ring R]
  (a: R)
  (n m: ℤ)
  (h : a < m + 1)
  (h₀ : (m : R) < a)
  : a ≠ n :=
begin
  cases le_or_lt n m with n0 n1,
  { have : (n : R) ≤ m,
    { exact_mod_cast n0, },
    exact (lt_of_le_of_lt this h₀).ne', },
  { have : (m : R) + 1 ≤ n,
    { assumption_mod_cast, },
    exact (lt_of_lt_of_le h this).ne, },
end

lemma num_btw_integers_not_integer2
  (R : Type*) [linear_ordered_ring R]
  (a: R)
  (n m: ℤ)
  (h : a < m + 1)
  (h₀ : (m : R) < a)
  : a ≠ n :=
begin
  rintro rfl,
  norm_cast at h h₀,
  exact not_le_of_lt h₀ (int.lt_add_one_iff.1 h),
end


-- Copyright 2022-2023 VMware, Inc.
-- SPDX-License-Identifier: BSD-2-Clause

import .linear

/-!
# Incremental version of an operator

A key idea of DBSP is to define for any `Q: operator a b` an incremental version
of it, `Q^Δ := D ∘ Q ∘ I`. Notice that `Q^Δ : operator a b` - it has the same
type as `Q`, but it takes as input a stream of changes and outputs a stream of
diffs.
-/

section groups.

variables {a : Type} [add_comm_group a].
variables {b : Type} [add_comm_group b].
variables {c : Type} [add_comm_group c].

/-- The core definition of DBSP is the incremental version of an operator Q, Q^Δ.

If we think of the operator Q as a transformation on databases, Q^Δ operates on
a stream of changes and outputs a stream of changes. It does this by simply
integrating the input, applying Q, and differentiating the output. The power of
DBSP comes from re-arranging incremental computations to produce more efficient plans.
-/
def incremental (Q: operator a b) : operator a b :=
  λ s, D (Q (I s)).

-- applied version of incremental that can be useful for rewriting
lemma incremental_unfold (Q: operator a b) (s: stream a) :
  incremental Q s = D (Q (I s)) := rfl.

/-- A version of incremental for curried operators, defined directly. Written
T^Δ2.  -/
def incremental2 (T: operator2 a b c) : operator2 a b c :=
  λ s1 s2, D (T (I s1) (I s2)).

-- applied version of incremental2 that can be useful for rewriting
lemma incremental2_unfold (Q: operator2 a b c) (s1: stream a) (s2: stream b) :
  incremental2 Q s1 s2 = D (Q (I s1) (I s2)) := rfl.

postfix `^Δ`:90 := incremental.
postfix `^Δ2`:90 := incremental2.

private def incremental_inv (Q: operator a b) : operator a b :=
  I ∘ Q ∘ D.

local attribute [simp] derivative_integral integral_derivative.

theorem incremental_inversion_l :
  function.left_inverse (@incremental a _ b _) incremental_inv :=
begin
  intros Q,
  unfold incremental incremental_inv,
  funext s, simp,
end

theorem incremental_inversion_r :
  function.right_inverse (@incremental a _ b _) incremental_inv :=
begin
  intros Q,
  unfold incremental incremental_inv,
  funext s, simp,
end

theorem incremental_bijection :
  function.bijective (@incremental a _ b _) :=
begin
  split,
  { apply function.left_inverse.injective,
    apply incremental_inversion_r, },
  { apply function.right_inverse.surjective,
    apply incremental_inversion_l, },
end

private meta def prove_incremental : tactic unit :=
  do
    tactic.interactive.unfold [``incremental, ``incremental2] (interactive.loc.ns [none]),
    tactic.interactive.funext [`s],
    tactic.interactive.simp none none false [] [] (interactive.loc.ns [none]),
    return ()

theorem delay_invariance : incremental (@delay a _) = delay :=
begin
  funext s, rw incremental_unfold,
  rw derivative_time_invariant,
  simp,
end

theorem integral_invariance : incremental (@I a _) = I :=
  by prove_incremental.

theorem derivative_invariance : incremental (@D a _) = D :=
  by prove_incremental.

theorem integrate_push (Q: operator a b) :
  Q ∘ I = I ∘ Q^Δ :=
  by prove_incremental.

theorem derivative_push (Q: operator a b) :
  D ∘ Q = Q^Δ ∘ D :=
  by prove_incremental.

theorem I_push (Q: operator a b) (s: stream a) :
  Q (I s) = I (Q^Δ s) :=
  by prove_incremental.

theorem D_push (Q: operator a b) (s: stream a) :
  D (Q s) = Q^Δ (D s) :=
  by prove_incremental.

theorem D_push2 (Q: operator2 a b c) (s1: stream a) (s2: stream b) :
  D (Q s1 s2) = Q^Δ2 (D s1) (D s2) :=
  by prove_incremental.

theorem chain_incremental (Q1: operator b c) (Q2: operator a b) :
  (Q1 ∘ Q2)^Δ = Q1^Δ ∘ Q2^Δ :=
  by prove_incremental.

theorem incremental_comp (Q1: operator b c) (Q2: operator a b) (s: stream a) :
  (λ s, Q1 (Q2 (s)))^Δ s = Q1^Δ (Q2^Δ s) :=
  by prove_incremental.

theorem add_incremental (Q1 Q2: operator a b) :
  (Q1 + Q2)^Δ = Q1^Δ + Q2^Δ :=
begin
  prove_incremental,
  rw derivative_linear,
end

lemma cycle_body_strict (T: operator2 a b b) (hcausal: causal (uncurry_op T)) :
  ∀ s, strict (λ (α : stream b), T s (z⁻¹ α)) :=
begin
  intros s,
  apply (causal_strict_strict delay delay_strict _ _),
  apply causal_uncurry_op_fixed, assumption,
end

lemma cycle_body_integral_strict (T: operator2 a b b) (hcausal: causal (uncurry_op T)) :
  ∀ s, strict (λ (α : stream b), T (I s) (z⁻¹ α)) :=
begin
  intros s,
  apply (causal_strict_strict delay delay_strict _ _),
  apply causal_uncurry_op_fixed, assumption,
end

lemma cycle_body_incremental_strict (T: operator2 a b b) (hcausal: causal (uncurry_op T))
  (s: stream a) : strict (λ α, T^Δ2 s (z⁻¹ α)) :=
begin
  apply (causal_strict_strict delay delay_strict
                              (λ α, D (T (I s) (I α))) _),
  apply (causal_comp_causal _ _ _ derivative_causal),
  apply (causal_comp_causal _ integral_causal _ _),
  apply causal_uncurry_op_fixed, assumption,
end

theorem cycle_incremental (T: operator2 a b b) (hcausal: causal (uncurry_op T)) :
  (λ (s: stream a), fix (λ α, T s (z⁻¹ α)))^Δ =
  λ s, fix (λ α, T^Δ2 s (z⁻¹ α)) :=
begin
  funext s,
  apply fix_unique,
  { -- strictness of the body
    apply cycle_body_incremental_strict, assumption, },
  { -- fixpoint equation
    unfold incremental incremental2,
    rw integral_time_invariant, simp,
    congr' 1,
    apply fix_eq, apply cycle_body_integral_strict; assumption, }
end

lemma incremental_sprod (f: operator (a×b) c) (s1: stream a) (s2: stream b) :
  f^Δ (sprod (s1, s2)) = (λ s1 s2, f (sprod (s1, s2)))^Δ2 s1 s2 :=
begin
  unfold incremental incremental2,
  rw integral_sprod,
end

theorem lifting_cycle_body_strict2 (T: operator2 a b b) (hcausal: causal (uncurry_op T)) :
  ∀ s, strict2 (λ (α : stream (stream b)), ↑²T s (↑↑z⁻¹ α)) :=
begin
  rw causal2 at hcausal,
  intros s,
  intros s1 s2 n t heq,
  apply hcausal, refl,
  intros n' hle,
  by_cases (n' = 0), { subst n', simp, },
  simp,
  rw delay_sub_1, swap, omega,
  rw delay_sub_1, swap, omega,
  apply heq; omega,
end

lemma sum_vals_nested (s: stream (stream a)) (n t: ℕ)  :
  sum_vals s n t = sum_vals (λ n, s n t) n :=
begin
  induction n with n; simp, finish,
end

lemma integral_lift_time_invariant (s: stream (stream a)) :
  I (↑↑z⁻¹ s) = ↑↑z⁻¹ (I s) :=
begin
  funext n t, simp,
  repeat { rw integral_sum_vals },
  rw sum_vals_nested,
  by_cases (t = 0),
  { subst t, simp, rw sum_vals_zero, finish, },
  simp,
  rw delay_linear, simp,
  rw delay_sub_1, swap, omega,
  rw sum_vals_nested,
  congr' 1,
  funext n,
  rw delay_sub_1, omega,
end

lemma lift_integral_lift_time_invariant (s: stream (stream a)) :
  ↑↑I (↑↑z⁻¹ s) = ↑↑z⁻¹ (↑↑I s) :=
begin
  funext n t, simp,
  rw integral_time_invariant,
end

lemma lifting_delay_linear : linear (↑↑(@delay a _)) :=
begin
  apply (lifting_lti _ _).1,
  intros, rw delay_linear,
end

lemma integral_causal_nested' (s1 s2: stream (stream a)) (n t: ℕ)
  (heq: ∀ n' ≤ n, s1 n' t = s2 n' t) :
  I s1 n t = I s2 n t :=
begin
  rw [integral_sum_vals, integral_sum_vals],
  repeat { rw sum_vals_nested }, simp,
  rw heq; try { omega }, simp,
  induction n with n; simp,
  rw heq; try { omega }, simp,
  apply n_ih,
  intros, apply heq; omega,
end

@[simp]
lemma integral_causal_nested : causal_nested (@I (stream a) _) :=
begin
  intros s1 s2 n t heq,
  apply integral_causal_nested',
  intros, apply heq; omega,
end

@[simp]
lemma derivative_causal_nested : causal_nested (@D (stream a) _) :=
begin
  intros s1 s2 n t heq,
  unfold D, simp,
  rw heq, rotate, omega, omega,
  simp,
  unfold delay, split_ifs, simp,
  rw heq; omega,
end

lemma cycle_body_strict2 (T: operator2 a (stream b) (stream b))
  (s: stream a) :
  causal_nested (T s) →
  strict2 (λ α, T s (↑↑z⁻¹ α)) :=
begin
  intros hcausal,
  unfold strict2, intros s1 s2 n t hseq,
  funext t,
  apply hcausal, intros,
  apply lifting_delay_strict2, intros,
  apply hseq; omega,
end

lemma cycle_body_incremental_strict2 (T: operator2 a (stream b) (stream b))
  (s: stream a) :
  causal_nested (T (I s)) →
  strict2 (λ α, T^Δ2 s (↑↑z⁻¹ α)) :=
begin
  intros hcausal,
  unfold incremental2,
  unfold strict2, intros s1 s2 n t hseq,
  funext t,
  apply derivative_causal_nested, intros,
  apply hcausal, intros,
  apply integral_causal_nested, intros,
  apply lifting_delay_strict2, intros,
  apply hseq; omega,
end

theorem lifting_cycle (T: operator2 a b b) (hcausal: causal (uncurry_op T)) :
  ↑↑(λ s, fix (λ α, T s (z⁻¹ α))) = λ s, fix2 (λ α, ↑²T s (↑↑z⁻¹ α)) :=
begin
  funext s,
  apply fix2_unique,
  { apply lifting_cycle_body_strict2, assumption, },
  { funext t, simp,
    apply fix_eq, apply cycle_body_strict, assumption,
   }
end

theorem cycle2_incremental (T: operator2 a (stream b) (stream b))
  (hcausal: ∀ s, causal_nested (T s)) :
  (λ (s: stream a), fix2 (λ α, T s (↑↑z⁻¹ α)))^Δ =
  λ s, fix2 (λ α, T^Δ2 s (↑↑z⁻¹ α)) :=
begin
  funext s,
  apply fix2_unique,
  { -- strictness of the body
    apply (cycle_body_incremental_strict2 T), finish, },
  { -- fixpoint equation
    unfold incremental incremental2,
    rw integral_lift_time_invariant, simp,
    congr' 1,
    apply fix2_eq, apply cycle_body_strict2, finish, },
end

theorem lti_incremental (Q: operator a b) (h: lti Q) :
  Q^Δ = Q :=
begin
  funext s, unfold incremental,
  unfold D,
  rw<- h.2,
  rw<- integral_time_invariant,
  rw<- (linear_sub h.1),
  rw<- (linear_sub integral_linear),
  change (s - z⁻¹ s) with (D s), simp,
end

@[simp]
theorem I_incremental :
  I^Δ = @I a _ :=
begin
  apply lti_incremental,
  apply integral_lti,
end

@[simp]
theorem D_incremental :
  D^Δ = @D a _ :=
begin
  apply lti_incremental,
  apply derivative_lti,
end

theorem delay_lti :
  lti (@delay a _) :=
begin
  split,
  apply delay_linear,
  apply delay_time_invariant,
end

@[simp]
theorem delay_incremental :
  z⁻¹^Δ = @delay a _ :=
begin
  apply lti_incremental,
  apply delay_lti,
end

lemma sprod_time_invariant (T : operator2 a b c)
  (s1 : stream a) (s2 : stream b) :
  ↑(z⁻¹ s1, z⁻¹ s2) = z⁻¹ (↑(s1, s2) : stream (a × b)) :=
begin
  funext t, simp,
  unfold delay,
  split_ifs; simp,
end

lemma time_invariant_map_fst (s: stream (a × b)) (n: ℕ) :
  (z⁻¹ s n).fst = z⁻¹ (λ (n : ℕ), (s n).fst) n :=
begin
  unfold delay,
  split_ifs; simp,
end

lemma time_invariant_map_snd (s: stream (a × b)) (n: ℕ) :
  (z⁻¹ s n).snd = z⁻¹ (λ (n : ℕ), (s n).snd) n :=
begin
  unfold delay,
  split_ifs; simp,
end

lemma time_invariant2 (T: operator2 a b c) :
  time_invariant (uncurry_op T) ↔
  (∀ s1 s2, T (z⁻¹ s1) (z⁻¹ s2) = z⁻¹ (T s1 s2)) :=
begin
  split,
  { intros hti, intros _ _,
    rw (uncurry_op_intro T),
    rw (uncurry_op_intro T),
    rw<- hti,
    congr,
    rw<- (sprod_time_invariant T), },
  { intros h s,
    funext t, simp [uncurry_op, lifting],
    rw<- h,
    congr' 1; funext t,
    { rw time_invariant_map_fst, },
    { rw time_invariant_map_snd, },
  }
end

@[simp]
theorem causal_incremental (Q: operator a b) :
  causal Q →
  causal (Q^Δ) :=
begin
  intros h,
  unfold incremental,
  apply causal_comp_causal, swap, apply derivative_causal,
  apply causal_comp_causal, swap, apply h,
  apply integral_causal,
end

theorem causal_incremental2 (Q: operator2 a b c) :
  causal (uncurry_op Q) →
  causal (λ s, Q^Δ2 (↑↑prod.fst s) (↑↑prod.snd s)) :=
begin
  intros h,
  apply causal_comp_causal, swap, apply derivative_causal,
  rw causal2 at h,
  intros s1 s2 n heq, simp,
  apply h,
  { apply causal_respects_agree_upto, apply integral_causal,
    apply causal_respects_agree_upto, apply lifting_causal,
    assumption,
  },
  { apply causal_respects_agree_upto, apply integral_causal,
    apply causal_respects_agree_upto, apply lifting_causal,
    assumption,
  },
end

@[simp]
theorem causal_nested_incremental
  (Q: operator (stream a) (stream b)) :
  causal_nested Q →
  causal_nested (Q^Δ) :=
begin
  intros h,
  unfold causal_nested, intros,
  rw [incremental_unfold, incremental_unfold],
  apply causal_nested_comp, apply derivative_causal_nested,
  apply h,
  intros,
  apply integral_causal_nested, intros, apply heq; omega,
end

@[simp]
theorem causal_nested_lifting2 {d: Type} [add_comm_group d]
  (f: stream b → stream c → stream d) (g: operator (stream a) (stream b)) (h: operator (stream a) (stream c)) :
  causal (uncurry_op f) →
  causal_nested g →
  causal_nested h →
  causal_nested (λ s, ↑²f (g s) (h s)) :=
begin
  intros hf hg hh,
  intros s1 s2 n t heq, simp,
  rw causal2 at hf,
  apply hf,
  { intros n' hle, apply hg, intros, apply heq; omega },
  { intros n' hle, apply hh, intros, apply heq; omega },
end

@[simp]
theorem causal_nested_lifting2_incremental {d: Type} [add_comm_group d]
  (f: stream b → stream c → stream d) (g: operator (stream a) (stream b)) (h: operator (stream a) (stream c)) :
  causal (uncurry_op f) →
  causal_nested g →
  causal_nested h →
  causal_nested (λ s, ↑²f^Δ2 (g s) (h s)) :=
begin
  intros hf hg hh,
  unfold incremental2,
  apply causal_nested_comp, simp,
  apply causal_nested_lifting2,
  { assumption, },
  { apply causal_nested_comp, simp, assumption, },
  { apply causal_nested_comp, simp, assumption, },
end

@[simp]
theorem causal_lifting2 {d: Type} [add_comm_group d]
  (f: b → c → d) (g: operator a b) (h: operator a c) :
  causal g →
  causal h →
  causal (λ s, ↑²f (g s) (h s)) :=
begin
  intros hg hh,
  intros s1 s2 n heq, simp,
  rw [hg, hh]; assumption,
end

@[simp]
theorem causal_lifting2_incremental {d: Type} [add_comm_group d]
  (f: b → c → d) (g: operator a b) (h: operator a c) :
  causal g →
  causal h →
  causal (λ s, ↑²f^Δ2 (g s) (h s)) :=
begin
  intros hg hh,
  apply causal_comp_causal, swap, simp,
  apply causal_lifting2,
  { apply causal_comp_causal; simp, assumption, },
  { apply causal_comp_causal; simp, assumption, },
end

lemma lifting2_sum (f g: a → b → c) :
  (↑² (λ x y, f x y + g x y)) = ↑²f + ↑²g := rfl.

theorem lifting2_incremental_sum (f g: a → b → c) :
  (↑² (λ x y, f x y + g x y))^Δ2 = ↑²f^Δ2 + ↑²g^Δ2 :=
begin
  unfold incremental2,
  funext s1 s2 t, simp,
  rw lifting2_sum, simp,
  rw derivative_linear, simp,
end

private lemma lifting2_incremental_unfold {d e: Type} [add_comm_group d] [add_comm_group e]
  (f: b → c → d) (g: a → b) (h: e → c) :
  ↑²(λ x y, f (g x) (h y))^Δ2 = λ s1 s2, D (↑²f (↑↑g (I s1)) (↑↑h (I s2))) :=
begin
  refl,
end

lemma lifting2_incremental_comp {d e: Type} [add_comm_group d] [add_comm_group e]
  (f: b → c → d) (g: a → b) (h: e → c) :
  ↑²(λ x y, f (g x) (h y))^Δ2 = λ s1 s2, ↑²f^Δ2 (↑↑g^Δ s1) (↑↑h^Δ s2) :=
begin
  funext s1 s2,
  rw lifting2_incremental_unfold, dsimp,
  rw incremental2_unfold,
  rw D_push2,
  refl,
end

@[simp]
lemma incremental_id :
  incremental (λ (x:stream a), x) = id :=
  by { funext s, rw incremental_unfold, simp, }.

@[simp]
lemma incremental_id' :
  incremental (@id (stream a)) = id :=
  by { funext s, rw incremental_unfold, simp, }.

lemma lifting2_incremental_comp_1' {d: Type} [add_comm_group d]
  (f: b → c → d) (g: a → b) :
  ↑²(λ x, f (g x))^Δ2 = λ s1, ↑²f^Δ2 (↑↑g^Δ s1) :=
begin
  funext s1 s2,
  rw lifting2_incremental_comp, simp,
end

lemma lifting2_incremental_comp_1 {d: Type} [add_comm_group d]
  (f: b → c → d) (g: a → b) :
  ↑²(λ x y, f (g x) y)^Δ2 = λ s1 s2, ↑²f^Δ2 (↑↑g^Δ s1) s2 :=
begin
  simp,
  apply lifting2_incremental_comp_1',
end

lemma lifting2_incremental_comp_2 {d e: Type} [add_comm_group d] [add_comm_group e]
  (f: b → c → d) (h: e → c) :
  ↑²(λ x y, f x (h y))^Δ2 = λ s1 s2, ↑²f^Δ2 s1 (↑↑h^Δ s2) :=
begin
  funext s1 s2,
  rw lifting2_incremental_comp, simp,
end

end groups.

-- This theorem is much more clearly stated using the metavariables a, b, c for
-- terms (to match the paper), so here we instead use α, β, γ for the types.
section bilinear.

variables {α : Type} [add_comm_group α].
variables {β : Type} [add_comm_group β].
variables {γ : Type} [add_comm_group γ].

variable (times: operator2 α β γ).

-- write times a b as a ** b for this section
-- NOTE: this isn't printed, sadly
local notation a ` ** `:70 b:70 := times a b.

local attribute [simp] derivative_integral integral_derivative.

def times_incremental : stream α → stream β → stream γ :=
  λ a b, a ** b + I (z⁻¹ a) ** b + a ** I (z⁻¹ b).

theorem bilinear_incremental  :
  time_invariant (uncurry_op times) →
  bilinear times →
  times^Δ2 = times_incremental times :=
begin
  intros hti hbil, funext a b,
  -- this calculation is almost a transcription of the paper proof in
  -- https://github.com/vmware/database-stream-processor/blob/main/doc/spec.pdf
  calc times^Δ2 a b = D (I a ** I b) : by refl
      ... = I a ** I b - z⁻¹ (I a ** I b) : by refl
      ... = I a ** I b - z⁻¹ (I a) ** z⁻¹ (I b) : by {
              rw (time_invariant2 _).mp hti
            }
      ... = I a ** I b - z⁻¹ (I a) ** z⁻¹ (I b)
                + z⁻¹ (I a) ** I b - z⁻¹ (I a) ** I b : by { abel }
      ... = D (I a) ** I b + z⁻¹ (I a) ** D (I b) : by {
              unfold D,
              rw (bilinear_sub_1 hbil),
              rw (bilinear_sub_2 hbil), abel,
            }
      ... = a ** I b + z⁻¹ (I a) ** b : by simp
      ... = a ** I b - a ** z⁻¹ (I b) + a ** z⁻¹ (I b)
            + z⁻¹ (I a) ** b : by abel
      ... = a ** D (I b) + a ** z⁻¹ (I b) + z⁻¹ (I a) ** b : by {
              unfold D,
              rw (bilinear_sub_2 hbil),
            }
      ... = a ** b + z⁻¹ (I a) ** b + a ** z⁻¹ (I b) : by { simp, abel, }
      -- this one extra step is needed that the paper skips over
      ... = a ** b + I (z⁻¹ a) ** b + a ** I (z⁻¹ b) : by {
              repeat { rw integral_time_invariant },
           },
end

-- NOTE: this is a much simpler proof than the one in the paper
theorem bilinear_incremental_forward_proof :
  time_invariant (uncurry_op times) →
  bilinear times →
  ∀ a b, times^Δ2 a b =
  a ** b + I (z⁻¹ a) ** b + a ** I (z⁻¹ b) :=
begin
  intros hti hbil a b,
  unfold incremental2 D,
  -- we're just going to expand (I a) and (I b) in the first occurrence
  conv {
    find (times (I a) (I b)) {
      rw [integral_unfold a, integral_unfold b]
    }
  },
  -- push delays as far inward as possible
  rw<- (time_invariant2 _).mp hti,
  repeat { rw<- integral_time_invariant },
  -- and now we can expand using bilinearity
  repeat { rw hbil.1 <|> rw hbil.2 },
  abel,
end

-- variant of [bilinear_incremental_forward_proof] written with [conv] so the
-- proof itself is readable
theorem bilinear_incremental_short_paper_proof  :
  time_invariant (uncurry_op times) →
  bilinear times →
  ∀ a b, times^Δ2 a b =
  a ** b + I (z⁻¹ a) ** b + a ** I (z⁻¹ b) :=
begin
  intros hti hbil a b,
  calc times^Δ2 a b = D (I a ** I b) : by refl
      ... = I a ** I b - z⁻¹ (I a ** I b) : by refl
      ... = I a ** I b - z⁻¹ (I a) ** z⁻¹ (I b) : by {
        rw<- (time_invariant2 _).mp hti,
      }
      ... = (a + z⁻¹ (I a)) ** (b + z⁻¹ (I b)) - z⁻¹ (I a) ** z⁻¹ (I b) : by {
          congr' 1,
          conv_lhs {
            find (times (I a) (I b)) {
              rw [integral_unfold a, integral_unfold b]
            }
          },
      }
      ... = a ** b + z⁻¹ (I a) ** b + a ** z⁻¹ (I b) + z⁻¹ (I a) ** z⁻¹ (I b)
                - z⁻¹ (I a) ** z⁻¹ (I b) : by {
              -- bilinearity to distribute (a + b) × (c + d)
              rw [hbil.2, hbil.1, hbil.1],
              abel,
            }
      ... = a ** b + z⁻¹ (I a) ** b + a ** z⁻¹ (I b) : by {
              -- cancel terms
              abel,
            }
      ... = a ** b + I (z⁻¹ a) ** b + a ** I (z⁻¹ b) : by {
          rw [integral_time_invariant, integral_time_invariant],
      },
end

end bilinear.

attribute [irreducible] incremental incremental2.

-- #lint only doc_blame simp_nf


import M4R.Algebra.Group.GMorphism

namespace M4R

  section Map

    instance MapZero (α : Type _) (β : Type _) [Zero β] : Zero (α → β) where zero := fun _ => 0

    protected theorem MapZero.def {α : Type _} {β : Type _} [Zero β] (a : α) :
      (0 : α → β) a = 0 := rfl

    instance MapAdd (α : Type _) (β : Type _) [Monoid β] : Add (α → β) where add := fun x y a => x a + y a

    protected theorem MapAdd.def {α : Type _} {β : Type _} [Monoid β] {x y : α → β} (a : α) :
      (x + y) a = x a + y a := rfl

    instance MapMonoid (α : Type _) (β : Type _) [Monoid β] : Monoid (α → β) where
      add_zero := fun x => funext fun _ => Monoid.add_zero _
      zero_add := fun x => funext fun a => by conv => rhs rw [←Monoid.zero_add (x a)]
      add_assoc := fun x y z => funext fun a => Monoid.add_assoc _ _ _

    instance MapCommMonoid (α : Type _) (β : Type _) [CommMonoid β] : CommMonoid (α → β) where
      add_comm := fun x y => funext fun a => CommMonoid.add_comm _ _

    instance MapNeg (α : Type _) (β : Type _) [Group β] : Neg (α → β) where neg := fun x a => - x a

    protected theorem MapNeg.def {α : Type _} {β : Type _} [Group β] {x : α → β} (a : α) :
      (- x) a = - x a := rfl

    instance MapGroup (α : Type _) (β : Type _) [Group β] : Group (α → β) where
      add_neg := fun _ => funext fun _ => Group.add_neg _

    instance MapAbelianGroup (α : Type _) (β : Type _) [AbelianGroup β] : AbelianGroup (α → β) where
      add_comm := (MapCommMonoid α β).add_comm

  end Map

  section MHomomorphism

    instance MHomomorphismZero (α : Type _) (β : Type _) [Monoid α] [Monoid β] : Zero (α →₊ β) where
      zero := {
        hom           := 0
        preserve_zero := rfl
        preserve_add  := by intros; simp only [MapZero.def, Monoid.add_zero]
      }

    protected theorem MHomomorphismZero.def {α : Type _} {β : Type _} [Monoid α] [Monoid β] (a : α) :
      (0 : α →₊ β) a = 0 := rfl

    instance MHomomorphismAdd (α : Type _) (β : Type _) [Monoid α] [CommMonoid β] : Add (α →₊ β) where
      add := fun x y => {
        hom := x.hom + y.hom
        preserve_zero := by rw [MapAdd.def, x.preserve_zero, y.preserve_zero, Monoid.add_zero]
        preserve_add := by
          intros; simp only [MapAdd.def]
          rw [x.preserve_add, y.preserve_add, ←Monoid.add_assoc, ←Monoid.add_assoc,
            CommMonoid.add_right_comm (x _)]
      }

    protected theorem MHomomorphismAdd.def {α : Type _} {β : Type _} [Monoid α] [CommMonoid β] {x y : α →₊ β} (a : α) :
      (x + y) a = x a + y a := rfl

    instance MHomomorphismCommMonoid (α : Type _) (β : Type _) [Monoid α] [CommMonoid β] : CommMonoid (α →₊ β) where
      add_zero := fun x => by
        apply MHomomorphism.ext.mpr; apply funext; intro a
        rw [MHomomorphismAdd.def, MHomomorphismZero.def]; exact Monoid.add_zero _
      zero_add := fun x => by
        apply MHomomorphism.ext.mpr; apply funext; intro a
        rw [MHomomorphismAdd.def, MHomomorphismZero.def]; exact Monoid.zero_add _
      add_assoc := fun x y z => by
        apply MHomomorphism.ext.mpr; apply funext; intro a
        simp only [MHomomorphismAdd.def]; exact Monoid.add_assoc _ _ _
      add_comm := fun x y => by
        apply MHomomorphism.ext.mpr; apply funext; intro a
        simp only [MHomomorphismAdd.def]; exact CommMonoid.add_comm _ _

  end MHomomorphism

  section GHomomorphism

    instance GHomomorphismZero (α : Type _) (β : Type _) [Group α] [AbelianGroup β] : Zero (α →₋ β) where
      zero := {
        toMHomomorphism := 0
        preserve_neg := by
          intros; simp only [MHomomorphismZero.def]; exact Group.neg_zero.symm
      }

    protected theorem GHomomorphismZero.def {α : Type _} {β : Type _} [Group α] [AbelianGroup β] (a : α) :
      (0 : α →₋ β) a = 0 := rfl

    instance GHomomorphismAdd (α : Type _) (β : Type _) [Group α] [AbelianGroup β] : Add (α →₋ β) where
      add := fun x y => {
        toMHomomorphism := x.toMHomomorphism + y.toMHomomorphism
        preserve_neg := by
          intros; simp only [MHomomorphismAdd.def]
          rw [x.preserve_neg, y.preserve_neg, AbelianGroup.neg_add_distrib]
      }

    protected theorem GHomomorphismAdd.def {α : Type _} {β : Type _} [Group α] [AbelianGroup β] {x y : α →₋ β} (a : α) :
      (x + y) a = x a + y a := rfl

    instance GHomomorphismNeg (α : Type _) (β : Type _) [Group α] [AbelianGroup β] : Neg (α →₋ β) where
      neg := fun x => {
        hom := -x.hom
        preserve_zero := by rw [MapNeg.def, x.preserve_zero]; exact Group.neg_zero
        preserve_add := by intros; simp only [MapNeg.def]; rw [x.preserve_add, AbelianGroup.neg_add_distrib]
        preserve_neg := by intros; simp only [MapNeg.def]; rw [x.preserve_neg]
      }

    protected theorem GHomomorphismNeg.def {α : Type _} {β : Type _} [Group α] [AbelianGroup β] {x : α →₋ β} (a : α) :
      (-x) a = - x a := rfl

    instance GHomomorphismAbelianGroup (α : Type _) (β : Type _) [Group α] [AbelianGroup β] : AbelianGroup (α →₋ β) where
      add_zero := fun x => by
        apply GHomomorphism.ext.mpr; apply funext; intro a
        rw [GHomomorphismAdd.def, GHomomorphismZero.def]; exact Monoid.add_zero _
      zero_add := fun x => by
        apply GHomomorphism.ext.mpr; apply funext; intro a
        rw [GHomomorphismAdd.def, GHomomorphismZero.def]; exact Monoid.zero_add _
      add_assoc := fun x y z => by
        apply GHomomorphism.ext.mpr; exact Monoid.add_assoc _ _ _
      add_comm := fun x y => by
        apply GHomomorphism.ext.mpr; exact CommMonoid.add_comm _ _
      add_neg := fun x => by
        apply GHomomorphism.ext.mpr; apply funext; intro a
        rw [GHomomorphismAdd.def, GHomomorphismNeg.def, GHomomorphismZero.def]; exact Group.add_neg _

  end GHomomorphism

end M4R


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.ordinal
import Mathlib.PostPort

universes u_1 u_2 u u_3 v

namespace Mathlib

/-!
# Ordinal arithmetic

Ordinals have an addition (corresponding to disjoint union) that turns them into an additive
monoid, and a multiplication (corresponding to the lexicographic order on the product) that turns
them into a monoid. One can also define correspondingly a subtraction, a division, a successor
function, a power function and a logarithm function.

We also define limit ordinals and prove the basic induction principle on ordinals separating
successor ordinals and limit ordinals, in `limit_rec_on`.

## Main definitions and results

* `o₁ + o₂` is the order on the disjoint union of `o₁` and `o₂` obtained by declaring that
  every element of `o₁` is smaller than every element of `o₂`.
* `o₁ - o₂` is the unique ordinal `o` such that `o₂ + o = o₁`, when `o₂ ≤ o₁`.
* `o₁ * o₂` is the lexicographic order on `o₂ × o₁`.
* `o₁ / o₂` is the ordinal `o` such that `o₁ = o₂ * o + o'` with `o' < o₂`. We also define the
  divisibility predicate, and a modulo operation.
* `succ o = o + 1` is the successor of `o`.
* `pred o` if the predecessor of `o`. If `o` is not a successor, we set `pred o = o`.

We also define the power function and the logarithm function on ordinals, and discuss the properties
of casts of natural numbers of and of `omega` with respect to these operations.

Some properties of the operations are also used to discuss general tools on ordinals:

* `is_limit o`: an ordinal is a limit ordinal if it is neither `0` nor a successor.
* `limit_rec_on` is the main induction principle of ordinals: if one can prove a property by
  induction at successor ordinals and at limit ordinals, then it holds for all ordinals.

* `is_normal`: a function `f : ordinal → ordinal` satisfies `is_normal` if it is strictly increasing
  and order-continuous, i.e., the image `f o` of a limit ordinal `o` is the sup of `f a` for
  `a < o`.
* `nfp f a`: the next fixed point of a function `f` on ordinals, above `a`. It behaves well
  for normal functions.

* `CNF b o` is the Cantor normal form of the ordinal `o` in base `b`.

* `sup`: the supremum of an indexed family of ordinals in `Type u`, as an ordinal in `Type u`.
* `bsup`: the supremum of a set of ordinals indexed by ordinals less than a given ordinal `o`.
-/

namespace ordinal

/-! ### Further properties of addition on ordinals -/

@[simp] theorem lift_add (a : ordinal) (b : ordinal) : lift (a + b) = lift a + lift b := sorry

@[simp] theorem lift_succ (a : ordinal) : lift (succ a) = succ (lift a) := sorry

theorem add_le_add_iff_left (a : ordinal) {b : ordinal} {c : ordinal} : a + b ≤ a + c ↔ b ≤ c := sorry

theorem add_succ (o₁ : ordinal) (o₂ : ordinal) : o₁ + succ o₂ = succ (o₁ + o₂) :=
  Eq.symm (add_assoc o₁ o₂ 1)

@[simp] theorem succ_zero : succ 0 = 1 :=
  zero_add 1

theorem one_le_iff_pos {o : ordinal} : 1 ≤ o ↔ 0 < o :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 ≤ o ↔ 0 < o)) (Eq.symm succ_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (succ 0 ≤ o ↔ 0 < o)) (propext succ_le))) (iff.refl (0 < o)))

theorem one_le_iff_ne_zero {o : ordinal} : 1 ≤ o ↔ o ≠ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 ≤ o ↔ o ≠ 0)) (propext one_le_iff_pos)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 < o ↔ o ≠ 0)) (propext ordinal.pos_iff_ne_zero))) (iff.refl (o ≠ 0)))

theorem succ_pos (o : ordinal) : 0 < succ o :=
  lt_of_le_of_lt (ordinal.zero_le o) (lt_succ_self o)

theorem succ_ne_zero (o : ordinal) : succ o ≠ 0 :=
  ne_of_gt (succ_pos o)

@[simp] theorem card_succ (o : ordinal) : card (succ o) = card o + 1 := sorry

theorem nat_cast_succ (n : ℕ) : succ ↑n = ↑(Nat.succ n) :=
  rfl

theorem add_left_cancel (a : ordinal) {b : ordinal} {c : ordinal} : a + b = a + c ↔ b = c := sorry

theorem lt_succ {a : ordinal} {b : ordinal} : a < succ b ↔ a ≤ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a < succ b ↔ a ≤ b)) (Eq.symm (propext not_le))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬succ b ≤ a ↔ a ≤ b)) (propext succ_le)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (¬b < a ↔ a ≤ b)) (propext not_lt))) (iff.refl (a ≤ b))))

theorem add_lt_add_iff_left (a : ordinal) {b : ordinal} {c : ordinal} : a + b < a + c ↔ b < c := sorry

theorem lt_of_add_lt_add_right {a : ordinal} {b : ordinal} {c : ordinal} : a + b < c + b → a < c :=
  lt_imp_lt_of_le_imp_le fun (h : c ≤ a) => add_le_add_right h b

@[simp] theorem succ_lt_succ {a : ordinal} {b : ordinal} : succ a < succ b ↔ a < b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (succ a < succ b ↔ a < b)) (propext lt_succ)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (succ a ≤ b ↔ a < b)) (propext succ_le))) (iff.refl (a < b)))

@[simp] theorem succ_le_succ {a : ordinal} {b : ordinal} : succ a ≤ succ b ↔ a ≤ b :=
  iff.mpr le_iff_le_iff_lt_iff_lt succ_lt_succ

theorem succ_inj {a : ordinal} {b : ordinal} : succ a = succ b ↔ a = b := sorry

theorem add_le_add_iff_right {a : ordinal} {b : ordinal} (n : ℕ) : a + ↑n ≤ b + ↑n ↔ a ≤ b := sorry

theorem add_right_cancel {a : ordinal} {b : ordinal} (n : ℕ) : a + ↑n = b + ↑n ↔ a = b := sorry

/-! ### The zero ordinal -/

@[simp] theorem card_eq_zero {o : ordinal} : card o = 0 ↔ o = 0 := sorry

theorem type_ne_zero_iff_nonempty {α : Type u_1} {r : α → α → Prop} [is_well_order α r] : type r ≠ 0 ↔ Nonempty α :=
  iff.trans (iff.symm (not_congr card_eq_zero)) cardinal.ne_zero_iff_nonempty

@[simp] theorem type_eq_zero_iff_empty {α : Type u_1} {r : α → α → Prop} [is_well_order α r] : type r = 0 ↔ ¬Nonempty α :=
  iff.symm (iff.mp not_iff_comm type_ne_zero_iff_nonempty)

protected theorem one_ne_zero : 1 ≠ 0 :=
  iff.mpr type_ne_zero_iff_nonempty (Nonempty.intro PUnit.unit)

protected instance nontrivial : nontrivial ordinal :=
  nontrivial.mk (Exists.intro 1 (Exists.intro 0 ordinal.one_ne_zero))

theorem zero_lt_one : 0 < 1 :=
  iff.mpr lt_iff_le_and_ne { left := ordinal.zero_le 1, right := ne.symm ordinal.one_ne_zero }

/-! ### The predecessor of an ordinal -/

/-- The ordinal predecessor of `o` is `o'` if `o = succ o'`,
  and `o` otherwise. -/
def pred (o : ordinal) : ordinal :=
  dite (∃ (a : ordinal), o = succ a) (fun (h : ∃ (a : ordinal), o = succ a) => classical.some h)
    fun (h : ¬∃ (a : ordinal), o = succ a) => o

@[simp] theorem pred_succ (o : ordinal) : pred (succ o) = o := sorry

theorem pred_le_self (o : ordinal) : pred o ≤ o := sorry

theorem pred_eq_iff_not_succ {o : ordinal} : pred o = o ↔ ¬∃ (a : ordinal), o = succ a := sorry

theorem pred_lt_iff_is_succ {o : ordinal} : pred o < o ↔ ∃ (a : ordinal), o = succ a := sorry

theorem succ_pred_iff_is_succ {o : ordinal} : succ (pred o) = o ↔ ∃ (a : ordinal), o = succ a := sorry

theorem succ_lt_of_not_succ {o : ordinal} (h : ¬∃ (a : ordinal), o = succ a) {b : ordinal} : succ b < o ↔ b < o :=
  { mp := lt_trans (lt_succ_self b),
    mpr := fun (l : b < o) => lt_of_le_of_ne (iff.mpr succ_le l) fun (e : succ b = o) => h (Exists.intro b (Eq.symm e)) }

theorem lt_pred {a : ordinal} {b : ordinal} : a < pred b ↔ succ a < b := sorry

theorem pred_le {a : ordinal} {b : ordinal} : pred a ≤ b ↔ a ≤ succ b :=
  iff.mpr le_iff_le_iff_lt_iff_lt lt_pred

@[simp] theorem lift_is_succ {o : ordinal} : (∃ (a : ordinal), lift o = succ a) ↔ ∃ (a : ordinal), o = succ a := sorry

@[simp] theorem lift_pred (o : ordinal) : lift (pred o) = pred (lift o) := sorry

/-! ### Limit ordinals -/

/-- A limit ordinal is an ordinal which is not zero and not a successor. -/
def is_limit (o : ordinal) :=
  o ≠ 0 ∧ ∀ (a : ordinal), a < o → succ a < o

theorem not_zero_is_limit : ¬is_limit 0 :=
  fun (ᾰ : is_limit 0) =>
    and.dcases_on ᾰ fun (ᾰ_left : 0 ≠ 0) (ᾰ_right : ∀ (a : ordinal), a < 0 → succ a < 0) => idRhs False (ᾰ_left rfl)

theorem not_succ_is_limit (o : ordinal) : ¬is_limit (succ o) := sorry

theorem not_succ_of_is_limit {o : ordinal} (h : is_limit o) : ¬∃ (a : ordinal), o = succ a :=
  fun (ᾰ : ∃ (a : ordinal), o = succ a) =>
    Exists.dcases_on ᾰ fun (ᾰ_w : ordinal) (ᾰ_h : o = succ ᾰ_w) => idRhs False (not_succ_is_limit ᾰ_w (ᾰ_h ▸ h))

theorem succ_lt_of_is_limit {o : ordinal} (h : is_limit o) {a : ordinal} : succ a < o ↔ a < o :=
  { mp := lt_trans (lt_succ_self a), mpr := and.right h a }

theorem le_succ_of_is_limit {o : ordinal} (h : is_limit o) {a : ordinal} : o ≤ succ a ↔ o ≤ a :=
  iff.mpr le_iff_le_iff_lt_iff_lt (succ_lt_of_is_limit h)

theorem limit_le {o : ordinal} (h : is_limit o) {a : ordinal} : o ≤ a ↔ ∀ (x : ordinal), x < o → x ≤ a := sorry

theorem lt_limit {o : ordinal} (h : is_limit o) {a : ordinal} : a < o ↔ ∃ (x : ordinal), ∃ (H : x < o), a < x := sorry

@[simp] theorem lift_is_limit (o : ordinal) : is_limit (lift o) ↔ is_limit o := sorry

theorem is_limit.pos {o : ordinal} (h : is_limit o) : 0 < o :=
  lt_of_le_of_ne (ordinal.zero_le o) (ne.symm (and.left h))

theorem is_limit.one_lt {o : ordinal} (h : is_limit o) : 1 < o := sorry

theorem is_limit.nat_lt {o : ordinal} (h : is_limit o) (n : ℕ) : ↑n < o := sorry

theorem zero_or_succ_or_limit (o : ordinal) : o = 0 ∨ (∃ (a : ordinal), o = succ a) ∨ is_limit o := sorry

/-- Main induction principle of ordinals: if one can prove a property by
  induction at successor ordinals and at limit ordinals, then it holds for all ordinals. -/
def limit_rec_on {C : ordinal → Sort u_2} (o : ordinal) (H₁ : C 0) (H₂ : (o : ordinal) → C o → C (succ o)) (H₃ : (o : ordinal) → is_limit o → ((o' : ordinal) → o' < o → C o') → C o) : C o :=
  well_founded.fix wf
    (fun (o : ordinal) (IH : (y : ordinal) → y < o → C y) =>
      dite (o = 0) (fun (o0 : o = 0) => eq.mpr sorry H₁)
        fun (o0 : ¬o = 0) =>
          dite (∃ (a : ordinal), o = succ a)
            (fun (h : ∃ (a : ordinal), o = succ a) => eq.mpr sorry (H₂ (pred o) (IH (pred o) sorry)))
            fun (h : ¬∃ (a : ordinal), o = succ a) => H₃ o sorry IH)
    o

@[simp] theorem limit_rec_on_zero {C : ordinal → Sort u_2} (H₁ : C 0) (H₂ : (o : ordinal) → C o → C (succ o)) (H₃ : (o : ordinal) → is_limit o → ((o' : ordinal) → o' < o → C o') → C o) : limit_rec_on 0 H₁ H₂ H₃ = H₁ := sorry

@[simp] theorem limit_rec_on_succ {C : ordinal → Sort u_2} (o : ordinal) (H₁ : C 0) (H₂ : (o : ordinal) → C o → C (succ o)) (H₃ : (o : ordinal) → is_limit o → ((o' : ordinal) → o' < o → C o') → C o) : limit_rec_on (succ o) H₁ H₂ H₃ = H₂ o (limit_rec_on o H₁ H₂ H₃) := sorry

@[simp] theorem limit_rec_on_limit {C : ordinal → Sort u_2} (o : ordinal) (H₁ : C 0) (H₂ : (o : ordinal) → C o → C (succ o)) (H₃ : (o : ordinal) → is_limit o → ((o' : ordinal) → o' < o → C o') → C o) (h : is_limit o) : limit_rec_on o H₁ H₂ H₃ = H₃ o h fun (x : ordinal) (h : x < o) => limit_rec_on x H₁ H₂ H₃ := sorry

theorem has_succ_of_is_limit {α : Type u_1} {r : α → α → Prop} [wo : is_well_order α r] (h : is_limit (type r)) (x : α) : ∃ (y : α), r x y := sorry

theorem type_subrel_lt (o : ordinal) : type (subrel Less (set_of fun (o' : ordinal) => o' < o)) = lift o := sorry

theorem mk_initial_seg (o : ordinal) : cardinal.mk ↥(set_of fun (o' : ordinal) => o' < o) = cardinal.lift (card o) := sorry

/-! ### Normal ordinal functions -/

/-- A normal ordinal function is a strictly increasing function which is
  order-continuous, i.e., the image `f o` of a limit ordinal `o` is the sup of `f a` for
  `a < o`.  -/
def is_normal (f : ordinal → ordinal) :=
  (∀ (o : ordinal), f o < f (succ o)) ∧
    ∀ (o : ordinal), is_limit o → ∀ (a : ordinal), f o ≤ a ↔ ∀ (b : ordinal), b < o → f b ≤ a

theorem is_normal.limit_le {f : ordinal → ordinal} (H : is_normal f) {o : ordinal} : is_limit o → ∀ {a : ordinal}, f o ≤ a ↔ ∀ (b : ordinal), b < o → f b ≤ a :=
  and.right H

theorem is_normal.limit_lt {f : ordinal → ordinal} (H : is_normal f) {o : ordinal} (h : is_limit o) {a : ordinal} : a < f o ↔ ∃ (b : ordinal), ∃ (H : b < o), a < f b := sorry

theorem is_normal.lt_iff {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} {b : ordinal} : f a < f b ↔ a < b := sorry

theorem is_normal.le_iff {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} {b : ordinal} : f a ≤ f b ↔ a ≤ b :=
  iff.mpr le_iff_le_iff_lt_iff_lt (is_normal.lt_iff H)

theorem is_normal.inj {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} {b : ordinal} : f a = f b ↔ a = b := sorry

theorem is_normal.le_self {f : ordinal → ordinal} (H : is_normal f) (a : ordinal) : a ≤ f a := sorry

theorem is_normal.le_set {f : ordinal → ordinal} (H : is_normal f) (p : ordinal → Prop) (p0 : ∃ (x : ordinal), p x) (S : ordinal) (H₂ : ∀ (o : ordinal), S ≤ o ↔ ∀ (a : ordinal), p a → a ≤ o) {o : ordinal} : f S ≤ o ↔ ∀ (a : ordinal), p a → f a ≤ o := sorry

theorem is_normal.le_set' {α : Type u_1} {f : ordinal → ordinal} (H : is_normal f) (p : α → Prop) (g : α → ordinal) (p0 : ∃ (x : α), p x) (S : ordinal) (H₂ : ∀ (o : ordinal), S ≤ o ↔ ∀ (a : α), p a → g a ≤ o) {o : ordinal} : f S ≤ o ↔ ∀ (a : α), p a → f (g a) ≤ o := sorry

theorem is_normal.refl : is_normal id :=
  { left := fun (x : ordinal) => lt_succ_self (id x),
    right := fun (o : ordinal) (l : is_limit o) (a : ordinal) => limit_le l }

theorem is_normal.trans {f : ordinal → ordinal} {g : ordinal → ordinal} (H₁ : is_normal f) (H₂ : is_normal g) : is_normal fun (x : ordinal) => f (g x) := sorry

theorem is_normal.is_limit {f : ordinal → ordinal} (H : is_normal f) {o : ordinal} (l : is_limit o) : is_limit (f o) := sorry

theorem add_le_of_limit {a : ordinal} {b : ordinal} {c : ordinal} (h : is_limit b) : a + b ≤ c ↔ ∀ (b' : ordinal), b' < b → a + b' ≤ c := sorry

theorem add_is_normal (a : ordinal) : is_normal (Add.add a) :=
  { left := fun (b : ordinal) => iff.mpr (add_lt_add_iff_left a) (lt_succ_self b),
    right := fun (b : ordinal) (l : is_limit b) (c : ordinal) => add_le_of_limit l }

theorem add_is_limit (a : ordinal) {b : ordinal} : is_limit b → is_limit (a + b) :=
  is_normal.is_limit (add_is_normal a)

/-! ### Subtraction on ordinals-/

/-- `a - b` is the unique ordinal satisfying
  `b + (a - b) = a` when `b ≤ a`. -/
def sub (a : ordinal) (b : ordinal) : ordinal :=
  omin (set_of fun (o : ordinal) => a ≤ b + o) sorry

protected instance has_sub : Sub ordinal :=
  { sub := sub }

theorem le_add_sub (a : ordinal) (b : ordinal) : a ≤ b + (a - b) :=
  omin_mem (set_of fun (o : ordinal) => a ≤ b + o) (sub._proof_1 a b)

theorem sub_le {a : ordinal} {b : ordinal} {c : ordinal} : a - b ≤ c ↔ a ≤ b + c :=
  { mp := fun (h : a - b ≤ c) => le_trans (le_add_sub a b) (add_le_add_left h b),
    mpr := fun (h : a ≤ b + c) => omin_le h }

theorem lt_sub {a : ordinal} {b : ordinal} {c : ordinal} : a < b - c ↔ c + a < b :=
  lt_iff_lt_of_le_iff_le sub_le

theorem add_sub_cancel (a : ordinal) (b : ordinal) : a + b - a = b :=
  le_antisymm (iff.mpr sub_le (le_refl (a + b))) (iff.mp (add_le_add_iff_left a) (le_add_sub (a + b) a))

theorem sub_eq_of_add_eq {a : ordinal} {b : ordinal} {c : ordinal} (h : a + b = c) : c - a = b :=
  h ▸ add_sub_cancel a b

theorem sub_le_self (a : ordinal) (b : ordinal) : a - b ≤ a :=
  iff.mpr sub_le (le_add_left a b)

theorem add_sub_cancel_of_le {a : ordinal} {b : ordinal} (h : b ≤ a) : b + (a - b) = a := sorry

@[simp] theorem sub_zero (a : ordinal) : a - 0 = a := sorry

@[simp] theorem zero_sub (a : ordinal) : 0 - a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 - a = 0)) (Eq.symm (propext ordinal.le_zero)))) (sub_le_self 0 a)

@[simp] theorem sub_self (a : ordinal) : a - a = 0 := sorry

theorem sub_eq_zero_iff_le {a : ordinal} {b : ordinal} : a - b = 0 ↔ a ≤ b := sorry

theorem sub_sub (a : ordinal) (b : ordinal) (c : ordinal) : a - b - c = a - (b + c) := sorry

theorem add_sub_add_cancel (a : ordinal) (b : ordinal) (c : ordinal) : a + b - (a + c) = b - c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b - (a + c) = b - c)) (Eq.symm (sub_sub (a + b) a c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b - a - c = b - c)) (add_sub_cancel a b))) (Eq.refl (b - c)))

theorem sub_is_limit {a : ordinal} {b : ordinal} (l : is_limit a) (h : b < a) : is_limit (a - b) := sorry

@[simp] theorem one_add_omega : 1 + omega = omega := sorry

@[simp] theorem one_add_of_omega_le {o : ordinal} (h : omega ≤ o) : 1 + o = o := sorry

/-! ### Multiplication of ordinals-/

/-- The multiplication of ordinals `o₁` and `o₂` is the (well founded) lexicographic order on
`o₂ × o₁`. -/
protected instance monoid : monoid ordinal :=
  monoid.mk (fun (a b : ordinal) => quotient.lift_on₂ a b (fun (_x : Well_order) => sorry) sorry) sorry 1 sorry sorry

@[simp] theorem type_mul {α : Type u} {β : Type u} (r : α → α → Prop) (s : β → β → Prop) [is_well_order α r] [is_well_order β s] : type r * type s = type (prod.lex s r) :=
  rfl

@[simp] theorem lift_mul (a : ordinal) (b : ordinal) : lift (a * b) = lift a * lift b := sorry

@[simp] theorem card_mul (a : ordinal) (b : ordinal) : card (a * b) = card a * card b := sorry

@[simp] theorem mul_zero (a : ordinal) : a * 0 = 0 := sorry

@[simp] theorem zero_mul (a : ordinal) : 0 * a = 0 := sorry

theorem mul_add (a : ordinal) (b : ordinal) (c : ordinal) : a * (b + c) = a * b + a * c := sorry

@[simp] theorem mul_add_one (a : ordinal) (b : ordinal) : a * (b + 1) = a * b + a := sorry

@[simp] theorem mul_succ (a : ordinal) (b : ordinal) : a * succ b = a * b + a :=
  mul_add_one a b

theorem mul_le_mul_left {a : ordinal} {b : ordinal} (c : ordinal) : a ≤ b → c * a ≤ c * b := sorry

theorem mul_le_mul_right {a : ordinal} {b : ordinal} (c : ordinal) : a ≤ b → a * c ≤ b * c := sorry

theorem mul_le_mul {a : ordinal} {b : ordinal} {c : ordinal} {d : ordinal} (h₁ : a ≤ c) (h₂ : b ≤ d) : a * b ≤ c * d :=
  le_trans (mul_le_mul_left a h₂) (mul_le_mul_right d h₁)

theorem mul_le_of_limit {a : ordinal} {b : ordinal} {c : ordinal} (h : is_limit b) : a * b ≤ c ↔ ∀ (b' : ordinal), b' < b → a * b' ≤ c := sorry

theorem mul_is_normal {a : ordinal} (h : 0 < a) : is_normal (Mul.mul a) := sorry

theorem lt_mul_of_limit {a : ordinal} {b : ordinal} {c : ordinal} (h : is_limit c) : a < b * c ↔ ∃ (c' : ordinal), ∃ (H : c' < c), a < b * c' := sorry

theorem mul_lt_mul_iff_left {a : ordinal} {b : ordinal} {c : ordinal} (a0 : 0 < a) : a * b < a * c ↔ b < c :=
  is_normal.lt_iff (mul_is_normal a0)

theorem mul_le_mul_iff_left {a : ordinal} {b : ordinal} {c : ordinal} (a0 : 0 < a) : a * b ≤ a * c ↔ b ≤ c :=
  is_normal.le_iff (mul_is_normal a0)

theorem mul_lt_mul_of_pos_left {a : ordinal} {b : ordinal} {c : ordinal} (h : a < b) (c0 : 0 < c) : c * a < c * b :=
  iff.mpr (mul_lt_mul_iff_left c0) h

theorem mul_pos {a : ordinal} {b : ordinal} (h₁ : 0 < a) (h₂ : 0 < b) : 0 < a * b := sorry

theorem mul_ne_zero {a : ordinal} {b : ordinal} : a ≠ 0 → b ≠ 0 → a * b ≠ 0 := sorry

theorem le_of_mul_le_mul_left {a : ordinal} {b : ordinal} {c : ordinal} (h : c * a ≤ c * b) (h0 : 0 < c) : a ≤ b :=
  le_imp_le_of_lt_imp_lt (fun (h' : b < a) => mul_lt_mul_of_pos_left h' h0) h

theorem mul_right_inj {a : ordinal} {b : ordinal} {c : ordinal} (a0 : 0 < a) : a * b = a * c ↔ b = c :=
  is_normal.inj (mul_is_normal a0)

theorem mul_is_limit {a : ordinal} {b : ordinal} (a0 : 0 < a) : is_limit b → is_limit (a * b) :=
  is_normal.is_limit (mul_is_normal a0)

theorem mul_is_limit_left {a : ordinal} {b : ordinal} (l : is_limit a) (b0 : 0 < b) : is_limit (a * b) := sorry

/-! ### Division on ordinals -/

protected theorem div_aux (a : ordinal) (b : ordinal) (h : b ≠ 0) : set.nonempty (set_of fun (o : ordinal) => a < b * succ o) := sorry

/-- `a / b` is the unique ordinal `o` satisfying
  `a = b * o + o'` with `o' < b`. -/
protected def div (a : ordinal) (b : ordinal) : ordinal :=
  dite (b = 0) (fun (h : b = 0) => 0)
    fun (h : ¬b = 0) => omin (set_of fun (o : ordinal) => a < b * succ o) (ordinal.div_aux a b h)

protected instance has_div : Div ordinal :=
  { div := ordinal.div }

@[simp] theorem div_zero (a : ordinal) : a / 0 = 0 :=
  dif_pos rfl

theorem div_def (a : ordinal) {b : ordinal} (h : b ≠ 0) : a / b = omin (set_of fun (o : ordinal) => a < b * succ o) (ordinal.div_aux a b h) :=
  dif_neg h

theorem lt_mul_succ_div (a : ordinal) {b : ordinal} (h : b ≠ 0) : a < b * succ (a / b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a < b * succ (a / b))) (div_def a h)))
    (omin_mem (set_of fun (o : ordinal) => a < b * succ o) (ordinal.div_aux a b h))

theorem lt_mul_div_add (a : ordinal) {b : ordinal} (h : b ≠ 0) : a < b * (a / b) + b := sorry

theorem div_le {a : ordinal} {b : ordinal} {c : ordinal} (b0 : b ≠ 0) : a / b ≤ c ↔ a < b * succ c :=
  { mp := fun (h : a / b ≤ c) => lt_of_lt_of_le (lt_mul_succ_div a b0) (mul_le_mul_left b (iff.mpr succ_le_succ h)),
    mpr := fun (h : a < b * succ c) => eq.mpr (id (Eq._oldrec (Eq.refl (a / b ≤ c)) (div_def a b0))) (omin_le h) }

theorem lt_div {a : ordinal} {b : ordinal} {c : ordinal} (c0 : c ≠ 0) : a < b / c ↔ c * succ a ≤ b := sorry

theorem le_div {a : ordinal} {b : ordinal} {c : ordinal} (c0 : c ≠ 0) : a ≤ b / c ↔ c * a ≤ b := sorry

theorem div_lt {a : ordinal} {b : ordinal} {c : ordinal} (b0 : b ≠ 0) : a / b < c ↔ a < b * c :=
  lt_iff_lt_of_le_iff_le (le_div b0)

theorem div_le_of_le_mul {a : ordinal} {b : ordinal} {c : ordinal} (h : a ≤ b * c) : a / b ≤ c := sorry

theorem mul_lt_of_lt_div {a : ordinal} {b : ordinal} {c : ordinal} : a < b / c → c * a < b :=
  lt_imp_lt_of_le_imp_le div_le_of_le_mul

@[simp] theorem zero_div (a : ordinal) : 0 / a = 0 :=
  iff.mp ordinal.le_zero (div_le_of_le_mul (ordinal.zero_le (a * 0)))

theorem mul_div_le (a : ordinal) (b : ordinal) : b * (a / b) ≤ a := sorry

theorem mul_add_div (a : ordinal) {b : ordinal} (b0 : b ≠ 0) (c : ordinal) : (b * a + c) / b = a + c / b := sorry

theorem div_eq_zero_of_lt {a : ordinal} {b : ordinal} (h : a < b) : a / b = 0 := sorry

@[simp] theorem mul_div_cancel (a : ordinal) {b : ordinal} (b0 : b ≠ 0) : b * a / b = a := sorry

@[simp] theorem div_one (a : ordinal) : a / 1 = a := sorry

@[simp] theorem div_self {a : ordinal} (h : a ≠ 0) : a / a = 1 := sorry

theorem mul_sub (a : ordinal) (b : ordinal) (c : ordinal) : a * (b - c) = a * b - a * c := sorry

theorem is_limit_add_iff {a : ordinal} {b : ordinal} : is_limit (a + b) ↔ is_limit b ∨ b = 0 ∧ is_limit a := sorry

theorem dvd_add_iff {a : ordinal} {b : ordinal} {c : ordinal} : a ∣ b → (a ∣ b + c ↔ a ∣ c) := sorry

theorem dvd_add {a : ordinal} {b : ordinal} {c : ordinal} (h₁ : a ∣ b) : a ∣ c → a ∣ b + c :=
  iff.mpr (dvd_add_iff h₁)

theorem dvd_zero (a : ordinal) : a ∣ 0 :=
  Exists.intro 0 (Eq.symm (mul_zero a))

theorem zero_dvd {a : ordinal} : 0 ∣ a ↔ a = 0 := sorry

theorem one_dvd (a : ordinal) : 1 ∣ a :=
  Exists.intro a (Eq.symm (one_mul a))

theorem div_mul_cancel {a : ordinal} {b : ordinal} : a ≠ 0 → a ∣ b → a * (b / a) = b := sorry

theorem le_of_dvd {a : ordinal} {b : ordinal} : b ≠ 0 → a ∣ b → a ≤ b := sorry

theorem dvd_antisymm {a : ordinal} {b : ordinal} (h₁ : a ∣ b) (h₂ : b ∣ a) : a = b := sorry

/-- `a % b` is the unique ordinal `o'` satisfying
  `a = b * o + o'` with `o' < b`. -/
protected instance has_mod : Mod ordinal :=
  { mod := fun (a b : ordinal) => a - b * (a / b) }

theorem mod_def (a : ordinal) (b : ordinal) : a % b = a - b * (a / b) :=
  rfl

@[simp] theorem mod_zero (a : ordinal) : a % 0 = a := sorry

theorem mod_eq_of_lt {a : ordinal} {b : ordinal} (h : a < b) : a % b = a := sorry

@[simp] theorem zero_mod (b : ordinal) : 0 % b = 0 := sorry

theorem div_add_mod (a : ordinal) (b : ordinal) : b * (a / b) + a % b = a :=
  add_sub_cancel_of_le (mul_div_le a b)

theorem mod_lt (a : ordinal) {b : ordinal} (h : b ≠ 0) : a % b < b :=
  iff.mp (add_lt_add_iff_left (b * (a / b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b * (a / b) + a % b < b * (a / b) + b)) (div_add_mod a b))) (lt_mul_div_add a h))

@[simp] theorem mod_self (a : ordinal) : a % a = 0 := sorry

@[simp] theorem mod_one (a : ordinal) : a % 1 = 0 := sorry

/-! ### Supremum of a family of ordinals -/

/-- The supremum of a family of ordinals -/
def sup {ι : Type u_1} (f : ι → ordinal) : ordinal :=
  omin (set_of fun (c : ordinal) => ∀ (i : ι), f i ≤ c) sorry

theorem le_sup {ι : Type u_1} (f : ι → ordinal) (i : ι) : f i ≤ sup f :=
  omin_mem (set_of fun (c : ordinal) => ∀ (i : ι), f i ≤ c) (sup._proof_1 f)

theorem sup_le {ι : Type u_1} {f : ι → ordinal} {a : ordinal} : sup f ≤ a ↔ ∀ (i : ι), f i ≤ a :=
  { mp := fun (h : sup f ≤ a) (i : ι) => le_trans (le_sup f i) h, mpr := fun (h : ∀ (i : ι), f i ≤ a) => omin_le h }

theorem lt_sup {ι : Type u_1} {f : ι → ordinal} {a : ordinal} : a < sup f ↔ ∃ (i : ι), a < f i := sorry

theorem is_normal.sup {f : ordinal → ordinal} (H : is_normal f) {ι : Type u_1} {g : ι → ordinal} (h : Nonempty ι) : f (sup g) = sup (f ∘ g) := sorry

theorem sup_ord {ι : Type u_1} (f : ι → cardinal) : (sup fun (i : ι) => cardinal.ord (f i)) = cardinal.ord (cardinal.sup f) := sorry

theorem sup_succ {ι : Type u_1} (f : ι → ordinal) : (sup fun (i : ι) => succ (f i)) ≤ succ (sup f) :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((sup fun (i : ι) => succ (f i)) ≤ succ (sup f))) (propext sup_le)))
    fun (i : ι) => eq.mpr (id (Eq._oldrec (Eq.refl (succ (f i) ≤ succ (sup f))) (propext succ_le_succ))) (le_sup f i)

theorem unbounded_range_of_sup_ge {α : Type u} {β : Type u} (r : α → α → Prop) [is_well_order α r] (f : β → α) (h : type r ≤ sup (typein r ∘ f)) : unbounded r (set.range f) := sorry

/-- The supremum of a family of ordinals indexed by the set
  of ordinals less than some `o : ordinal.{u}`.
  (This is not a special case of `sup` over the subtype,
  because `{a // a < o} : Type (u+1)` and `sup` only works over
  families in `Type u`.) -/
def bsup (o : ordinal) : ((a : ordinal) → a < o → ordinal) → ordinal :=
  sorry

theorem bsup_le {o : ordinal} {f : (a : ordinal) → a < o → ordinal} {a : ordinal} : bsup o f ≤ a ↔ ∀ (i : ordinal) (h : i < o), f i h ≤ a := sorry

theorem bsup_type {α : Type u_1} (r : α → α → Prop) [is_well_order α r] (f : (a : ordinal) → a < type r → ordinal) : bsup (type r) f = sup fun (a : α) => f (typein r a) (typein_lt_type r a) := sorry

theorem le_bsup {o : ordinal} (f : (a : ordinal) → a < o → ordinal) (i : ordinal) (h : i < o) : f i h ≤ bsup o f :=
  iff.mp bsup_le (le_refl (bsup o f)) i h

theorem lt_bsup {o : ordinal} {f : (a : ordinal) → a < o → ordinal} (hf : ∀ {a a' : ordinal} (ha : a < o) (ha' : a' < o), a < a' → f a ha < f a' ha') (ho : is_limit o) (i : ordinal) (h : i < o) : f i h < bsup o f :=
  lt_of_lt_of_le (hf h (and.right ho i h) (lt_succ_self i)) (le_bsup f (succ i) (and.right ho i h))

theorem bsup_id {o : ordinal} (ho : is_limit o) : (bsup o fun (x : ordinal) (_x : x < o) => x) = o := sorry

theorem is_normal.bsup {f : ordinal → ordinal} (H : is_normal f) {o : ordinal} (g : (a : ordinal) → a < o → ordinal) (h : o ≠ 0) : f (bsup o g) = bsup o fun (a : ordinal) (h : a < o) => f (g a h) := sorry

theorem is_normal.bsup_eq {f : ordinal → ordinal} (H : is_normal f) {o : ordinal} (h : is_limit o) : (bsup o fun (x : ordinal) (_x : x < o) => f x) = f o := sorry

/-! ### Ordinal exponential -/

/-- The ordinal exponential, defined by transfinite recursion. -/
def power (a : ordinal) (b : ordinal) : ordinal :=
  ite (a = 0) (1 - b) (limit_rec_on b 1 (fun (_x IH : ordinal) => IH * a) fun (b : ordinal) (_x : is_limit b) => bsup b)

protected instance has_pow : has_pow ordinal ordinal :=
  has_pow.mk power

theorem zero_power' (a : ordinal) : 0 ^ a = 1 - a := sorry

@[simp] theorem zero_power {a : ordinal} (a0 : a ≠ 0) : 0 ^ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 ^ a = 0)) (zero_power' a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 - a = 0)) (propext sub_eq_zero_iff_le)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 ≤ a)) (propext one_le_iff_ne_zero))) a0))

@[simp] theorem power_zero (a : ordinal) : a ^ 0 = 1 := sorry

@[simp] theorem power_succ (a : ordinal) (b : ordinal) : a ^ succ b = a ^ b * a := sorry

theorem power_limit {a : ordinal} {b : ordinal} (a0 : a ≠ 0) (h : is_limit b) : a ^ b = bsup b fun (c : ordinal) (_x : c < b) => a ^ c := sorry

theorem power_le_of_limit {a : ordinal} {b : ordinal} {c : ordinal} (a0 : a ≠ 0) (h : is_limit b) : a ^ b ≤ c ↔ ∀ (b' : ordinal), b' < b → a ^ b' ≤ c := sorry

theorem lt_power_of_limit {a : ordinal} {b : ordinal} {c : ordinal} (b0 : b ≠ 0) (h : is_limit c) : a < b ^ c ↔ ∃ (c' : ordinal), ∃ (H : c' < c), a < b ^ c' := sorry

@[simp] theorem power_one (a : ordinal) : a ^ 1 = a := sorry

@[simp] theorem one_power (a : ordinal) : 1 ^ a = 1 := sorry

theorem power_pos {a : ordinal} (b : ordinal) (a0 : 0 < a) : 0 < a ^ b := sorry

theorem power_ne_zero {a : ordinal} (b : ordinal) (a0 : a ≠ 0) : a ^ b ≠ 0 :=
  iff.mp ordinal.pos_iff_ne_zero (power_pos b (iff.mpr ordinal.pos_iff_ne_zero a0))

theorem power_is_normal {a : ordinal} (h : 1 < a) : is_normal fun (_y : ordinal) => a ^ _y := sorry

theorem power_lt_power_iff_right {a : ordinal} {b : ordinal} {c : ordinal} (a1 : 1 < a) : a ^ b < a ^ c ↔ b < c :=
  is_normal.lt_iff (power_is_normal a1)

theorem power_le_power_iff_right {a : ordinal} {b : ordinal} {c : ordinal} (a1 : 1 < a) : a ^ b ≤ a ^ c ↔ b ≤ c :=
  is_normal.le_iff (power_is_normal a1)

theorem power_right_inj {a : ordinal} {b : ordinal} {c : ordinal} (a1 : 1 < a) : a ^ b = a ^ c ↔ b = c :=
  is_normal.inj (power_is_normal a1)

theorem power_is_limit {a : ordinal} {b : ordinal} (a1 : 1 < a) : is_limit b → is_limit (a ^ b) :=
  is_normal.is_limit (power_is_normal a1)

theorem power_is_limit_left {a : ordinal} {b : ordinal} (l : is_limit a) (hb : b ≠ 0) : is_limit (a ^ b) := sorry

theorem power_le_power_right {a : ordinal} {b : ordinal} {c : ordinal} (h₁ : 0 < a) (h₂ : b ≤ c) : a ^ b ≤ a ^ c := sorry

theorem power_le_power_left {a : ordinal} {b : ordinal} (c : ordinal) (ab : a ≤ b) : a ^ c ≤ b ^ c := sorry

theorem le_power_self {a : ordinal} (b : ordinal) (a1 : 1 < a) : b ≤ a ^ b :=
  is_normal.le_self (power_is_normal a1) b

theorem power_lt_power_left_of_succ {a : ordinal} {b : ordinal} {c : ordinal} (ab : a < b) : a ^ succ c < b ^ succ c := sorry

theorem power_add (a : ordinal) (b : ordinal) (c : ordinal) : a ^ (b + c) = a ^ b * a ^ c := sorry

theorem power_dvd_power (a : ordinal) {b : ordinal} {c : ordinal} (h : b ≤ c) : a ^ b ∣ a ^ c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ b ∣ a ^ c)) (Eq.symm (add_sub_cancel_of_le h))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ b ∣ a ^ (b + (c - b)))) (power_add a b (c - b))))
      (dvd_mul_right (a ^ b) (a ^ (c - b))))

theorem power_dvd_power_iff {a : ordinal} {b : ordinal} {c : ordinal} (a1 : 1 < a) : a ^ b ∣ a ^ c ↔ b ≤ c := sorry

theorem power_mul (a : ordinal) (b : ordinal) (c : ordinal) : a ^ (b * c) = (a ^ b) ^ c := sorry

/-! ### Ordinal logarithm -/

/-- The ordinal logarithm is the solution `u` to the equation
  `x = b ^ u * v + w` where `v < b` and `w < b`. -/
def log (b : ordinal) (x : ordinal) : ordinal :=
  dite (1 < b) (fun (h : 1 < b) => pred (omin (set_of fun (o : ordinal) => x < b ^ o) sorry)) fun (h : ¬1 < b) => 0

@[simp] theorem log_not_one_lt {b : ordinal} (b1 : ¬1 < b) (x : ordinal) : log b x = 0 := sorry

theorem log_def {b : ordinal} (b1 : 1 < b) (x : ordinal) : log b x = pred (omin (set_of fun (o : ordinal) => x < b ^ o) (log._proof_1 b x b1)) := sorry

@[simp] theorem log_zero (b : ordinal) : log b 0 = 0 := sorry

theorem succ_log_def {b : ordinal} {x : ordinal} (b1 : 1 < b) (x0 : 0 < x) : succ (log b x) = omin (set_of fun (o : ordinal) => x < b ^ o) (log._proof_1 b x b1) := sorry

theorem lt_power_succ_log {b : ordinal} (b1 : 1 < b) (x : ordinal) : x < b ^ succ (log b x) := sorry

theorem power_log_le (b : ordinal) {x : ordinal} (x0 : 0 < x) : b ^ log b x ≤ x := sorry

theorem le_log {b : ordinal} {x : ordinal} {c : ordinal} (b1 : 1 < b) (x0 : 0 < x) : c ≤ log b x ↔ b ^ c ≤ x := sorry

theorem log_lt {b : ordinal} {x : ordinal} {c : ordinal} (b1 : 1 < b) (x0 : 0 < x) : log b x < c ↔ x < b ^ c :=
  lt_iff_lt_of_le_iff_le (le_log b1 x0)

theorem log_le_log (b : ordinal) {x : ordinal} {y : ordinal} (xy : x ≤ y) : log b x ≤ log b y := sorry

theorem log_le_self (b : ordinal) (x : ordinal) : log b x ≤ x := sorry

/-! ### The Cantor normal form -/

theorem CNF_aux {b : ordinal} {o : ordinal} (b0 : b ≠ 0) (o0 : o ≠ 0) : o % b ^ log b o < o :=
  lt_of_lt_of_le (mod_lt o (power_ne_zero (log b o) b0)) (power_log_le b (iff.mpr ordinal.pos_iff_ne_zero o0))

/-- Proving properties of ordinals by induction over their Cantor normal form. -/
def CNF_rec {b : ordinal} (b0 : b ≠ 0) {C : ordinal → Sort u_2} (H0 : C 0) (H : (o : ordinal) → o ≠ 0 → o % b ^ log b o < o → C (o % b ^ log b o) → C o) (o : ordinal) : C o :=
  sorry

@[simp] theorem CNF_rec_zero {b : ordinal} (b0 : b ≠ 0) {C : ordinal → Sort u_2} {H0 : C 0} {H : (o : ordinal) → o ≠ 0 → o % b ^ log b o < o → C (o % b ^ log b o) → C o} : CNF_rec b0 H0 H 0 = H0 := sorry

@[simp] theorem CNF_rec_ne_zero {b : ordinal} (b0 : b ≠ 0) {C : ordinal → Sort u_2} {H0 : C 0} {H : (o : ordinal) → o ≠ 0 → o % b ^ log b o < o → C (o % b ^ log b o) → C o} {o : ordinal} (o0 : o ≠ 0) : CNF_rec b0 H0 H o = H o o0 (CNF_aux b0 o0) (CNF_rec b0 H0 H (o % b ^ log b o)) := sorry

/-- The Cantor normal form of an ordinal is the list of coefficients
  in the base-`b` expansion of `o`.

    CNF b (b ^ u₁ * v₁ + b ^ u₂ * v₂) = [(u₁, v₁), (u₂, v₂)] -/
def CNF (b : optParam ordinal omega) (o : ordinal) : List (ordinal × ordinal) :=
  dite (b = 0) (fun (b0 : b = 0) => [])
    fun (b0 : ¬b = 0) =>
      CNF_rec b0 []
        (fun (o : ordinal) (o0 : o ≠ 0) (h : o % b ^ log b o < o) (IH : List (ordinal × ordinal)) =>
          (log b o, o / b ^ log b o) :: IH)
        o

@[simp] theorem zero_CNF (o : ordinal) : CNF 0 o = [] :=
  dif_pos rfl

@[simp] theorem CNF_zero (b : optParam ordinal omega) : CNF b 0 = [] :=
  dite (b = 0) (fun (b0 : b = 0) => dif_pos b0) fun (b0 : ¬b = 0) => Eq.trans (dif_neg b0) (CNF_rec_zero b0)

theorem CNF_ne_zero {b : ordinal} {o : ordinal} (b0 : b ≠ 0) (o0 : o ≠ 0) : CNF b o = (log b o, o / b ^ log b o) :: CNF b (o % b ^ log b o) := sorry

theorem one_CNF {o : ordinal} (o0 : o ≠ 0) : CNF 1 o = [(0, o)] := sorry

theorem CNF_foldr {b : ordinal} (b0 : b ≠ 0) (o : ordinal) : list.foldr (fun (p : ordinal × ordinal) (r : ordinal) => b ^ prod.fst p * prod.snd p + r) 0 (CNF b o) = o := sorry

theorem CNF_pairwise_aux (b : optParam ordinal omega) (o : ordinal) : (∀ (p : ordinal × ordinal), p ∈ CNF b o → prod.fst p ≤ log b o) ∧
  list.pairwise (fun (p q : ordinal × ordinal) => prod.fst q < prod.fst p) (CNF b o) := sorry

theorem CNF_pairwise (b : optParam ordinal omega) (o : ordinal) : list.pairwise (fun (p q : ordinal × ordinal) => prod.fst q < prod.fst p) (CNF b o) :=
  and.right (CNF_pairwise_aux b o)

theorem CNF_fst_le_log (b : optParam ordinal omega) (o : ordinal) (p : ordinal × ordinal) (H : p ∈ CNF b o) : prod.fst p ≤ log b o :=
  and.left (CNF_pairwise_aux b o)

theorem CNF_fst_le (b : optParam ordinal omega) (o : ordinal) (p : ordinal × ordinal) (H : p ∈ CNF b o) : prod.fst p ≤ o :=
  le_trans (CNF_fst_le_log b o p H) (log_le_self b o)

theorem CNF_snd_lt {b : ordinal} (b1 : 1 < b) (o : ordinal) (p : ordinal × ordinal) (H : p ∈ CNF b o) : prod.snd p < b := sorry

theorem CNF_sorted (b : optParam ordinal omega) (o : ordinal) : list.sorted gt (list.map prod.fst (CNF b o)) := sorry

/-! ### Casting naturals into ordinals, compatibility with operations -/

@[simp] theorem nat_cast_mul {m : ℕ} {n : ℕ} : ↑(m * n) = ↑m * ↑n := sorry

@[simp] theorem nat_cast_power {m : ℕ} {n : ℕ} : ↑(m ^ n) = ↑m ^ ↑n := sorry

@[simp] theorem nat_cast_le {m : ℕ} {n : ℕ} : ↑m ≤ ↑n ↔ m ≤ n := sorry

@[simp] theorem nat_cast_lt {m : ℕ} {n : ℕ} : ↑m < ↑n ↔ m < n := sorry

@[simp] theorem nat_cast_inj {m : ℕ} {n : ℕ} : ↑m = ↑n ↔ m = n := sorry

@[simp] theorem nat_cast_eq_zero {n : ℕ} : ↑n = 0 ↔ n = 0 :=
  nat_cast_inj

theorem nat_cast_ne_zero {n : ℕ} : ↑n ≠ 0 ↔ n ≠ 0 :=
  not_congr nat_cast_eq_zero

@[simp] theorem nat_cast_pos {n : ℕ} : 0 < ↑n ↔ 0 < n :=
  nat_cast_lt

@[simp] theorem nat_cast_sub {m : ℕ} {n : ℕ} : ↑(m - n) = ↑m - ↑n := sorry

@[simp] theorem nat_cast_div {m : ℕ} {n : ℕ} : ↑(m / n) = ↑m / ↑n := sorry

@[simp] theorem nat_cast_mod {m : ℕ} {n : ℕ} : ↑(m % n) = ↑m % ↑n := sorry

@[simp] theorem nat_le_card {o : ordinal} {n : ℕ} : ↑n ≤ card o ↔ ↑n ≤ o := sorry

@[simp] theorem nat_lt_card {o : ordinal} {n : ℕ} : ↑n < card o ↔ ↑n < o := sorry

@[simp] theorem card_lt_nat {o : ordinal} {n : ℕ} : card o < ↑n ↔ o < ↑n :=
  lt_iff_lt_of_le_iff_le nat_le_card

@[simp] theorem card_le_nat {o : ordinal} {n : ℕ} : card o ≤ ↑n ↔ o ≤ ↑n :=
  iff.mpr le_iff_le_iff_lt_iff_lt nat_lt_card

@[simp] theorem card_eq_nat {o : ordinal} {n : ℕ} : card o = ↑n ↔ o = ↑n := sorry

@[simp] theorem type_fin (n : ℕ) : type Less = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (type Less = ↑n)) (Eq.symm (propext card_eq_nat))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (card (type Less) = ↑n)) (card_type Less)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (cardinal.mk (fin n) = ↑n)) (cardinal.mk_fin n))) (Eq.refl ↑n)))

@[simp] theorem lift_nat_cast (n : ℕ) : lift ↑n = ↑n := sorry

theorem lift_type_fin (n : ℕ) : lift (type Less) = ↑n := sorry

theorem fintype_card {α : Type u_1} (r : α → α → Prop) [is_well_order α r] [fintype α] : type r = ↑(fintype.card α) := sorry

end ordinal

/-! ### Properties of `omega` -/

namespace cardinal

@[simp] theorem ord_omega : ord omega = ordinal.omega := sorry

@[simp] theorem add_one_of_omega_le {c : cardinal} (h : omega ≤ c) : c + 1 = c := sorry

end cardinal

namespace ordinal

theorem lt_omega {o : ordinal} : o < omega ↔ ∃ (n : ℕ), o = ↑n := sorry

theorem nat_lt_omega (n : ℕ) : ↑n < omega :=
  iff.mpr lt_omega (Exists.intro n rfl)

theorem omega_pos : 0 < omega :=
  nat_lt_omega 0

theorem omega_ne_zero : omega ≠ 0 :=
  ne_of_gt omega_pos

theorem one_lt_omega : 1 < omega := sorry

theorem omega_is_limit : is_limit omega := sorry

theorem omega_le {o : ordinal} : omega ≤ o ↔ ∀ (n : ℕ), ↑n ≤ o := sorry

theorem nat_lt_limit {o : ordinal} (h : is_limit o) (n : ℕ) : ↑n < o := sorry

theorem omega_le_of_is_limit {o : ordinal} (h : is_limit o) : omega ≤ o :=
  iff.mpr omega_le fun (n : ℕ) => le_of_lt (nat_lt_limit h n)

theorem add_omega {a : ordinal} (h : a < omega) : a + omega = omega := sorry

theorem add_lt_omega {a : ordinal} {b : ordinal} (ha : a < omega) (hb : b < omega) : a + b < omega := sorry

theorem mul_lt_omega {a : ordinal} {b : ordinal} (ha : a < omega) (hb : b < omega) : a * b < omega := sorry

theorem is_limit_iff_omega_dvd {a : ordinal} : is_limit a ↔ a ≠ 0 ∧ omega ∣ a := sorry

theorem power_lt_omega {a : ordinal} {b : ordinal} (ha : a < omega) (hb : b < omega) : a ^ b < omega := sorry

theorem add_omega_power {a : ordinal} {b : ordinal} (h : a < omega ^ b) : a + omega ^ b = omega ^ b := sorry

theorem add_lt_omega_power {a : ordinal} {b : ordinal} {c : ordinal} (h₁ : a < omega ^ c) (h₂ : b < omega ^ c) : a + b < omega ^ c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b < omega ^ c)) (Eq.symm (add_omega_power h₁))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b < a + omega ^ c)) (propext (add_lt_add_iff_left a)))) h₂)

theorem add_absorp {a : ordinal} {b : ordinal} {c : ordinal} (h₁ : a < omega ^ b) (h₂ : omega ^ b ≤ c) : a + c = c := sorry

theorem add_absorp_iff {o : ordinal} (o0 : 0 < o) : (∀ (a : ordinal), a < o → a + o = o) ↔ ∃ (a : ordinal), o = omega ^ a := sorry

theorem add_mul_limit_aux {a : ordinal} {b : ordinal} {c : ordinal} (ba : b + a = a) (l : is_limit c) (IH : ∀ (c' : ordinal), c' < c → (a + b) * succ c' = a * succ c' + b) : (a + b) * c = a * c := sorry

theorem add_mul_succ {a : ordinal} {b : ordinal} (c : ordinal) (ba : b + a = a) : (a + b) * succ c = a * succ c + b := sorry

theorem add_mul_limit {a : ordinal} {b : ordinal} {c : ordinal} (ba : b + a = a) (l : is_limit c) : (a + b) * c = a * c :=
  add_mul_limit_aux ba l fun (c' : ordinal) (_x : c' < c) => add_mul_succ c' ba

theorem mul_omega {a : ordinal} (a0 : 0 < a) (ha : a < omega) : a * omega = omega := sorry

theorem mul_lt_omega_power {a : ordinal} {b : ordinal} {c : ordinal} (c0 : 0 < c) (ha : a < omega ^ c) (hb : b < omega) : a * b < omega ^ c := sorry

theorem mul_omega_dvd {a : ordinal} (a0 : 0 < a) (ha : a < omega) {b : ordinal} : omega ∣ b → a * b = b := sorry

theorem mul_omega_power_power {a : ordinal} {b : ordinal} (a0 : 0 < a) (h : a < omega ^ omega ^ b) : a * omega ^ omega ^ b = omega ^ omega ^ b := sorry

theorem power_omega {a : ordinal} (a1 : 1 < a) (h : a < omega) : a ^ omega = omega := sorry

/-! ### Fixed points of normal functions -/

/-- The next fixed point function, the least fixed point of the
  normal function `f` above `a`. -/
def nfp (f : ordinal → ordinal) (a : ordinal) : ordinal :=
  sup fun (n : ℕ) => nat.iterate f n a

theorem iterate_le_nfp (f : ordinal → ordinal) (a : ordinal) (n : ℕ) : nat.iterate f n a ≤ nfp f a :=
  le_sup (fun (n : ℕ) => nat.iterate f n a) n

theorem le_nfp_self (f : ordinal → ordinal) (a : ordinal) : a ≤ nfp f a :=
  iterate_le_nfp f a 0

theorem is_normal.lt_nfp {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} {b : ordinal} : f b < nfp f a ↔ b < nfp f a := sorry

theorem is_normal.nfp_le {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} {b : ordinal} : nfp f a ≤ f b ↔ nfp f a ≤ b :=
  iff.mpr le_iff_le_iff_lt_iff_lt (is_normal.lt_nfp H)

theorem is_normal.nfp_le_fp {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} {b : ordinal} (ab : a ≤ b) (h : f b ≤ b) : nfp f a ≤ b := sorry

theorem is_normal.nfp_fp {f : ordinal → ordinal} (H : is_normal f) (a : ordinal) : f (nfp f a) = nfp f a := sorry

theorem is_normal.le_nfp {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} {b : ordinal} : f b ≤ nfp f a ↔ b ≤ nfp f a := sorry

theorem nfp_eq_self {f : ordinal → ordinal} {a : ordinal} (h : f a = a) : nfp f a = a := sorry

/-- The derivative of a normal function `f` is
  the sequence of fixed points of `f`. -/
def deriv (f : ordinal → ordinal) (o : ordinal) : ordinal :=
  limit_rec_on o (nfp f 0) (fun (a IH : ordinal) => nfp f (succ IH)) fun (a : ordinal) (l : is_limit a) => bsup a

@[simp] theorem deriv_zero (f : ordinal → ordinal) : deriv f 0 = nfp f 0 :=
  limit_rec_on_zero (nfp f 0) (fun (a IH : ordinal) => nfp f (succ IH)) fun (a : ordinal) (l : is_limit a) => bsup a

@[simp] theorem deriv_succ (f : ordinal → ordinal) (o : ordinal) : deriv f (succ o) = nfp f (succ (deriv f o)) :=
  limit_rec_on_succ o (nfp f 0) (fun (a IH : ordinal) => nfp f (succ IH)) fun (a : ordinal) (l : is_limit a) => bsup a

theorem deriv_limit (f : ordinal → ordinal) {o : ordinal} : is_limit o → deriv f o = bsup o fun (a : ordinal) (_x : a < o) => deriv f a :=
  limit_rec_on_limit o (nfp f 0) (fun (a IH : ordinal) => nfp f (succ IH)) fun (a : ordinal) (l : is_limit a) => bsup a

theorem deriv_is_normal (f : ordinal → ordinal) : is_normal (deriv f) := sorry

theorem is_normal.deriv_fp {f : ordinal → ordinal} (H : is_normal f) (o : ordinal) : f (deriv f o) = deriv f o := sorry

theorem is_normal.fp_iff_deriv {f : ordinal → ordinal} (H : is_normal f) {a : ordinal} : f a ≤ a ↔ ∃ (o : ordinal), a = deriv f o := sorry


import topology.metric_space.basic

open_locale classical filter topological_space

namespace lftcm
open filter set

/-!
# Filters

## Definition of filters
-/

def principal {α : Type*} (s : set α) : filter α :=
{ sets := {t | s ⊆ t},
  univ_sets := begin
    -- sorry
    tauto,
    -- sorry
  end,
  sets_of_superset := begin
    -- sorry
    intros U V hU hUV,
    tauto,
    -- sorry
  end,
  inter_sets := begin
    -- sorry
    rintros U V hU hV,
    intros x xs,
    split ; tauto,
    -- sorry
  end}

def at_top : filter ℕ :=
{ sets := {s | ∃ a, ∀ b, a ≤ b → b ∈ s},
  univ_sets := begin
    -- sorry
    use 42,
    finish,
    -- sorry
  end,
  sets_of_superset := begin
    -- sorry
    rintros U V ⟨N, hN⟩ hUV,
    use N,
    tauto,
    -- sorry
  end,
  inter_sets := begin
    -- sorry
    rintros U V ⟨N, hN⟩ ⟨N', hN'⟩,
    use max N N',
    intros b hb,
    rw max_le_iff at hb,
    split ; tauto,
    -- sorry
  end}

-- The next exercise is slightly more tricky, you should probably keep it for later

def nhds (x : ℝ) : filter ℝ :=
{ sets := {s | ∃ ε > 0, Ioo (x - ε) (x + ε) ⊆ s},
  univ_sets := begin
    -- sorry
    use 42⁻¹,
    split,
    norm_num,
    tauto,
    -- sorry
  end,
  sets_of_superset := begin
    -- sorry
    rintros U V ⟨ε, hε⟩ hUV,
    use ε,
    tauto,
    -- sorry
  end,
  inter_sets := begin
    -- sorry
    rintros U V ⟨ε, hε, hU⟩ ⟨ε', hε', hV⟩,
    use [min ε ε', lt_min hε hε'],
    intros b hb,
    rw mem_Ioo at hb,
    split,
    { apply hU,
      split ; linarith [min_le_left ε ε'] },
    { apply hV,
      split ; linarith [min_le_right ε ε'] },
    -- sorry
  end}

/-
The filter axiom are also available as standalone lemmas where the filter argument is implicit
Compare
-/
#check @filter.sets_of_superset
#check @mem_of_superset

-- And analogously:
#check @inter_mem

/-!
## Definition of "tends to"
-/

-- We'll practive using tendsto by reproving the composition lemma `tendsto.comp` from mathlib
-- Let's first use the concrete definition recorded by `tendsto_def`
#check @tendsto_def
#check @preimage_comp

example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
  (hf : tendsto f A B) (hg : tendsto g B C) : tendsto (g ∘ f) A C :=
begin
  -- sorry
  rw tendsto_def at *,
  intros U U_in,
  rw preimage_comp,
  apply hf,
  apply hg,
  assumption,
  -- sorry
end

-- Now let's get functorial (same statement as above, different proof packaging).
example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
  (hf : tendsto f A B) (hg : tendsto g B C) : tendsto (g ∘ f) A C :=
begin
  calc
  map (g ∘ f) A = map g (map f A) : /- inline sorry -/ map_map/- inline sorry -/
            ... ≤ map g B         : /- inline sorry -/map_mono hf/- inline sorry -/
            ... ≤ C               : /- inline sorry -/hg/- inline sorry -/,
end

/-
Let's now focus on the pull-back operation `filter.comap` which takes `f : X → Y`
and a filter `G` on `Y` and returns a filter on `X`.
-/

#check @mem_comap -- this is by definition, the proof is `iff.rfl`

-- It also help to record a special case of one implication:
#check @preimage_mem_comap

-- The following exercise, which reproves `comap_ne_bot_iff` can start using
#check @forall_mem_nonempty_iff_ne_bot

example {α β : Type*} {f : filter β} {m : α → β} :
  (comap m f).ne_bot ↔ ∀ t ∈ f, ∃ a, m a ∈ t :=
begin
  -- sorry
  rw ← forall_mem_nonempty_iff_ne_bot,
  split ; intro h,
  { intros t t_in,
    exact h (m ⁻¹' t) ⟨t, t_in, subset.refl _⟩, },
  { rintros s ⟨u, u_in, hu⟩,
    cases h u u_in with x hx,
    exact ⟨x, hu hx⟩ },
  -- sorry
end

/-!
## Properties holding eventually
-/

/--
The next exercise only needs the definition of filters and the fact that
  `∀ᶠ x in f, p x` is a notation for `{x | p x} ∈ f`.
It is called `eventually_and` in mathlib, and won't be needed below.

For instance, applied to `α = ℕ` and the `at_top` filter above, it says
that, given two predicates `p` and `q` on natural numbers,
p n and q n for n large enough if and only if p n holds for n large enough
and q n holds for n large enough.
-/

example {α : Type*} {p q : α → Prop} {f : filter α} :
  (∀ᶠ x in f, p x ∧ q x) ↔ (∀ᶠ x in f, p x) ∧ (∀ᶠ x in f, q x) :=
begin
  -- sorry
  split,
  { intro h,
    split,
    { apply mem_of_superset h,
      intros x x_in,
      exact x_in.1 },
    { apply mem_of_superset h,
      intros x x_in,
      exact x_in.2 } },
  { intros h,
    exact f.inter_sets h.1 h.2, },
  -- sorry
end

/-!
## Topological spaces
-/

section

-- This is how we can talk about two topological spaces X and Y
variables {X Y : Type*} [topological_space X] [topological_space Y]

/-
Given a topological space `X` and some `A : set X`, we have the usual zoo of predicates
`is_open A`, `is_closed A`, `is_connected A`, `is_compact A` (and some more)

There are also additional type classes referring to properties of `X` itself,
like `compact_space X` or `connected_space X`
-/

/-- We can talk about continuous functions from `X` to `Y` -/
example (f : X → Y) : continuous f ↔ ∀ V, is_open V → is_open (f ⁻¹' V) := continuous_def

/- Each point `x` of a topological space has a neighborhood filter `𝓝 x`
   made of sets containing an open set containing `x`.
   It is always a proper filter, as recorded by `nhds_ne_bot`
   Asking for continuity is the same as asking for continuity at each point
   the right-hand side below is known as `continuous_at f x` -/
example (f : X → Y) : continuous f ↔ ∀ x, tendsto f (𝓝 x) (𝓝 (f x)) := continuous_iff_continuous_at

/- The topological structure also brings operations on sets.
   To each `A : set X`, we can associate `closure A`, `interior A` and `frontier A`.

   We'll focus on `closure A`. It is defined as the intersection of closed sets containing `A`
   but we can characterize it in terms of neighborhoods. The most concrete version is

   `mem_closure_iff_nhds : a ∈ closure A ↔ ∀ B ∈ 𝓝 a, (B ∩ A).nonempty`

   We'll pratice by reproving the slightly more abstract `mem_closure_iff_comap_ne_bot`.
   First let's review sets and subtypes. Fix a type `X` and recall
   that `A : set X` is not a type a priori, but Lean coerces automatically when needed to the
   type `↥A` whose terms are build of a term `x : X` and a proof of `x ∈ A`.
   In the other direction, inhabitants of `↥A` can be coerced to `X` automatically.
   This inclusion coercion map is called `coe : A → X` and `coe a` is also denoted by `↑a`.

   Now assume `X` is a topological space, and let's understand the closure of A in terms
   of `coe` and the neighborhood filter.

   In the next exercise, you can use `simp_rw` instead of `rw` to rewrite inside a quantifier
-/

#check inter_nonempty_iff_exists_right

example {A : set X} {x : X} :
  x ∈ closure A ↔ (comap (coe : A → X) (𝓝 x)).ne_bot :=
begin
  -- sorry
  simp_rw [mem_closure_iff_nhds, comap_ne_bot_iff, inter_nonempty_iff_exists_right],
  simp only [set_coe.exists, subtype.coe_mk],
  -- sorry
end

/-
In elementary contexts, the main property of `closure A` is that a converging sequence
`u : ℕ → X` such that `∀ n, u n ∈ A` has its limit in `closure A`.
Note we don't need all the full sequence to be in
`A`, it's enough to ask it for `n` large enough, ie. `∀ᶠ n in at_top, u n ∈ A`.
Also there is no reason to use sequences only, we can use any map and any source filter.
We hence have the important
`mem_closure_of_tendsto` : ∀ {f : β → X} {F : filter β} {a : X}
  {A : set X}, F ≠ ⊥ → tendsto f F (𝓝 a) → (∀ᶠ x in F, f x ∈ A) → a ∈ closure A

If `A` is known to be closed then we can replace `closure A` by `A`, this is
`is_closed.mem_of_tendsto`.
-/

/-
We need one last piece of filter technology: bases. By definition, each neighborhood of a point
`x` contains an *open* neighborhood of `x`.
Hence we can often restrict our attention to such neighborhoods.
The general definition recording such a situation is:

`has_basis` (l : filter α) (p : ι → Prop) (s : ι → set α) : Prop :=
(mem_iff' : ∀ t, t ∈ l ↔ ∃ i (hi : p i), s i ⊆ t)

You can now inspect three examples of how bases allow to restrict attention to certain elements
of a filter.
-/

#check @has_basis.mem_iff
#check @has_basis.tendsto_left_iff
#check @has_basis.tendsto_right_iff

-- We'll use the following bases:

#check @nhds_basis_opens'
#check @closed_nhds_basis

/--
Our main goal is now to prove the basic theorem which allows extension by continuity.
From Bourbaki's general topology book, I.8.5, Theorem 1 (taking only the non-trivial implication):

Let `X` be a topological space, `A` a dense subset of `X`, `f : A → Y`  a mapping of `A` into a
regular space `Y`. If, for each `x` in `X`, `f(y)` tends to a limit in `Y` when `y` tends to `x`
while remaining in `A` then there exists a continuous extension `φ` of `f` to `X`.

The regularity assumption on `Y` ensures that each point of `Y` has a basis of *closed*
neighborhoods, this is `closed_nhds_basis`.
It also ensures that `Y` is Hausdorff so limits in `Y` are unique, this is `tendsto_nhds_unique`.

mathlib contains a refinement of the above lemma, `dense_inducing.continuous_at_extend`,
but we'll stick to Bourbaki's version here.

Remember that, given `A : set X`, `↥A` is the subtype associated to `A`, and Lean will automatically
insert that funny up arrow when needed. And the (inclusion) coercion map is `coe : A → X`.
The assumption "tends to `x` while remaining in `A`" corresponds to the pull-back filter
`comap coe (𝓝 x)`.

Let's prove first an auxilliary lemma, extracted to simplify the context
(in particular we don't need Y to be a topological space here).
-/
lemma aux {X Y A : Type*} [topological_space X] {c : A → X} {f : A → Y} {x : X} {F : filter Y}
  (h : tendsto f (comap c (𝓝 x)) F) {V' : set Y} (V'_in : V' ∈ F) :
  ∃ V ∈ 𝓝 x, is_open V ∧ c ⁻¹' V ⊆ f ⁻¹' V' :=
begin
  -- sorry
  simpa [and_assoc] using ((nhds_basis_opens' x).comap c).tendsto_left_iff.mp h V' V'_in
  -- sorry
end

/--
Let's now turn to the main proof of the extension by continuity theorem.

When Lean needs a topology on `↥A` it will use the induced topology, thanks to the instance
`subtype.topological_space`.
This all happens automatically. The only relevant lemma is
`nhds_induced coe : ∀ a : ↥A, 𝓝 a = comap coe (𝓝 ↑a)`
(this is actually a general lemma about induced topologies).

The proof outline is:

The main assumption and the axiom of choice give a function `φ` such that
`∀ x, tendsto f (comap coe $ 𝓝 x) (𝓝 (φ x))`
(because `Y` is Hausdorff, `φ` is entirely determined, but we won't need that until we try to
prove that `φ` indeed extends `f`).

Let's first prove `φ` is continuous. Fix any `x : X`.
Since `Y` is regular, it suffices to check that for every *closed* neighborhood
`V'` of `φ x`, `φ ⁻¹' V' ∈ 𝓝 x`.

The limit assumption gives (through the auxilliary lemma above)
some `V ∈ 𝓝 x` such `is_open V ∧ coe ⁻¹' V ⊆ f ⁻¹' V'`.

Since `V ∈ 𝓝 x`, it suffices to prove `V ⊆ φ ⁻¹' V'`, ie  `∀ y ∈ V, φ y ∈ V'`.
Let's fix `y` in `V`. Because `V` is *open*, it is a neighborhood of `y`.

In particular `coe ⁻¹' V ∈ comap coe (𝓝 y)` and a fortiori `f ⁻¹' V' ∈ comap coe (𝓝 y)`.
In addition `comap coe $ 𝓝 y ≠ ⊥` because `A` is dense.

Because we know `tendsto f (comap coe $ 𝓝 y) (𝓝 (φ y))` this implies
`φ y ∈ closure V'` and, since `V'` is closed, we have proved `φ y ∈ V'`.

It remains to prove that `φ` extends `f`. This is were continuity of `f` enters the discussion,
together with the fact that `Y` is Hausdorff.
-/
example [t3_space Y] {A : set X} (hA : ∀ x, x ∈ closure A)
  {f : A → Y} (f_cont : continuous f)
  (hf : ∀ x : X, ∃ c : Y, tendsto f (comap coe $ 𝓝 x) $ 𝓝 c) :
  ∃ φ : X → Y, continuous φ ∧ ∀ a : A, φ a = f a :=
begin
  -- sorry
  choose φ hφ using hf,
  use φ,
  split,
  { rw continuous_iff_continuous_at,
    intros x,
    suffices : ∀ V' ∈ 𝓝 (φ x), is_closed V' → φ ⁻¹' V' ∈ 𝓝 x,
      by simpa [continuous_at, (closed_nhds_basis _).tendsto_right_iff],
    intros V' V'_in V'_closed,
    obtain ⟨V, V_in, V_op, hV⟩ : ∃ V ∈ 𝓝 x, is_open V ∧ coe ⁻¹' V ⊆ f ⁻¹' V',
    { exact aux (hφ x) V'_in },
    suffices : ∀ y ∈ V, φ y ∈ V',
      from mem_of_superset V_in this,
    intros y y_in,
    have hVx : V ∈ 𝓝 y := is_open.mem_nhds V_op y_in,
    haveI : (comap (coe : A → X) (𝓝 y)).ne_bot := by simpa [mem_closure_iff_comap_ne_bot] using hA y,
    apply is_closed.mem_of_tendsto V'_closed (hφ y),
    exact mem_of_superset (preimage_mem_comap hVx) hV },
  { intros a,
    have lim : tendsto f (𝓝 a) (𝓝 $ φ a),
      by simpa [nhds_induced] using hφ a,
    exact tendsto_nhds_unique lim f_cont.continuous_at },
  -- sorry
end

end

/-!
## Metric spaces
-/

/--
We now leave general topology and turn to metric spaces. The distance function is denoted by `dist`.
A slight difficulty here is that, as in Bourbaki, many results you may expect
to see stated for metric spaces are stated for uniform spaces, a more general notion that also
includes topological groups. In this tutorial we will avoid uniform spaces for simplicity.

We will prove that continuous functions from a compact metric space to a
metric space are uniformly continuous. mathlib has a much more general
version (about functions between uniform spaces...).

The lemma `metric.uniform_continuous_iff` allows to translate the general definition
of uniform continuity to the ε-δ definition that works for metric spaces only.
So let's fix `ε > 0` and start looking for `δ`.

We will deduce Heine-Cantor from the fact that a real value continuous function
on a nonempty compact set reaches its infimum. There are several ways to state that,
but here we recommend `is_compact.exists_forall_le`.

Let `φ : X × X → ℝ := λ p, dist (f p.1) (f p.2)` and let `K := { p : X × X | ε ≤ φ p }`.
Observe `φ` is continuous by assumption on `f` and using `continuous_dist`.
And `K` is closed using `is_closed_le` hence compact since `X` is compact.

Then we discuss two possibilities using `eq_empty_or_nonempty`.
If `K` is empty then we are clearly done (we can set `δ = 1` for instance).
So let's assume `K` is not empty, and choose `(x₀, x₁)` attaining the infimum
of `φ` on `K`. We can then set `δ = dist x₀ x₁` and check everything works.
-/
example {X : Type*} [metric_space X] [compact_space X] {Y : Type*} [metric_space Y]
  {f : X → Y} (hf : continuous f) : uniform_continuous f :=
begin
  -- sorry
  rw metric.uniform_continuous_iff,
  intros ε ε_pos,
  let φ : X × X → ℝ := λ p, dist (f p.1) (f p.2),
  have φ_cont : continuous φ := continuous_dist.comp (hf.prod_map hf),
  let K := { p : X × X | ε ≤ φ p },
  have K_closed : is_closed K := is_closed_le continuous_const φ_cont,
  have K_cpct : is_compact K := K_closed.is_compact,
  cases eq_empty_or_nonempty K with hK hK,
  { use [1, by norm_num],
    intros x y hxy,
    have : (x, y) ∉ K, by simp [hK],
    simpa [K] },
  { rcases K_cpct.exists_forall_le hK continuous_dist.continuous_on with ⟨⟨x₀, x₁⟩, xx_in, H⟩,
    use dist x₀ x₁,
    split,
    { change _ < _,
      rw dist_pos,
      intro h,
      have : ε ≤ 0, by simpa [*] using xx_in,
      linarith },
    { intros x x',
      contrapose!,
      intros hxx',
      linarith [H (x, x') hxx'] } },
  -- sorry
end

end lftcm