import .reify .main

open tactic

/- Theorems (Easy) -/

example : ∀ (x y : rat), ∃ (z : rat), (z > x ∧ z > y) := by dlo
example : ∃ (z : rat), (z > (5 : rat)) := by dlo
example : ∃ (x y : rat), x < 1.348 ∧ y > (324 / 23) := by dlo

example : forall x y : rat, exists z : rat, z < x ∧ z < y := by dlo
example : forall x : rat, exists y : rat, x < y := by dlo
example : forall x y : rat, x < y ∨ (x = y) ∨ y < x := by dlo
example : forall x y : rat, exists z : rat, z < x ∧ z < y := by dlo
example : forall x y : rat, x < y → exists z : rat, x < z ∧ z < y := by dlo
example : exists x : rat, x = x := by dlo
example : forall x y z : rat, exists u, u < x ∧ u < y ∧ u < z := by dlo
example : forall a b : rat, exists x : rat, ¬(x = a) ∨ ¬(x = b) ∨ (a = b) := by dlo


--import filter
import seminormed_rings
import analysis.special_functions.pow
import csupr

noncomputable theory

open_locale topological_space nnreal

def normed_group_hom.normed_group_hom_inv_of_bijective_bounded {V : Type*} {W : Type*}
  [seminormed_add_comm_group V] [seminormed_add_comm_group W] (f : normed_add_group_hom V W)
  (h_bij : function.bijective f) (h_bdd : ∃ (C : ℝ), ∀ v, ∥v∥ ≤ C * ∥f v∥) :
  normed_add_group_hom W V :=
{ to_fun   := function.inv_fun f,
  map_add' := (add_monoid_hom.inverse f.to_add_monoid_hom (function.inv_fun f)
    (function.left_inverse_inv_fun h_bij.injective)
    (function.right_inverse_inv_fun h_bij.surjective)).map_add,
  bound'   := begin
    obtain ⟨C, hC⟩ := h_bdd,
    use C,
    intro w,
    set v := function.inv_fun f w with hv,
    rw ← function.right_inverse_inv_fun h_bij.surjective w,
    exact hC v,
  end}

-- TODO : find new name
lemma normed_group_hom.continuous_inv_of_bijective_bounded {V : Type*} {W : Type*}
  [seminormed_add_comm_group V] [seminormed_add_comm_group W] {f : normed_add_group_hom V W}
  (h_bij : function.bijective f) (h_bdd : ∃ (C : ℝ), ∀ v, ∥v∥ ≤ C * ∥f v∥) :
  continuous (function.inv_fun f) :=
begin
  set g : normed_add_group_hom W V :=
  { to_fun := function.inv_fun f,
    map_add' := λ x y,
    begin
      rw [← (classical.some_spec (((function.bijective_iff_exists_unique _).mp h_bij) x)).1,
        ← (classical.some_spec (((function.bijective_iff_exists_unique _).mp h_bij) y)).1],
      simp only [← function.comp_app (function.inv_fun f) f, function.inv_fun_comp h_bij.injective,
        id.def, ← map_add],
    end,
    bound'   :=
    begin
      use classical.some h_bdd,
      intro w,
      rw ← (classical.some_spec (((function.bijective_iff_exists_unique _).mp h_bij) w)).1,
      simp only [← function.comp_app (function.inv_fun f) f, function.inv_fun_comp h_bij.injective,
        id.def],
      exact classical.some_spec h_bdd _,
    end } with hg,
  change continuous g,
  apply normed_add_group_hom.continuous,
end

def normed_group_hom.homeo_of_bijective_bounded {V : Type*} {W : Type*} [seminormed_add_comm_group V]
  [seminormed_add_comm_group W] {f : normed_add_group_hom V W} (h_bij : function.bijective f)
  (h_bdd : ∃ (C : ℝ), ∀ v, ∥v∥ ≤ C * ∥f v∥) : homeomorph V W :=
{ to_fun             := f.to_fun,
  inv_fun            := function.inv_fun f.to_fun,
  left_inv           := function.left_inverse_inv_fun h_bij.injective,
  right_inv          := function.right_inverse_inv_fun h_bij.surjective,
  continuous_to_fun  := f.continuous,
  continuous_inv_fun := normed_group_hom.continuous_inv_of_bijective_bounded h_bij h_bdd }

variables {α : Type*} [comm_ring α] (f : α → nnreal)

section seminorm_from_bounded

variable (f)

def seminorm_from_bounded : α → nnreal :=
λ x, supr (λ (y : α), f(x*y)/f(y))

variables {f}

lemma nat.one_div_cast_pos {n : ℕ} (hn : 0 < n) : 0 < 1/(n : ℝ) :=
begin
  rw [one_div, inv_pos, nat.cast_pos],
  exact lt_of_lt_of_le zero_lt_one hn,
end

lemma nat.one_div_cast_nonneg (n : ℕ): 0 ≤ 1/(n : ℝ) :=
begin
  by_cases hn : n = 0,
  { rw [hn, nat.cast_zero, div_zero] },
  { refine le_of_lt (nat.one_div_cast_pos (zero_lt_iff.mpr hn)), }
end

lemma nat.one_div_cast_ne_zero {n : ℕ} (hn : 0 < n) : 1/(n : ℝ) ≠ 0 :=
ne_of_gt (nat.one_div_cast_pos hn)

lemma f_one_ne_zero (f_ne_zero : ∃ (x : α), f x ≠ 0)
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) : f 1 ≠ 0 :=
begin
  intro h1,
  obtain ⟨c, hc, hxy⟩ := f_mul,
  specialize hxy 1,
  simp_rw [h1, one_mul, mul_zero, zero_mul] at hxy,
  obtain ⟨z, hz⟩ := f_ne_zero,
  exact hz (le_antisymm (hxy z) (zero_le (f z))),
end

lemma f_pow_ne_zero {x : α} (hx : is_unit x) (hfx : f x ≠ 0) (n : ℕ)
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) : f (x ^ n) ≠ 0 :=
begin
  have h1 : f 1 ≠ 0 := f_one_ne_zero (exists.intro x hfx) f_mul,
  intro hxn,
  obtain ⟨c, hc, hxy⟩ := f_mul,
  obtain ⟨u, hu⟩ := hx,
  specialize hxy (x^n) (u.inv^n),
  rw [hxn, mul_zero, zero_mul, ← mul_pow, ← hu, units.inv_eq_coe_inv, units.mul_inv, one_pow,
    le_zero_iff] at hxy,
  exact h1 hxy,
end

lemma seminorm_from_bounded_zero (f_zero : f 0 = 0) :
  seminorm_from_bounded f (0 : α) = 0 :=
begin
  simp_rw [seminorm_from_bounded, zero_mul, f_zero, zero_div],
  exact csupr_const,
end

lemma seminorm_from_bounded_bdd_range (x : α)
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) :
  bdd_above (set.range (λ y, f (x * y) / f y)) :=
begin
  obtain ⟨c, hc_pos, hxy⟩ := f_mul,
  use c * f x,
  rw mem_upper_bounds,
  rintros r ⟨y, hy⟩,
  simp only [← hy],
  by_cases hy0 : 0 = f y,
  { rw [← hy0, div_zero],
    exact mul_nonneg (le_of_lt hc_pos) (zero_le _), },
  { simpa [div_le_iff₀ (ne.symm hy0)] using hxy x y, },
end

lemma seminorm_from_bounded_le (x : α)
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded f x ≤ (classical.some f_mul) * f x :=
begin
  have h := classical.some_spec(classical.some_spec f_mul),
  apply csupr_le,
  intro y, by_cases hy : 0 = f y,
  { rw [← hy, div_zero],
    exact mul_nonneg (le_of_lt (classical.some (classical.some_spec f_mul))) (zero_le _), },
  { rw div_le_iff₀ (ne.symm hy),
    exact (classical.some_spec (classical.some_spec f_mul)) x y }
end

lemma seminorm_from_bounded_ge (x : α)
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) :
  f x ≤ f 1 * seminorm_from_bounded f x :=
begin
  by_cases h1 : 0 = f 1,
  { obtain ⟨c, hc_pos, hxy⟩ := f_mul,
    specialize hxy x 1,
    rw [mul_one, ← h1, mul_zero] at hxy,
    have hx0 : f x = 0 := le_antisymm hxy (zero_le _),
    rw [hx0, ← h1, zero_mul] },
  { rw [mul_comm,  ← div_le_iff₀ (ne.symm h1)],
    have h_bdd : bdd_above (set.range (λ y, f (x * y) / f y)),
    { exact seminorm_from_bounded_bdd_range x f_mul},
    convert le_csupr h_bdd (1 : α),
    rw mul_one, } ,
end

lemma f_mul_zero_of_f_zero (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α),
  f (x * y) ≤ c * f x * f y) {x : α} (hx : f x = 0) (y : α) : f (x * y) = 0 :=
begin
  obtain ⟨c, hc, hxy⟩ := f_mul,
  specialize hxy x y,
  rw [hx, mul_zero, zero_mul] at hxy,
  exact le_antisymm hxy (zero_le _),
end

lemma seminorm_from_bounded_eq_zero_iff (x : α)
(f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded f x = 0 ↔ f x = 0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { have hf := seminorm_from_bounded_ge x f_mul,
    rw [h, mul_zero] at hf,
    exact le_antisymm hf (zero_le _)},
  { have hf : seminorm_from_bounded f x ≤ classical.some f_mul * f x :=
    seminorm_from_bounded_le x f_mul,
    rw [h, mul_zero] at hf,
    exact le_zero_iff.mp hf, }
end

lemma seminorm_from_bounded_mul (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α),
  f (x * y) ≤ c * f x * f y) (x y : α) : seminorm_from_bounded f (x * y) ≤
  seminorm_from_bounded f x * seminorm_from_bounded f y :=
begin
  apply csupr_le,
  by_cases hy : seminorm_from_bounded f y = 0,
  { rw seminorm_from_bounded_eq_zero_iff _ f_mul at hy,
    intro z,
    simp_rw [mul_comm x y, mul_assoc, f_mul_zero_of_f_zero f_mul hy _, zero_div],
    exact zero_le _, },
  { intro z,
    rw ← div_le_iff₀ hy,
    apply le_csupr_of_le (seminorm_from_bounded_bdd_range x f_mul) z,
    rw [div_le_iff₀ hy, div_mul_eq_mul_div],
    by_cases hz : f z = 0,
    { simp_rw [mul_comm, f_mul_zero_of_f_zero f_mul hz _, zero_div],
      exact zero_le _, },
    { rw [div_le_div_right₀ hz, mul_comm (f (x * z))],
      by_cases hxz : f (x * z) = 0,
      { simp_rw [mul_comm x y, mul_assoc, mul_comm y, f_mul_zero_of_f_zero f_mul hxz _],
        exact zero_le _, },
      { rw ← div_le_iff₀ hxz,
        apply le_csupr_of_le (seminorm_from_bounded_bdd_range y f_mul) (x * z),
        rw [div_le_div_right₀ hxz, mul_comm x y, mul_assoc], }}},
end

lemma seminorm_from_bounded_one_eq (f_ne_zero : ∃ (x : α),
  f x ≠ 0) (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded f 1 = 1 :=
begin
  simp_rw [seminorm_from_bounded, one_mul],
  have h_le : (⨆ (y : α), f y / f y) ≤ 1,
  { apply csupr_le,
    intro x, by_cases hx : f x = 0,
    { rw hx, rw div_zero, exact zero_le_one },
    { rw div_self hx }},
  have h_ge : 1 ≤ (⨆ (y : α), f y / f y),
  { rw ← div_self (f_one_ne_zero f_ne_zero f_mul),
    have h_bdd : bdd_above (set.range (λ y, f y / f y)),
    { use (1 : nnreal),
      rw mem_upper_bounds,
      rintros r ⟨y, hy⟩,
      simp_rw [← hy],
      by_cases hy : f y = 0,
    { rw [hy, div_zero], exact zero_le_one },
    { rw div_self hy }},
    exact le_csupr h_bdd (1 : α), },
  exact le_antisymm h_le h_ge,
end

lemma seminorm_from_bounded_is_norm_le_one_class
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded f 1 ≤ 1 :=
begin
  by_cases f_ne_zero : ∃ (x : α), f x ≠ 0,
  { exact le_of_eq (seminorm_from_bounded_one_eq f_ne_zero f_mul)},
  { simp_rw [seminorm_from_bounded, one_mul],
    apply csupr_le,
    intro x,
    push_neg at f_ne_zero,
    { rw (f_ne_zero x), rw div_zero, exact zero_le_one }}
end

lemma seminorm_from_bounded_add
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (x y : α) :
  seminorm_from_bounded f (x + y) ≤ seminorm_from_bounded f x + seminorm_from_bounded f y :=
begin
  apply csupr_le,
  intro z,
  suffices hf : f ((x + y) * z) / f z ≤ f (x * z) / f z + f (y * z) / f z,
  { exact le_trans hf (add_le_add
      (le_csupr_of_le (seminorm_from_bounded_bdd_range x f_mul) z (le_refl _))
      (le_csupr_of_le (seminorm_from_bounded_bdd_range y f_mul) z (le_refl _))), },
  { by_cases hz : f z = 0,
    { simp only [hz, div_zero, zero_add, le_refl, or_self], },
    { rw [nnreal.div_add_div_same, div_le_div_right₀ hz, add_mul], exact f_add _ _,  }}
end

lemma seminorm_from_bounded_is_seminorm (f_zero : f 0 = 0)
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) : is_seminorm (seminorm_from_bounded f) :=
{ zero := seminorm_from_bounded_zero f_zero,
  add  := seminorm_from_bounded_add f_mul f_add,
  mul  := seminorm_from_bounded_mul f_mul }

lemma seminorm_from_bounded_is_nonarchimedean
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y)
  (hna : is_nonarchimedean f) : is_nonarchimedean (seminorm_from_bounded f) :=
begin
  intros x y,
  apply csupr_le,
  intro z,
  rw le_max_iff,
  suffices hf : f ((x - y) * z) / f z ≤ f (x * z) / f z ∨
    f ((x - y) * z) / f z ≤ f (y * z) / f z,
  cases hf with hfx hfy; [left, right],
  { exact le_csupr_of_le (seminorm_from_bounded_bdd_range x f_mul) z hfx },
  { exact le_csupr_of_le (seminorm_from_bounded_bdd_range y f_mul) z hfy },
  { by_cases hz : f z = 0,
    { simp only [hz, div_zero, le_refl, or_self], },
    { rw [div_le_div_right₀ hz, div_le_div_right₀ hz, sub_mul, ← le_max_iff],
      exact hna _ _ }},
end

lemma seminorm_from_bounded_of_mul_apply
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y)  {x : α}
  (hx : ∀ (y : α), f (x * y) = f x * f y) :
  seminorm_from_bounded f x = f x :=
begin
  simp_rw [seminorm_from_bounded, hx, ← mul_div_assoc'],
  have h_le : (⨆ (y : α), f x * (f y / f y)) ≤ f x,
  { apply csupr_le,
    intro x, by_cases hx : f x = 0,
    { rw hx, rw div_zero, rw mul_zero, exact zero_le _, },
    { rw [div_self hx, mul_one] }},
  have h_ge : f x ≤ (⨆ (y : α), f x * (f y / f y)),
  { by_cases f_ne_zero : ∃ (x : α), f x ≠ 0,
    { conv_lhs { rw ← mul_one (f x) },
      rw ← div_self (f_one_ne_zero f_ne_zero f_mul),
      have h_bdd : bdd_above (set.range (λ y, f x * (f y / f y))),
      { use (f x : nnreal),
        rw mem_upper_bounds,
        rintros r ⟨y, hy⟩,
        simp_rw [← hy],
        by_cases hy0 : f y = 0,
      { rw [hy0, div_zero, mul_zero], exact zero_le _ },
      { rw [div_self hy0, mul_one] }},
      exact le_csupr h_bdd (1 : α), },
      { push_neg at f_ne_zero,
        simp_rw [f_ne_zero, zero_div, zero_mul, csupr_const], }},
  exact le_antisymm h_le h_ge,
end

lemma seminorm_from_bounded_of_mul_le {x : α}
  (hx : ∀ (y : α), f (x * y) ≤ f x * f y) (h_one : f 1 ≤ 1) : seminorm_from_bounded f x = f x :=
begin
  simp_rw [seminorm_from_bounded],
  have h_le : (⨆ (y : α), f (x * y) / f y) ≤ f x,
  { apply csupr_le,
    intro y, by_cases hy : f y = 0,
    { rw [hy, div_zero], exact zero_le _, },
    { rw div_le_iff₀ hy, exact hx _, }},
  have h_ge : f x ≤ (⨆ (y : α), f (x * y) / f y),
  { have h_bdd : bdd_above (set.range (λ y, f (x * y) / f y)),
    { use (f x),
      rw mem_upper_bounds,
      rintros r ⟨y, hy⟩,
      simp only [← hy],
      by_cases hy0 : f y = 0,
      { rw [hy0, div_zero],
        exact zero_le _  },
      { rw [← mul_one (f x), ← div_self hy0, ← mul_div_assoc, div_le_iff₀ hy0, mul_div_assoc,
          div_self hy0, mul_one],
          exact hx y, }},
    convert le_csupr h_bdd (1 : α),
    by_cases h0 : f x = 0,
    { rw [mul_one, h0, zero_div],},
    { have heq : f 1 = 1,
      { apply le_antisymm h_one,
        specialize hx 1,
        rw [mul_one, le_mul_iff_one_le_right (lt_of_le_of_ne (zero_le (f x)) (ne.symm h0))] at hx,
        exact hx, },
      rw [heq, mul_one, div_one], } },
  exact le_antisymm h_le h_ge,
end

lemma seminorm_from_bounded_ne_zero
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y)
  (f_ne_zero : ∃ x : α, f x ≠ 0) :
  ∃ x : α, seminorm_from_bounded f x ≠ 0 :=
