import syntax.syntaxCLC
import syntax.axiomsCLC
import semantics.semanticsCLC
import tactic.induction
import data.set.finite
import data.fintype.basic
local attribute [instance] classical.prop_decidable

open set list

---------------------- Soundness ----------------------

theorem soundnessCLC {agents: Type} [hN : fintype agents] (φ : formCLC agents) :
  axCLC φ → global_valid φ :=
begin
  intro h,
  unfold global_valid valid_m s_entails_CLC,

  induction' h,

  -- Prop 1
  { intros m s h1 h2,
    exact h1, },

  -- Prop 2
  { intros m s h1 h2 h3,
    apply h1,
      { exact h3,},

      { apply h2,
        exact h3 }, },

  -- Prop 3
  { intros m s h1 h2,
    by_contradiction hf,
    exact (h1 hf) (h2 hf), },

  -- Prop 4
  { intros m s h1 h2,
    exact and.intro h1 h2, },

  -- Prop 5
  { intros m s h1,
    exact h1.left, },

  -- Prop 6
  { intros m s h1,
    exact h1.right, },

  -- Prop 7
  { intros m s h1 h2,
    by_contradiction hf,
    exact h1 hf h2, },

  -- Bot
  { intros m s h1,
    exact m.f.E.liveness s G h1, },

  -- Top
  { intros m s,
    simp [s_entails_CLC],
    exact m.f.E.safety s G, },

  -- N
  { intros m s h1,
    apply m.f.E.N_max,
    by_contradiction,
    exact h1 h, },

  -- M
  { intros m s,
    apply m.f.E.monoticity s G {t: m.f.states | s_entails_CLC m t (φ & φ_1)} {t: m.f.states | s_entails_CLC m t φ},
    intros t h1,
    unfold s_entails_CLC at h1,
    exact h1.left, },

  -- S
  { intros m s h1,
    exact m.f.E.superadd s G F {t: m.f.states | s_entails_CLC m t φ} {t: m.f.states | s_entails_CLC m t φ_1} h1.left h1.right hInt, },

  -- MP
  { intros m s,
    apply ih_h,
    exact ih_h_1 m s, },

  -- Eq
  { intros m s,
    have heq: {t: m.f.states | s_entails_CLC m t φ} = {t: m.f.states | s_entails_CLC m t φ_1},
    { apply set.ext,
      intros u,
      cases (ih m u),
      apply iff.intro,
      { intro hu,
        exact left hu, },
      { intro hu,
        exact right hu } },
    apply and.intro,
    { intro h1,
      simp [s_entails_CLC] at *,
      rw [← heq],
      exact h1, },
    { intro h1,
      simp [s_entails_CLC] at *,
      rw [heq],
      exact h1, }, },

  -- K
  { intros m s h1 h2 t ht,
    exact h1 t ht (h2 t ht), },

  -- T
  { intros m s h,
    exact h s (m.f.rfl i s), },

  -- Four
  { intros m s h t ht u hu,
    exact h u (m.f.trans i s t u ht hu), },

  -- Five
  { intros m s h1 t ht ht1,
    apply h1,
    intros u hu,
    apply ht1,
    exact m.f.trans _ _ _ _ (m.f.sym _ _ _ ht) hu, },

  -- C
  { unfold s_entails_CLC,
    intros m s h,
    rw s_entails_CLC_conjunction,
    intros ψ hψ,
    simp at hψ, cases hψ with i hi, cases hi with hi hψ,
    rw [←(hψ)],
    unfold s_entails_CLC,
    intros t hts,
    split,
    { apply h,
      split,
      { split,
        { show ∀ a, a ∈ (i :: list.nil) → a ∈ G,
          simp,
          exact hi, },
        { apply exists.intro list.nil,
          unfold C_path,
          exact hts, }, }, },
    { { intros u hu, cases hu with js hu, cases hu with hjs hu, cases hu with us htu,
        apply h,
        split,
        { split,
          { show ∀ a, a ∈ (i :: js) → a ∈ G,
            simp,
            exact and.intro hi hjs, },
          { apply exists.intro (t :: us),
            unfold C_path,
            exact and.intro hts htu, }, }, }, }, },

  -- RN
  { intros m s t hst,
    apply ih, },

  -- RC
  { intros m s hs t hC,
    cases hC with is hC,
    cases hC with his hC,
    cases hC with ss hC,
    simp [s_entails_CLC] at ih,
    induction' is with i is ih_is,
    { by_contradiction,
      exact C_path_nil hC, },
    { have ih' := ih,
      specialize ih m s hs,
      rw s_entails_CLC_conjunction at ih,
      specialize ih (k i (φ & φ_1)),
      simp [s_entails_CLC] at ih,
      simp[C_path] at *,
      cases ss with u ss,
      {
        simp[C_path] at *,
         specialize ih his.left t hC,
        exact ih.left,
        },
      { simp[C_path] at *,
        specialize @ih_is hN _ _ _ h m u,
        apply ih_is,
        { apply and.elim_right,
          apply ih his.left u hC.left, },
          { intros m s hs,
            specialize ih' m s hs,
            simp [s_entails_CLC_conjunction, s_entails_CLC] at *,
            exact ih', },
          exact his.right,
          exact hC.right, }, }, },
end

inductive single : Type
  | one: single

lemma univ_single : (set.univ: set single) = {single.one} :=
begin
  rw eq_comm,
  rw set.eq_univ_iff_forall,
  intro x,
  cases x,
  simp,
end

lemma single_nonempty : nonempty single :=
begin
  apply exists_true_iff_nonempty.mp,
  apply exists.intro single.one,
  exact trivial,
end

def m_ex {agents : Type} [hN : fintype agents] (ha : nonempty agents) : modelCLK agents  :=
{ f :=
  { states := single,
    hs := single_nonempty,
    ha := ha,
    E  :=
    { E := λ s G, {{single.one}},
      liveness :=
      begin
        intros _ _ hf,
        simp at hf,
        rw set.ext_iff at hf,
        simp at hf,
        apply hf single.one,
        refl,
      end,
      safety:=
        begin
          intros _ _, simp at *,
          exact univ_single,
        end,
      N_max :=
        begin
          intros _ _ hxc, simp at *,
          rw ←univ_single at *,
          have hcond : {single.one} ≠ (∅: set single),

            { intro hf,
              rw set.ext_iff at hf,
              simp at *,
              apply hf single.one,
              refl, },
          simp [hcond] at *, by_contradiction,
          have hex: ∃ x, x ∈ X, from nonempty_def.mp (ne_empty_iff_nonempty.mp hxc),
          cases hex with s hs,
          cases s,
          rw ←singleton_subset_iff at hs,
          rw ←univ_single at hs,
          exact h (univ_subset_iff.mp hs),
        end,
      monoticity:=
        begin
          intros _ _ _ _ hxy hx,
          simp [←univ_single] at *,
          rw hx at hxy,
          exact univ_subset_iff.mp hxy,
        end,
      superadd:=
      begin
        intros _ _ _ _ _ hX hY hGF,
        simp at *,
        simp[hX, hY],
      end },
    rel := λ a s, {s},
    rfl := by simp,
    sym :=
    begin
      intros i s t h,
      simp at *,
      rw h,
    end,
    trans :=
    begin
      intros i s t u hst htu,
      simp at *,
      simp[hst, htu],
    end, },
  v := λ _, {}, }

lemma nprfalseCLC {agents : Type} [hN : fintype agents] (ha : nonempty agents) :
  ¬ (axCLC (formCLC.bot : formCLC agents )) :=
begin
  apply (mt (soundnessCLC (@formCLC.bot agents))),
  intro hf ,
  simp[global_valid, valid_m, s_entails_CLC] at hf,
  apply hf (m_ex ha),
  exact single.one,
end


import tactic

inductive Form : Type
| atom : ℕ → Form
| tensor : Form → Form → Form
| par : Form → Form → Form
| neg : Form → Form

infix ` ⊗ `:70 := Form.tensor
infix ` ⅋ `:65 := Form.par
prefix `~` := Form.neg

inductive Link : Type
| ax : ℕ → ℕ → Form → Link
| cut : ℕ → ℕ → Form → Link
| tensor : ℕ → ℕ → ℕ → Form → Form → Link
| par : ℕ → ℕ → ℕ → Form → Form → Link
| con : ℕ → Form → Link

def Form_occ := Form × ℕ

inductive premise : Form_occ → Link → Prop
| cut_pos {A i j}          : premise (A,i) (Link.cut i j A)
| cut_neg {A i j}          : premise (~A,j) (Link.cut i j A)
| tensor_left {A B i j k}  : premise (A,i) (Link.tensor i j k A B)
| tensor_right {A B i j k} : premise (B,j) (Link.tensor i j k A B)
| par_left {A B i j k}     : premise (A,i) (Link.par i j k A B)
| par_right {A B i j k}    : premise (B,j) (Link.par i j k A B)
| con {A i}                : premise (A,i) (Link.con i A)

inductive conclusion : Form_occ → Link → Prop
| ax_pos {A i j}     : conclusion (A,i) (Link.ax i j A)
| ax_neg {A i j}     : conclusion (~A,j) (Link.ax i j A)
| tensor {A B i j k} : conclusion (A ⊗ B,k) (Link.tensor i j k A B)
| par {A B i j k}    : conclusion (A ⅋ B,k) (Link.par i j k A B)

inductive valid_link : Link → Prop
| ax  (i j A) : valid_link (Link.ax i j A)
| cut (i j A) : valid_link (Link.cut i j A)
| con (i A) : valid_link (Link.con i A)
| tensor (i j k A B) : (A,i) ≠ (B,j) → valid_link (Link.tensor i j k A B)
| par (i j k A B) : (A,i) ≠ (B,j) → valid_link (Link.par i j k A B)

structure proof_structure : Type :=
(links : set Link)
(valid : ∀ l ∈ links, valid_link l)
(prem_unique : ∀ Ai : Form_occ, ∀ l₁ l₂ ∈ links, premise Ai l₁ → premise Ai l₂ → l₁ = l₂)
(con_unique : ∀ Ai : Form_occ, ∀ l₁ l₂ ∈ links, conclusion Ai l₁ → conclusion Ai l₂ → l₁ = l₂)

inductive mem_Form_occ_ps (Ai : Form_occ) (ps : proof_structure) : Prop
| prem (l) : l ∈ ps.links → premise Ai l → mem_Form_occ_ps
| con (l) : l ∈ ps.links → conclusion Ai l → mem_Form_occ_ps

instance : has_mem Form_occ proof_structure := ⟨mem_Form_occ_ps⟩

@[reducible]
def dir := bool

@[pattern] def down := ff
@[pattern] def up := tt

@[pattern] def with_down (Ai : Form_occ) := (Ai,down)
@[pattern] def with_up (Ai : Form_occ) := (Ai,up)
postfix `↓`:max_plus := with_down
postfix `↑`:max_plus := with_up

@[reducible]
def switch := bool

@[reducible, pattern] def L := ff
@[reducible, pattern] def R := tt

def switching := Link → switch

@[simp]
def switch.flip {α β} (f : α → α → β) : switch → α → α → β
| L a b := f a b
| R a b := f b a

inductive steps_tensor (Ai Bi Ci : Form_occ) : Form_occ × dir → Form_occ × dir → Prop
| down : steps_tensor Ai↓ Ci↓
| turn : steps_tensor Bi↓ Ai↑
| up : steps_tensor Ci↑ Bi↑

inductive steps_par (Ai Bi Ci : Form_occ) : Form_occ × dir → Form_occ × dir → Prop
| down : steps_par Ai↓ Ci↓
| turn : steps_par Bi↓ Bi↑
| up : steps_par Ci↑ Ai↑

inductive dual (A : Form) (ai ni : ℕ) : Form_occ → Form_occ → Prop
| posneg : dual (A,ai) (~A,ni)
| negpos : dual (~A,ni) (A,ai)

inductive steps (T : switch) : Link → Form_occ × dir → Form_occ × dir → Prop
| ax  {A ai ni Bi Ci} : dual A ai ni Bi Ci → steps (Link.ax ai ni A) Bi↑ Ci↓
| cut {A ai ni Bi Ci} : dual A ai ni Bi Ci → steps (Link.cut ai ni A) Bi↓ Ci↑
| con {A ai}          : steps (Link.con ai A) (A, ai)↓ (A,ai)↑
| tensor {A B ai bi ci X Y} :
  T.flip steps_tensor (A, ai) (B, bi) (A ⊗ B, ci) X Y →
  steps (Link.tensor ai bi ci A B) X Y
| par {A B ai bi ci X Y} :
  T.flip steps_par (A, ai) (B, bi) (A ⅋ B, ci) X Y →
  steps (Link.par ai bi ci A B) X Y

inductive trip (ps : proof_structure) (S : switching) : ℕ → Form_occ × dir → Form_occ × dir → Prop
| single {Ai d}    : Ai ∈ ps → trip 0 (Ai,d) (Ai,d)
| cons {X Y Z Δ n} : Δ ∈ ps.links → steps (S Δ) Δ X Y → trip n Y Z → trip (n.succ) X Z

section
  variable {Δ : Link}
  variable {T : switch}
  variables {Ai Bi Ci : Form_occ}
  variables {X Y Z : Form_occ × dir}

  theorem steps_unique_prev : valid_link Δ → steps T Δ X Z → steps T Δ Y Z → X = Y := sorry

  theorem steps_unique_next : valid_link Δ → steps T Δ X Y → steps T Δ X Z → Y = Z := sorry

  lemma mem_ps_of_steps_next {ps : proof_structure} {d : dir} :
    Δ ∈ ps.links → steps T Δ X (Bi,d) → Bi ∈ ps := sorry

end

section
  variable {ps : proof_structure}
  variable {S : switching}
  variables {X Y Z : Form_occ × dir}
  variables {n m : ℕ}

  theorem link_unique_of_steps_prev {Δ₁ Δ₂} :
    Δ₁ ∈ ps.links → Δ₂ ∈ ps.links → steps (S Δ₁) Δ₁ X Y → steps (S Δ₂) Δ₂ X Z → Δ₁ = Δ₂ := sorry

  theorem link_unique_of_steps_next {Δ₁ Δ₂} :
    Δ₁ ∈ ps.links → Δ₂ ∈ ps.links → steps (S Δ₁) Δ₁ X Z → steps (S Δ₂) Δ₂ Y Z → Δ₁ = Δ₂ := sorry

  def trip.rcons {Δ} : Δ ∈ ps.links → trip ps S n X Y → steps (S Δ) Δ Y Z → trip ps S n.succ X Z :=
  begin
    revert X Y Z,
    induction n,
    case nat.zero : {
      rintros X Y Z hΔ ⟨Ai,d,hA⟩ s,
      apply trip.cons hΔ s,
      cases Z with Ci d',
      apply trip.single,
      apply mem_ps_of_steps_next hΔ s,
    },
    case nat.succ : n ih {
      rintros X Y Z hΔ tXY sYZ,
      cases tXY with _ _ _ _ W _ Δ' _ hΔ' sXW tWY,
      apply trip.cons hΔ' sXW,
      apply ih hΔ tWY sYZ,
    },
  end

  theorem trip_unique_start : trip ps S n X Z → trip ps S n Y Z → X = Y :=
  begin
    intros tX tY,
    revert X Y,
    induction n,
    case nat.zero : { intros, cases tX; cases tY, refl},
    case nat.succ : n ih {
      rintros X Y tX tY,
      rcases tX with _ | ⟨_,X',_,Δ,_,hΔ,sX,tX'⟩,
      rcases tY with _ | ⟨_,Y',_,Δ',_,hΔ',sY,tY'⟩,
      have : Y' = X', by exact ih tY' tX',
      rw this at sY,
      have : Δ' = Δ, apply link_unique_of_steps_next hΔ' hΔ sY sX,
      rw this at sY,
      exact steps_unique_prev (ps.valid Δ hΔ) sX sY,
      }
  end

  lemma trip_rcons_decompose {α : Prop} (f : Π Δ Y, Δ ∈ ps.links → trip ps S n X Y → steps (S Δ) Δ Y Z → α) :
    trip ps S n.succ X Z → α :=
  begin
    sorry
  end

  theorem trip_unique_stop : trip ps S n X Y → trip ps S n X Z → Y = Z :=
  begin
    revert Y Z,
    induction n,
    case nat.zero : { intros _ _ tXY tXZ, cases tXY, cases tXZ, refl},
    case nat.succ : n ih {
      rintros Y Z tXY tXZ,
      apply trip_rcons_decompose _ tXY,
      intros Δ V hΔ tXV sVY,
      apply trip_rcons_decompose _ tXZ,
      intros Δ' W hΔ' tXW sWZ,
      have : W = V, apply ih tXW tXV,
      rw this at sWZ,
      have : Δ' = Δ, apply link_unique_of_steps_prev hΔ' hΔ sWZ sVY,
      rw this at sWZ,
      apply steps_unique_next (ps.valid Δ hΔ) sVY sWZ,
      }
  end

end


/-
Copyright (c) 2022 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import data.nat.totient
import algebra.ring.add_aut
import group_theory.divisible
import group_theory.order_of_element
import ring_theory.int.basic
import algebra.order.floor
import algebra.order.to_interval_mod
import topology.instances.real

/-!
# The additive circle

We define the additive circle `add_circle p` as the quotient `𝕜 ⧸ (ℤ ∙ p)` for some period `p : 𝕜`.

See also `circle` and `real.angle`.  For the normed group structure on `add_circle`, see
`add_circle.normed_add_comm_group` in a later file.

## Main definitions and results:

 * `add_circle`: the additive circle `𝕜 ⧸ (ℤ ∙ p)` for some period `p : 𝕜`
 * `unit_add_circle`: the special case `ℝ ⧸ ℤ`
 * `add_circle.equiv_add_circle`: the rescaling equivalence `add_circle p ≃+ add_circle q`
 * `add_circle.equiv_Ico`: the natural equivalence `add_circle p ≃ Ico a (a + p)`
 * `add_circle.add_order_of_div_of_gcd_eq_one`: rational points have finite order
 * `add_circle.exists_gcd_eq_one_of_is_of_fin_add_order`: finite-order points are rational
 * `add_circle.homeo_Icc_quot`: the natural topological equivalence between `add_circle p` and
   `Icc a (a + p)` with its endpoints identified.
 * `add_circle.lift_Ico_continuous`: if `f : ℝ → B` is continuous, and `f a = f (a + p)` for
   some `a`, then there is a continuous function `add_circle p → B` which agrees with `f` on
   `Icc a (a + p)`.

## Implementation notes:

Although the most important case is `𝕜 = ℝ` we wish to support other types of scalars, such as
the rational circle `add_circle (1 : ℚ)`, and so we set things up more generally.

## TODO

 * Link with periodicity
 * Lie group structure
 * Exponential equivalence to `circle`

-/

noncomputable theory

open set function add_subgroup topological_space
open_locale topology

variables {𝕜 B : Type*}

section continuity

variables [linear_ordered_add_comm_group 𝕜] [archimedean 𝕜]
  [topological_space 𝕜] [order_topology 𝕜] (a : 𝕜) {p : 𝕜} (hp : 0 < p) (x : 𝕜)

lemma continuous_right_to_Ico_mod : continuous_within_at (to_Ico_mod a hp) (Ici x) x :=
begin
  intros s h,
  rw [filter.mem_map, mem_nhds_within_iff_exists_mem_nhds_inter],
  haveI : nontrivial 𝕜 := ⟨⟨0, p, hp.ne⟩⟩,
  simp_rw mem_nhds_iff_exists_Ioo_subset at h ⊢,
  obtain ⟨l, u, hxI, hIs⟩ := h,
  let d := to_Ico_div a hp x • p,
  have hd := to_Ico_mod_mem_Ico a hp x,
  simp_rw [subset_def, mem_inter_iff],
  refine ⟨_, ⟨l + d, min (a + p) u + d, _, λ x, id⟩, λ y, _⟩;
    simp_rw [← sub_mem_Ioo_iff_left, mem_Ioo, lt_min_iff],
  { exact ⟨hxI.1, hd.2, hxI.2⟩ },
  { rintro ⟨h, h'⟩, apply hIs,
    rw [← to_Ico_mod_sub_zsmul, (to_Ico_mod_eq_self _).2],
    exacts [⟨h.1, h.2.2⟩, ⟨hd.1.trans (sub_le_sub_right h' _), h.2.1⟩] },
end

lemma continuous_left_to_Ioc_mod : continuous_within_at (to_Ioc_mod a hp) (Iic x) x :=
begin
  rw (funext (λ y, eq.trans (by rw neg_neg) $ to_Ioc_mod_neg _ _ _) :
    to_Ioc_mod a hp = (λ x, p - x) ∘ to_Ico_mod (-a) hp ∘ has_neg.neg),
  exact ((continuous_sub_left _).continuous_at.comp_continuous_within_at $
    (continuous_right_to_Ico_mod _ _ _).comp continuous_neg.continuous_within_at $ λ y, neg_le_neg),
end

variables {x} (hx : (x : 𝕜 ⧸ zmultiples p) ≠ a)

lemma to_Ico_mod_eventually_eq_to_Ioc_mod : to_Ico_mod a hp =ᶠ[𝓝 x] to_Ioc_mod a hp :=
is_open.mem_nhds (by {rw Ico_eq_locus_Ioc_eq_Union_Ioo, exact is_open_Union (λ i, is_open_Ioo)}) $
  (mem_Ioo_mod_iff_to_Ico_mod_eq_to_Ioc_mod hp).1 ((mem_Ioo_mod_iff_ne_mod_zmultiples hp).2 hx)

lemma continuous_at_to_Ico_mod : continuous_at (to_Ico_mod a hp) x :=
let h := to_Ico_mod_eventually_eq_to_Ioc_mod a hp hx in continuous_at_iff_continuous_left_right.2 $
  ⟨(continuous_left_to_Ioc_mod a hp x).congr_of_eventually_eq
    (h.filter_mono nhds_within_le_nhds) h.eq_of_nhds, continuous_right_to_Ico_mod a hp x⟩

lemma continuous_at_to_Ioc_mod : continuous_at (to_Ioc_mod a hp) x :=
let h := to_Ico_mod_eventually_eq_to_Ioc_mod a hp hx in continuous_at_iff_continuous_left_right.2 $
  ⟨continuous_left_to_Ioc_mod a hp x, (continuous_right_to_Ico_mod a hp x).congr_of_eventually_eq
    (h.symm.filter_mono nhds_within_le_nhds) h.symm.eq_of_nhds⟩

end continuity

/-- The "additive circle": `𝕜 ⧸ (ℤ ∙ p)`. See also `circle` and `real.angle`. -/
@[derive [add_comm_group, topological_space, topological_add_group, inhabited, has_coe_t 𝕜],
  nolint unused_arguments]
def add_circle [linear_ordered_add_comm_group 𝕜] [topological_space 𝕜] [order_topology 𝕜] (p : 𝕜) :=
𝕜 ⧸ zmultiples p

namespace add_circle

section linear_ordered_add_comm_group
variables [linear_ordered_add_comm_group 𝕜] [topological_space 𝕜] [order_topology 𝕜] (p : 𝕜)

lemma coe_nsmul {n : ℕ} {x : 𝕜} : (↑(n • x) : add_circle p) = n • (x : add_circle p) := rfl

lemma coe_zsmul {n : ℤ} {x : 𝕜} : (↑(n • x) : add_circle p) = n • (x : add_circle p) := rfl

lemma coe_add (x y : 𝕜) : (↑(x + y) : add_circle p) = (x : add_circle p) + (y : add_circle p) := rfl

lemma coe_sub (x y : 𝕜) : (↑(x - y) : add_circle p) = (x : add_circle p) - (y : add_circle p) := rfl

lemma coe_neg {x : 𝕜} : (↑(-x) : add_circle p) = -(x : add_circle p) := rfl

lemma coe_eq_zero_iff {x : 𝕜} : (x : add_circle p) = 0 ↔ ∃ (n : ℤ), n • p = x :=
by simp [add_subgroup.mem_zmultiples_iff]

lemma coe_eq_zero_of_pos_iff (hp : 0 < p) {x : 𝕜} (hx : 0 < x) :
  (x : add_circle p) = 0 ↔ ∃ (n : ℕ), n • p = x :=
begin
  rw coe_eq_zero_iff,
  split;
  rintros ⟨n, rfl⟩,
  { replace hx : 0 < n,
    { contrapose! hx,
      simpa only [←neg_nonneg, ←zsmul_neg, zsmul_neg'] using zsmul_nonneg hp.le (neg_nonneg.2 hx) },
    exact ⟨n.to_nat, by rw [← coe_nat_zsmul, int.to_nat_of_nonneg hx.le]⟩, },
  { exact ⟨(n : ℤ), by simp⟩, },
end

lemma coe_period : (p : add_circle p) = 0 :=
(quotient_add_group.eq_zero_iff p).2 $ mem_zmultiples p

@[simp] lemma coe_add_period (x : 𝕜) : ((x + p : 𝕜) : add_circle p) = x :=
by rw [coe_add, ←eq_sub_iff_add_eq', sub_self, coe_period]

@[continuity, nolint unused_arguments] protected lemma continuous_mk' :
  continuous (quotient_add_group.mk' (zmultiples p) : 𝕜 → add_circle p) :=
continuous_coinduced_rng

variables [hp : fact (0 < p)]
include hp

variables (a : 𝕜) [archimedean 𝕜]

/-- The equivalence between `add_circle p` and the half-open interval `[a, a + p)`, whose inverse
is the natural quotient map. -/
def equiv_Ico : add_circle p ≃ Ico a (a + p) := quotient_add_group.equiv_Ico_mod a hp.out

/-- The equivalence between `add_circle p` and the half-open interval `(a, a + p]`, whose inverse
is the natural quotient map. -/
def equiv_Ioc : add_circle p ≃ Ioc a (a + p) := quotient_add_group.equiv_Ioc_mod a hp.out

/-- Given a function on `𝕜`, return the unique function on `add_circle p` agreeing with `f` on
`[a, a + p)`. -/
def lift_Ico (f : 𝕜 → B) : add_circle p → B := restrict _ f ∘ add_circle.equiv_Ico p a

/-- Given a function on `𝕜`, return the unique function on `add_circle p` agreeing with `f` on
`(a, a + p]`. -/
def lift_Ioc (f : 𝕜 → B) : add_circle p → B := restrict _ f ∘ add_circle.equiv_Ioc p a

variables {p a}

lemma coe_eq_coe_iff_of_mem_Ico {x y : 𝕜}
  (hx : x ∈ Ico a (a + p)) (hy : y ∈ Ico a (a + p)) : (x : add_circle p) = y ↔ x = y :=
begin
  refine ⟨λ h, _, by tauto⟩,
  suffices : (⟨x, hx⟩ : Ico a (a + p)) = ⟨y, hy⟩, by exact subtype.mk.inj this,
  apply_fun equiv_Ico p a at h,
  rw [←(equiv_Ico p a).right_inv ⟨x, hx⟩, ←(equiv_Ico p a).right_inv ⟨y, hy⟩],
  exact h
end

lemma lift_Ico_coe_apply {f : 𝕜 → B} {x : 𝕜} (hx : x ∈ Ico a (a + p)) : lift_Ico p a f ↑x = f x :=
begin
  have : (equiv_Ico p a) x = ⟨x, hx⟩,
  { rw equiv.apply_eq_iff_eq_symm_apply,
    refl, },
  rw [lift_Ico, comp_apply, this],
  refl,
end

lemma lift_Ioc_coe_apply {f : 𝕜 → B} {x : 𝕜} (hx : x ∈ Ioc a (a + p)) : lift_Ioc p a f ↑x = f x :=
begin
  have : (equiv_Ioc p a) x = ⟨x, hx⟩,
  { rw equiv.apply_eq_iff_eq_symm_apply,
    refl, },
  rw [lift_Ioc, comp_apply, this],
  refl,
end

variables (p a)

section continuity

@[continuity] lemma continuous_equiv_Ico_symm : continuous (equiv_Ico p a).symm :=
continuous_quotient_mk.comp continuous_subtype_coe

@[continuity] lemma continuous_equiv_Ioc_symm : continuous (equiv_Ioc p a).symm :=
continuous_quotient_mk.comp continuous_subtype_coe

variables {x : add_circle p} (hx : x ≠ a)
include hx

lemma continuous_at_equiv_Ico : continuous_at (equiv_Ico p a) x :=
begin
  induction x using quotient_add_group.induction_on',
  rw [continuous_at, filter.tendsto, quotient_add_group.nhds_eq, filter.map_map],
  apply continuous_at.cod_restrict, exact continuous_at_to_Ico_mod a hp.out hx,
end

lemma continuous_at_equiv_Ioc : continuous_at (equiv_Ioc p a) x :=
begin
  induction x using quotient_add_group.induction_on',
  rw [continuous_at, filter.tendsto, quotient_add_group.nhds_eq, filter.map_map],
  apply continuous_at.cod_restrict, exact continuous_at_to_Ioc_mod a hp.out hx,
end

end continuity

/-- The image of the closed-open interval `[a, a + p)` under the quotient map `𝕜 → add_circle p` is
the entire space. -/
@[simp] lemma coe_image_Ico_eq : (coe : 𝕜 → add_circle p) '' Ico a (a + p) = univ :=
by { rw image_eq_range, exact (equiv_Ico p a).symm.range_eq_univ }

/-- The image of the closed-open interval `[a, a + p)` under the quotient map `𝕜 → add_circle p` is
the entire space. -/
@[simp] lemma coe_image_Ioc_eq : (coe : 𝕜 → add_circle p) '' Ioc a (a + p) = univ :=
by { rw image_eq_range, exact (equiv_Ioc p a).symm.range_eq_univ }

/-- The image of the closed interval `[0, p]` under the quotient map `𝕜 → add_circle p` is the
entire space. -/
@[simp] lemma coe_image_Icc_eq : (coe : 𝕜 → add_circle p) '' Icc a (a + p) = univ :=
eq_top_mono (image_subset _ Ico_subset_Icc_self) $ coe_image_Ico_eq _ _

end linear_ordered_add_comm_group

section linear_ordered_field
variables [linear_ordered_field 𝕜] [topological_space 𝕜] [order_topology 𝕜] (p q : 𝕜)

/-- The rescaling equivalence between additive circles with different periods. -/
def equiv_add_circle (hp : p ≠ 0) (hq : q ≠ 0) : add_circle p ≃+ add_circle q :=
quotient_add_group.congr _ _ (add_aut.mul_right $ (units.mk0 p hp)⁻¹ * units.mk0 q hq) $
  by rw [add_monoid_hom.map_zmultiples, add_monoid_hom.coe_coe, add_aut.mul_right_apply,
    units.coe_mul, units.coe_mk0, units.coe_inv, units.coe_mk0, mul_inv_cancel_left₀ hp]

@[simp] lemma equiv_add_circle_apply_mk (hp : p ≠ 0) (hq : q ≠ 0) (x : 𝕜) :
  equiv_add_circle p q hp hq (x : 𝕜) = (x * (p⁻¹ * q) : 𝕜) :=
rfl

@[simp] lemma equiv_add_circle_symm_apply_mk (hp : p ≠ 0) (hq : q ≠ 0) (x : 𝕜) :
  (equiv_add_circle p q hp hq).symm (x : 𝕜) = (x * (q⁻¹ * p) : 𝕜) :=
rfl

variables [hp : fact (0 < p)]
include hp

section floor_ring

variables [floor_ring 𝕜]

@[simp] lemma coe_equiv_Ico_mk_apply (x : 𝕜) :
  (equiv_Ico p 0 $ quotient_add_group.mk x : 𝕜) = int.fract (x / p) * p :=
to_Ico_mod_eq_fract_mul _ x

instance : divisible_by (add_circle p) ℤ :=
{ div := λ x n, (↑(((n : 𝕜)⁻¹) * (equiv_Ico p 0 x : 𝕜)) : add_circle p),
  div_zero := λ x,
    by simp only [algebra_map.coe_zero, quotient_add_group.coe_zero, inv_zero, zero_mul],
  div_cancel := λ n x hn,
  begin
    replace hn : (n : 𝕜) ≠ 0, { norm_cast, assumption, },
    change n • quotient_add_group.mk' _ ((n : 𝕜)⁻¹ * ↑(equiv_Ico p 0 x)) = x,
    rw [← map_zsmul, ← smul_mul_assoc, zsmul_eq_mul, mul_inv_cancel hn, one_mul],
    exact (equiv_Ico p 0).symm_apply_apply x,
  end, }

end floor_ring

section finite_order_points

variables {p}

lemma add_order_of_period_div {n : ℕ} (h : 0 < n) : add_order_of ((p / n : 𝕜) : add_circle p) = n :=
begin
  rw [add_order_of_eq_iff h],
  replace h : 0 < (n : 𝕜) := nat.cast_pos.2 h,
  refine ⟨_, λ m hn h0, _⟩; simp only [ne, ← coe_nsmul, nsmul_eq_mul],
  { rw [mul_div_cancel' _ h.ne', coe_period] },
  rw coe_eq_zero_of_pos_iff p hp.out (mul_pos (nat.cast_pos.2 h0) $ div_pos hp.out h),
  rintro ⟨k, hk⟩,
  rw [mul_div, eq_div_iff h.ne', nsmul_eq_mul, mul_right_comm, ← nat.cast_mul,
      (mul_left_injective₀ hp.out.ne').eq_iff, nat.cast_inj, mul_comm] at hk,
  exact (nat.le_of_dvd h0 ⟨_, hk.symm⟩).not_lt hn,
end

variables (p)

lemma gcd_mul_add_order_of_div_eq {n : ℕ} (m : ℕ) (hn : 0 < n) :
  m.gcd n * add_order_of (↑(↑m / ↑n * p) : add_circle p) = n :=
begin
  rw [mul_comm_div, ← nsmul_eq_mul, coe_nsmul, add_order_of_nsmul''],
  { rw [add_order_of_period_div hn, nat.gcd_comm, nat.mul_div_cancel'],
    exacts [n.gcd_dvd_left m, hp] },
  { rw [← add_order_of_pos_iff, add_order_of_period_div hn], exacts [hn, hp] },
end

variable {p}

lemma add_order_of_div_of_gcd_eq_one {m n : ℕ} (hn : 0 < n) (h : m.gcd n = 1) :
  add_order_of (↑(↑m / ↑n * p) : add_circle p) = n :=
by { convert gcd_mul_add_order_of_div_eq p m hn, rw [h, one_mul] }

lemma add_order_of_div_of_gcd_eq_one' {m : ℤ} {n : ℕ} (hn : 0 < n) (h : m.nat_abs.gcd n = 1) :
  add_order_of (↑(↑m / ↑n * p) : add_circle p) = n :=
begin
  induction m,
  { simp only [int.of_nat_eq_coe, int.cast_coe_nat, int.nat_abs_of_nat] at h ⊢,
    exact add_order_of_div_of_gcd_eq_one hn h, },
  { simp only [int.cast_neg_succ_of_nat, neg_div, neg_mul, coe_neg, order_of_neg],
    exact add_order_of_div_of_gcd_eq_one hn h, },
end

lemma add_order_of_coe_rat {q : ℚ} : add_order_of (↑(↑q * p) : add_circle p) = q.denom :=
begin
  have : (↑(q.denom : ℤ) : 𝕜) ≠ 0, { norm_cast, exact q.pos.ne.symm, },
  rw [← @rat.num_denom q, rat.cast_mk_of_ne_zero _ _ this, int.cast_coe_nat, rat.num_denom,
    add_order_of_div_of_gcd_eq_one' q.pos q.cop],
  apply_instance,
end

lemma add_order_of_eq_pos_iff {u : add_circle p} {n : ℕ} (h : 0 < n) :
  add_order_of u = n ↔ ∃ m < n, m.gcd n = 1 ∧ ↑(↑m / ↑n * p) = u :=
begin
  refine ⟨quotient_add_group.induction_on' u (λ k hk, _), _⟩, swap,
  { rintros ⟨m, h₀, h₁, rfl⟩, exact add_order_of_div_of_gcd_eq_one h h₁ },
  have h0 := add_order_of_nsmul_eq_zero (k : add_circle p),
  rw [hk, ← coe_nsmul, coe_eq_zero_iff] at h0,
  obtain ⟨a, ha⟩ := h0,
  have h0 : (_ : 𝕜) ≠ 0 := nat.cast_ne_zero.2 h.ne',
  rw [nsmul_eq_mul, mul_comm, ← div_eq_iff h0, ← a.div_add_mod' n, add_smul, add_div, zsmul_eq_mul,
    int.cast_mul, int.cast_coe_nat, mul_assoc, ← mul_div, mul_comm _ p, mul_div_cancel p h0] at ha,
  have han : _ = a % n := int.to_nat_of_nonneg (int.mod_nonneg _ $ by exact_mod_cast h.ne'),
  have he := _, refine ⟨(a % n).to_nat, _, _, he⟩,
  { rw [← int.coe_nat_lt, han],
    exact int.mod_lt_of_pos _ (int.coe_nat_lt.2 h) },
  { have := (gcd_mul_add_order_of_div_eq p _ h).trans ((congr_arg add_order_of he).trans hk).symm,
    rw [he, nat.mul_left_eq_self_iff] at this, { exact this }, { rwa hk } },
  convert congr_arg coe ha using 1,
  rw [coe_add, ← int.cast_coe_nat, han, zsmul_eq_mul, mul_div_right_comm,
      eq_comm, add_left_eq_self, ← zsmul_eq_mul, coe_zsmul, coe_period, smul_zero],
end

lemma exists_gcd_eq_one_of_is_of_fin_add_order {u : add_circle p} (h : is_of_fin_add_order u) :
  ∃ m : ℕ, m.gcd (add_order_of u) = 1 ∧
           m < (add_order_of u) ∧
           ↑(((m : 𝕜) / add_order_of u) * p) = u :=
let ⟨m, hl, hg, he⟩ := (add_order_of_eq_pos_iff $ add_order_of_pos' h).1 rfl in ⟨m, hg, hl, he⟩

variables (p)

/-- The natural bijection between points of order `n` and natural numbers less than and coprime to
`n`. The inverse of the map sends `m ↦ (m/n * p : add_circle p)` where `m` is coprime to `n` and
satisfies `0 ≤ m < n`. -/
def set_add_order_of_equiv {n : ℕ} (hn : 0 < n) :
  {u : add_circle p | add_order_of u = n} ≃ {m | m < n ∧ m.gcd n = 1} :=
equiv.symm $ equiv.of_bijective
  (λ m, ⟨↑((m : 𝕜) / n * p), add_order_of_div_of_gcd_eq_one hn (m.prop.2)⟩)
begin
  refine ⟨λ m₁ m₂ h, subtype.ext _, λ u, _⟩,
  { simp_rw [subtype.ext_iff, subtype.coe_mk] at h,
    rw [← sub_eq_zero, ← coe_sub, ← sub_mul, ← sub_div, coe_coe, coe_coe, ← int.cast_coe_nat m₁,
        ← int.cast_coe_nat m₂, ← int.cast_sub, coe_eq_zero_iff] at h,
    obtain ⟨m, hm⟩ := h,
    rw [← mul_div_right_comm, eq_div_iff, mul_comm, ← zsmul_eq_mul, mul_smul_comm, ← nsmul_eq_mul,
      ← coe_nat_zsmul, smul_smul, (zsmul_strict_mono_left hp.out).injective.eq_iff, mul_comm] at hm,
    swap, { exact nat.cast_ne_zero.2 hn.ne' },
    rw [← @nat.cast_inj ℤ, ← sub_eq_zero],
    refine int.eq_zero_of_abs_lt_dvd ⟨_, hm.symm⟩ (abs_sub_lt_iff.2 ⟨_, _⟩);
    apply (int.sub_le_self _ $ nat.cast_nonneg _).trans_lt (nat.cast_lt.2 _),
    exacts [m₁.2.1, m₂.2.1] },
  obtain ⟨m, hmn, hg, he⟩ := (add_order_of_eq_pos_iff hn).mp u.2,
  exact ⟨⟨m, hmn, hg⟩, subtype.ext he⟩,
end

@[simp] lemma card_add_order_of_eq_totient {n : ℕ} :
  nat.card {u : add_circle p // add_order_of u = n} = n.totient :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { simp only [nat.totient_zero, add_order_of_eq_zero_iff],
    rcases em (∃ (u : add_circle p), ¬ is_of_fin_add_order u) with ⟨u, hu⟩ | h,
    { haveI : infinite {u : add_circle p // ¬is_of_fin_add_order u},
      { erw infinite_coe_iff,
        exact infinite_not_is_of_fin_add_order hu, },
      exact nat.card_eq_zero_of_infinite, },
    { haveI : is_empty {u : add_circle p // ¬is_of_fin_add_order u}, { simpa using h, },
      exact nat.card_of_is_empty, }, },
  { rw [← coe_set_of, nat.card_congr (set_add_order_of_equiv p hn),
      n.totient_eq_card_lt_and_coprime],
    simp only [nat.gcd_comm], },
end

lemma finite_set_of_add_order_eq {n : ℕ} (hn : 0 < n) :
  {u : add_circle p | add_order_of u = n}.finite :=
finite_coe_iff.mp $ nat.finite_of_card_ne_zero $ by simpa only [coe_set_of,
  card_add_order_of_eq_totient p] using (nat.totient_pos hn).ne'

end finite_order_points

end linear_ordered_field

variables (p : ℝ)

/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is compact. -/
instance compact_space [fact (0 < p)] : compact_space $ add_circle p :=
begin
  rw [← is_compact_univ_iff, ← coe_image_Icc_eq p 0],
  exact is_compact_Icc.image (add_circle.continuous_mk' p),
end

/-- The action on `ℝ` by right multiplication of its the subgroup `zmultiples p` (the multiples of
`p:ℝ`) is properly discontinuous. -/
instance : properly_discontinuous_vadd (zmultiples p).opposite ℝ :=
(zmultiples p).properly_discontinuous_vadd_opposite_of_tendsto_cofinite
  (add_subgroup.tendsto_zmultiples_subtype_cofinite p)

/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is Hausdorff. -/
instance : t2_space (add_circle p) := t2_space_of_properly_discontinuous_vadd_of_t2_space

/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is normal. -/
instance [fact (0 < p)] : normal_space (add_circle p) := normal_of_compact_t2

/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is second-countable. -/
instance : second_countable_topology (add_circle p) := quotient_add_group.second_countable_topology

end add_circle

local attribute [instance] real.fact_zero_lt_one

/-- The unit circle `ℝ ⧸ ℤ`. -/
@[derive [compact_space, normal_space, second_countable_topology]]
abbreviation unit_add_circle := add_circle (1 : ℝ)

section identify_Icc_ends
/-! This section proves that for any `a`, the natural map from `[a, a + p] ⊂ 𝕜` to `add_circle p`
gives an identification of `add_circle p`, as a topological space, with the quotient of `[a, a + p]`
by the equivalence relation identifying the endpoints. -/

namespace add_circle

variables [linear_ordered_add_comm_group 𝕜] [topological_space 𝕜] [order_topology 𝕜]
(p a : 𝕜) [hp : fact (0 < p)]

include hp

local notation `𝕋` := add_circle p

/-- The relation identifying the endpoints of `Icc a (a + p)`. -/
inductive endpoint_ident : Icc a (a + p) → Icc a (a + p) → Prop
| mk : endpoint_ident
    ⟨a,      left_mem_Icc.mpr $ le_add_of_nonneg_right hp.out.le⟩
    ⟨a + p, right_mem_Icc.mpr $ le_add_of_nonneg_right hp.out.le⟩

variables [archimedean 𝕜]

/-- The equivalence between `add_circle p` and the quotient of `[a, a + p]` by the relation
identifying the endpoints. -/
def equiv_Icc_quot : 𝕋 ≃ quot (endpoint_ident p a) :=
{ to_fun := λ x, quot.mk _ $ inclusion Ico_subset_Icc_self (equiv_Ico _ _ x),
  inv_fun := λ x, quot.lift_on x coe $ by { rintro _ _ ⟨_⟩, exact (coe_add_period p a).symm },
  left_inv := (equiv_Ico p a).symm_apply_apply,
  right_inv := quot.ind $ by
  { rintro ⟨x, hx⟩,
    have := _,
    rcases ne_or_eq x (a + p) with h | rfl,
    { revert x, exact this },
    { rw ← quot.sound endpoint_ident.mk, exact this _ _ (lt_add_of_pos_right a hp.out).ne },
    intros x hx h,
    congr, ext1,
    apply congr_arg subtype.val ((equiv_Ico p a).right_inv ⟨x, hx.1, hx.2.lt_of_ne h⟩) } }

lemma equiv_Icc_quot_comp_mk_eq_to_Ico_mod : equiv_Icc_quot p a ∘ quotient.mk' =
  λ x, quot.mk _ ⟨to_Ico_mod a hp.out x, Ico_subset_Icc_self $ to_Ico_mod_mem_Ico a _ x⟩ := rfl

lemma equiv_Icc_quot_comp_mk_eq_to_Ioc_mod : equiv_Icc_quot p a ∘ quotient.mk' =
  λ x, quot.mk _ ⟨to_Ioc_mod a hp.out x, Ioc_subset_Icc_self $ to_Ioc_mod_mem_Ioc a _ x⟩ :=
begin
  rw equiv_Icc_quot_comp_mk_eq_to_Ico_mod, funext,
  by_cases mem_Ioo_mod a p x,
  { simp_rw (mem_Ioo_mod_iff_to_Ico_mod_eq_to_Ioc_mod hp.out).1 h },
  { simp_rw [not_imp_comm.1 (mem_Ioo_mod_iff_to_Ico_mod_ne_left hp.out).2 h,
             not_imp_comm.1 (mem_Ioo_mod_iff_to_Ioc_mod_ne_right hp.out).2 h],
    exact quot.sound endpoint_ident.mk },
end

/-- The natural map from `[a, a + p] ⊂ 𝕜` with endpoints identified to `𝕜 / ℤ • p`, as a
homeomorphism of topological spaces. -/
def homeo_Icc_quot : 𝕋 ≃ₜ quot (endpoint_ident p a) :=
{ to_equiv := equiv_Icc_quot p a,
  continuous_to_fun := begin
    simp_rw [quotient_map_quotient_mk.continuous_iff,
      continuous_iff_continuous_at, continuous_at_iff_continuous_left_right],
    intro x, split,
    work_on_goal 1 { erw equiv_Icc_quot_comp_mk_eq_to_Ioc_mod },
    work_on_goal 2 { erw equiv_Icc_quot_comp_mk_eq_to_Ico_mod },
    all_goals { apply continuous_quot_mk.continuous_at.comp_continuous_within_at,
      rw inducing_coe.continuous_within_at_iff },
    { apply continuous_left_to_Ioc_mod },
    { apply continuous_right_to_Ico_mod },
  end,
  continuous_inv_fun := continuous_quot_lift _
    ((add_circle.continuous_mk' p).comp continuous_subtype_coe) }

/-! We now show that a continuous function on `[a, a + p]` satisfying `f a = f (a + p)` is the
pullback of a continuous function on `add_circle p`. -/

variables {p a}

lemma lift_Ico_continuous [topological_space B] {f : 𝕜 → B} (hf : f a = f (a + p))
  (hc : continuous_on f $ Icc a (a + p)) : continuous (lift_Ico p a f) :=
begin
  rw lift_Ico_eq_lift_Icc hf,
  refine continuous.comp _ (homeo_Icc_quot p a).continuous_to_fun,
  exact continuous_coinduced_dom.mpr (continuous_on_iff_continuous_restrict.mp hc),
end

section zero_based

lemma lift_Ico_zero_coe_apply {f : 𝕜 → B} {x : 𝕜} (hx : x ∈ Ico 0 p) :
  lift_Ico p 0 f ↑x = f x := lift_Ico_coe_apply (by rwa zero_add)

lemma lift_Ico_zero_continuous [topological_space B] {f : 𝕜 → B}
  (hf : f 0 = f p) (hc : continuous_on f $ Icc 0 p) : continuous (lift_Ico p 0 f) :=
lift_Ico_continuous (by rwa zero_add : f 0 = f (0 + p)) (by rwa zero_add)

end zero_based

end add_circle

end identify_Icc_ends


-- Si_a_es_un_punto_de_acumulacion_de_la_sucesion_de_Cauchy_u,_entonces_a_es_el_limite_de_u.lean
-- Si a es un punto de acumulación de la sucesión de Cauchy u, entonces a es el límite de u
-- José A. Alonso Jiménez
-- Sevilla, 4 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, una sucesión u₀, u₁, u₂, ... se puede representar mediante
-- una función (u : ℕ → ℝ) de forma que u(n) es uₙ.
--
-- Para extraer una subsucesión se aplica una función de extracción que
-- conserva el orden; por ejemplo, la subsucesión
--    uₒ, u₂, u₄, u₆, ...
-- se ha obtenido con la función de extracción φ tal que φ(n) = 2*n.
--
-- En Lean, se puede definir que φ es una función de extracción por
--    def extraccion (φ : ℕ → ℕ) :=
--      ∀ n m, n < m → φ n < φ m
-- que a es un límite de u por
--    def limite (u : ℕ → ℝ) (a : ℝ) :=
--      ∀ ε > 0, ∃ N, ∀ k ≥ N, |u k - a| < ε
-- que a es un punto de acumulación de u por
--    def punto_acumulacion (u : ℕ → ℝ) (a : ℝ) :=
--      ∃ φ, extraccion φ ∧ limite (u ∘ φ) a
-- que la sucesión u es de Cauchy por
--    def suc_cauchy (u : ℕ → ℝ) :=
--      ∀ ε > 0, ∃ N, ∀ p ≥ N, ∀ q ≥ N, |u p - u q| < ε
--
-- Demostrar que si u es una sucesión de Cauchy y a es un punto de
-- acumulación de u, entonces a es el límite de u.
-- ---------------------------------------------------------------------

import data.real.basic
open nat

variable  {u : ℕ → ℝ}
variables {a : ℝ}
variable  {φ : ℕ → ℕ}

notation `|`x`|` := abs x

def extraccion (φ : ℕ → ℕ) :=
  ∀ n m, n < m → φ n < φ m

def limite (u : ℕ → ℝ) (l : ℝ) : Prop :=
  ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| < ε

def punto_acumulacion (u : ℕ → ℝ) (a : ℝ) :=
  ∃ φ, extraccion φ ∧ limite (u ∘ φ) a

def suc_cauchy (u : ℕ → ℝ) :=
  ∀ ε > 0, ∃ N, ∀ p ≥ N, ∀ q ≥ N, |u p - u q| < ε

lemma aux1
  (h : extraccion φ)
  : ∀ n, n ≤ φ n :=
begin
  intro n,
  induction n with m HI,
  { exact nat.zero_le (φ 0), },
  { apply nat.succ_le_of_lt,
    calc m ≤ φ m        : HI
       ... < φ (succ m) : h m (m+1) (lt_add_one m), },
end

lemma aux2
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
λ N N', ⟨max N N', ⟨le_max_right N N',
                    le_trans (le_max_left N N')
                             (aux1 h (max N N'))⟩⟩

lemma cerca_acumulacion
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
begin
  intros ε hε N,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  cases hφ2 ε hε with N' hN',
  rcases aux2 hφ1 N N' with ⟨m, hm, hm'⟩,
  exact ⟨φ m, hm', hN' _ hm⟩,
end

-- 1ª demostración
example
  (hu : suc_cauchy u)
  (ha : punto_acumulacion u a)
  : limite u a :=
begin
  unfold limite,
  intros ε hε,
  unfold suc_cauchy at hu,
  cases hu (ε/2) (half_pos hε) with N hN,
  use N,
  have ha' : ∃ N' ≥ N, |u N' - a| < ε/2,
    apply cerca_acumulacion ha (ε/2) (half_pos hε),
  cases ha' with N' h,
  cases h with hNN' hN',
  intros n hn,
  calc   |u n - a|
       = |(u n - u N') + (u N' - a)| : by ring_nf
   ... ≤ |u n - u N'| + |u N' - a|   : abs_add (u n - u N') (u N' - a)
   ... < ε/2 + |u N' - a|            : add_lt_add_right (hN n hn N' hNN') _
   ... < ε/2 + ε/2                   : add_lt_add_left hN' (ε / 2)
   ... = ε                           : add_halves ε
end

-- 2ª demostración
example
  (hu : suc_cauchy u)
  (ha : punto_acumulacion u a)
  : limite u a :=
begin
  intros ε hε,
  cases hu (ε/2) (by linarith) with N hN,
  use N,
  have ha' : ∃ N' ≥ N, |u N' - a| < ε/2,
    apply cerca_acumulacion ha (ε/2) (by linarith),
  rcases ha' with ⟨N', hNN', hN'⟩,
  intros n hn,
  calc  |u n - a|
      = |(u n - u N') + (u N' - a)| : by ring_nf
  ... ≤ |u n - u N'| + |u N' - a|   : abs_add (u n - u N') (u N' - a)
  ... < ε                           : by linarith [hN n hn N' hNN'],
end


/- How would one axiomatise Kelley's set theory in Lean? Like this: -/
namespace kelley
noncomputable theory

/--The space of all classes. -/
constant C : Type
constant ε : C → C → Prop
instance : has_mem C C := ⟨ε⟩

axiom I : ∀ {x y : C}, (∀ z, z ∈ x ↔ z ∈ y) → x = y
def is_set (x : C) : Prop := ∃ y:C, x ∈ y

constant sep (P : C → Prop) : C
--instance : has_sep C C := ⟨sep⟩
axiom II {P : C → Prop} : ∀ {x:C}, (x ∈ sep P) ↔ (is_set(x) ∧ P(x))
notation `{` binders `| ` r:(scoped f, sep f) `}` := r
variables {x y z: C}
definition D2 (x y : C) : C := {z|z ∈ x ∧ z ∈ y}
instance : has_inter C := ⟨D2⟩
definition D3 (x y : C) : C := {z|z ∈ x ∨ z ∈ y}
instance : has_union C := ⟨D3⟩
theorem T4a : z ∈ x ∪ y ↔ (z ∈ x) ∨ (z ∈ y) := ⟨λ x, (II.1 x).2,λ y, or.cases_on y (λ h, II.2 ⟨⟨_,h⟩,or.inl h⟩) (λ h, II.2 ⟨⟨_,h⟩,or.inr h⟩)⟩
theorem T4b : z ∈ x ∩ y ↔ (z ∈ x) ∧ (z ∈ y) := ⟨λ h, (II.1 h).2,λ ⟨h₁,h₂⟩, II.2 ⟨⟨_,h₁⟩,⟨h₁, h₂⟩⟩⟩
theorem T5a : x ∪ x = x := I (λ z, ⟨λ h, or.cases_on (II.1 h).2 id id,λ h, II.2 ⟨⟨_,h⟩,or.inl h⟩⟩)
theorem T5b : x ∩ x = x := I (λ z, ⟨λ h, and.cases_on (II.1 h).2 (λ _ h, h),λ h, II.2 ⟨⟨_,h⟩,⟨h,h⟩⟩⟩)
theorem T6a : x ∪ y = y ∪ x := sorry
theorem T6b : x ∩ y = y ∩ x := sorry
theorem T7a : (x ∪ y) ∪ z = x ∪ (y ∪ z) := sorry
theorem T7b : (x ∩ y) ∩ z = x ∩ (y ∩ z) := I $ λ a,
    ⟨λ h, let ⟨h₂,h₃⟩ := T4b.1 h in let ⟨h₂,h₄⟩ := T4b.1 h₂ in T4b.2 ⟨h₂,T4b.2 ⟨h₄,h₃⟩⟩
    ,λ h, let ⟨h₂,h₃⟩ := T4b.1 h in let ⟨h₃,h₄⟩ := T4b.1 h₃ in T4b.2 ⟨T4b.2 ⟨h₂,h₃⟩, h₄⟩
    ⟩
theorem T8a : x ∩ (y ∪ z) = (x ∩ y) ∪ (x ∩ z) := sorry
theorem T8b : x ∪ (y ∩ z) = (x ∪ y) ∩ (x ∪ z) := sorry
definition D10 (x:C) : C := {y|y ∉ x}
prefix `~` := D10
theorem T11 : (~ (~ x)) = x := I $ assume z:C,
    ⟨   assume h : z ∈ ~ (~ x),
        have h₂ : z ∉ ~x := (II.1 h).2,
        classical.by_contradiction (
            assume h₃ : z ∉ x,
            have h₄ : z ∈ { z | z ∉ x}, from II.2 $ ⟨⟨_,h⟩,h₃⟩,
            show false, from h₂ h₄
            )
    , λ h, II.2 $ ⟨⟨_,h⟩,λ h₂, absurd h (II.1 h₂).2⟩
    ⟩

definition D13 (x y : C) := x ∩ (~ y)
instance : has_sub C := ⟨D13⟩
theorem T14 : x ∩ (y - z) = (x ∩ y) - z := eq.symm T7b
definition D15 :C := {x|false}
instance : has_emptyc C := ⟨D15⟩
theorem T16 : x ∉ (∅:C) := λ h, (II.1 h).2
theorem T17a : ∅ ∪ x = x := sorry
theorem T17b : ∅ ∩ x = ∅ := sorry
definition U : C := {x|true}
theorem T19 : x ∈ U ↔ is_set x := ⟨λ h, (II.1 h).1, λ h, II.2 ⟨h,⟨⟩⟩⟩
theorem T20a : x ∪ U = U := sorry
theorem T20b : x ∩ U = x := sorry
theorem T21a : (~ ∅) = U := I $ λ z, ⟨λ h, let ⟨s,h⟩ := II.1 h in II.2 ⟨s,⟨⟩⟩,λ h, let ⟨s,h⟩ := II.1 h in II.2 ⟨s,T16⟩⟩
theorem T21b : (~ U) = ∅ := calc (~ U) = ~ ~ ∅ : by rw <- T21a ... = ∅ : T11
definition D22 (x : C) := {z|∀ y, y ∈ x → z ∈ y}
prefix `⋂`:100 := D22
definition D23 (x : C) := {z|∃ y, y ∈ x ∧ z ∈ y}
prefix `⋃`:100 := D23

theorem T24a : ⋂ ∅ = U := I $ λ z,
⟨assume h: z ∈ ⋂∅, II.2 ⟨⟨_,h⟩,⟨⟩⟩
,assume h: z ∈ U, II.2 ⟨T19.1 h,λ y h₂, false.rec_on _ (T16 h₂)⟩
⟩
theorem T24b : ⋃ ∅ = ∅ := I $ λ z, ⟨λ h, let ⟨_,_,h₂,_⟩ := II.1 h in false.rec_on _ (T16 h₂),λ h, false.rec_on _ (T16 h)⟩
definition D25 (x y : C) : Prop := ∀ z, z ∈ x → z ∈ y
instance : has_subset C := ⟨D25⟩
-- etc etc
theorem T26a : ∅ ⊆ x := λ z ze, false.rec_on _ (T16 ze)
theorem T26b : x ⊆ U := λ z ze, II.2 ⟨⟨_,ze⟩, ⟨⟩⟩
theorem T27 : x ⊆ y → y ⊆ x → x = y := λ xy yx, I $ λ z, ⟨xy _,yx _⟩
theorem T28 : x ⊆ y → y ⊆ z → x ⊆ z := λ xy yz a ax, yz _ $ xy _ ax
theorem T29 : x ⊆ y ↔ x ∪ y = y := sorry
theorem T30 : x ⊆ y ↔ x ∩ y = x := sorry
theorem T31a : x ⊆ y → ⋃x ⊆ ⋃y := sorry
theorem T31b : x ⊆ y → ⋂y ⊆ ⋂x := sorry
theorem T32 : x ∈ y → x ⊆ ⋃ y := sorry
theorem T32b : x ∈ y → ⋂ y ⊆ x := sorry
-- the powerset axiom
axiom III : is_set(x) → ∃ y, is_set(y) ∧ ∀ z, z ⊆ x → z ∈ y
theorem T33 : is_set(x) → (z ⊆ x) → is_set(z) := λ h₁ h₂,
    let ⟨w,h₃,h₄⟩ := III (h₁) in ⟨w,h₄ _ h₂⟩
theorem T34a : ∅ = ⋂ U := sorry
theorem T34b : U = ⋃ U := sorry
theorem T35 : x ≠ ∅ → is_set ⋂x := sorry
definition D36 (x:C) : C := {y|y⊆x}
prefix `P`:100 := D36
lemma x_in_P_x : is_set(x) → x ∈ P x := λ sx, II.2 ⟨sx,λ z h, h⟩
theorem T37 : U = P U := I $ λ x, ⟨λ h, II.2 $ ⟨⟨_,h⟩,λ y h₂, II.2 $ ⟨⟨_,h₂⟩,⟨⟩⟩⟩,λ p, II.2 ⟨(II.1 p).1,⟨⟩⟩⟩
theorem T38a : is_set x → is_set (P x) :=
    assume h₁,
    let ⟨y,h₂,h₃⟩ := III h₁ in
    have P x ⊆ y, from λ z h₄, h₃ _ (II.1 h₄).2,
    T33 h₂ this

definition R := {y|y∉y}
lemma R_not_in_R : R ∉ R := assume h : R ∈ R, absurd h (II.1 h).2
lemma R_not_set : ¬ is_set(R) := λ c, R_not_in_R $ II.2 $ ⟨c,R_not_in_R⟩
lemma R_sub_U : R ⊆ U := λ z h, II.2 ⟨⟨_,h⟩,⟨⟩⟩
theorem T39 : ¬ is_set(U) := λ h, absurd (T33 h R_sub_U) R_not_set
definition singleton (x:C) := {z|x ∈ U → z = x}
definition insert (x X : C) := (singleton x) ∪ X
notation `⟮` l:(foldr `, ` (h t, insert h t) ∅ `⟯`) := l
theorem T41 : is_set(x) → ∀ {y}, y ∈ ⟮x⟯ ↔ y = x := sorry
theorem T41b : is_set(x) → x ∈ ⟮x⟯ := sorry
theorem T42 : (is_set(x)) → (is_set ⟮x⟯) := sorry
theorem T43 : ⟮x⟯ = U ↔ ¬is_set x := sorry
theorem T44a : is_set x → ⋂⟮x⟯ = x := sorry
theorem T44b : is_set x → ⋃⟮x⟯ = x := sorry
theorem T44c : ¬is_set x → ⋂⟮x⟯ = ∅ := sorry
theorem T44d : ¬is_set x → ⋃⟮x⟯ = U := sorry
axiom IV: is_set(x) → is_set(y) → is_set (x ∪ y)

theorem T46a : is_set x → is_set y → is_set (⟮x,y⟯) := sorry
theorem T46b : is_set x → is_set y → ((z ∈ ⟮x,y⟯) ↔ (z = x ∨ z = y)) := sorry
theorem T46c : (⟮x,y⟯ = U) ↔ ((¬ is_set x) ∨ (¬ is_set y)) := sorry
theorem T46d : x ∈ z → y ∈ z → ⟮x,y⟯ ⊆ z := λ xz yz u up,
    have h : (u = x ∨ u = y), from (T46b ⟨z,xz⟩ ⟨z,yz⟩).1 up,
    or.rec_on h (λ h, eq.symm h ▸ xz) (λ h, eq.symm h ▸ yz)
theorem T46e : is_set x → is_set y → ⟮x,y⟯ ≠ ∅ := sorry
theorem T46f : is_set x → is_set y →  x ∈ ⟮x,y⟯ := sorry
theorem T46g : is_set x → is_set y →  y ∈ ⟮x,y⟯ := sorry
theorem T47a : is_set x → is_set y → ⋂ ⟮x,y⟯ = x ∩ y := sorry
theorem T47b : is_set x → is_set y → ⋃ ⟮x,y⟯ = x ∪ y := sorry
theorem T47c : (¬is_set x ∨ ¬is_set y) → ⋂ ⟮x,y⟯ = ∅ := sorry
theorem T47d : (¬is_set x ∨ ¬is_set y) → ⋃ ⟮x,y⟯ = U := sorry
/-- Ordered Pair -/
definition D48 (x y : C) := ⟮⟮x⟯,⟮x,y⟯⟯
notation `[`x`,`y`]` := D48 x y
theorem T49a : is_set x → is_set y → is_set [x,y] := λ sx sy, T46a (T42 sx) (T46a sx sy)
theorem T49b : is_set [x,y] → is_set x := sorry
theorem T49c : is_set [x,y] → is_set y := sorry
theorem T49d : ¬is_set [x,y] → [x,y] = U := sorry
theorem T50 : is_set x → is_set y →
      ⋃[x,y] = ⟮x,y⟯
    ∧ ⋂[x,y] = ⟮x⟯
    ∧ ⋃⋂[x,y] = x
    ∧ ⋂⋂[x,y] = x
    ∧ ⋃⋃[x,y] = x ∪ y
    ∧ ⋂⋃[x,y] = x ∩ y
:= sorry
definition fst (x:C) := ⋂ ⋂ x -- D51
definition snd (x:C) := (⋂⋃x) ∪ (⋃⋃x - ⋃⋂x) -- D52
theorem T53 : snd U = U := sorry
theorem T54a : (is_set x) → (is_set y) → ((fst [x,y]) = x) ∧ (snd [x,y] = y) := sorry
theorem T54b : ¬(is_set x ∧ is_set y) → ((fst [x,y]) = U) ∧ (snd [x,y] = U) := sorry
theorem T55 {x y u v : C} : [x,y] = [u,v] → x = u ∧ y = v := sorry
definition is_relation (r:C) : Prop := ∀ z, z ∈ r → ∃ x y, z = [x,y]
definition D57 (r s : C) := {u| ∃ x y z, u = [x,z] ∧ [x,y] ∈ s ∧ [y,z] ∈ r}
infix ` ∙ `:80 := D57
variables {r s t : C}
theorem T58 : (r ∙ s) ∙ t = r ∙ (s ∙ t) := sorry
theorem T59a : r ∙ (s ∪ t) = (r ∙ s) ∪ (r ∙ t) :=
    I $ λ p,
    ⟨λ h, let ⟨h₁,x,y,z,h₂,h₃,h₄⟩ := II.1 h in let ⟨h₅,h₆⟩ := II.1 h₃ in II.2 ⟨h₁, or.cases_on h₆ (λ h₇, or.inl $ II.2 ⟨h₁,x,y,z,h₂,h₇,h₄⟩) (λ h₇, or.inr $ II.2 ⟨h₁,x,y,z,h₂,h₇,h₄⟩)⟩
    ,λ h, let ⟨h₁,h₂⟩ := II.1 h in or.cases_on h₂ (λ h₃,let ⟨h₃,x,y,z,h₄,h₅,h₆⟩ := II.1 h₃ in II.2 ⟨h₃,x,y,z,h₄,T4a.2 $ or.inl h₅,h₆⟩) (λ h₃,let ⟨h₃,x,y,z,h₄,h₅,h₆⟩ := II.1 h₃ in II.2 ⟨h₃,x,y,z,h₄,T4a.2 $ or.inr h₅,h₆⟩)
    ⟩
theorem T59b : r ∙ (s ∩ t) ⊆ (r ∙ s) ∩ (r ∙ t) := λ a h₁,
  let ⟨h₂,x,y,z,h₃,h₄,h₅⟩ := (II.1 h₁) in
  let ⟨h₆,h₇,h₈⟩ := II.1 h₄ in
  II.2 ⟨h₂, II.2 ⟨h₂,x,y,z,h₃,h₇,h₅⟩, II.2 ⟨h₂,x,y,z,h₃,h₈,h₅⟩⟩
definition inverse (r:C) : C := {s|∃ x y, s = [x,y] ∧ [y,x] ∈ r}
postfix `⁻¹` := inverse
theorem T61 : r ⁻¹ ⁻¹ = r := sorry
theorem T62 : (r ∙ s) ⁻¹ = s ⁻¹ ∙ r ⁻¹ := sorry
definition is_function (f : C) := is_relation f ∧ ∀ x y z, [x,y] ∈ f → [x,z] ∈ f → y = z
definition domain (f:C) := {x|∃ y, [x,y] ∈ f}
definition range (f:C) := {y|∃ x, [x,y] ∈ f}

variables {f g : C}
theorem T64 : is_function f → is_function g → is_function (f ∙ g) := sorry
theorem T67a : domain U = U := sorry
theorem T67b : range U =  U := sorry
definition apply (f : C) (x : C) := ⋂ {y|[x,y] ∈ f}
instance function_coe : has_coe_to_fun C := ⟨λ x,C→C,apply⟩
theorem T69a : x ∉ (domain f) → f(x) = U := sorry
theorem T69b : x ∈ (domain f) → f(x) ∈ U := sorry
theorem T71 : is_function f → is_function g → (∀ x, f(x) = g(x)) → f = g := sorry
-- Axiom of substitution.
axiom V: ∀ {f : C}, is_function f → is_set (domain f) → is_set(range f)
axiom VI: is_set(x) → is_set(⋃ x)

definition D72 (x y : C) := {p|∃ u v, p = [u,v] ∧ u∈x ∧ v∈y}
infix ` ⨉ `:100 := D72
lemma prod_is_rel : is_relation (x ⨉ y) := λ z zr, let ⟨h₁,u,v,zuv,ux,vy⟩ := II.1 zr in ⟨u,v,zuv⟩
theorem T73 : (is_set x) → (is_set y) → is_set (⟮x⟯ ⨉ y) := sorry
theorem T74 : is_set x → is_set y → is_set (x ⨉ y) := sorry
definition D76 (x y : C) : C := {f|is_function f ∧ domain f = x ∧ range f ⊆ y}
infix ` => `:90 := D76
lemma function_sub_PPproduct : (x => y) ⊆ P (x ⨉ y) :=
λ f h, let ⟨h₁,⟨h₂,h₃⟩,h₄,h₅⟩ := II.1 h in II.2 ⟨h₁,λ p h₆, II.2 ⟨⟨_,h₆⟩, let ⟨u,v,h₇⟩ := h₂ _ h₆ in ⟨u,v,h₇,have u ∈ domain f, from II.2 sorry, h₄ ▸ this,sorry⟩⟩⟩
theorem T77 : is_set x → is_set y → is_set (x => y) := λ h₁ h₂, sorry

notation x` -`r`> `y := [x,y] ∈ r

definition connects (r x : C) := ∀ (u v ∈ x), (u -r> v) ∨ (v -r> u) ∨ (u = v)
definition transitive (r x : C) := ∀ (u v w ∈ x), (u -r> v) → (v -r> w) → (u -r> w)
definition asymmetric (r x : C) := ∀ (u v ∈ x), (u -r> v) → ¬(v -r> u)
definition first_mem (z r x : C) := z ∈ x ∧ ∀ y ∈ x, ¬ (y-r>z)
/-- r well-orders x -/
definition well_orders (r x : C) := connects r x ∧ ∀ y, y ⊆ x → y ≠ ∅ → ∃ z, first_mem z r y
instance : has_coe (x ∈ y) (is_set x) := ⟨λ xy, ⟨y,xy⟩⟩
theorem T88a : well_orders r x → asymmetric r x :=
    λ ⟨hc,fm⟩ u v,
    assume ux : u ∈ x,
    assume vx : v ∈ x,
    assume uv : u -r> v,
    assume vu : v -r> u,
    have h₁ : ⟮u,v⟯ ⊆ x, from T46d ux vx,
    let ⟨z,h₂,h₃⟩ := fm _ h₁ (T46e ux vx) in
    or.rec_on ((T46b ⟨x,ux⟩ ⟨x,vx⟩).1 h₂)
      (assume h : z = u, h₃ v (T46g ux vx) (eq.symm h ▸ vu))
      (assume h : z = v, h₃ u (T46f ux vx) (eq.symm h ▸ uv))
theorem T88b : well_orders r x → transitive r x :=
λ ⟨hc, fm⟩ u v w ux vx wx uv vw, classical.by_contradiction (λ nuw,
    or.rec_on (hc w u wx ux) (λ h,
        let t := ⟮u,v,w⟯ in
        have tsx : t ⊆ x, from (λ a ha, sorry),
        have tne : t ≠ ∅, from sorry,
        let ⟨z,h₁,h₂⟩ := fm _ tsx tne in
        sorry -- [TODO] rec on u,v,w again ☹
    ) (λ h, or.rec_on h (λ uw, absurd uw nuw) (λ uw, T88a ⟨hc,fm⟩ u v ux vx uv (uw ▸ vw)))
)
/-- y is an r-section on x-/
definition sect (y r x : C) := y ⊆ x ∧ well_orders r x ∧ ∀ (u ∈ x) (v ∈ y), (u -r> v) → u ∈ y
theorem T90 : x ≠ ∅ → (∀ y ∈ x, sect y r x) → sect (⋃x) r x ∧ sect (⋂x) r x := sorry
theorem T91 : sect y r x → y ≠ x → ∃ v∈x, y = {u|u∈x ∧ u-r>v} := sorry
theorem T92 : sect x r z → sect y r z → x ⊆ y ∨ y ⊆ x := sorry
/--f is r-s-order preserving. -/
definition order_pres (f r s : C) :=
      is_function f
    ∧ well_orders r (domain f)
    ∧ well_orders s (range f)
    ∧ ∀ u v : C,
        u ∈ (domain f)
        → v ∈ (domain f)
        → (u-r>v)
        → (f(u) -s> f(v))
theorem T94 : sect x r y → order_pres f r r → domain f = x → range f = y → ∀ u ∈ x, ¬f(u) -r> u := sorry
definition isomorphism (f:C) := is_function f ∧ is_function f⁻¹
theorem T96 : order_pres f r s → isomorphism(f) ∧ order_pres (f⁻¹) s r := sorry
theorem T97 :
       order_pres f r s
    → order_pres g r s
    → sect (domain f) r x
    → sect (domain g) r x
    → sect (range f) s y
    → sect (range g) s y
    → f ⊆ g ∨ g ⊆ f
    := sorry
definition order_pres_in (f r s x y : C) :=
      well_orders r x
    ∧ well_orders s y
    ∧ order_pres f r s
    ∧ sect (domain f) r x
    ∧ sect (range f) s y
theorem T99 : well_orders r x → well_orders s y → ∃ f, order_pres_in f r s x y ∧ (domain f = x ∨ range f = y) := sorry
theorem T100 :
       well_orders r x
    → well_orders s y
    → is_set x
    → ¬is_set y
    → ∃! f, order_pres_in f r s x y ∧ domain f = x
    := sorry
/-- Regularity -/
axiom VII: x ≠ ∅ → ∃ y, y ∈ x ∧ x ∩ y = ∅

theorem T101 : x ∉ x :=
    assume h₁ : x ∈ x,
    have sx : is_set x, from h₁,
    have h₂ : x ≠ ∅, from assume o : x = ∅, absurd h₁ (eq.symm o ▸ T16),
    have h₃ : x ∈ ⟮x⟯, from T41b h₁,
    have h₄ : ⟮x⟯ ≠ ∅, from
        assume h₅ : ⟮x⟯ = ∅,
        have h₆ : x ∈ (∅:C), from h₅ ▸ h₃,
        absurd h₆ T16,
    have r :  ∃ (y : C), y ∈ ⟮x⟯ ∧ ⟮x⟯ ∩ y = ∅, from @VII ⟮x⟯ h₄,
    let ⟨y,r⟩ := r in
    have h₅ : y ∈ ⟮x⟯, from r.1,
    have h₆ : ⟮x⟯ ∩ y = ∅, from r.2,
    have h₇ : y = x, from (T41 sx).1 h₅,
    have h₈ : y ∈ y, from eq.symm h₇ ▸ h₁,
    have h₉ : y ∈ ⟮x⟯ ∩ y, from T4b.2 ⟨h₅, h₈⟩,
    have h₁₀ : y ∈ (∅:C), from h₆ ▸ h₉,
    absurd h₁₀ T16

theorem T102 : x ∈ y → y ∈ x → false := λ xy yx,
    let z := ⟮x,y⟯ in
    have sx : is_set x, from xy,
    have sy : is_set y, from yx,
    have h₁ : z ≠ ∅, from T46e sx sy,
    let ⟨q,h₂,h₃⟩ := VII h₁ in
    sorry -- same proof structure as T101.

definition E : C := {p|∃ x y,p=[x,y] ∧ x ∈ y}
theorem T104 : ¬is_set(E) := sorry
definition is_full (x:C) := ∀ y ∈ x, y ⊆ x
definition is_ordinal (x:C) := connects E x ∧ is_full x
theorem T107 : is_ordinal x → well_orders E x := sorry

theorem T108 : is_ordinal x → y ⊆ x → y ≠ x → is_full y → y ∈ x := sorry
theorem T109 : is_ordinal x → is_ordinal y → x ⊆ y ∨ y ⊆ x := sorry
theorem T110 : is_ordinal x → is_ordinal y → x ∈ y ∨ y ∈ x ∨ x = y := sorry
theorem T111 : is_ordinal x → y ∈ x → is_ordinal y := sorry
definition R : C := {x|is_ordinal x}
theorem T113a : is_ordinal R := sorry
theorem T113b : ¬is_set R := sorry
theorem T114 : sect E R x → is_ordinal x := sorry
definition is_ordinal_number (x:C) := x ∈ R
definition lt (x y : C) := x ∈ y
instance :has_lt C := ⟨lt⟩
definition le (x y : C) := x ∈ y ∨ x = y
instance : has_le C := ⟨le⟩
theorem T118 : is_ordinal x → is_ordinal y → x ≤ y ↔ x ⊆ y := sorry
theorem T119 : is_ordinal x → x = {y|y ∈ R ∧ y < x} := sorry
theorem T120 : x ⊆ R →is_ordinal  ⋃x := sorry
theorem T121 : x ⊆ R → x ≠ ∅ → ⋂x ∈ x := sorry
definition succ (x : C) := x ∪ ⟮x⟯
theorem T123 : x ∈ R → first_mem (succ x) E {y|y∈R ∧ x < y} := sorry
theorem T124 : x ∈ R → ⋃(succ x) = x := sorry
definition D125 (f x : C) := f ∩ (x ⨉ U)
notation f`↓`x := D125 f x
theorem T126 : is_function y →
    (is_function (y↓x))
    ∧ ((domain y↓x) = x ∩ (domain y))
    ∧ (∀ (z ∈ (domain (y↓x))), (y↓x) z = y z)
:= sorry

/-- Infinity -/
axiom VIII: ∃ y, is_set(y) ∧ ∅ ∈ y ∧ ∀ x, x ∈ y → x ∪ ⟮x⟯ ∈ y
lemma empty_is_set : is_set(∅) := let ⟨y,_,ey,_⟩ := VIII in ⟨y,ey⟩
/-- Choice -/
axiom IX: ∃ c, is_function(c) ∧ domain(c) = U - ⟮∅⟯

end kelley


/-
Copyright (c) 2018 Jan-David Salchow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jan-David Salchow, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.bases
import Mathlib.topology.subset_properties
import Mathlib.topology.metric_space.basic
import Mathlib.PostPort

universes u_1 u_3 l u_2

namespace Mathlib

/-!
# Sequences in topological spaces

In this file we define sequences in topological spaces and show how they are related to
filters and the topology. In particular, we
* define the sequential closure of a set and prove that it's contained in the closure,
* define a type class "sequential_space" in which closure and sequential closure agree,
* define sequential continuity and show that it coincides with continuity in sequential spaces,
* provide an instance that shows that every first-countable (and in particular metric) space is
  a sequential space.
* define sequential compactness, prove that compactness implies sequential compactness in first
  countable spaces, and prove they are equivalent for uniform spaces having a countable uniformity
  basis (in particular metric spaces).
-/

/-! ### Sequential closures, sequential continuity, and sequential spaces. -/

/-- A sequence converges in the sence of topological spaces iff the associated statement for filter
holds. -/
theorem topological_space.seq_tendsto_iff {α : Type u_1} [topological_space α] {x : ℕ → α}
    {limit : α} :
    filter.tendsto x filter.at_top (nhds limit) ↔
        ∀ (U : set α), limit ∈ U → is_open U → ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → x n ∈ U :=
  sorry

/-- The sequential closure of a subset M ⊆ α of a topological space α is
the set of all p ∈ α which arise as limit of sequences in M. -/
def sequential_closure {α : Type u_1} [topological_space α] (M : set α) : set α :=
  set_of
    fun (p : α) => ∃ (x : ℕ → α), (∀ (n : ℕ), x n ∈ M) ∧ filter.tendsto x filter.at_top (nhds p)

theorem subset_sequential_closure {α : Type u_1} [topological_space α] (M : set α) :
    M ⊆ sequential_closure M :=
  fun (p : α) (_x : p ∈ M) =>
    (fun (this : p ∈ sequential_closure M) => this)
      (Exists.intro (fun (n : ℕ) => p) { left := fun (n : ℕ) => _x, right := tendsto_const_nhds })

/-- A set `s` is sequentially closed if for any converging sequence `x n` of elements of `s`,
the limit belongs to `s` as well. -/
def is_seq_closed {α : Type u_1} [topological_space α] (s : set α) := s = sequential_closure s

/-- A convenience lemma for showing that a set is sequentially closed. -/
theorem is_seq_closed_of_def {α : Type u_1} [topological_space α] {A : set α}
    (h :
      ∀ (x : ℕ → α) (p : α),
        (∀ (n : ℕ), x n ∈ A) → filter.tendsto x filter.at_top (nhds p) → p ∈ A) :
    is_seq_closed A :=
  sorry

/-- The sequential closure of a set is contained in the closure of that set.
The converse is not true. -/
theorem sequential_closure_subset_closure {α : Type u_1} [topological_space α] (M : set α) :
    sequential_closure M ⊆ closure M :=
  sorry

/-- A set is sequentially closed if it is closed. -/
theorem is_seq_closed_of_is_closed {α : Type u_1} [topological_space α] (M : set α)
    (_x : is_closed M) : is_seq_closed M :=
  (fun (this : sequential_closure M ⊆ M) =>
      set.eq_of_subset_of_subset (subset_sequential_closure M) this)
    (trans_rel_left has_subset.subset (sequential_closure_subset_closure M)
      (is_closed.closure_eq _x))

/-- The limit of a convergent sequence in a sequentially closed set is in that set.-/
theorem mem_of_is_seq_closed {α : Type u_1} [topological_space α] {A : set α} (_x : is_seq_closed A)
    {x : ℕ → α} :
    (∀ (n : ℕ), x n ∈ A) → ∀ {limit : α}, filter.tendsto x filter.at_top (nhds limit) → limit ∈ A :=
  sorry

/-- The limit of a convergent sequence in a closed set is in that set.-/
theorem mem_of_is_closed_sequential {α : Type u_1} [topological_space α] {A : set α}
    (_x : is_closed A) {x : ℕ → α} :
    (∀ (n : ℕ), x n ∈ A) → ∀ {limit : α}, filter.tendsto x filter.at_top (nhds limit) → limit ∈ A :=
  fun (_x_1 : ∀ (n : ℕ), x n ∈ A) {limit : α}
    (_x_2 : filter.tendsto x filter.at_top (nhds limit)) =>
    mem_of_is_seq_closed (is_seq_closed_of_is_closed A _x) _x_1 _x_2

/-- A sequential space is a space in which 'sequences are enough to probe the topology'. This can be
 formalised by demanding that the sequential closure and the closure coincide. The following
 statements show that other topological properties can be deduced from sequences in sequential
 spaces. -/
class sequential_space (α : Type u_3) [topological_space α] where
  sequential_closure_eq_closure : ∀ (M : set α), sequential_closure M = closure M

/-- In a sequential space, a set is closed iff it's sequentially closed. -/
theorem is_seq_closed_iff_is_closed {α : Type u_1} [topological_space α] [sequential_space α]
    {M : set α} : is_seq_closed M ↔ is_closed M :=
  sorry

/-- In a sequential space, a point belongs to the closure of a set iff it is a limit of a sequence
taking values in this set. -/
theorem mem_closure_iff_seq_limit {α : Type u_1} [topological_space α] [sequential_space α]
    {s : set α} {a : α} :
    a ∈ closure s ↔ ∃ (x : ℕ → α), (∀ (n : ℕ), x n ∈ s) ∧ filter.tendsto x filter.at_top (nhds a) :=
  sorry

/-- A function between topological spaces is sequentially continuous if it commutes with limit of
 convergent sequences. -/
def sequentially_continuous {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] (f : α → β) :=
  ∀ (x : ℕ → α) {limit : α},
    filter.tendsto x filter.at_top (nhds limit) →
      filter.tendsto (f ∘ x) filter.at_top (nhds (f limit))

/- A continuous function is sequentially continuous. -/

theorem continuous.to_sequentially_continuous {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {f : α → β} (_x : continuous f) : sequentially_continuous f :=
  sorry

/-- In a sequential space, continuity and sequential continuity coincide. -/
theorem continuous_iff_sequentially_continuous {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {f : α → β} [sequential_space α] :
    continuous f ↔ sequentially_continuous f :=
  sorry

namespace topological_space

namespace first_countable_topology

/-- Every first-countable space is sequential. -/
protected instance sequential_space {α : Type u_1} [topological_space α]
    [first_countable_topology α] : sequential_space α :=
  sequential_space.mk
    ((fun (this : ∀ (M : set α), sequential_closure M = closure M) => this)
      fun (M : set α) =>
        (fun (this : closure M ⊆ sequential_closure M) =>
            set.subset.antisymm (sequential_closure_subset_closure M) this)
          fun (p : α) (hp : p ∈ closure M) => sorry)

end first_countable_topology

end topological_space

/-- A set `s` is sequentially compact if every sequence taking values in `s` has a
converging subsequence. -/
def is_seq_compact {α : Type u_1} [topological_space α] (s : set α) :=
  ∀ {u : ℕ → α},
    (∀ (n : ℕ), u n ∈ s) →
      ∃ (x : α),
        ∃ (H : x ∈ s), ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds x)

/-- A space `α` is sequentially compact if every sequence in `α` has a
converging subsequence. -/
class seq_compact_space (α : Type u_3) [topological_space α] where
  seq_compact_univ : is_seq_compact set.univ

theorem is_seq_compact.subseq_of_frequently_in {α : Type u_1} [topological_space α] {s : set α}
    (hs : is_seq_compact s) {u : ℕ → α}
    (hu : filter.frequently (fun (n : ℕ) => u n ∈ s) filter.at_top) :
    ∃ (x : α),
        ∃ (H : x ∈ s),
          ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds x) :=
  sorry

theorem seq_compact_space.tendsto_subseq {α : Type u_1} [topological_space α] [seq_compact_space α]
    (u : ℕ → α) :
    ∃ (x : α), ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds x) :=
  sorry

theorem is_compact.is_seq_compact {α : Type u_1} [topological_space α]
    [topological_space.first_countable_topology α] {s : set α} (hs : is_compact s) :
    is_seq_compact s :=
  sorry

theorem is_compact.tendsto_subseq' {α : Type u_1} [topological_space α]
    [topological_space.first_countable_topology α] {s : set α} {u : ℕ → α} (hs : is_compact s)
    (hu : filter.frequently (fun (n : ℕ) => u n ∈ s) filter.at_top) :
    ∃ (x : α),
        ∃ (H : x ∈ s),
          ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds x) :=
  is_seq_compact.subseq_of_frequently_in (is_compact.is_seq_compact hs) hu

theorem is_compact.tendsto_subseq {α : Type u_1} [topological_space α]
    [topological_space.first_countable_topology α] {s : set α} {u : ℕ → α} (hs : is_compact s)
    (hu : ∀ (n : ℕ), u n ∈ s) :
    ∃ (x : α),
        ∃ (H : x ∈ s),
          ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds x) :=
  is_compact.is_seq_compact hs hu

protected instance first_countable_topology.seq_compact_of_compact {α : Type u_1}
    [topological_space α] [topological_space.first_countable_topology α] [compact_space α] :
    seq_compact_space α :=
  seq_compact_space.mk (is_compact.is_seq_compact compact_univ)

theorem compact_space.tendsto_subseq {α : Type u_1} [topological_space α]
    [topological_space.first_countable_topology α] [compact_space α] (u : ℕ → α) :
    ∃ (x : α), ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds x) :=
  seq_compact_space.tendsto_subseq u

theorem lebesgue_number_lemma_seq {β : Type u_2} [uniform_space β] {s : set β} {ι : Type u_1}
    {c : ι → set β} (hs : is_seq_compact s) (hc₁ : ∀ (i : ι), is_open (c i))
    (hc₂ : s ⊆ set.Union fun (i : ι) => c i) (hU : filter.is_countably_generated (uniformity β)) :
    ∃ (V : set (β × β)),
        ∃ (H : V ∈ uniformity β),
          symmetric_rel V ∧ ∀ (x : β), x ∈ s → ∃ (i : ι), uniform_space.ball x V ⊆ c i :=
  sorry

theorem is_seq_compact.totally_bounded {β : Type u_2} [uniform_space β] {s : set β}
    (h : is_seq_compact s) : totally_bounded s :=
  sorry

protected theorem is_seq_compact.is_compact {β : Type u_2} [uniform_space β] {s : set β}
    (h : filter.is_countably_generated (uniformity β)) (hs : is_seq_compact s) : is_compact s :=
  sorry

protected theorem uniform_space.compact_iff_seq_compact {β : Type u_2} [uniform_space β] {s : set β}
    (h : filter.is_countably_generated (uniformity β)) : is_compact s ↔ is_seq_compact s :=
  { mp := fun (H : is_compact s) => is_compact.is_seq_compact H,
    mpr := fun (H : is_seq_compact s) => is_seq_compact.is_compact h H }

theorem uniform_space.compact_space_iff_seq_compact_space {β : Type u_2} [uniform_space β]
    (H : filter.is_countably_generated (uniformity β)) : compact_space β ↔ seq_compact_space β :=
  sorry

/-- A version of Bolzano-Weistrass: in a metric space, is_compact s ↔ is_seq_compact s -/
theorem metric.compact_iff_seq_compact {β : Type u_2} [metric_space β] {s : set β} :
    is_compact s ↔ is_seq_compact s :=
  uniform_space.compact_iff_seq_compact emetric.uniformity_has_countable_basis

/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. This version assumes only
that the sequence is frequently in some bounded set. -/
theorem tendsto_subseq_of_frequently_bounded {β : Type u_2} [metric_space β] {s : set β}
    [proper_space β] (hs : metric.bounded s) {u : ℕ → β}
    (hu : filter.frequently (fun (n : ℕ) => u n ∈ s) filter.at_top) :
    ∃ (b : β),
        ∃ (H : b ∈ closure s),
          ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds b) :=
  sorry

/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. -/
theorem tendsto_subseq_of_bounded {β : Type u_2} [metric_space β] {s : set β} [proper_space β]
    (hs : metric.bounded s) {u : ℕ → β} (hu : ∀ (n : ℕ), u n ∈ s) :
    ∃ (b : β),
        ∃ (H : b ∈ closure s),
          ∃ (φ : ℕ → ℕ), strict_mono φ ∧ filter.tendsto (u ∘ φ) filter.at_top (nhds b) :=
  tendsto_subseq_of_frequently_bounded hs (filter.frequently_of_forall hu)

theorem metric.compact_space_iff_seq_compact_space {β : Type u_2} [metric_space β] :
    compact_space β ↔ seq_compact_space β :=
  uniform_space.compact_space_iff_seq_compact_space emetric.uniformity_has_countable_basis

theorem seq_compact.lebesgue_number_lemma_of_metric {β : Type u_2} [metric_space β] {s : set β}
    {ι : Type u_1} {c : ι → set β} (hs : is_seq_compact s) (hc₁ : ∀ (i : ι), is_open (c i))
    (hc₂ : s ⊆ set.Union fun (i : ι) => c i) :
    ∃ (δ : ℝ), ∃ (H : δ > 0), ∀ (x : β), x ∈ s → ∃ (i : ι), metric.ball x δ ⊆ c i :=
  sorry

end Mathlib