begin
  obtain ⟨x, hx⟩ := f_ne_zero,
  use x,
  rw [ne.def, seminorm_from_bounded_eq_zero_iff x f_mul],
  exact hx,
end

lemma seminorm_from_bounded_ker
(f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y) :
  (seminorm_from_bounded f)⁻¹' {0} = f⁻¹' {0} :=
begin
  ext x,
  simp only [set.mem_preimage, set.mem_singleton_iff],
  exact seminorm_from_bounded_eq_zero_iff x f_mul,
end

lemma seminorm_from_bounded_is_norm_iff (f_zero : f 0 = 0)
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) :
  is_norm (seminorm_from_bounded f) ↔ f⁻¹' {0} = {0} :=
begin
  refine ⟨λ h_norm, _, λ h_ker, _⟩,
  { rw ← seminorm_from_bounded_ker f_mul,
    ext x,
    simp only [set.mem_preimage, set.mem_singleton_iff],
    have h_ne_zero := h_norm.ne_zero,
    refine ⟨λ h, _, λ h, by {rw h, exact seminorm_from_bounded_zero f_zero}⟩,
    { specialize h_ne_zero x,
      contrapose! h_ne_zero,
      exact ⟨h_ne_zero, le_of_eq h⟩, }},
  { refine ⟨seminorm_from_bounded_is_seminorm f_zero f_mul f_add, _⟩,
    intros x hx,
    apply lt_of_le_of_ne (zero_le _),
    rw [ne.def, eq_comm, seminorm_from_bounded_eq_zero_iff x f_mul],
    intro h0,
    rw [← set.mem_singleton_iff, ← set.mem_preimage, h_ker, set.mem_singleton_iff] at h0,
    exact hx h0, }
end

lemma seminorm_from_bounded_of_mul_is_mul {x : α}
  (f_mul : ∃ (c : nnreal) (hc : 0 < c), ∀ (x y : α), f (x * y) ≤ c * f x * f y)
  (hx : ∀ (y : α), f (x * y) = f x * f y) (y : α) :
  seminorm_from_bounded f (x * y) = (seminorm_from_bounded f x) * (seminorm_from_bounded f y) :=
begin
  rw [seminorm_from_bounded_of_mul_apply f_mul hx],
  simp only [seminorm_from_bounded, mul_assoc, hx, mul_div_assoc],
  rw nnreal.mul_csupr,
  exact seminorm_from_bounded_bdd_range _ f_mul,
end

end seminorm_from_bounded

-- Prop. 1.3.2/1 from BGR
section smoothing_seminorm

variable {f}

def smoothing_seminorm_seq (hsn : is_seminorm f) (x : α) : ℕ → nnreal :=
λ n, (f (x ^ n))^(1/n : ℝ)

variables (hsn : is_seminorm f) (hf1 : is_norm_le_one_class f) (x : α)

lemma pow_n_n_inv (r : nnreal) {n : ℕ} (hn : 0 < n) : (r ^ n)^(1/n : ℝ) = r :=
begin
  have hn1 : (n : ℝ) * (1/n) = 1,
  { apply mul_one_div_cancel,
    exact (nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn)) },
  conv_rhs { rw [← nnreal.rpow_one r, ← hn1] },
  rw [nnreal.rpow_mul, nnreal.rpow_nat_cast],
end

private lemma smoothing_seminorm_seq_has_limit_m (f : α → nnreal) (x : α) {ε : ℝ} (hε : 0 < ε) :
  ∃ (m : pnat), (f (x ^(m : ℕ)))^(1/m : ℝ) <
    infi (λ (n : pnat), (f(x ^(n : ℕ)))^(1/(n : ℝ))) + ⟨ε, le_of_lt hε⟩/2 :=
exists_lt_of_cinfi_lt (lt_add_of_le_of_pos (le_refl _) (nnreal.half_pos hε))

lemma tendsto_bdd_div_at_top_nhds_0_nat (f : ℕ → ℝ)
 (hfb : ∃ b : ℝ, ∀ᶠ (n : ℕ) in filter.at_top, b ≤ f n)
 (hfB : ∃ B : ℝ, ∀ᶠ (n : ℕ) in filter.at_top, f n ≤ B) :
  filter.tendsto (λ (n: ℕ), ((f n / (n : ℝ)))) filter.at_top (𝓝 0) :=
begin
  obtain ⟨b, hb⟩ := hfb,
  obtain ⟨B, hB⟩ := hfB,
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le' (tendsto_const_div_at_top_nhds_0_nat b)
    (tendsto_const_div_at_top_nhds_0_nat B) _ _,
  { simp only [filter.eventually_at_top, ge_iff_le] at hb ⊢,
    obtain ⟨N, hN⟩ := hb,
    use N, intros n hn,
    exact div_le_div_of_le (nat.cast_nonneg _) (hN n hn), },
  { simp only [filter.eventually_at_top, ge_iff_le] at hB ⊢,
    obtain ⟨N, hN⟩ := hB,
    use N, intros n hn,
    exact div_le_div_of_le (nat.cast_nonneg _) (hN n hn), },
end

lemma tendsto_mod_div_at_top_nhds_0_nat {m : ℕ} (hm : 0 < m) :
  filter.tendsto (λ (n: ℕ), (((n % m : ℕ) : ℝ) / (n : ℝ))) filter.at_top (𝓝 0) :=
begin
  apply tendsto_bdd_div_at_top_nhds_0_nat (λ (n: ℕ), ((n % m : ℕ) : ℝ)),
  { use 0,
    apply filter.eventually_of_forall,
    intros n,
    simp only [nat.cast_nonneg], },
  { use m,
    apply filter.eventually_of_forall,
    intros n,
    simp only [nat.cast_le,le_of_lt (nat.mod_lt n hm)], }
end

private lemma smoothing_seminorm_seq_has_limit_aux {x : α} (L : nnreal) {ε : nnreal} (hε : 0 < ε)
  {m1 : ℕ} (hm1 : 0 < m1) (hx : f x ≠ 0) :
  filter.tendsto (λ (n : ℕ), (L + ε)^
    (-(((n % m1 : ℕ) : ℝ)/(n : ℝ)))*((f x) ^(n % m1)) ^ (1 / (n : ℝ))) filter.at_top (𝓝 1) :=
begin
  rw ← mul_one (1 : nnreal),
  have h_exp : filter.tendsto (λ (n: ℕ), (((n % m1 : ℕ) : ℝ) / (n : ℝ)))
    filter.at_top (𝓝 0) := tendsto_mod_div_at_top_nhds_0_nat hm1,
  apply filter.tendsto.mul,
  { have h0 : filter.tendsto (λ (t : ℕ), -(((t % m1 : ℕ) : ℝ) / (t : ℝ))) filter.at_top (𝓝 0),
    { rw ← neg_zero, exact filter.tendsto.neg h_exp, },
    rw [← nnreal.rpow_zero (L + ε), ← nnreal.tendsto_coe],
    simp_rw nnreal.coe_rpow,
    apply filter.tendsto.rpow tendsto_const_nhds h0,
    rw [nnreal.coe_ne_zero, ne.def, add_eq_zero_iff],
    exact or.inl (not_and_of_not_right _ (ne_of_gt hε)) },
  { simp_rw [← nnreal.rpow_nat_cast, ← nnreal.rpow_mul, ← nnreal.rpow_zero (f x),
      ← nnreal.tendsto_coe, nnreal.coe_rpow, ← mul_div_assoc, mul_one],
    exact filter.tendsto.rpow tendsto_const_nhds h_exp (or.inl (nnreal.coe_ne_zero.mpr hx)), },
end

include hf1

def smoothing_seminorm_seq_lim : nnreal := infi (λ (n : pnat), (f(x^(n : ℕ)))^(1/(n : ℝ)))

lemma smoothing_seminorm_seq_lim_is_limit :
  filter.tendsto ((smoothing_seminorm_seq hsn x)) filter.at_top
    (𝓝 (smoothing_seminorm_seq_lim hf1 x)) :=
begin
  by_cases hx : f x = 0,
  { simp only [smoothing_seminorm_seq_lim],
    set L := infi (λ (n : pnat), (f(x^(n : ℕ)))^(1/(n : ℝ))) with hL,
    have h0 : ∀ (n : ℕ) (hn : 1 ≤ n), (f (x ^ n))^(1/(n : ℝ)) = 0,
    { intros n hn,
      have hfn : f (x ^ n) = 0,
      { rw [← le_zero_iff, ← zero_pow hn, ← hx], exact hsn.pow_le x hn, },
      rw [hfn, nnreal.zero_rpow (nat.one_div_cast_ne_zero hn)], },
    have hL0 : L = 0,
    { have h_bdd : bdd_below (set.range (λ (n : ℕ+), f (x ^(n : ℕ)) ^ (1 / (n : ℝ)))),
      { use 0, rw mem_lower_bounds, rintros x -, exact zero_le _ },
      have h_le : (f(x^((1 : pnat) : ℕ)))^(1/((1 : pnat) : ℝ)) ≤ 0,
      { simp only [pnat.one_coe, pow_one, coe_coe, nat.cast_one, div_one, nnreal.rpow_one,
          le_zero_iff], exact hx },
      exact le_antisymm (cinfi_le_of_le h_bdd (1 : pnat) h_le) (zero_le _), },
    simp only [hL0, smoothing_seminorm_seq],
    exact tendsto_at_top_of_eventually_const h0, },
  { simp only [smoothing_seminorm_seq_lim],
    set L := infi (λ (n : pnat), (f(x^(n : ℕ)))^(1/(n : ℝ))) with hL,
    rw metric.tendsto_at_top,
    intros ε hε,
    obtain ⟨m1, hm1⟩ := smoothing_seminorm_seq_has_limit_m f x hε,
    obtain ⟨m2, hm2⟩ : ∃ m : ℕ, ∀ (n ≥ m), (L + ⟨ε, (le_of_lt hε)⟩/2)^
      (-(((n % m1 : ℕ) : ℝ)/(n : ℝ)))*((f x) ^(n % m1)) ^ (1 / (n : ℝ)) - 1 ≤
      ⟨ε, (le_of_lt hε)⟩/(2 * (L + ⟨ε, (le_of_lt hε)⟩/2)),
    { have hε2 : (0 : nnreal) < ⟨ε, (le_of_lt hε)⟩/2 := nnreal.half_pos hε,
      have hL2  := smoothing_seminorm_seq_has_limit_aux L hε2 (pnat.pos m1) hx,
      rw metric.tendsto_at_top at hL2,
      set δ : nnreal := ⟨ε, (le_of_lt hε)⟩/(2 * (L + ⟨ε, (le_of_lt hε)⟩/2)) with hδ_def,
      have hδ : 0 < δ,
      { rw [hδ_def, div_mul_eq_div_mul_one_div],
        exact mul_pos hε2 ((one_div (L + ⟨ε, (le_of_lt hε)⟩/2)).symm ▸ nnreal.inv_pos.mpr
          (add_pos_of_nonneg_of_pos (zero_le L) hε2)), },
      obtain ⟨N, hN⟩ := hL2 δ hδ,
      use N,
      intros n hn,
      specialize hN n hn,
      rw [nnreal.dist_eq, abs_lt] at hN,
      rw [← nnreal.coe_le_coe, nnreal.coe_sub_def],
      exact max_le (le_of_lt hN.right) (nnreal.coe_nonneg _), },
    use max (m1 : ℕ) m2,
    intros n hn,
    have hn0 : 0 < n := lt_of_lt_of_le (lt_of_lt_of_le (pnat.pos m1) (le_max_left m1 m2)) hn,
    rw [nnreal.dist_eq, abs_lt],
    have hL_le : L ≤ smoothing_seminorm_seq hsn x n,
    { have h_bdd : bdd_below (set.range (λ (n : pnat), (f(x ^ (n : ℕ)))^(1/(n : ℝ)))),
      { use 0, rw mem_lower_bounds, intros y hy, exact zero_le _ },
      simp only [smoothing_seminorm_seq],
      rw ← pnat.mk_coe n hn0,
      apply cinfi_le h_bdd, },
    refine ⟨lt_of_lt_of_le (neg_lt_zero.mpr hε) (by simp only
      [← nnreal.coe_sub hL_le, nnreal.zero_le_coe]), _⟩,
    { suffices h : smoothing_seminorm_seq hsn x n < L + ⟨ε, (le_of_lt hε)⟩,
      { rw [← nnreal.coe_sub hL_le, ← subtype.coe_mk ε (le_of_lt hε), nnreal.coe_lt_coe,
          tsub_lt_iff_left hL_le],
        exact h, },
      by_cases hxn : f (x ^(n % m1)) = 0,
      { simp only [smoothing_seminorm_seq],
        nth_rewrite 0 ← nat.div_add_mod n m1,
        have hLε : 0 < L + ⟨ε, (le_of_lt hε)⟩ := add_pos_of_nonneg_of_pos (zero_le _) hε,
        apply lt_of_le_of_lt _ hLε,
        rw [pow_add, ← mul_zero ((f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ))))) ^ (1/(n : ℝ))),
          ← nnreal.zero_rpow (nat.one_div_cast_ne_zero hn0), ← hxn, ← nnreal.mul_rpow],
        exact nnreal.rpow_le_rpow (hsn.mul _ _) (nat.one_div_cast_nonneg _), },
      { simp only [smoothing_seminorm_seq],
        nth_rewrite 0 ← nat.div_add_mod n m1,
        have h : f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ)))) ^ (1 / (n : ℝ))  ≤
          (f (x ^ (m1 : ℕ)) ^ (n / (m1 : ℕ))) ^ (1 / (n : ℝ)),
        { apply nnreal.rpow_le_rpow _ (nat.one_div_cast_nonneg _),
          rw pow_mul,
          exact hsn.pow_le (x^(m1 : ℕ)) (nat.div_pos (le_trans (le_max_left m1 m2) hn)
            (pnat.pos m1)), },
        have h1 : (f (x ^ (m1 : ℕ)) ^ (n / (m1 : ℕ))) ^ (1 / (n : ℝ))  <
          (L + ⟨ε, (le_of_lt hε)⟩/2) * ((L + ⟨ε, (le_of_lt hε)⟩/2) ^ -(((n % m1 : ℕ) : ℝ)/(n : ℝ))),
        { have hm10 : (m1 : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (pnat.pos m1)),
          rw [← nnreal.rpow_lt_rpow_iff (nat.cast_pos.mpr (pnat.pos m1)), ← nnreal.rpow_mul,
            ← coe_coe, one_div_mul_cancel hm10, nnreal.rpow_one] at hm1,
          nth_rewrite 0 ← nnreal.rpow_one (L + ⟨ε, _⟩ / 2),
          have : (n : ℝ)/n = 1 := div_self (nat.cast_ne_zero.mpr (ne_of_gt hn0)),
          nth_rewrite 1 ← this, clear this,
          nth_rewrite 2 ← nat.div_add_mod n m1,
          have h_lt : 0 < ((n / m1 : ℕ) : ℝ) / (n : ℝ),
          { apply div_pos,
            { exact nat.cast_pos.mpr (nat.div_pos (le_trans (le_max_left _ _) hn) (pnat.pos m1)) },
            { exact nat.cast_pos.mpr hn0 }},
          have h_ne : L + ⟨ε, (le_of_lt hε)⟩ / 2 ≠ 0,
          { exact zero_lt_iff.mp (add_pos_of_nonneg_of_pos (zero_le _) (nnreal.half_pos hε)) },
          rw [← nnreal.rpow_nat_cast, ← nnreal.rpow_add h_ne, ← neg_div, div_add_div_same,
            nat.cast_add, add_neg_cancel_right, nat.cast_mul, ← nnreal.rpow_mul, mul_one_div,
            mul_div_assoc, nnreal.rpow_mul],
          exact nnreal.rpow_lt_rpow hm1 h_lt },
        have h2 : f (x ^(n % m1)) ^ (1 / (n : ℝ)) ≤ (f x ^(n % m1)) ^ (1 / (n : ℝ)),
        { by_cases hnm1 : n % m1 = 0,
          { simpa [hnm1, pow_zero] using nnreal.rpow_le_rpow hf1 (nat.one_div_cast_nonneg _) },
          { exact nnreal.rpow_le_rpow (hsn.pow_le _ (nat.pos_of_ne_zero hnm1))
              (nat.one_div_cast_nonneg _), }},
        have h3 : (L + ⟨ε, (le_of_lt hε)⟩/2) * ((L + ⟨ε, (le_of_lt hε)⟩/2) ^
          -(((n%m1 : ℕ) : ℝ)/(n : ℝ))) * (f x ^(n % m1)) ^ (1 / (n : ℝ)) ≤ L + ⟨ε, (le_of_lt hε)⟩,
        { have heq :  L + ⟨ε, (le_of_lt hε)⟩ = L + ⟨ε, (le_of_lt hε)⟩/2 + ⟨ε, (le_of_lt hε)⟩/2,
          { rw [add_assoc, nnreal.div_add_div_same, ← mul_two, mul_div_cancel], exact two_ne_zero },
          have hL0 : L + ⟨ε, (le_of_lt hε)⟩ / 2 ≠ 0,
          { apply ne_of_gt,
            exact (add_pos_of_nonneg_of_pos (zero_le _) (nnreal.half_pos hε)), },
          rw [heq, ← tsub_le_iff_left],
          nth_rewrite 2 ← mul_one (L + ⟨ε, _⟩ / 2),
          rw [mul_assoc, ← mul_tsub, mul_comm, ← le_div_iff₀ hL0, div_div],
          exact hm2 n (le_trans (le_max_right m1 m2) hn) },
      calc f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ)) + n % m1)) ^ (1 / (n : ℝ)) =
              f (x ^ ((m1 : ℕ) * (n /(m1 : ℕ))) * x ^(n % m1)) ^ (1 / (n : ℝ)) : by rw pow_add
        ... ≤ (f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ)))) * f (x ^(n % m1))) ^ (1 / (n : ℝ)) :
              nnreal.rpow_le_rpow (hsn.mul _ _) (nat.one_div_cast_nonneg _)
        ... = f (x ^ ((m1 : ℕ) * (n /(m1 : ℕ)))) ^ (1 / (n : ℝ)) * f (x ^(n % m1)) ^ (1 / (n : ℝ)) :
              nnreal.mul_rpow
        ... ≤ (f (x ^ (m1 : ℕ)) ^ (n /(m1 : ℕ))) ^ (1 / (n : ℝ)) * f (x ^(n % m1)) ^ (1 / (n : ℝ)) :
              mul_le_mul_right' h _
        ... < (L + ⟨ε, (le_of_lt hε)⟩/2) * ((L + ⟨ε, (le_of_lt hε)⟩/2) ^
              -(((n%m1 : ℕ) : ℝ)/(n : ℝ))) * f (x ^(n % m1)) ^ (1 / (n : ℝ)) :
              mul_lt_mul h1 (le_refl _) (nnreal.rpow_pos (zero_lt_iff.mpr hxn)) (zero_le _)
        ... ≤ (L + ⟨ε, (le_of_lt hε)⟩/2) * ((L + ⟨ε, (le_of_lt hε)⟩/2) ^
              -(((n%m1 : ℕ) : ℝ)/(n : ℝ))) * (f x ^(n % m1)) ^ (1 / (n : ℝ)) : mul_le_mul_left' h2 _
        ... ≤  L + ⟨ε, (le_of_lt hε)⟩ : h3 }}}
end

def smoothing_seminorm : α → nnreal := λ x, smoothing_seminorm_seq_lim hf1 x

include hsn
lemma smoothing_seminorm_nonneg : 0 ≤ smoothing_seminorm hf1 x :=
begin
  apply ge_of_tendsto (smoothing_seminorm_seq_lim_is_limit hsn hf1 x),
  simp only [filter.eventually_at_top, ge_iff_le],
  use 1,
  rintros n hn,
  simp only [smoothing_seminorm_seq],
  rw ← nnreal.coe_le_coe,
  exact real.rpow_nonneg_of_nonneg (nnreal.coe_nonneg _) _,
end

lemma smoothing_seminorm_zero : smoothing_seminorm hf1 0 = 0 :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_seq_lim_is_limit hsn hf1 0)
    tendsto_const_nhds,
  simp only [filter.eventually_eq, filter.eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  simp only [smoothing_seminorm_seq],
  rw [zero_pow (nat.succ_le_iff.mp hn), hsn.zero, nnreal.zero_rpow],
  apply one_div_ne_zero,
  exact nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn),
end

lemma smoothing_seminorm_mul (y : α) : smoothing_seminorm /- hsn -/ hf1 (x * y) ≤
  smoothing_seminorm /- hsn -/ hf1 x * smoothing_seminorm /- hsn  -/hf1 y :=
begin
  apply le_of_tendsto_of_tendsto' (smoothing_seminorm_seq_lim_is_limit  hsn hf1 (x *y))
    (filter.tendsto.mul (smoothing_seminorm_seq_lim_is_limit  hsn hf1 x)
      (smoothing_seminorm_seq_lim_is_limit hsn hf1 y)),
  intro n,
  have hn : 0 ≤ 1 / (n : ℝ),
  { simp only [one_div, inv_nonneg, nat.cast_nonneg] },
  simp only [smoothing_seminorm_seq],
  rw [← nnreal.mul_rpow, mul_pow],
  exact nnreal.rpow_le_rpow (hsn.mul _ _) hn,
end

lemma smoothing_seminorm_one : smoothing_seminorm /- hsn -/ hf1 1 ≤ 1 :=
begin
  apply le_of_tendsto (smoothing_seminorm_seq_lim_is_limit hsn hf1 (1 : α) ),
  simp only [filter.eventually_at_top, ge_iff_le],
  use 1,
  rintros n hn,
  simp only [smoothing_seminorm_seq],
  rw [one_pow],
  conv_rhs{rw ← nnreal.one_rpow (1/n : ℝ)},
  have hn1 : 0 < (1/n : ℝ),
  { have h01 : (0 : ℝ) < 1 := zero_lt_one,
    apply div_pos h01,
    rw [← nat.cast_zero, nat.cast_lt],
    exact (nat.succ_le_iff.mp hn) },
  exact (nnreal.rpow_le_rpow_iff hn1).mpr hf1,
end

lemma smoothing_seminorm_le : smoothing_seminorm hf1 x ≤ f x :=
begin
  apply le_of_tendsto (smoothing_seminorm_seq_lim_is_limit hsn hf1 x),
  simp only [filter.eventually_at_top, ge_iff_le],
  use 1,
  rintros n hn,
  have hn1 : (n : ℝ) * (1/n) = 1,
  { apply mul_one_div_cancel,
    exact (nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn)) },
  have hn' : 0 < (1/n : ℝ),
  { have h01 : (0 : ℝ) < 1 := zero_lt_one,
    apply div_pos h01,
    rw [← nat.cast_zero, nat.cast_lt],
    exact (nat.succ_le_iff.mp hn) },
  simp only [smoothing_seminorm_seq],
  rw [← nnreal.rpow_one (f x)],
  conv_rhs { rw ← hn1 },
  rw [nnreal.rpow_mul, nnreal.rpow_le_rpow_iff hn', nnreal.rpow_nat_cast],
  exact hsn.pow_le x (nat.succ_le_iff.mp hn),
end

lemma smoothing_seminorm_is_nonarchimedean (hna : is_nonarchimedean f) :
  is_nonarchimedean (smoothing_seminorm hf1) :=
begin
  intros x y,
  have hn : ∀ (n : pnat), ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    smoothing_seminorm hf1 (x + y) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ)),
  { intros n,
    obtain ⟨m, hm_lt, hm⟩ := is_nonarchimedean_add_pow hsn hna n x y,
    use [m, hm_lt],
    have hn_le : smoothing_seminorm hf1 (x + y) ≤ f ((x + y)^(n : ℕ))^(1/n : ℝ),
    { apply cinfi_le,
      use 0, rw mem_lower_bounds, rintros x -, exact zero_le _ },
    exact le_trans hn_le (nnreal.rpow_le_rpow hm (nat.one_div_cast_nonneg (n : ℕ))), },
  set mu_n : ℕ → ℕ := λ n, if h : n = 0 then 0 else
    (classical.some (hn (⟨n, nat.pos_of_ne_zero h⟩ : pnat))) with hmu_n,
  set nu_n : ℕ → ℕ := λ n, n - (mu_n n) with hnu_n,
  have hmu_n_le : ∀ n : ℕ, mu_n n ≤ n,
  { intro n,
    by_cases hn0 : n = 0,
    { simp only [hmu_n, dif_pos hn0], exact eq.ge hn0 },
    { simp only [hmu_n, dif_neg hn0, ← nat.lt_succ_iff, ← finset.mem_range],
      exact classical.some (classical.some_spec (hn (⟨n, nat.pos_of_ne_zero hn0⟩ : pnat))), }},
  have hmu_bdd : ∀ n : ℕ, (mu_n n : ℝ)/n ∈ set.interval (0 : ℝ) 1,
  { intro n,
    refine set.mem_Icc.mpr ⟨_, _⟩,
    { simp only [min_eq_left, zero_le_one],
      exact div_nonneg (nat.cast_nonneg (mu_n n)) (nat.cast_nonneg n), },
    { simp only [zero_le_one, max_eq_right],
      by_cases hn0 : n = 0,
      { rw [hn0, nat.cast_zero, div_zero], exact zero_le_one, },
      { have hn' : 0 < (n : ℝ) := nat.cast_pos.mpr (nat.pos_of_ne_zero hn0),
        rw [div_le_one hn', nat.cast_le],
        exact hmu_n_le _, }}},
  have hs : metric.bounded (set.interval (0 : ℝ) 1),
  { exact metric.bounded_Icc (min 0 1) (max 0 1)},
  obtain ⟨a, a_in, φ, hφ_mono, hφ_lim⟩ := tendsto_subseq_of_bounded hs hmu_bdd,
  set b := 1 - a with hb,
  have hb_lim : filter.tendsto ((λ (n : ℕ), ↑(nu_n n) / ↑n) ∘ φ) filter.at_top (𝓝 b),
  { apply filter.tendsto.congr' _ (filter.tendsto.const_sub 1 hφ_lim),
    simp only [filter.eventually_eq,function.comp_app, filter.eventually_at_top, ge_iff_le],
    use 1,
    intros m hm,
    have h0 : (φ m : ℝ ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_le_of_lt (zero_le _)
      (hφ_mono (nat.pos_of_ne_zero (nat.one_le_iff_ne_zero.mp hm))))),
    rw [← div_self h0, ← sub_div],
    simp only [hnu_n],
    rw nat.cast_sub,
    exact hmu_n_le _ },

  have hx : filter.limsup filter.at_top (λ (n : ℕ), (f (x ^ (mu_n (φ n))))^(1/(φ n : ℝ))) ≤
    (smoothing_seminorm hf1 x)^a,
  { sorry },
  have hy : filter.limsup filter.at_top (λ (n : ℕ), (f (y ^ (nu_n (φ n))))^(1/(φ n : ℝ))) ≤
    (smoothing_seminorm hf1 y)^b,
  { sorry },

  have hxy : filter.limsup filter.at_top
    (λ (n : ℕ), (f (x ^ (mu_n (φ n))))^(1/(φ n : ℝ) * f (y ^ (nu_n (φ n))))^(1/(φ n : ℝ))) ≤
    (smoothing_seminorm hf1 x)^a * (smoothing_seminorm hf1 y)^b,
  { have : filter.limsup filter.at_top
    (λ (n : ℕ), (f (x ^ (mu_n (φ n))))^(1/(φ n : ℝ) * f (y ^ (nu_n (φ n))))^(1/(φ n : ℝ))) ≤
    (filter.limsup filter.at_top (λ (n : ℕ), (f (x ^ (mu_n (φ n))))^(1/(φ n : ℝ)))) *
    ( filter.limsup filter.at_top (λ (n : ℕ), (f (y ^ (nu_n (φ n))))^(1/(φ n : ℝ)))),
    { sorry },
    apply le_trans this,
    exact mul_le_mul' hx hy },

  conv_lhs { simp only [smoothing_seminorm, smoothing_seminorm_seq_lim], },
  rw ← nnreal.coe_le_coe,
  apply le_of_forall_sub_le,
  intros ε hε,
  have hε_nnr : ε = ((⟨ε, le_of_lt hε⟩ : nnreal) : ℝ) := rfl,
  rw sub_le_iff_le_add, rw hε_nnr, rw ← nnreal.coe_add, rw nnreal.coe_le_coe,

  have hxy' : filter.limsup filter.at_top
    (λ (n : ℕ), (f (x ^ (mu_n (φ n))))^(1/(φ n : ℝ) * f (y ^ (nu_n (φ n))))^(1/(φ n : ℝ))) <
    (smoothing_seminorm hf1 x)^a * (smoothing_seminorm hf1 y)^b + ⟨ε, le_of_lt hε⟩,
  { sorry },
  sorry
  --sorry,
   /-  have h := filter.eventually_lt_of_limsup_lt hxy' _,

    { sorry },

    { simp only [auto_param_eq],

      --refine filter.is_bounded_under_of _,
      sorry }, -/

    --rw ← filter.limsup_const ((smoothing_seminorm hf1 x)^a) at hx,
    --apply cinfi_le_of_le,

end

lemma smoothing_seminorm_is_seminorm (hna : is_nonarchimedean f) :
  is_seminorm (smoothing_seminorm hf1) :=
{ zero := smoothing_seminorm_zero hsn hf1,
  add  := add_le_of_is_nonarchimedean (smoothing_seminorm_zero hsn hf1)
    (smoothing_seminorm_is_nonarchimedean hsn hf1 hna),
  mul  := smoothing_seminorm_mul hsn hf1 }

lemma smoothing_seminorm_is_seminorm_is_norm_le_one_class :
  is_norm_le_one_class (smoothing_seminorm /- hsn -/ hf1) :=
smoothing_seminorm_one hsn hf1

lemma smoothing_seminorm_is_pow_mult : is_pow_mult (smoothing_seminorm hf1) :=
begin
  intros x m hm,
  simp only [smoothing_seminorm],
  have hlim : filter.tendsto (λ n, smoothing_seminorm_seq hsn x (m*n)) filter.at_top
    (𝓝 (smoothing_seminorm_seq_lim hf1 x )),
  { refine filter.tendsto.comp (smoothing_seminorm_seq_lim_is_limit hsn hf1 x) _,
    apply filter.tendsto_at_top_at_top_of_monotone,
    { intros n k hnk, exact mul_le_mul_left' hnk m, },
    { rintro n, use n, exact le_mul_of_one_le_left' hm, }},
  apply tendsto_nhds_unique _ (filter.tendsto.pow hlim m),
  have h_eq : ∀ (n : ℕ), smoothing_seminorm_seq hsn x (m * n) ^ m =
    smoothing_seminorm_seq hsn (x^m) n,
  { have hm' : (m : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_lt_of_le zero_lt_one hm)),
    intro n,
    simp only [smoothing_seminorm_seq],
    rw [pow_mul, ← nnreal.rpow_nat_cast, ← nnreal.rpow_mul, nat.cast_mul, ← one_div_mul_one_div,
      mul_comm (1 / (m : ℝ)), mul_assoc, one_div_mul_cancel hm', mul_one] },
  simp_rw h_eq,
  exact smoothing_seminorm_seq_lim_is_limit hsn hf1 _
end

variable {x}

lemma smoothing_seminorm_of_pow_mult (hx : ∀ (n : ℕ) (hn : 1 ≤ n), f (x ^ n) = f x ^ n) :
  smoothing_seminorm hf1 x = f x :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_seq_lim_is_limit hsn hf1 x)
    tendsto_const_nhds,
  simp only [filter.eventually_eq, filter.eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  simp only [smoothing_seminorm_seq],
  have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn),
  rw [hx n hn, ← nnreal.rpow_nat_cast, ← nnreal.rpow_mul, mul_one_div_cancel hn0,
    nnreal.rpow_one],
end

lemma f_is_mult_pow_of_is_mult (hx : ∀ y : α, f (x * y) = f x * f y) :
   ∀ (n : ℕ) (y : α), f (x ^ n * y) = f x ^ n * f y :=
begin
  { intros n,
    induction n with n hn,
    { intro y, rw [pow_zero, pow_zero, one_mul, one_mul]},
    { intro y, rw [pow_succ', pow_succ', mul_assoc, mul_assoc, ← hx y], exact hn _, }},
end

lemma smoothing_seminorm_apply_of_is_mult (hx : ∀ y : α, f (x * y) = f x * f y) :
  smoothing_seminorm hf1 x = f x :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_seq_lim_is_limit hsn hf1 x)
    tendsto_const_nhds,
  simp only [filter.eventually_eq, filter.eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  simp only [smoothing_seminorm_seq],
  by_cases hx0 : f x = 0,
  { have hxn : f (x ^ n) = 0,
    { apply le_antisymm _ (zero_le _),
      apply le_trans (hsn.pow_le x (lt_of_lt_of_le zero_lt_one hn)),
      rw [hx0, zero_pow (lt_of_lt_of_le zero_lt_one hn)], },
    rw [hx0, hxn, nnreal.zero_rpow (nat.one_div_cast_ne_zero hn)] },
  { have h1 : f 1 = 1,
    { rw [← nnreal.mul_eq_mul_left hx0, ← hx 1, mul_one, mul_one], },
    have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_lt_of_le zero_lt_one hn)),
    rw [← mul_one (x ^ n), f_is_mult_pow_of_is_mult hsn hf1 hx, ← nnreal.rpow_nat_cast, h1, mul_one,
      ← nnreal.rpow_mul, mul_one_div_cancel hn0, nnreal.rpow_one], },
end

lemma smoothing_seminorm_of_mult (hx : ∀ (y : α), f (x * y) = f x * f y) (y : α) :
  smoothing_seminorm hf1 (x * y) =
    smoothing_seminorm hf1 x * smoothing_seminorm hf1 y :=
begin
  have hlim : filter.tendsto (λ n, f x * smoothing_seminorm_seq hsn y n) filter.at_top
    (𝓝 (smoothing_seminorm hf1 x * smoothing_seminorm hf1 y)),
  { rw [smoothing_seminorm_apply_of_is_mult hsn hf1 hx],
    exact filter.tendsto.const_mul _ (smoothing_seminorm_seq_lim_is_limit hsn hf1 y), },
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_seq_lim_is_limit hsn hf1 (x * y))
    hlim,
  simp only [filter.eventually_eq, filter.eventually_at_top, ge_iff_le],
  use 1,
  intros n hn1,
  have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_lt_of_le zero_lt_one hn1)),
  simp only [smoothing_seminorm_seq],
  rw [mul_pow, f_is_mult_pow_of_is_mult hsn hf1 hx, nnreal.mul_rpow, ← nnreal.rpow_nat_cast,
    ← nnreal.rpow_mul, mul_one_div_cancel hn0, nnreal.rpow_one],
end

end smoothing_seminorm


import pseudo_normed_group.profinitely_filtered
import prop_92.extension_profinite
import normed_group.normed_with_aut

import analysis.normed.group.hom_completion

import locally_constant.analysis

import tactic.ring_exp

import for_mathlib.nnreal

/-!
This file builds a concrete version of Proposition 9.2, with almost no category.
The exception is that `SemiNormedGroup` is used because this is expected in
`normed_with_aut` (we could easily get rid of this but this is very mild category theory hell).
There are two independent parts. The first one is all about locally constant maps from
compact spaces to seminormed groups. The next one forgets about locally constant functions
and does abstract normed space stuff.
-/

noncomputable theory

section
open finset
open_locale big_operators

-- Why can't I find this in mathlib?!?
lemma partial_sum_geom {r : ℝ} (hr : 0 ≤ r) (hr' : r < 1) (n : ℕ) : (∑ k in range n, r^k) = (1 - r^n)/(1 - r) :=
begin
  refine (eq_div_iff (sub_ne_zero.mpr hr'.ne')).mpr _,
  induction n with n ih,
  { simp },
  { rw [sum_range_succ, add_mul, ih],
    ring_exp }
end

-- Why can't I find this in mathlib?!?
lemma partial_sum_geom_le {r : ℝ} (hr : 0 ≤ r) (hr' : r < 1) (n : ℕ) : (∑ k in range n, r^k) ≤ 1/(1 - r) :=
begin
  rw partial_sum_geom hr hr',
  exact div_le_div zero_le_one (sub_le_self _ (pow_nonneg hr n)) (sub_pos.mpr hr') rfl.le,
end

lemma norm_sum_le_of_le_geom {α : Type*} [semi_normed_group α] {r C : ℝ} (hC : 0 ≤ C)
  (hr₀ : 0 ≤ r) (hr₁ : r < 1) {f : ℕ → α} (h : ∀ n, ∥f n∥ ≤ C*r^n) {n : ℕ} :
  ∥∑ k in range n, f k∥ ≤ C/(1-r) :=
begin
calc
  ∥∑ k in range n, f k∥ ≤ ∑ k in range n, ∥f k∥ : norm_sum_le _ _
    ... ≤ ∑ k in range n, C*r^k : sum_le_sum (λ k hk, h k)
  ... = C*(∑ k in range n, r^k) : by rw mul_sum
  ... ≤ C*(1/(1-r)) :  mul_le_mul_of_nonneg_left (partial_sum_geom_le hr₀ hr₁ n) hC
  ... = C/(1-r) : mul_one_div C (1 - r)
end

end

open set

@[simp]
lemma real.supr_zero (ι : Type*) : (⨆ i : ι, (0 : ℝ)) = 0 :=
begin
  rw supr,
  casesI is_empty_or_nonempty ι,
  { rw [set.range_eq_empty, real.Sup_empty] },
  { rw [set.range_const, cSup_singleton] },
end

-- Move me
lemma real.Sup_eq {s : set ℝ} (hs : s.nonempty) (hs' : ∃ x, ∀ y ∈ s, y ≤ x) {x : ℝ} :
  Sup s = x ↔ ∀ y, x ≤ y ↔ (∀ z ∈ s, z ≤ y) :=
begin
  classical,
  rw real.Sup_def,
  rw dif_pos,
  { let x₀ := classical.some (real.exists_is_lub s hs hs'),
    change x₀ = x ↔ _,
    have H : ∀ y, x₀ ≤ y ↔ ∀ z ∈ s, z ≤ y,
    { intros y,
      exact is_lub_le_iff (classical.some_spec (real.exists_is_lub s hs hs')) },
    split,
    { dsimp [x₀],
      rintro rfl,
      exact H },
    { intro h,
      replace H : ∀ y, x₀ ≤ y ↔ x ≤ y,
      { intro y,
        rw [h, H] },
      apply le_antisymm,
      { exact (H _).mpr (le_refl _) },
      { exact (H _).mp (le_refl _) } } },
  { exact ⟨hs, hs'⟩ }
end

-- Move me
lemma is_lub_iff {α : Type*} [preorder α] {s : set α} {x : α} :
  is_lub s x ↔ ∀ y, x ≤ y ↔ ∀ z ∈ s, z ≤ y :=
begin
  split,
  { rintros ⟨h₁, h₂⟩ y,
    exact ⟨λ hxy z z_in, (h₁ z_in).trans hxy, λ h, h₂ h⟩ },
  { intro H,
    exact ⟨λ y y_in, (H x).mp (le_refl x) y y_in, λ z hz, by rwa H⟩ }
end

-- Move me
lemma real.Sup_eq' {s : set ℝ} (hs : s.nonempty) (hs' : ∃ x, ∀ y ∈ s, y ≤ x) {x : ℝ} :
  Sup s = x ↔ (∀ y ∈ s, y ≤ x) ∧ ∀ z, (∀ y ∈ s, y ≤ z) → x ≤ z :=
begin
  rw real.Sup_eq hs hs',
  change _ ↔ is_lub _ _,
  rw is_lub_iff
end

lemma real.supr_comp {α β : Type*} (f : β → α) (g : α → ℝ) :
  (⨆ b, g (f b)) = Sup (g '' range f) :=
begin
  change Sup _ = _,
  congr,
  ext x,
  simp,
end

instance semi_normed_group.inhabited (G : Type*) [semi_normed_group G] : inhabited G := ⟨0⟩

section general_completion_stuff
open filter uniform_space
open_locale topological_space

-- Now we want an abstract machine where we can plug the sequence g from the previous section.

variables {M₁ : Type*} [semi_normed_group M₁] {M₂ : Type*} [semi_normed_group M₂]
          (f : normed_group_hom M₁ M₂)

-- PR very close to the definition of cauchy_seq
lemma cauchy_seq.map {β : Type*} [semilattice_sup β]
  {α : Type*} [uniform_space α] {γ : Type*} [uniform_space γ]
  {u : β → α} {f : α → γ} (hu : cauchy_seq u) (hf : uniform_continuous f) :
  cauchy_seq (f ∘ u) :=
begin
  change cauchy _,
  rw ← map_map,
  exact cauchy.map hu hf
end

-- actually not used here, but should go somewhere
lemma normed_group_hom.coe_range : (f.range : set M₂) = set.range f :=
by { erw add_monoid_hom.coe_range, refl }

open normed_group

lemma bar {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε)
  (h : ∀ m₂ : M₂, ∃ g : ℕ → M₁, cauchy_seq g ∧ tendsto (f ∘ g) at_top (𝓝 m₂) ∧ ∀ n, ∥g n∥ ≤ C*∥m₂∥) :
  ∀ hatm₂ : completion M₂, ∃ m₁, f.completion m₁ = hatm₂ ∧ ∥m₁∥ ≤ (C+ε)*∥hatm₂∥ :=
begin
  intro hatm₂,
  refine controlled_closure_range_of_complete normed_group.norm_to_compl hC hε _ _
    (normed_group.dense_range_to_compl _),
  intro m₂,
  rcases h m₂ with ⟨g, cauchy_g, lim_g, bound_g⟩,
  have : cauchy_seq (to_compl ∘ g),
    from cauchy_g.map to_compl.uniform_continuous,
  rcases cauchy_seq_tendsto_of_complete this with ⟨y, hy⟩,
  refine ⟨y, _, _⟩,
  { have lim : tendsto ((f.completion.comp to_compl) ∘ g) at_top (𝓝 (f.completion y)),
      from (f.completion.continuous.tendsto _).comp hy,
    rw f.completion_to_compl at lim,
    have : tendsto ((to_compl ∘ f) ∘ g) at_top (𝓝 (to_compl m₂)) :=
      (to_compl.continuous.tendsto _).comp lim_g,
    exact tendsto_nhds_unique lim this },
  { refine le_of_tendsto' (tendsto_norm.comp hy) (_ : ∀ n, ∥to_compl (g n)∥ ≤ C * ∥m₂∥),
    intro n,
    rw normed_group.norm_to_compl,
    apply bound_g }
end

end general_completion_stuff

section locally_constant_stuff
open topological_space normed_with_aut set
open_locale nnreal big_operators

local attribute [instance] locally_constant.semi_normed_group

/- Comment below indicate how this will be applied to Prop 9.2 -/
variables
  /- this will be M_{≤ r'c}^a -/
  {X : Type*} [topological_space X] [compact_space X]
  /- this will be M_{≤ c}^a -/
  {Y : Type*} [topological_space Y] [compact_space Y] [t2_space Y] [totally_disconnected_space Y]
  /- This will be inclusion -/
  {e : X → Y} (he : embedding e)
  /- This is used only for premilinary lemma not need the T action on V -/
  {G : Type*} [semi_normed_group G]

@[simp]
lemma locally_constant.norm_of_is_empty [is_empty X] (f : locally_constant X G) : ∥f∥ = 0 :=
by rw [locally_constant.norm_def, supr, range_eq_empty, real.Sup_empty]

@[simp]
lemma embedding.locally_constant_extend_of_empty (hX : ¬ nonempty X) (f : locally_constant X G) :
 he.locally_constant_extend f = 0 :=
begin
  ext y, dsimp [embedding.locally_constant_extend, embedding.extend],
  rw dif_neg,
  { refl },
  { intro h, exact hX h.2 }
end

@[simp]
lemma locally_constant.map_zero {Z : Type*} (g : G → Z) :
  (0 : locally_constant X G).map g = locally_constant.const X (g 0) :=
begin
  ext x,
  simp only [function.comp_app, locally_constant.map_apply, locally_constant.zero_apply],
  refl,
end

@[simp]
lemma locally_constant.norm_const [h : nonempty X] (g : G) : ∥locally_constant.const X g∥ = ∥g∥ :=
by simp only [locally_constant.norm_def, locally_constant.const, csupr_const,
    function.const_apply, locally_constant.coe_mk]

@[simp]
lemma locally_constant.norm_zero : ∥(0 : locally_constant X G)∥ = 0 :=
by simp only [locally_constant.norm_def, norm_zero, real.supr_zero, locally_constant.zero_apply]

@[simp]
lemma locally_constant.norm_const_zero : ∥locally_constant.const X (0 : G)∥ = 0 :=
locally_constant.norm_zero

-- Should go in mathlib topology/algebra/ordered, next to is_compast.exists_Sup_image_eq
lemma continuous.exists_forall_le_of_compact {X : Type*} [topological_space X] [compact_space X] [nonempty X]
{β : Type*} [conditionally_complete_linear_order β] [topological_space β] [order_topology β] {f : X → β}
(hf : continuous f) : ∃ x, Sup (range f) = f x :=
by simpa using compact_univ.exists_Sup_image_eq univ_nonempty hf.continuous_on

lemma locally_constant.exists_norm_eq [nonempty X] (f : locally_constant X G) : ∃ x, ∥f∥ = ∥f x∥ :=
(continuous_norm.comp f.continuous).exists_forall_le_of_compact

lemma locally_constant.norm_eq_iff (f : locally_constant X G) {x : X} :
  ∥f∥ = ∥f x∥ ↔ ∀ x', ∥f x'∥ ≤ ∥f x∥ :=
begin
  have fin_range : (range (λ (x : X), ∥f x∥)).finite,
  { rw range_comp,
    apply finite.image,
    exact f.range_finite },
  have bound : ∃ b, ∀ y ∈ range (λ (x : X), ∥f x∥), y ≤ b,
    from exists_upper_bound_image _ _ fin_range,
  rw [locally_constant.norm_def],
  split,
  { intros h x',
    rw ← h,
    exact le_cSup bound (mem_range_self _) } ,
  { intro h,
    erw real.Sup_eq _ bound,
    { intro y,
      rw forall_range_iff,
      split,
      { intros h' x',
        exact (h x').trans h' },
      { exact λ i, i x } },
    { exact ⟨∥f x∥, mem_range_self _⟩ } }
end

lemma locally_constant.norm_eq_iff' (f : locally_constant X G) {x : X} :
  ∥f∥ = ∥f x∥ ↔ ∀ g ∈ range f, ∥g∥ ≤ ∥f x∥ :=
by rw [forall_range_iff, locally_constant.norm_eq_iff]

lemma locally_constant.norm_comap_le {α : Type*} [topological_space α] [compact_space α]
  (f : locally_constant X G) {g : α → X} (h : continuous g) : ∥f.comap g∥ ≤ ∥f∥ :=
locally_constant.comap_hom_norm_noninc g h f

lemma locally_constant.comap_map {W X Y Z : Type*} [topological_space W] [topological_space X] [topological_space Y]
  (f : locally_constant X Y) (g : W → X) (h : Y → Z) (hg : continuous g) : (f.comap g).map h = (f.map h).comap g :=
by { ext, simp [hg] }

lemma locally_constant.map_comp' {W X Y Z : Type*} [topological_space W]
  (f : locally_constant W X) (g : X → Y) (h : Y → Z) : (f.map g).map h = f.map (h ∘ g) :=
rfl

lemma embedding.norm_extend (f : locally_constant X G) : ∥he.locally_constant_extend f∥ = ∥f∥ :=
begin
  casesI is_empty_or_nonempty X,
  { rw [f.norm_of_is_empty],
    dsimp [embedding.locally_constant_extend, embedding.extend],
    have hX : ¬ nonempty X, { rwa not_nonempty_iff },
    suffices : (⨆ (y : Y), ∥(0 : G)∥) = 0, { simpa only [hX, dif_neg, not_false_iff, and_false] },
    simp only [norm_zero, real.supr_zero] },
  { change (⨆ y : Y, _) = (⨆ x : X, _),
    rw [real.supr_comp, real.supr_comp, he.range_locally_constant_extend f] },
end

variables
  (φ : X → Y) -- this will be φ is T⁻¹ : M_{≤ r'c}^a → M_{≤ c}^a
  {r : ℝ≥0} {V : SemiNormedGroup} [normed_with_aut r V] -- this is indeed V!

include r

lemma locally_constant.norm_map_aut (g : locally_constant Y V) : ∥g.map T.hom∥ = r*∥g∥ :=
begin
  casesI is_empty_or_nonempty Y,
  { simp only [mul_zero, locally_constant.norm_of_is_empty] },
  { cases g.exists_norm_eq with y hy,
    erw [hy, ← norm_T, locally_constant.norm_eq_iff],
    intro y',
    erw [norm_T, norm_T],
    cases (eq_zero_or_pos : r = 0 ∨ 0 < r) with hr hr,
    { simp only [hr, nnreal.coe_zero, zero_mul] },
    { simp only [hr, ←hy, g.norm_apply_le, mul_le_mul_left, nnreal.coe_pos] } },
end

@[simp]
lemma normed_with_aut.T_inv_T_hom : (T.inv : V → V) ∘ T.hom = id :=
begin
  ext,
  simp,
end

open locally_constant
variables {φ} (hφ : continuous φ)

include hφ

noncomputable
def embedding.h (f : locally_constant X V) : ℕ → locally_constant Y V
| 0     := map_hom T.hom (he.locally_constant_extend f)
| (i+1) := map_hom T.hom (he.locally_constant_extend $ (comap_hom φ hφ $ embedding.h i))

variables (f : locally_constant X V)

lemma norm_h (i : ℕ) : ∥he.h hφ f i∥ ≤ r^(i+1)*∥f∥ :=
begin
  induction i with i ih ; dsimp [embedding.h],
  { rw [locally_constant.norm_map_aut, he.norm_extend, zero_add, pow_one] },
  { rw [locally_constant.norm_map_aut, he.norm_extend, pow_succ, mul_assoc],
    exact mul_le_mul_of_nonneg_left (((he.h hφ f i).norm_comap_le hφ).trans ih) r.coe_nonneg },
end

open finset

def embedding.g (f : locally_constant X V) (N : ℕ) : locally_constant Y V :=
∑ i in range (N + 1), he.h hφ f i

/-- T⁻¹ g_N e - g_N φ = f - h_N φ-/
lemma one (hφ : continuous φ) (N : ℕ) :
  map_hom T.inv (comap_hom e he.continuous (he.g hφ f N)) - (comap_hom φ hφ (he.g hφ f N)) =
  f - comap_hom φ hφ (he.h hφ f N) :=
begin
  induction N with N ih,
  { dsimp [embedding.g],
    simp only [embedding.h, finset.sum_singleton, sub_left_inj],
    ext x,
    simp [he.continuous, he.locally_constant_extend_extends] },
  { set c_φ : normed_group_hom (locally_constant Y V) (locally_constant X V) := comap_hom φ hφ,
    set c_e : normed_group_hom (locally_constant Y V) (locally_constant X V) := comap_hom e he.continuous,
    set m_T : normed_group_hom (locally_constant X V) (locally_constant X V) := map_hom T.inv,
    set G := he.g hφ f,
    set H := he.h hφ f,
    change m_T _ - _ = _,
    rw sub_eq_iff_eq_add at ih,
    dsimp [embedding.g, embedding.h],
    change m_T (c_e ∑ i in range (N.succ + 1), H i) -
      c_φ ∑ i in range (N.succ + 1), H i = _,
    erw [finset.sum_range_succ, normed_group_hom.map_add, normed_group_hom.map_add, normed_group_hom.map_add, ih],
    change f - c_φ (H N) + c_φ (G N) + m_T (c_e (H N.succ)) - (c_φ (G N) + c_φ (H N.succ)) =  f - comap φ (H N.succ),
    dsimp [H, embedding.h],
    rw [← (he.locally_constant_extend $ comap φ $ H N).comap_map  e T.hom he.continuous,
        he.comap_locally_constant_extend, locally_constant.map_comp', normed_with_aut.T_inv_T_hom],
    simp [H],
    abel },
end

open filter
open_locale topological_space

variables [fact ((r : ℝ) < 1)]

lemma limit : tendsto (λ N, map_hom T.inv (comap_hom e he.continuous (he.g hφ f N)) - (comap_hom φ hφ (he.g hφ f N))) at_top (𝓝 f) :=
begin
  simp_rw one,
  rw show 𝓝 f = 𝓝 (f - 0), by simp,
  refine tendsto_const_nhds.sub _,
  apply squeeze_zero_norm,
  intro n,
  apply ((he.h hφ f n).norm_comap_le hφ).trans (norm_h he hφ _ _),
  rw ← zero_mul (∥f∥),
  apply tendsto.mul_const,
  rw tendsto_add_at_top_iff_nat,
  exact tendsto_pow_at_top_nhds_0_of_lt_1 r.coe_nonneg (fact.out _)
end

lemma cauchy_seq_g : cauchy_seq (he.g hφ f) :=
begin
  apply cauchy_seq_of_le_geometric r (r^2*∥f∥) (fact.out _),
  intro n,
  dsimp [embedding.g],
  rw [dist_eq_norm, sum_range_succ _ (n+1), sub_add_eq_sub_sub, sub_self, zero_sub, norm_neg],
  convert norm_h he hφ f (n+1) using 1,
  ring_exp
end

lemma norm_g_le (N : ℕ) : ∥he.g hφ f N∥ ≤ r/(1 - r) * ∥f∥ :=
begin
  have : ∀ (n : ℕ), ∥he.h hφ f n∥ ≤ r * ∥f∥ * r ^ n,
  { intro n,
    convert norm_h he hφ f n using 1,
    ring_exp },
  convert norm_sum_le_of_le_geom (mul_nonneg r.coe_nonneg $ norm_nonneg f) r.coe_nonneg (fact.out _) this using 1,
  exact div_mul_eq_mul_div _ _ _,
end

open uniform_space

lemma concrete_92 [fact (0 < r)] (f : completion (locally_constant X V)) {ε : ℝ} (hε : 0 < ε) :
  ∃ g : completion (locally_constant Y V),
    ((map_hom T.inv).comp (comap_hom e he.continuous) - comap_hom φ hφ).completion g = f ∧
    ∥g∥ ≤ (r/(1-r) + ε)*∥f∥ :=
begin
  have : (0 : ℝ) < r / (1 - r),
  { have : 0 < r := fact.out _,
    apply div_pos,
    { exact_mod_cast this },
    { exact sub_pos.mpr (fact.out _) } },
  apply bar _ this hε,
  intro m₂,
  exact ⟨he.g hφ m₂, cauchy_seq_g he hφ m₂, limit he hφ m₂, norm_g_le he hφ m₂⟩
end

end locally_constant_stuff


import data.equiv.basic

namespace equiv

@[simp] lemma symm_comp_self_eq_id {α β : Sort*} (e : α ≃ β) : e.symm ∘ e = id :=
function.left_inverse.comp_eq_id e.left_inverse_symm

@[simp] lemma self_comp_symm_eq_id {α β : Sort*} (e : α ≃ β) : e ∘ e.symm = id :=
function.right_inverse.comp_eq_id e.right_inverse_symm

def subtype_prod_subtype_equiv_subtype {α β : Type*} {p : α → Prop} {q : β → Prop} :
  ({a // p a} × {b // q b}) ≃ {c : α × β // p c.1 ∧ q c.2} :=
⟨λ apbq, ⟨(apbq.fst.val, apbq.snd.val), ⟨apbq.fst.property, apbq.snd.property⟩⟩,
 λ abpq, (⟨abpq.val.fst, abpq.property.left⟩, ⟨abpq.val.snd, abpq.property.right⟩),
 λ ⟨⟨a, p⟩, ⟨b, q⟩⟩, rfl,
 λ ⟨⟨a, b⟩, ⟨p, q⟩⟩, rfl⟩

def replace_to_fun {α β : Sort*} (e : α ≃ β) (f : α → β) (h : ⇑e = f) : α ≃ β :=
{ to_fun := f,
  inv_fun := e.inv_fun,
  left_inv := h ▸ e.left_inv,
  right_inv := h ▸ e.right_inv }

end equiv


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_192
  (q e d : ℂ)
  (h₀ : q = 11 - (5 * complex.I))
  (h₁ : e = 11 + (5 * complex.I))
  (h₂ : d = 2 * complex.I) :
  q * e * d = 292 * complex.I :=
begin
  rw [h₀, h₁, h₂],
  ring_nf,
  rw [pow_two, complex.I_mul_I],
  ring,
end


/-
Copyright (c) 2021 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou, Adam Topaz, Johan Commelin

! This file was ported from Lean 3 source module algebraic_topology.alternating_face_map_complex
! leanprover-community/mathlib commit 88bca0ce5d22ebfd9e73e682e51d60ea13b48347
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.Additive
import Mathbin.AlgebraicTopology.MooreComplex
import Mathbin.Algebra.BigOperators.Fin
import Mathbin.CategoryTheory.Preadditive.Opposite
import Mathbin.CategoryTheory.Idempotents.FunctorCategories
import Mathbin.Tactic.EquivRw

/-!

# The alternating face map complex of a simplicial object in a preadditive category

We construct the alternating face map complex, as a
functor `alternating_face_map_complex : simplicial_object C ⥤ chain_complex C ℕ`
for any preadditive category `C`. For any simplicial object `X` in `C`,
this is the homological complex `... → X_2 → X_1 → X_0`
where the differentials are alternating sums of faces.

The dual version `alternating_coface_map_complex : cosimplicial_object C ⥤ cochain_complex C ℕ`
is also constructed.

We also construct the natural transformation
`inclusion_of_Moore_complex : normalized_Moore_complex A ⟶ alternating_face_map_complex A`
when `A` is an abelian category.

## References
* https://stacks.math.columbia.edu/tag/0194
* https://ncatlab.org/nlab/show/Moore+complex

-/

open CategoryTheory CategoryTheory.Limits CategoryTheory.Subobject

open CategoryTheory.Preadditive CategoryTheory.Category CategoryTheory.Idempotents

open Opposite

open BigOperators

open Simplicial

noncomputable section

namespace AlgebraicTopology

namespace AlternatingFaceMapComplex

/-!
## Construction of the alternating face map complex
-/

variable {C : Type _} [Category C] [Preadditive C]

variable (X : SimplicialObject C)

variable (Y : SimplicialObject C)

/-- The differential on the alternating face map complex is the alternate
sum of the face maps -/
@[simp]
def objD (n : ℕ) : X _[n + 1] ⟶ X _[n] :=
  ∑ i : Fin (n + 2), (-1 : ℤ) ^ (i : ℕ) • X.δ i
#align algebraic_topology.alternating_face_map_complex.obj_d AlgebraicTopology.AlternatingFaceMapComplex.objD

/-- ## The chain complex relation `d ≫ d`
-/
theorem d_squared (n : ℕ) : objD X (n + 1) ≫ objD X n = 0 :=
  by
  -- we start by expanding d ≫ d as a double sum
  dsimp
  rw [comp_sum]
  let d_l := fun j : Fin (n + 3) => (-1 : ℤ) ^ (j : ℕ) • X.δ j
  let d_r := fun i : Fin (n + 2) => (-1 : ℤ) ^ (i : ℕ) • X.δ i
  rw [show (fun i => (∑ j : Fin (n + 3), d_l j) ≫ d_r i) = fun i => ∑ j : Fin (n + 3), d_l j ≫ d_r i
      by
      ext i
      rw [sum_comp]]
  rw [← Finset.sum_product']
  -- then, we decompose the index set P into a subet S and its complement Sᶜ
  let P := Fin (n + 2) × Fin (n + 3)
  let S := finset.univ.filter fun ij : P => (ij.2 : ℕ) ≤ (ij.1 : ℕ)
  let term := fun ij : P => d_l ij.2 ≫ d_r ij.1
  erw [show (∑ ij : P, term ij) = (∑ ij in S, term ij) + ∑ ij in Sᶜ, term ij by
      rw [Finset.sum_add_sum_compl]]
  rw [← eq_neg_iff_add_eq_zero, ← Finset.sum_neg_distrib]
  /- we are reduced to showing that two sums are equal, and this is obtained
    by constructing a bijection φ : S -> Sᶜ, which maps (i,j) to (j,i+1),
    and by comparing the terms -/
  let φ : ∀ ij : P, ij ∈ S → P := fun ij hij =>
    (Fin.castLt ij.2 (lt_of_le_of_lt (finset.mem_filter.mp hij).right (Fin.is_lt ij.1)), ij.1.succ)
  apply Finset.sum_bij φ
  · -- φ(S) is contained in Sᶜ
    intro ij hij
    simp only [Finset.mem_univ, Finset.compl_filter, Finset.mem_filter, true_and_iff, Fin.val_succ,
      Fin.coe_castLt] at hij⊢
    linarith
  · -- identification of corresponding terms in both sums
    rintro ⟨i, j⟩ hij
    simp only [term, d_l, d_r, φ, comp_zsmul, zsmul_comp, ← neg_smul, ← mul_smul, pow_add, neg_mul,
      mul_one, Fin.coe_castLt, Fin.val_succ, pow_one, mul_neg, neg_neg]
    let jj : Fin (n + 2) := (φ (i, j) hij).1
    have ineq : jj ≤ i := by
      rw [← Fin.val_fin_le]
      simpa using hij
    rw [CategoryTheory.SimplicialObject.δ_comp_δ X ineq, Fin.castSucc_cast_lt, mul_comm]
  · -- φ : S → Sᶜ is injective
    rintro ⟨i, j⟩ ⟨i', j'⟩ hij hij' h
    rw [Prod.mk.inj_iff]
    refine' ⟨by simpa using congr_arg Prod.snd h, _⟩
    have h1 := congr_arg Fin.castSucc (congr_arg Prod.fst h)
    simpa [Fin.castSucc_cast_lt] using h1
  · -- φ : S → Sᶜ is surjective
    rintro ⟨i', j'⟩ hij'
    simp only [true_and_iff, Finset.mem_univ, Finset.compl_filter, not_le, Finset.mem_filter] at
      hij'
    refine' ⟨(j'.pred _, Fin.castSucc i'), _, _⟩
    · intro H
      simpa only [H, Nat.not_lt_zero, Fin.val_zero] using hij'
    ·
      simpa only [true_and_iff, Finset.mem_univ, Fin.coe_castSucc, Fin.coe_pred,
        Finset.mem_filter] using Nat.le_pred_of_lt hij'
    · simp only [Prod.mk.inj_iff, Fin.succ_pred, Fin.cast_lt_castSucc]
      constructor <;> rfl
#align algebraic_topology.alternating_face_map_complex.d_squared AlgebraicTopology.AlternatingFaceMapComplex.d_squared

/-!
## Construction of the alternating face map complex functor
-/

/-- The alternating face map complex, on objects -/
def obj : ChainComplex C ℕ :=
  ChainComplex.of (fun n => X _[n]) (objD X) (d_squared X)
#align algebraic_topology.alternating_face_map_complex.obj AlgebraicTopology.AlternatingFaceMapComplex.obj

@[simp]
theorem obj_x (X : SimplicialObject C) (n : ℕ) : (AlternatingFaceMapComplex.obj X).pt n = X _[n] :=
  rfl
#align algebraic_topology.alternating_face_map_complex.obj_X AlgebraicTopology.AlternatingFaceMapComplex.obj_x

@[simp]
theorem obj_d_eq (X : SimplicialObject C) (n : ℕ) :
    (AlternatingFaceMapComplex.obj X).d (n + 1) n = ∑ i : Fin (n + 2), (-1 : ℤ) ^ (i : ℕ) • X.δ i :=
  by apply ChainComplex.of_d
#align algebraic_topology.alternating_face_map_complex.obj_d_eq AlgebraicTopology.AlternatingFaceMapComplex.obj_d_eq

variable {X} {Y}

/-- The alternating face map complex, on morphisms -/
def map (f : X ⟶ Y) : obj X ⟶ obj Y :=
  ChainComplex.ofHom _ _ _ _ _ _ (fun n => f.app (op [n])) fun n =>
    by
    dsimp
    rw [comp_sum, sum_comp]
    apply Finset.sum_congr rfl fun x h => _
    rw [comp_zsmul, zsmul_comp]
    congr 1
    symm
    apply f.naturality
#align algebraic_topology.alternating_face_map_complex.map AlgebraicTopology.AlternatingFaceMapComplex.map

@[simp]
theorem map_f (f : X ⟶ Y) (n : ℕ) : (map f).f n = f.app (op [n]) :=
  rfl
#align algebraic_topology.alternating_face_map_complex.map_f AlgebraicTopology.AlternatingFaceMapComplex.map_f

end AlternatingFaceMapComplex

variable (C : Type _) [Category C] [Preadditive C]

/-- The alternating face map complex, as a functor -/
def alternatingFaceMapComplex : SimplicialObject C ⥤ ChainComplex C ℕ
    where
  obj := AlternatingFaceMapComplex.obj
  map X Y f := AlternatingFaceMapComplex.map f
#align algebraic_topology.alternating_face_map_complex AlgebraicTopology.alternatingFaceMapComplex

variable {C}

@[simp]
theorem alternatingFaceMapComplex_obj_x (X : SimplicialObject C) (n : ℕ) :
    ((alternatingFaceMapComplex C).obj X).pt n = X _[n] :=
  rfl
#align algebraic_topology.alternating_face_map_complex_obj_X AlgebraicTopology.alternatingFaceMapComplex_obj_x

@[simp]
theorem alternatingFaceMapComplex_objD (X : SimplicialObject C) (n : ℕ) :
    ((alternatingFaceMapComplex C).obj X).d (n + 1) n = AlternatingFaceMapComplex.objD X n := by
  apply ChainComplex.of_d
#align algebraic_topology.alternating_face_map_complex_obj_d AlgebraicTopology.alternatingFaceMapComplex_objD

@[simp]
theorem alternatingFaceMapComplex_map_f {X Y : SimplicialObject C} (f : X ⟶ Y) (n : ℕ) :
    ((alternatingFaceMapComplex C).map f).f n = f.app (op [n]) :=
  rfl
#align algebraic_topology.alternating_face_map_complex_map_f AlgebraicTopology.alternatingFaceMapComplex_map_f

theorem map_alternatingFaceMapComplex {D : Type _} [Category D] [Preadditive D] (F : C ⥤ D)
    [F.Additive] :
    alternatingFaceMapComplex C ⋙ F.mapHomologicalComplex _ =
      (SimplicialObject.whiskering C D).obj F ⋙ alternatingFaceMapComplex D :=
  by
  apply CategoryTheory.Functor.ext
  · intro X Y f
    ext n
    simp only [functor.comp_map, HomologicalComplex.comp_f, alternating_face_map_complex_map_f,
      functor.map_homological_complex_map_f, HomologicalComplex.eqToHom_f, eq_to_hom_refl, comp_id,
      id_comp, simplicial_object.whiskering_obj_map_app]
  · intro X
    apply HomologicalComplex.ext
    · rintro i j (rfl : j + 1 = i)
      dsimp only [functor.comp_obj]
      simpa only [functor.map_homological_complex_obj_d, alternating_face_map_complex_obj_d,
        eq_to_hom_refl, id_comp, comp_id, alternating_face_map_complex.obj_d, functor.map_sum,
        functor.map_zsmul]
    · ext n
      rfl
#align algebraic_topology.map_alternating_face_map_complex AlgebraicTopology.map_alternatingFaceMapComplex

theorem karoubi_alternating_face_map_complex_d (P : Karoubi (SimplicialObject C)) (n : ℕ) :
    ((AlternatingFaceMapComplex.obj (KaroubiFunctorCategoryEmbedding.obj P)).d (n + 1) n).f =
      P.p.app (op [n + 1]) ≫ (AlternatingFaceMapComplex.obj P.pt).d (n + 1) n :=
  by
  dsimp
  simpa only [alternating_face_map_complex.obj_d_eq, karoubi.sum_hom, preadditive.comp_sum,
    karoubi.zsmul_hom, preadditive.comp_zsmul]
#align algebraic_topology.karoubi_alternating_face_map_complex_d AlgebraicTopology.karoubi_alternating_face_map_complex_d

namespace AlternatingFaceMapComplex

/-- The natural transformation which gives the augmentation of the alternating face map
complex attached to an augmented simplicial object. -/
@[simps]
def ε [Limits.HasZeroObject C] :
    SimplicialObject.Augmented.drop ⋙ AlgebraicTopology.alternatingFaceMapComplex C ⟶
      SimplicialObject.Augmented.point ⋙ ChainComplex.single₀ C
    where
  app X := by
    equiv_rw ChainComplex.toSingle₀Equiv _ _
    refine' ⟨X.hom.app (op [0]), _⟩
    dsimp
    simp only [alternating_face_map_complex_obj_d, obj_d, Fin.sum_univ_two, Fin.val_zero, pow_zero,
      one_zsmul, Fin.val_one, pow_one, neg_smul, add_comp, simplicial_object.δ_naturality, neg_comp]
    apply add_right_neg
  naturality' X Y f := by
    ext
    exact congr_app f.w _
#align algebraic_topology.alternating_face_map_complex.ε AlgebraicTopology.alternatingFaceMapComplex.ε

end AlternatingFaceMapComplex

/-!
## Construction of the natural inclusion of the normalized Moore complex
-/

variable {A : Type _} [Category A] [Abelian A]

/-- The inclusion map of the Moore complex in the alternating face map complex -/
def inclusionOfMooreComplexMap (X : SimplicialObject A) :
    (normalizedMooreComplex A).obj X ⟶ (alternatingFaceMapComplex A).obj X :=
  ChainComplex.ofHom _ _ _ _ _ _ (fun n => (NormalizedMooreComplex.objX X n).arrow) fun n =>
    by
    /- we have to show the compatibility of the differentials on the alternating
             face map complex with those defined on the normalized Moore complex:
             we first get rid of the terms of the alternating sum that are obviously
             zero on the normalized_Moore_complex -/
    simp only [alternating_face_map_complex.obj_d]
    rw [comp_sum]
    let t := fun j : Fin (n + 2) =>
      (normalized_Moore_complex.obj_X X (n + 1)).arrow ≫ ((-1 : ℤ) ^ (j : ℕ) • X.δ j)
    have def_t :
      ∀ j : Fin (n + 2),
        t j = (normalized_Moore_complex.obj_X X (n + 1)).arrow ≫ ((-1 : ℤ) ^ (j : ℕ) • X.δ j) :=
      by
      intro j
      rfl
    rw [Fin.sum_univ_succ t]
    have null : ∀ j : Fin (n + 1), t j.succ = 0 :=
      by
      intro j
      rw [def_t, comp_zsmul, ← zsmul_zero ((-1 : ℤ) ^ (j.succ : ℕ))]
      apply congr_arg
      rw [normalized_Moore_complex.obj_X]
      rw [←
        factor_thru_arrow _ _
          (finset_inf_arrow_factors Finset.univ _ j (by simp only [Finset.mem_univ]))]
      slice_lhs 2 3 => rw [kernel_subobject_arrow_comp (X.δ j.succ)]
      simp only [comp_zero]
    rw [Fintype.sum_eq_zero _ null]
    simp only [add_zero]
    -- finally, we study the remaining term which is induced by X.δ 0
    let eq := def_t 0
    rw [show (-1 : ℤ) ^ ((0 : Fin (n + 2)) : ℕ) = 1 by ring] at eq
    rw [one_smul] at eq
    rw [Eq]
    cases n <;> dsimp <;> simp
#align algebraic_topology.inclusion_of_Moore_complex_map AlgebraicTopology.inclusionOfMooreComplexMap

@[simp]
theorem inclusionOfMooreComplexMap_f (X : SimplicialObject A) (n : ℕ) :
    (inclusionOfMooreComplexMap X).f n = (NormalizedMooreComplex.objX X n).arrow :=
  ChainComplex.ofHom_f _ _ _ _ _ _ _ _ n
#align algebraic_topology.inclusion_of_Moore_complex_map_f AlgebraicTopology.inclusionOfMooreComplexMap_f

variable (A)

/-- The inclusion map of the Moore complex in the alternating face map complex,
as a natural transformation -/
@[simps]
def inclusionOfMooreComplex : normalizedMooreComplex A ⟶ alternatingFaceMapComplex A
    where app := inclusionOfMooreComplexMap
#align algebraic_topology.inclusion_of_Moore_complex AlgebraicTopology.inclusionOfMooreComplex

namespace AlternatingCofaceMapComplex

variable (X Y : CosimplicialObject C)

/-- The differential on the alternating coface map complex is the alternate
sum of the coface maps -/
@[simp]
def objD (n : ℕ) : X.obj [n] ⟶ X.obj [n + 1] :=
  ∑ i : Fin (n + 2), (-1 : ℤ) ^ (i : ℕ) • X.δ i
#align algebraic_topology.alternating_coface_map_complex.obj_d AlgebraicTopology.AlternatingCofaceMapComplex.objD

theorem d_eq_unop_d (n : ℕ) :
    objD X n =
      (AlternatingFaceMapComplex.objD ((cosimplicialSimplicialEquiv C).Functor.obj (op X))
          n).unop :=
  by simpa only [obj_d, alternating_face_map_complex.obj_d, unop_sum, unop_zsmul]
#align algebraic_topology.alternating_coface_map_complex.d_eq_unop_d AlgebraicTopology.AlternatingCofaceMapComplex.d_eq_unop_d

theorem d_squared (n : ℕ) : objD X n ≫ objD X (n + 1) = 0 := by
  simp only [d_eq_unop_d, ← unop_comp, alternating_face_map_complex.d_squared, unop_zero]
#align algebraic_topology.alternating_coface_map_complex.d_squared AlgebraicTopology.AlternatingCofaceMapComplex.d_squared

/-- The alternating coface map complex, on objects -/
def obj : CochainComplex C ℕ :=
  CochainComplex.of (fun n => X.obj [n]) (objD X) (d_squared X)
#align algebraic_topology.alternating_coface_map_complex.obj AlgebraicTopology.AlternatingCofaceMapComplex.obj

variable {X} {Y}

/-- The alternating face map complex, on morphisms -/
@[simp]
def map (f : X ⟶ Y) : obj X ⟶ obj Y :=
  CochainComplex.ofHom _ _ _ _ _ _ (fun n => f.app [n]) fun n =>
    by
    dsimp
    rw [comp_sum, sum_comp]
    apply Finset.sum_congr rfl fun x h => _
    rw [comp_zsmul, zsmul_comp]
    congr 1
    symm
    apply f.naturality
#align algebraic_topology.alternating_coface_map_complex.map AlgebraicTopology.AlternatingCofaceMapComplex.map

end AlternatingCofaceMapComplex

variable (C)

/-- The alternating coface map complex, as a functor -/
@[simps]
def alternatingCofaceMapComplex : CosimplicialObject C ⥤ CochainComplex C ℕ
    where
  obj := AlternatingCofaceMapComplex.obj
  map X Y f := AlternatingCofaceMapComplex.map f
#align algebraic_topology.alternating_coface_map_complex AlgebraicTopology.alternatingCofaceMapComplex

end AlgebraicTopology


import Rings.Fields
import completeness
import Rings.ToMathlib.finset

namespace Lefschetz

open fol
open Rings
open Fields
open Rings.instances

/-- Lefschetz part 1. Being true in a model of ACF₀ implies being true for any model of ACF₀-/
theorem is_complete''_ACF₀ : is_complete'' ACF₀ :=
by {rw ← is_complete''_iff_is_complete', exact is_complete'_ACF₀}

/-- Lefcschetz part 3. Being true in a model of ACFₚ implies being true for any model of ACFₚ-/
theorem is_complete''_ACFₚ {p : ℕ} (hp : nat.prime p) :
  is_complete'' (ACFₚ hp) :=
by {rw ← is_complete''_iff_is_complete', exact is_complete'_ACFₚ hp}

/-- Lefchetz part 2. A sentence holds for ACF₀ if and
  only if it holds for ACFₚ for large enough p (forward direction only) -/
theorem characteristic_change_left (ϕ : sentence ring_signature) :
ACF₀ ⊨ ϕ → ∃ (n : ℕ), ∀ {p : ℕ} (hp : nat.prime p), n < p → ACFₚ hp ⊨ ϕ :=
begin
  rw compactness,
  intro hsatis,
  obtain ⟨ fs , hsatis , hsub ⟩ := hsatis,
  classical,
  obtain ⟨ fsACF , fsrange , hunion, hACF , hrange ⟩ :=
    finset.subset_union_elim hsub,
  set fsnat : finset ℕ := finset.preimage fsrange plus_one_ne_zero
      (set.inj_on_of_injective injective_plus_one_ne_zero _) with hfsnat,
  use fsnat.sup id + 1,
  intros p hp hlt M hMx hmodel,
  haveI : fact (M ⊨ ACF) := ⟨ (models_ACFₚ_iff'.mp hmodel).2 ⟩,
  have hchar := (@models_ACFₚ_iff _ _ _inst_1 _).1 hmodel,
  apply hsatis hMx,
  rw [← hunion, finset.coe_union, all_realize_sentence_union],
  split,
  {
    apply all_realize_sentence_of_subset _ hACF,
    exact all_realize_sentence_of_subset hmodel ACF_subset_ACFₚ,
  },
  {
    have hSTS :(∀ n : ℕ, n ∈ fsnat → M ⊨ plus_one_ne_zero n) → M ⊨ fsrange,
    {
      classical,
      have hrw0 := finset.image_preimage plus_one_ne_zero fsrange
        (set.inj_on_of_injective injective_plus_one_ne_zero _),
      rw [← hfsnat, finset.filter_mem_set_of_subset_set (λ x hx, (hrange hx).1)]
        at hrw0,
      rw ← hrw0,
      simp only [all_realize_sentence],
      intros hrealize ϕ hϕ,
      simp only [set.mem_preimage, set.mem_image,
        finset.coe_preimage, finset.mem_coe, finset.coe_image] at hϕ,
      obtain ⟨ n , hn , hϕ ⟩ := hϕ,
      rw [← hϕ],
      apply hrealize,
      rw [hfsnat, finset.mem_preimage],
      exact hn,
    },
    apply hSTS,
    intros n hnp,
    rw realize_plus_one_ne_zero,
    have hne_zero_of_le_char :
      ∀ x : ℕ, x.succ < p → (x.succ : M) ≠ 0,
    {
      intros x hx hbot,
      apply nat.succ_ne_zero x,
      apply ring_char.lt_char_field hbot,
      rw ← hchar at hx,
      exact hx,
    },
    apply hne_zero_of_le_char _,
    apply lt_of_le_of_lt (nat.succ_le_succ _) hlt,
    exact finset.le_sup hnp,
  },
end

/-- Any ring fact holds in ACF₀ if and only if for all large p it holds for all ACFₚ-/
theorem characteristic_change (ϕ : sentence ring_signature) :
ACF₀ ⊨ ϕ ↔ (∃ (n : ℕ), ∀ {p : ℕ} (hp : nat.prime p), n < p → ACFₚ hp ⊨ ϕ) :=
begin
  split,
  { apply characteristic_change_left },
  {
    intro hn,
    cases is_complete'_ACF₀ ϕ with hsatis hsatis,
    { exact hsatis },
    { have hm := characteristic_change_left (∼ ϕ) hsatis,
      cases hn with n hn,
      cases hm with m hm,
      obtain ⟨ p , hle , hp ⟩ := nat.exists_infinite_primes (max n m).succ,
      have hnp : n < p :=
        lt_of_lt_of_le (nat.lt_succ_of_le (le_max_left _ _)) hle,
      have hmp : m < p :=
        lt_of_lt_of_le (nat.lt_succ_of_le (le_max_right _ _)) hle,
      have hS := instances.algebraic_closure_of_zmod_models_ACFₚ hp,
      specialize @hn p hp hnp _ ⟨ 0 ⟩ hS,
      specialize @hm p hp hmp _ ⟨ 0 ⟩ hS,
      simp only [realize_sentence_not] at hm,
      exfalso,
      apply hm hn } },
end

end Lefschetz


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison

Defines a functor between categories.

(As it is a 'bundled' object rather than the `is_functorial` typeclass parametrised
by the underlying function on objects, the name is capitalised.)

Introduces notations
  `C ⥤ D` for the type of all functors from `C` to `D`.
    (I would like a better arrow here, unfortunately ⇒ (`\functor`) is taken by core.)
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.reassoc_axiom
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l u₃ v₃

namespace Mathlib

namespace category_theory

/--
`functor C D` represents a functor between categories `C` and `D`.

To apply a functor `F` to an object use `F.obj X`, and to a morphism use `F.map f`.

The axiom `map_id` expresses preservation of identities, and
`map_comp` expresses functoriality.

See https://stacks.math.columbia.edu/tag/001B.
-/
structure functor (C : Type u₁) [category C] (D : Type u₂) [category D] where
  obj : C → D
  map : {X Y : C} → (X ⟶ Y) → (obj X ⟶ obj Y)
  map_id' :
    autoParam (C → map 𝟙 = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  map_comp' :
    autoParam (∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

infixr:26 " ⥤ " => Mathlib.category_theory.functor

-- A functor is basically a function, so give ⥤ a similar precedence to → (25).

-- For example, `C × D ⥤ E` should parse as `(C × D) ⥤ E` not `C × (D ⥤ E)`.

@[simp] theorem functor.map_id {C : Type u₁} [category C] {D : Type u₂} [category D] (c : C ⥤ D)
    (X : C) : functor.map c 𝟙 = 𝟙 :=
  sorry

@[simp] theorem functor.map_comp {C : Type u₁} [category C] {D : Type u₂} [category D] (c : C ⥤ D)
    {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
    functor.map c (f ≫ g) = functor.map c f ≫ functor.map c g :=
  sorry

theorem functor.map_comp_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] (c : C ⥤ D)
    {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) {X' : D} (f' : functor.obj c Z ⟶ X') :
    functor.map c (f ≫ g) ≫ f' = functor.map c f ≫ functor.map c g ≫ f' :=
  sorry

namespace functor

/-- `𝟭 C` is the identity functor on a category `C`. -/
protected def id (C : Type u₁) [category C] : C ⥤ C :=
  mk (fun (X : C) => X) fun (_x _x_1 : C) (f : _x ⟶ _x_1) => f

notation:1024 "𝟭" => Mathlib.category_theory.functor.id

protected instance inhabited (C : Type u₁) [category C] : Inhabited (C ⥤ C) := { default := 𝟭 }

@[simp] theorem id_obj {C : Type u₁} [category C] (X : C) : obj 𝟭 X = X := rfl

@[simp] theorem id_map {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y) : map 𝟭 f = f := rfl

/--
`F ⋙ G` is the composition of a functor `F` and a functor `G` (`F` first, then `G`).
-/
def comp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E]
    (F : C ⥤ D) (G : D ⥤ E) : C ⥤ E :=
  mk (fun (X : C) => obj G (obj F X)) fun (_x _x_1 : C) (f : _x ⟶ _x_1) => map G (map F f)

infixr:80 " ⋙ " => Mathlib.category_theory.functor.comp

@[simp] theorem comp_obj {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃}
    [category E] (F : C ⥤ D) (G : D ⥤ E) (X : C) : obj (F ⋙ G) X = obj G (obj F X) :=
  rfl

@[simp] theorem comp_map {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃}
    [category E] (F : C ⥤ D) (G : D ⥤ E) {X : C} {Y : C} (f : X ⟶ Y) :
    map (F ⋙ G) f = map G (map F f) :=
  rfl

-- These are not simp lemmas because rewriting along equalities between functors

-- is not necessarily a good idea.

-- Natural isomorphisms are also provided in `whiskering.lean`.

protected theorem comp_id {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) :
    F ⋙ 𝟭 = F :=
  sorry

protected theorem id_comp {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) :
    𝟭 ⋙ F = F :=
  sorry

end Mathlib


import geometry.tarski_1
open classical set
namespace Euclidean_plane
variables {point : Type} [Euclidean_plane point]

local attribute [instance, priority 0] prop_decidable

theorem six9 {a b p : point} : b ∈ ray p a → ray p a = ray p b :=
begin
intro h,
ext,
split,
  intro h1,
  cases h with h h2,
  cases h2 with h2 h3,
  cases h1 with h1 h4,
  cases h4 with h4 h5,
  split,
    exact h2,
  split,
    exact h4,
  cases h3,
    cases h5,
      exact five1 h.symm h3 h5,
    right,
    exact three6b h5 h3,
  cases h5,
    left,
    exact three6b h3 h5,
  exact five3 h3 h5,
intro h1,
cases h with h h2,
cases h2 with h2 h3,
cases h1 with h1 h4,
cases h4 with h4 h5,
split,
  exact h,
split,
exact h4,
cases h3,
  cases h5,
    left,
    exact three6b h3 h5,
  exact five3 h3 h5,
cases h5,
  exact five1 h2.symm h3 h5,
right,
exact three6b h5 h3
end

theorem six10 {a b c p q r : point} : sided a b c → sided p q r → eqd a b p q → eqd a c p r → cong a b c p q r :=
begin
intro h,
revert p q r,
wlog h4 : distle a b a c,
    exact (five10 a b a c),
  introv h1 h2 h3,
  repeat {split};
  try {assumption},
  have h5 : distle p q p r,
    exact five6 h4 h2 h3,
  have h6 : B a b c,
    exact (six12 h).1 h4,
  have h7 : B p q r,
    exact (six12 h1).1 h5,
  exact (four3 h6.symm h7.symm h3.flip h2.flip).flip,
have h1 := this h.symm a_1.symm a_3 a_2,
repeat {split},
    exact h1.2.2,
  exact h1.2.1.flip,
exact h1.1
end

theorem six10a {a b c a' b' c' : point} : sided a b c → cong a b c a' b' c' → sided a' b' c' :=
begin
intro h,
revert a' b' c',
wlog h1 : B a b c := (h.2.2) using b c,
  introv h2,
  split,
    intro h_1,
    subst b',
    exact h.1.symm (id_eqd h2.1),
  split,
    intro h_1,
    subst c',
    exact h.2.1.symm (id_eqd h2.2.2),
  exact or.inl (four6 h1 h2),
apply (this h.symm _).symm,
exact ⟨a_1.2.2, a_1.2.1.flip, a_1.1⟩
end

def l (a b : point) : set point := {x | col a b x}

class line (k : set point) : Prop :=
(hyp : ∃ a b, a ≠ b ∧ k = l a b)

lemma six14 {a b : point} (h : a ≠ b) : line (l a b) := ⟨⟨a, b, ⟨h, rfl⟩⟩⟩

theorem six15 {p q r : point} : p ≠ q → p ≠ r → B q p r → l p q = ray p q ∪ {p} ∪ ray p r :=
begin
intros h h1 h2,
ext,
split,
  intro h3,
  cases em (x = p),
    left, right,
    rw h_1,
    simp,
  cases h3,
    left, left,
    split,
      exact h.symm,
    split,
      exact h_1,
    left,
    exact h3,
    cases h3,
    left, left,
    split,
      exact h.symm,
    split,
      exact h_1,
    right,
    exact h3.symm,
  right,
  split,
    exact h1.symm,
  split,
    exact h_1,
  exact five2 h.symm h2 h3.symm,
intro h3,
cases h3,
  cases h3,
    cases h3 with h3 h4,
    cases h4 with h4 h5,
    cases h5,
      left,
      exact h5,
    right, left,
    exact h5.symm,
  have : x = p,
    simpa using h3,
  right, left,
  rw this,
  exact three1 q p,
cases h3 with h3 h4,
cases h4 with h4 h5,
right, right,
cases h5,
  exact (three7b h2 h5 h1).symm,
exact (three5a h2 h5).symm
end

theorem six16 {p q r : point} : p ≠ q → p ≠ r → r ∈ l p q → l p q = l p r :=
begin
intros h h1 h2,
ext,
split,
  intro h3,
  exact five4 h h2 h3,
intro h3,
have : col p r q,
  exact (four11 h2).1,
exact five4 h1 this h3
end

theorem six16a {p q r : point} : sided p q r → l p q = l p r :=
λ h, six16 h.1.symm h.2.1.symm (four11 (six4.1 h).1).2.1

theorem six17 (p q : point) : l p q = l q p :=
ext (λ x, ⟨λ h, (four11 h).2.1, λ h, (four11 h).2.1⟩)

theorem line.symm {a b : point} (h : line (l a b)) : line (l b a) := (six17 a b) ▸ h

@[simp] theorem six17a (p q : point) : p ∈ l p q := (four11 (four12 p q)).1

@[simp] theorem six17b (p q : point) : q ∈ l p q := (four11 (four12 q p)).2.2.2.1

theorem six18 {a b : point} {L : set point} : line L → a ≠ b → a ∈ L → b ∈ L → L = l a b :=
begin
intros h h1 h2 h3,
rcases h with ⟨p, q, hq⟩,
rw hq.2 at *,
cases em (a = p),
  rw h at *,
  exact six16 hq.1 h1 h3,
have ha : l p q = l p a,
  exact six16 hq.1 (ne.symm h) h2,
rw ha at *,
rw six17 p a at *,
exact six16 h h1 h3
end

theorem six18a {a p q : point} : a ∉ l p q → a ≠ p ∧ a ≠ q :=
begin
intro h,
split,
  intro h1,
  subst a,
  apply h,
  simp,
intro h1,
subst a,
simpa using h
end

theorem six19 {a b : point} : a ≠ b → ∃! L : set point, line L ∧ a ∈ L ∧ b ∈ L :=
λ h, ⟨l a b, ⟨six14 h, six17a a b, six17b a b⟩, λ Y hy, six18 hy.1 h hy.2.1 hy.2.2⟩

theorem six20 {a b c : point} {A : set point} : line A → a ∈ A → b ∈ A → a ≠ b → col a b c → c ∈ A :=
begin
intros h h1 h2 h3 h4,
suffices : A = l a b,
  subst A,
  exact h4,
exact six18 h h3 h1 h2
end

theorem six21 {a b : point} {A B : set point} : a ≠ b → line A → line B → a ∈ A → a ∈ B → b ∈ A → b ∈ B → A = B :=
begin
intros h h1 h2 h3 h4 h5 h6,
apply unique_of_exists_unique (six19 h),
  repeat {split, assumption},
  assumption,
assumption
end

def is (x : point) (A B : set point) : Prop := line A ∧ line B ∧ A ≠ B ∧ x ∈ A ∧ x ∈ B

theorem is.symm {x : point} (A B : set point) : is x A B → is x B A :=
λ h, ⟨h.2.1, h.1, h.2.2.1.symm, h.2.2.2.2, h.2.2.2.1⟩

theorem six21a {x y : point} {A B : set point} : line A → line B → A ≠ B → x ∈ A → x ∈ B → y ∈ A → y ∈ B → x = y :=
λ h h1 h2 h3 h4 h5 h6, classical.by_contradiction (λ h_1, h2 (six21 h_1 h h1 h3 h4 h5 h6))

theorem six21b {x y : point} {A B : set point} : is x A B → x ≠ y → y ∈ A → y ∉ B :=
λ h h1 h2 h3, h1 (six21a h.1 h.2.1 h.2.2.1 h.2.2.2.1 h.2.2.2.2 h2 h3)

theorem six22 {x : point} {A : set point} : line A → x ∈ A → ∃ y, x ≠ y ∧ A = l x y :=
begin
intros h h1,
rcases h with ⟨u, v, h⟩,
by_cases h_1 : x = u,
  subst u,
  exact ⟨v, h⟩,
rw h.2 at *,
exact ⟨u, h_1, six18 (six14 h.1) h_1 h1 (six17a u v)⟩
end

theorem six23 {a b c : point} : col a b c ↔ ∃ (L : set point), line L ∧ a ∈ L ∧ b ∈ L ∧ c ∈ L :=
begin
split,
  intro h,
  cases em (a = b),
    rw h_1 at *,
    cases em (b = c),
      rw h_2 at *,
      cases three14 c c with p hp,
      existsi l c p,
      split,
        exact six14 hp.2,
      simp,
    existsi l b c,
    split,
      exact six14 h_2,
    simp,
  existsi l a b,
  split,
    exact six14 h_1,
  simpa using h,
intro h,
cases h with L h,
cases em (a = b),
  rw h_1,
  exact four12 b c,
have : L = l a b,
  exact six18 h.1 h_1 h.2.1 h.2.2.1,
rw this at *,
exact h.2.2.2
end

theorem six24 : ¬col (P1 : point) P2 P3 :=
begin
have h := two_dim point,
intro h1,
cases h1,
  exact h.1 h1,
exact h1.elim h.2.1 h.2.2
end

theorem six25 {a b : point} : a ≠ b → ∃ c, ¬col a b c :=
begin
intro h1,
by_contradiction h2,
rw not_exists at h2,
simp at h2,
apply @six24 point,
apply six23.2,
exact ⟨l a b, six14 h1, h2 P1, h2 P2, h2 P3⟩
end

lemma six13a (a : point) : ¬line (l a a) :=
begin
intro h,
rcases h with ⟨u, v, h⟩,
cases six25 h.1 with r hr,
apply hr,
suffices : r ∈ l a a,
  rw h.2 at this,
  exact this,
left,
exact three3 a r
end

lemma six13 {a b : point} : line (l a b) → a ≠ b :=
begin
intros h h1,
subst b,
exact (six13a a) h
end

def tri (a b c : point) : Prop := a ≠ b ∧ b ≠ c ∧ a ≠ c

theorem six26 {a b c : point} : ¬col a b c → tri a b c :=
begin
intro h,
split,
  intro h,
  rw h at *,
  exact h (four12 b c),
split,
  intro h,
  rw h at *,
  exact h (four11 (four12 c a)).2.2.2.1,
intro h,
rw h at *,
exact h (four11 (four12 c b)).1
end

theorem six27 {a b c : point} {A : set point} : line A → a ∈ A → c ∈ A → B a b c → b ∈ A :=
begin
intros h h1 h2 h3,
cases em (a = c),
  rw h_1 at h3,
  have : c = b,
    exact bet_same h3,
  rwa this at h2,
have h4 := six18 h h_1 h1 h2,
rw h4,
right, left,
exact h3.symm
end

theorem six28 {a b c :point} : ¬col a b c → is a (l a b) (l a c) :=
begin
intro h,
split,
  exact six14 (six26 h).1,
split,
  exact six14 (six26 h).2.2,
split,
  intro h1,
  apply h,
  show c ∈ l a b,
  rw h1,
  simp,
simp
end

-- middle points

def M (a m b : point) : Prop := B a m b ∧ eqd m a m b

theorem M.symm {a b m : point} : M a m b → M b m a :=
λ h, ⟨h.1.symm, h.2.symm⟩

theorem seven3 {a m : point} : M a m a ↔ a = m :=
begin
split,
  intro h,
  exact bet_same h.1,
intro h,
rw h at *,
split,
  exact three1 m m,
exact eqd.refl m m
end

theorem seven4 {a m p q : point} : M a m p → M a m q → p = q :=
begin
intros h h1,
by_cases h_1 : a = m,
  subst m,
  exact (id_eqd h.2.symm).symm.trans (id_eqd h1.2.symm),
exact two12 h_1 h.1 h.2.symm h1.1 h1.2.symm
end

def S [decidable_eq point] (a p : point) : point :=
if a = p then a else (seg_cons a a p p).1

theorem seven5 (a p : point) : M p a (S a p) :=
begin
unfold S,
by_cases h : a = p,
  subst h,
  rw if_pos rfl,
  exact ⟨three1 a a, eqd.refl a a⟩,
rw if_neg h,
rcases seg_cons a a p p with ⟨q, hq⟩,
exact ⟨hq.1, hq.2.symm⟩
end

theorem seven6 {a p q : point} : M p a q → q = S a p :=
begin
intro h,
exact seven4 h (seven5 a p)
end

@[simp] theorem seven7 (a p : point) : S a (S a p) = p :=
begin
cases seven5 a p with h1 h2,
generalize hq : S a p = q,
rw hq at *,
cases seven5 a q with h3 h4,
generalize hr : S a q = r,
rw hr at *,
cases em (q = a),
  rw h at *,
  have ha : a = r,
    exact id_eqd h4.symm,
  rw ha at *,
  exact id_eqd h2,
exact two12 h h3 (eqd.trans h2 h4).symm h1.symm (eqd.refl a p)
end

theorem seven8 (a p : point) : ∃! q, S a q = p :=
begin
existsi S a p,
split,
  exact seven7 a p,
intros q h,
rw ←h,
exact (seven7 a q).symm
end

theorem seven9 {a p q : point} : S a p = S a q → p = q :=
begin
intro h,
apply unique_of_exists_unique (seven8 a (S a p)),
  simp,
rw ←h
end

theorem seven9a {a b : point} (p : point) : a ≠ b → S p a ≠ S p b :=
begin
intros h h1,
exact h (seven9 h1)
end

theorem seven10 {a p : point} : S a p = p ↔ a = p :=
begin
split,
  intro h,
  have : M p a (S a p),
    exact seven5 a p,
  rw h at *,
  exact (seven3.1 this).symm,
intro h,
subst p,
cases seven5 a a with h1 h2,
exact id_eqd h2.symm.flip
end

@[simp] theorem seven11 (a : point) : S a a = a :=
seven10.2 rfl

theorem seven12a {a p : point} : p ≠ a → S a p ≠ a :=
λ h h1, h (seven9 (h1.trans (seven11 a).symm))

theorem seven12b {a p : point} : p ≠ a → S a p ≠ p :=
λ h h1, h (seven10.1 h1).symm

theorem seven13 (a p q : point) : eqd p q (S a p) (S a q) :=
begin
have hp : M p a (S a p),
  exact seven5 a p,
have hq : M q a (S a q),
  exact seven5 a q,
generalize hp' : S a p = p',
generalize hq' : S a q = q',
rw hp' at *,
rw hq' at *,
cases em (p = a),
  have : S a p = p,
    exact seven10.2 h.symm,
  rw h at *,
  rw this at *,
  rw ←hp' at *,
  exact hq.2,
cases seg_cons p q a p' with x hx,
cases seg_cons p' q a x with x' hx',
cases seg_cons q p a q' with y hy,
cases seg_cons q' p a y with y' hy',
have h1 : B a p x,
  exact three6a hp.1.symm hx.1,
have h2 : B p p' x',
  exact three6a hx.1.symm hx'.1,
have h3 : B a p' x',
  exact three6a hp.1 h2,
have h4 : B a q y,
  exact three6a hq.1.symm hy.1,
have h5 : B q q' y',
  exact three6a hy.1.symm hy'.1,
have h6 : B a q' y',
  exact three6a hq.1 h5,
have h7 : eqd a x y a,
  exact two11 h1 h4.symm hy.2.symm.flip hx.2,
have h8 : eqd a x a x',
  exact two11 h1 h3 hp.2 (eqd.trans hx.2 hx'.2.symm),
have h9 : eqd a x y' a,
  exact two11 h1 h6.symm hy'.2.symm.flip (eqd.trans hx.2 hq.2.flip),
have h10 : B x a p',
      exact three5b hx.1.symm hp.1,
have h11 : B y a q',
      exact three5b hy.1.symm hq.1,
have h12 : afs x a x' y' y' a y x,
  repeat {split},
    exact three6b h10 hx'.1,
    exact (three6b h11 hy'.1).symm,
    exact two4 h9,
    exact two5 (eqd.trans h8.symm h7),
    exact two5 (eqd.refl x y'),
  exact two4 h9.symm,
have h13 : x ≠ a,
  intro h_1,
  rw h_1 at h1,
  exact h (bet_same h1).symm,
have h14 : eqd x' y' y x,
  exact afive_seg h12 h13,
have h15 : ifs y q a x y' q' a x',
  repeat {split},
    exact h4.symm,
    exact h6.symm,
    exact eqd.trans h7.symm h9,
    exact hq.2.flip,
    exact two5 h14.symm,
  exact h8,
have h16 := four2 h15,
have h17 : ifs x p a q x' p' a q',
  repeat {split},
    exact h1.symm,
    exact h3.symm,
    exact h8.flip,
    exact hp.2.flip,
    exact h16.flip,
  exact hq.2,
exact four2 h17
end

theorem seven15 (a : point) {p q r : point} : B p q r ↔ B (S a p) (S a q) (S a r) :=
begin
split,
  intro h,
  apply four6 h,
  repeat {split};
  exact seven13 a _ _,
intro h,
rw ←(seven7 a p),
rw ←(seven7 a q),
rw ←(seven7 a r),
apply four6 h,
repeat {split};
exact seven13 a _ _,
end

theorem seven16 (a : point) {p q r s : point}: eqd p q r s ↔ eqd (S a p) (S a q) (S a r) (S a s) :=
begin
split,
  intro h,
  exact (seven13 a p q).symm.trans (h.trans (seven13 a r s)),
intro h,
have h1 := eqd.trans (seven13 a (S a p) (S a q)).symm (eqd.trans h (seven13 a (S a r) (S a s))),
simpa using h1
end

theorem seven16a (a : point) {p q r : point} : cong p q r (S a p) (S a q) (S a r) :=
begin
repeat {split};
exact seven13 a _ _
end

theorem seven14 (a : point) {p q r : point} : M p q r ↔ M (S a p) (S a q) (S a r) :=
begin
split,
  intro h,
  cases h with h h1,
  split,
    exact (seven15 a).1 h,
  exact (seven16 a).1 h1,
intro h,
cases h with h h1,
split,
  exact (seven15 a).2 h,
exact (seven16 a).2 h1
end

theorem S_of_col {p q r : point} (a : point) : col p q r ↔ col (S a p) (S a q) (S a r) :=
begin
split,
  intro h,
  unfold col,
  repeat {cases h};
  simp [(seven15 a).1 h],
intro h,
unfold col,
repeat {cases h};
simp [(seven15 a).2 h]
end

theorem seven17 {a b p q : point} : M p a q → M p b q → a = b :=
begin
intros h h1,
have h2 := seven6 h,
have h3 := seven13 a q b,
have h4 := seven7 a p,
rwa ←h2 at h4,
rw h4 at h3,
have h6 : eqd p b p (S a b),
  exact eqd.trans h1.2.flip h3,
have h7 := seven13 a p b,
rw ←h2 at h7,
have h8 : eqd q b q (S a b),
  exact eqd.trans h1.2.symm.flip h7,
have h9 : b = (S a b),
  exact four19 h1.1 h6 h8.flip,
exact (seven10.1 h9.symm)
end

theorem seven18 {a b p : point} : S a p = S b p → a = b :=
begin
intro h,
generalize h1 : S a p = q,
have h2 := seven5 a p,
rw h1 at h2,
have h3 := seven5 b p,
rw (eq.trans h.symm h1) at h3,
exact seven17 h2 h3
end

theorem seven18a {a b : point} (p : point) : a ≠ b → S a p ≠ S b p :=
λ h h1, h (seven18 h1)

theorem seven19 {a b p : point} : S a (S b p) = S b (S a p) ↔ a = b :=
begin
split,
  intro h,
  generalize h1 : S a p = q,
  have h2 := seven5 a p,
  rw h1 at *,
  have h3 := seven5 a (S b p),
  rw h at h3,
  cases h3 with h3 h4,
  have h5 := (seven15 b).1 h3,
  have h6 := (seven16 b).1 h4,
  rw seven7 b p at *,
  rw seven7 b q at *,
  have h7 : M p (S b a) q,
    split;
    assumption,
  have h8 : a = (S b a),
    exact seven17 h2 h7,
  exact (seven10.1 h8.symm).symm,
intro h,
rw h
end

theorem seven20 {a m b : point} : col a m b → eqd m a m b → a = b ∨ M a m b :=
begin
intros h h1,
cases h,
  right,
  split;
  assumption,
cases h,
  left,
  have h2 := three3 b m,
  have h3 : eqd a b b b,
    exact four3 h.symm h2 h1.flip (eqd.refl b m),
  exact id_eqd h3,
left,
have h2 := three3 a m,
have h3 : eqd b a a a,
  exact four3 h h2 h1.symm.flip (eqd.refl a m),
exact id_eqd h3.flip
end

theorem seven21 {a b c d p : point} : ¬col a b c → b ≠ d → eqd a b c d → eqd b c d a →
col a p c → col b p d → M a p c ∧ M b p d :=
begin
intros h h1 h2 h3 h4 h5,
cases four14 (four11 h5).1 (two5 (eqd.refl b d)) with q hq,
have h6 := four13 (four11 h5).1 hq,
have h7 : fs b d p a d b q c,
  split,
    exact (four11 h5).1,
  split,
    exact hq,
  split,
    exact h2.flip,
  exact h3.symm,
have h8 : fs b d p c d b q a,
  split,
    exact (four11 h5).1,
  split,
    exact hq,
  split,
    exact h3,
  exact h2.symm.flip,
have h9 := four16 h7 h1,
have h10 := four16 h8 h1,
have h11 : cong a p c c q a,
split,
  exact h9.flip,
split,
  exact h10,
exact two5 (eqd.refl a c),
have h12 : p = q,
  suffices : l a c ≠ l b d,
    apply six21a (six14 (six26 h).2.2) (six14 h1) this (four11 h4).1 (four11 h5).1 (four11 (four13 h4 h11)).2.2.2.1 (four11 h6).2.1,
  intro h_1,
  suffices : b ∉ l a c,
    simpa [h_1, (six17a b d)] using this,
  exact (four10 h).1,
subst q,
split,
  cases seven20 h4 h9,
    exact ((six26 h).2.2 h_1).elim,
  assumption,
cases seven20 h5 (hq.2.2).flip,
  contradiction,
assumption
end

def hourglass (a b c p q m n : point) : Prop := B a c p ∧ B b c q ∧ eqd c a c b ∧ eqd c p c q ∧
M a m b ∧ M p n q

lemma seven23 {a b c p q m n : point} : hourglass a b c p q m n → distle c a c q → B m c n :=
begin
intros h h_1,
cases h with h h1,
cases h1 with h1 h2,
cases h2 with h2 h3,
cases h3 with h3 h4,
cases h4 with h4 h5,
cases em (p = c),
  rw h_2 at *,
  have h_3 : q = c,
    exact id_eqd h3.symm.flip,
  rw h_3 at *,
  have h_4 : c = n,
    exact seven3.1 h5,
  rw h_4 at *,
  exact three1 m n,
generalize h6 : S c p = a',
generalize h7 : S c q = b',
generalize h8 : S c n = m',
have h9 : M a' m' b',
  have h_3 := (seven14 c).1 h5,
  rwa [h6, h7, h8] at h_3,
have h10 : M p c a',
  have h10 := seven5 c p,
  rwa h6 at h10,
have h11 : M q c b',
  have h11 := seven5 c q,
  rwa h7 at h11,
have h12 : M n c m',
  have h12 := seven5 c n,
  rwa h8 at h12,
have h13 : distle c a c a',
  exact five6 h_1 (eqd.refl c a) (eqd.trans h3.symm h10.2),
cases em (a = c),
  rw h_3 at *,
  have : b = c,
    exact id_eqd h2.symm.flip,
  rw this at *,
  have : c = m,
    exact seven3.1 h4,
  rw this,
  exact three3 m n,
have h_4 : a' ≠ c,
  intro h_4,
  rw h_4 at *,
  have : eqd c a c c,
    exact five9 h13 (five11 c c a),
  exact h_3 (id_eqd this.flip),
have h14 : sided c a a',
  apply six3.2,
  split,
    exact h_3,
  split,
    exact h_4,
  existsi p,
  split,
    exact h_2,
  split,
    exact h,
  exact h10.1.symm,
have h15 : B c a a',
  exact (six12 h14).1 h13,
have h16 : distle c b c b',
  exact five6 h_1 h2 h11.2,
have h_5 : q ≠ c,
  intro h_5,
  rw h_5 at *,
  exact h_2 (id_eqd h3.flip),
cases em (b = c),
  rw h_6 at *,
  have : a = c,
   exact id_eqd h2.flip,
  rw this at *,
  have : c = m,
    exact seven3.1 h4,
  rw this,
  exact three3 m n,
have h_7 : b' ≠ c,
  intro h_7,
  rw h_7 at *,
  have : eqd c b c c,
    exact five9 h16 (five11 c c b),
  exact h_6 (id_eqd this.flip),
have h17 : sided c b b',
  apply six3.2,
  split,
    exact h_6,
  split,
    exact h_7,
  existsi q,
  split,
    exact h_5,
  split,
    exact h1,
  exact h11.1.symm,
have h18 : B c b b',
  exact (six12 h17).1 h16,
cases three17 h15.symm h18.symm h9.1 with r hr,
have h19 : B r c n,
  exact three6a hr.1 h12.1.symm,
suffices : r = m,
  rwa this at h19,
have h20 : ifs a' a c m' b' b c m',
  repeat {split},
    exact h15.symm,
    exact h18.symm,
    exact eqd.trans h10.2.symm.flip (eqd.trans h3.flip h11.2.flip),
    exact h2.flip,
    exact h9.2.flip,
  exact eqd.refl c m',
have h20 := four2 h20,
have h21 : col m' c r,
  right, left,
  exact hr.1.symm,
have h22 : eqd r a r b,
  cases em (m' = c),
    rw h_8 at *,
    have : c = r,
      exact bet_same hr.1,
    rw this at *,
    exact h20.flip,
  exact four17 h_8 h21 h20.flip h2,
have h23 : M a r b,
  split,
    exact hr.2,
  exact h22,
exact seven17 h23 h4
end

theorem seven22 {a b c p q m n : point} : hourglass a b c p q m n → B m c n :=
begin
intro h,
cases five10 c a c q,
  exact seven23 h h_1,
cases h with h h1,
cases h1 with h1 h2,
cases h2 with h2 h3,
cases h3 with h3 h4,
cases h4 with h4 h5,
have h6 : hourglass q p c b a n m,
  repeat {split},
    exact h1.symm,
    exact h.symm,
    exact h3.symm,
    exact h2.symm,
    exact h5.1.symm,
    exact h5.2.symm,
    exact h4.1.symm,
  exact h4.2.symm,
exact (seven23 h6 h_1).symm
end

theorem seven24 {a p : point} {A : set point} : line A → a ∈ A → (p ∈ A ↔ (S a p) ∈ A) :=
begin
intros h h1,
split,
  intro h2,
  cases em (a = p),
    have h3 := seven10.2 h_1,
    rwa h3,
  have h3 := six18 h h_1 h1 h2,
  rw h3,
  have h4 := seven5 a p,
  right, right,
  exact h4.1.symm,
intro h2,
cases em (a = (S a p)),
  have h3 := seven10.2 h_1,
  rw ←seven7 a p,
  rwa h3,
have h3 := six18 h h_1 h1 h2,
rw h3,
have h4 := seven5 a p,
right, right,
exact h4.1
end

theorem seven25 {a b c : point} : eqd c a c b → ∃ x, M a x b :=
begin
intro h,
cases em (col a c b),
  cases seven20 h_1 h,
    rw h_2 at *,
    existsi b,
    split,
      exact three1 b b,
    exact eqd.refl b b,
  constructor, exact h_2,
cases three14 c a with p hp,
cases seg_cons b a p c with q hq,
cases pasch hp.1.symm hq.1.symm with r hr,
cases pasch hp.1 hr.2 with x hx,
existsi x,
suffices : eqd x a x b,
  split,
    exact hx.1,
  exact this,
suffices : eqd r a r b,
  have h1 : col c r x,
    right, left,
    exact hx.2,
  cases em (c = r),
    rw h_2 at hx,
    have : r = x,
      exact bet_same hx.2,
    rw this at *,
    exact this,
  exact four17 h_2 h1 h this,
have h1 : afs c a p b c b q a,
  repeat {split},
    exact hp.1,
    exact hq.1,
    exact h,
    exact hq.2.symm,
    exact h.symm,
  exact two5 (eqd.refl a b),
have h2 : eqd p b q a,
  exact afive_seg h1 (six26 h_1).1.symm,
cases four5 hr.2 h2.flip with r' hr',
have h3 : ifs b r p a a r' q b,
  repeat {split},
    exact hr.2,
    exact hr'.1,
    exact hr'.2.2.2,
    exact hr'.2.2.1,
    exact two4 (eqd.refl a b),
  exact hq.2.symm.flip,
have h4 : ifs b r p q a r' q p,
  repeat {split},
    exact hr.2,
    exact hr'.1,
    exact hr'.2.2.2,
    exact hr'.2.2.1,
    exact hq.2,
  exact two5 (eqd.refl p q),
have h5 := four2 h3,
have h6 := four2 h4,
have h7 : cong a r q b r' p,
  split,
    exact h5.flip,
  split,
    exact h6,
  exact h2.symm.flip,
have h8 : col a r q,
  left, exact hr.1,
have h9 := four13 h8 h7,
have h_2 : a ≠ q,
  intro h_2,
  rw ←h_2 at *,
  have : col a c b,
    right, left,
    exact hq.1,
  exact h_1 this,
have h_3 : b ≠ p,
  intro h_3,
  rw ←h_3 at *,
  have : col a c b,
    right, right,
    exact hp.1.symm,
  exact h_1 this,
have h10 : l a q ≠ l b p,
  intro h_4,
  suffices : a ∈ l b p,
    have h_6 : col a p c,
      right, right,
      exact hp.1,
    exact h_1 (five4 hp.2 h_6 (four11 this).2.2.2.2),
  rw ←h_4,
  simp,
have h11 : col b p r,
  right, left,
  exact hr.2.symm,
  have h12 : col a q r',
    right, left,
    exact hr'.1.symm,
suffices : r' = r,
  rwa this at h5,
exact six21a (six14 h_2) (six14 h_3) h10 h12 (four11 h9).1 (four11 h8).1 h11
end

end Euclidean_plane