-- import laurent_measures.functor
import data.finset.basic
import analysis.special_functions.log.base
import for_mathlib.pi_induced
import laurent_measures.thm69
-- import data.real.basic

/-!
This files introduces the maps `Θ`, `Φ` (***and `Ψ` ???***), which are the "measurifications" of
`θ`, `ϕ` (*** and `ψ` ???***)
`laurent_measures.thm69`, they are morphisms in the right category.

We then prove in **???** that `θ_ϕ_exact` of `laurent_measures.thm69` becomes a short exact sequence
in the category **???**.
-/

noncomputable theory

universe u

namespace laurent_measures_ses

open laurent_measures pseudo_normed_group comphaus_filtered_pseudo_normed_group
open comphaus_filtered_pseudo_normed_group_hom
open_locale big_operators nnreal

section phi_to_hom

-- parameter {p : ℝ≥0}
-- variables [fact(0 < p)] [fact (p < 1)]
-- local notation `r` := @r p
-- local notation `ℳ` := real_measures p

variable {r : ℝ≥0}
variables [fact (0 < r)]
variable {S : Fintype}

local notation `ℒ` := laurent_measures r
local notation `ϖ` := (Fintype.of punit : Type u)

variables {M₁ M₂ : Type u} [comphaus_filtered_pseudo_normed_group M₁]
  [comphaus_filtered_pseudo_normed_group M₂]

def cfpng_hom_add (f g : comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :
  (comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :=
begin
  apply mk_of_bound (f.to_add_monoid_hom + g.to_add_monoid_hom) (f.bound.some + g.bound.some),
  intro c,
  refine ⟨_, _⟩,
  { intros x hx,
      simp only [comphaus_filtered_pseudo_normed_group_hom.coe_mk],
      simp only [add_monoid_hom.add_apply, coe_to_add_monoid_hom],
      convert pseudo_normed_group.add_mem_filtration (f.bound.some_spec hx) (g.bound.some_spec hx),
      rw add_mul, },
  let f₀ : filtration M₁ c → filtration M₂ (f.bound.some * c) := λ x, ⟨f x, f.bound.some_spec x.2⟩,
  have hf₀ : continuous f₀ := f.continuous _ (λ x, rfl),
  let g₀ : filtration M₁ c → filtration M₂ (g.bound.some * c) := λ x, ⟨g x, g.bound.some_spec x.2⟩,
  have hg₀ : continuous g₀ := g.continuous _ (λ x, rfl),
  simp only [add_monoid_hom.add_apply, coe_to_add_monoid_hom],
  haveI : fact ((f.bound.some * c + g.bound.some * c) ≤ ((f.bound.some + g.bound.some) * c) ) :=
    fact.mk (le_of_eq (add_mul _ _ _).symm),
  let ι : filtration M₂ (f.bound.some * c + g.bound.some * c) → filtration M₂
    ((f.bound.some + g.bound.some) * c) := cast_le,
  have hι : continuous ι := continuous_cast_le _ _,
  let S₀ : filtration M₂ (f.bound.some * c) × filtration M₂ (g.bound.some * c) →
    filtration M₂ (f.bound.some * c + g.bound.some * c) :=
      λ x, ⟨x.fst + x.snd, add_mem_filtration x.fst.2 x.snd.2⟩,
  have hS₀ := continuous_add' (f.bound.some * c) (g.bound.some * c),
  exact hι.comp (hS₀.comp (continuous.prod_mk hf₀ hg₀)),
end

def cfpng_hom_neg (f : comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :
  (comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :=
begin
  apply mk_of_bound (- f.to_add_monoid_hom) (f.bound.some),
  intro c,
  refine ⟨_, _⟩,
  { intros x hx,
    simp only [comphaus_filtered_pseudo_normed_group_hom.coe_mk],
    convert pseudo_normed_group.neg_mem_filtration (f.bound.some_spec hx) },
  let f₀ : filtration M₁ c → filtration M₂ (f.bound.some * c) := λ x, ⟨f x, f.bound.some_spec x.2⟩,
  have hf₀ : continuous f₀ := f.continuous _ (λ x, rfl),
  exact (continuous_neg' _).comp hf₀,
end

instance : add_comm_group (comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :=
{ add := cfpng_hom_add,
  add_assoc := by {intros, ext, apply add_assoc},
  zero := 0,
  zero_add := by {intros, ext, apply zero_add},
  add_zero := by {intros, ext, apply add_zero},
  neg := cfpng_hom_neg,
  add_left_neg := by {intros, ext, apply add_left_neg},
  add_comm := by {intros, ext, apply add_comm} }

variable (S)

/-- The map on Laurent measures induced by multiplication by `T⁻¹ - 2` on `ℤ((T))ᵣ`. -/
def Φ : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) := shift (1) - 2 • id
-- variable {S}

lemma Φ_eq_ϕ (F : ℒ S) : Φ S F = ϕ F := rfl

-- after the Φ refactor the below lemma is no longer true

-- lemma Φ_bound_by_3 [fact (r ≤ 1)] :
--   (Φ S : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S)).bound_by 3 :=
-- begin
--   let sh : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) := shift (-1),
--   let shup : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) := shift (1),
--   have Hsh : sh.bound_by 1,
--   { refine (mk_of_bound_bound_by _ _ _).mono 1 _,
--     rw [neg_neg], exact (pow_one r).le.trans (fact.out _) },
--   have Hshup : shup.bound_by 1,
--   { refine (mk_of_bound_bound_by _ _ _).mono (1) _,

--   }
--   suffices : (sh + sh + (-id)).bound_by (1 + 1 + 1),
--   { convert this using 1, ext1, dsimp only [Φ_eq_ϕ, ϕ], erw two_nsmul, }, -- was refl
--   refine (Hsh.add Hsh).add (mk_of_bound_bound_by _ _ _).neg,
-- end

lemma Φ_natural (S T : Fintype) (f : S ⟶ T) (F : ℒ S) (t : T) (n : ℤ) :
  Φ T (map f F) t n = laurent_measures.map f (Φ S F) t n :=
begin
  simp [Φ_eq_ϕ, ϕ, finset.mul_sum],
end

end phi_to_hom

section theta

open theta real_measures

parameter (p : ℝ≥0)
local notation `r` := @r p
local notation `ℳ` := real_measures p
local notation `ℒ` := laurent_measures r

variable {S : Fintype.{u}}

local notation `ϖ` := Fintype.of (punit : Type u)

def seval_ℒ_c (c : ℝ≥0) (s : S) : filtration (ℒ S) c → (filtration (ℒ ϖ) c) :=
λ F,
begin
  refine ⟨seval_ℒ S s F, _⟩,
  have hF := F.2,
  simp only [filtration, set.mem_set_of_eq, seval_ℒ, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at ⊢ hF,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hF,
end

variable [fact (0 < p)]

lemma θ_zero : θ (0 : ℒ S) = 0 :=
begin
  dsimp only [θ, theta.ϑ],
  funext,
  simp only [laurent_measures.zero_apply, int.cast_zero, zero_mul, tsum_zero, real_measures.zero_apply],
end

variable [fact (p < 1)]

lemma θ_add (F G : ℒ S) : θ (F + G) = θ F + θ G :=
begin
  dsimp only [θ, theta.ϑ],
  funext,
  simp only [laurent_measures.add_apply, int.cast_add, one_div, inv_zpow', zpow_neg,
    real_measures.add_apply, tsum_add],
  rw ← tsum_add,
  { congr,
    funext,
    rw add_mul },
  all_goals {apply summable_of_summable_norm, simp_rw [← inv_zpow, norm_mul, norm_zpow, norm_inv,
    real.norm_two] },
  exact aux_thm69.summable_smaller_radius_norm F.d half_lt_r (F.summable s) (λ n, lt_d_eq_zero _ _ _),
  exact aux_thm69.summable_smaller_radius_norm G.d half_lt_r (G.summable s) (λ n, lt_d_eq_zero _ _ _),
end

--for mathlib
lemma nnreal.rpow_int_cast (x : ℝ≥0) (n : ℤ) : x ^ n = x ^ (n : ℝ) := by {
  rw [← nnreal.coe_eq, nnreal.coe_zpow, ← real.rpow_int_cast, ← nnreal.coe_rpow] }

lemma nnreal.rpow_le_rpow_of_exponent_le {x : ℝ≥0} (x1 : 1 ≤ x) {y z : ℝ}
  (hyz : y ≤ z) :
  x ^ y ≤ x ^ z :=
by { cases x with x hx, exact real.rpow_le_rpow_of_exponent_le x1 hyz }

lemma nnreal.tsum_geom_arit_inequality (f: ℤ → ℝ) {r' : ℝ} (hr'1 : 0 < r') (hr'2 : r' ≤ 1)
  (hs1 : summable (λ n, f n)) (hs2 : summable (λ n, ∥(f n)∥₊ ^ r')) :
  ∥ tsum (λ n, f n) ∥₊ ^ r' ≤ tsum (λ n, ∥(f n)∥₊ ^ r' ) :=
begin
  rw ← summable_norm_iff at hs1,
  simp_rw ← _root_.coe_nnnorm at hs1,
  rw nnreal.summable_coe at hs1,
  refine le_trans (nnreal.rpow_le_rpow (nnnorm_tsum_le hs1) hr'1.le) _,
  have := λ s : finset ℤ, nnreal.rpow_sum_le_sum_rpow s (λ i, ∥f i∥₊) hr'1 hr'2,
  dsimp only at this,
  have s1' := filter.tendsto.comp (continuous.tendsto
    (nnreal.continuous_rpow_const hr'1.le) _) hs1.has_sum,
  dsimp [function.comp] at s1',
  apply tendsto_le_of_eventually_le s1' hs2.has_sum,
  delta filter.eventually_le,
  convert filter.univ_sets _,
  ext x,
  simp [this],
end

lemma aux_bound (F : ℒ S) (s : S) : ∀ (b : ℤ), ∥(F s b : ℝ) ∥₊ ^ (p : ℝ) *
  (2⁻¹ ^ (p : ℝ)) ^ (b : ℝ) ≤ ∥F s b∥₊ * r ^ b :=
begin
  intro b,
  rw [nnreal.rpow_int_cast],
  refine mul_le_mul_of_nonneg_right _ (real.rpow_nonneg_of_nonneg (nnreal.coe_nonneg _) _),
  have p_le_one : (p : ℝ) ≤ 1,
  { rw ← nnreal.coe_one,
    exact (nnreal.coe_lt_coe.mpr $ fact.out _).le },
  by_cases hF_nz : F s b = 0,
  { rw [hF_nz, int.cast_zero, nnnorm_zero, nnnorm_zero, nnreal.zero_rpow],
    rw [ne.def, ← nnreal.coe_zero, nnreal.coe_eq, ← ne.def],
    exact ne_of_gt (fact.out _) },
  { convert nnreal.rpow_le_rpow_of_exponent_le _ p_le_one,
    { rw nnreal.rpow_one,
      refl },
    { refine not_lt.mp (λ hf, hF_nz (int.abs_lt_one_iff.mp _)),
      suffices : (|F s b| : ℝ) < 1, exact_mod_cast this,
      rw ← int.norm_eq_abs,
      rwa [← nnreal.coe_lt_coe, ← nnnorm_norm, real.nnnorm_of_nonneg (norm_nonneg _)] at hf } }
end

lemma θ_bound : ∀ c : ℝ≥0, ∀ F : (ℒ S), F ∈ filtration (ℒ S) c → (θ F) ∈ filtration (ℳ S)
  (1 * c) :=
begin
  intros c F hF,
  rw laurent_measures.mem_filtration_iff at hF,
  dsimp only [laurent_measures.has_nnnorm] at hF,
  rw [one_mul, real_measures.mem_filtration_iff],
  dsimp only [real_measures.has_nnnorm, θ, theta.ϑ],
  let T := S.2.1,
  have ineq : ∀ (s ∈ T), ∥∑' (n : ℤ), ((F s n) : ℝ) * 2⁻¹ ^ n∥₊ ^ (p : ℝ) ≤ ∑' (n : ℤ),
    ∥ ((F s n) : ℝ) * 2⁻¹ ^ n∥₊ ^ (p : ℝ),
  { intros s hs,
    apply nnreal.tsum_geom_arit_inequality (λ n, ((F s n) * 2⁻¹ ^ n)),
    { norm_num, exact fact.out _},
    { suffices : p ≤ 1, assumption_mod_cast, exact fact.out _},
    { dsimp only,
      obtain ⟨d, hd⟩ := exists_bdd_filtration (r_pos) (r_lt_one) F,
      apply aux_thm69.summable_smaller_radius d (F.summable s) (hd s) half_lt_r },
    { dsimp only,
      simp_rw [nnnorm_mul, nnreal.mul_rpow],
      have := F.summable s,
      rw ← nnreal.summable_coe,
      apply summable_of_nonneg_of_le (λ i, _) _ this, apply nnreal.zero_le_coe,
      intro n,
      push_cast,
      apply mul_le_mul,
      { -- true because ∥integer∥ is either 0 or >= 1
        norm_cast,
        by_cases h : F s n = 0,
        { simp only [h, norm_zero],
          refine le_of_eq (real.zero_rpow _),
          norm_cast,
          exact ne_of_gt (fact.out _) },
        { nth_rewrite 1 (real.rpow_one (∥F s n∥)).symm,
          apply real.rpow_le_rpow_of_exponent_le,
          { rw [int.norm_eq_abs, le_abs'],
            norm_cast,
            rcases lt_trichotomy 0 (F s n) with (hF|hF|hF),
            { right, linarith },
            { exact false.elim (h hF.symm) },
            { left, change _ ≤ -(1 : ℤ), linarith, } },
          { norm_cast, exact fact.out _ } } },
      { apply le_of_eq,
        rw [← r_coe],
        rw real.norm_of_nonneg,
        { -- can't use pow_mul yet because one is int one is real
          rw [← real.rpow_int_cast, ← real.rpow_int_cast],
          rw [← real.rpow_mul, mul_comm, real.rpow_mul];
          norm_num },
        { apply zpow_nonneg,
          norm_num } },
      { refine (real.rpow_pos_of_pos _ _).le,
        rw norm_pos_iff,
        apply zpow_ne_zero,
        norm_num, },
      { apply norm_nonneg, } } },
  apply (finset.sum_le_sum ineq).trans,
  simp_rw [nnnorm_mul, nnnorm_zpow, nnnorm_inv, nnreal.mul_rpow, real.nnnorm_two,
    nnreal.rpow_int_cast, ← nnreal.rpow_mul (2 : ℝ≥0)⁻¹, mul_comm, nnreal.rpow_mul (2 : ℝ≥0)⁻¹],
  apply le_trans _ hF,
  apply finset.sum_le_sum,
  intros s hs,
  apply tsum_le_tsum,
  exact aux_bound p F s,
  refine nnreal.summable_of_le _ (F.2 s),
  exacts [aux_bound p F s, F.2 s],
end

lemma θ_bound' :  ∀ c : ℝ≥0, ∀ F : (ℒ S), F ∈ filtration (ℒ S) c → (θ F) ∈ filtration (ℳ S)
  c :=by { simpa [one_mul] using (θ_bound p)}

def θ_to_add : (ℒ S) →+ (ℳ S) :=
{ to_fun := λ F, θ F,
  map_zero' := θ_zero,
  map_add' := θ_add, }

variable (S)

open theta metric real_measures

def seval_ℳ_c (c : ℝ≥0) (s : S) : filtration (ℳ S) c → (filtration (ℳ ϖ) c) :=
λ x,
  begin
  refine ⟨(λ _, x.1 s), _⟩,
  have hx := x.2,
  simp only [filtration, set.mem_set_of_eq, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at ⊢ hx,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hx,
end

-- **[FAE]** From here everything might be useless until `lemma inducing_cast_ℳ`: check
-- also the `variable (c : ℝ≥0)` issue; the idea is to replace cast_ℳ_c with α, for which
-- everything seems to work

variable (c : ℝ≥0)

def box := {F : (ℳ S) // ∀ s, ∥ F s ∥₊ ^ (p : ℝ) ≤ c }

instance : has_coe (box S c) (ℳ S) := by {dsimp only [box], apply_instance}
instance : topological_space (ℳ S) := by {dsimp only [real_measures], apply_instance}
instance : topological_space (box S c) := by {dsimp only [box], apply_instance}

def equiv_box_ϖ : (box S c) ≃ Π (s : S), (filtration (ℳ ϖ) c) :=
begin
  fconstructor,
  { intros F s,
    use seval_ℳ S s F.1,
    simp only [real_measures.mem_filtration_iff, nnnorm, fintype.univ_punit,
      finset.sum_singleton, seval_ℳ],
    exact F.2 s },
  { intro G,
    use λ s, (G s).1 punit.star,
    intro s,
    simpa only [real_measures.mem_filtration_iff, nnnorm, fintype.univ_punit,
      finset.sum_singleton, seval_ℳ] using (G s).2 },
  { intro _,
    ext s,
    simpa only [seval_ℳ] },
  { intro G,
    ext s,
    simp only [seval_ℳ, subtype.val_eq_coe, subtype.coe_mk],
    induction x,
    refl }
end

def homeo_box_ϖ : (box S c) ≃ₜ Π (s : S), (filtration (ℳ ϖ) c) :=
{ to_equiv := equiv_box_ϖ S c,
  continuous_to_fun := begin
    apply continuous_pi,
    intro s,
    dsimp only [equiv_box_ϖ, seval_ℳ],
    refine continuous.subtype_mk (continuous_pi $ λ i, _) _,
    exact continuous_pi_iff.mp continuous_induced_dom s,
  end,
  continuous_inv_fun :=
  begin
    dsimp only [equiv_box_ϖ, seval_ℳ],
    refine continuous.subtype_mk _ _,
    apply continuous_pi,
    intro s,
    have h : continuous (λ (a : S → (filtration (ℳ ϖ) c)), (a s).val)
       := continuous.subtype_coe (continuous_apply s),
    have H := continuous_apply punit.star,
    exact H.comp h,
  end}

def α : filtration (ℳ S) c → box S c :=
begin
  intro x,
  use x,
  have hx := x.2,
  intro s,
  simp only [filtration, set.mem_set_of_eq, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at hx,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hx,
end

lemma coe_α_coe : (coe : (box S c) → (ℳ S)) ∘ (α S c) = coe := by {funext _, refl}

lemma inducing_α : inducing (α S c) :=
begin
  have ind_ind := @induced_compose _ _ (ℳ S) _ (α p S c) coe,
  rw [coe_α_coe p S c] at ind_ind,
  exact {induced := eq.symm ind_ind},
end

lemma seval_ℳ_α_commute (c : ℝ≥0) (s : S) :
 (λ F, ((homeo_box_ϖ S c) ∘ (α S c)) F s) = (λ F, seval_ℳ_c S c s F) := rfl

 lemma seval_ℳ_α_commute' {X : Type*} (c : ℝ≥0) {f : X → filtration (ℳ S) c} (s : S)  :
 (λ x, ((homeo_box_ϖ S c) ∘ (α S c)) (f x) s) = (λ x, seval_ℳ_c S c s (f x)) :=
 begin
  ext z,
  have h_commute := @seval_ℳ_α_commute p S _ _ c s,
  have := congr_fun h_commute (f z),
  simp only at this,
  rw this,
 end

@[nolint unused_arguments]
def seval_ℒ_bdd_c (c : ℝ≥0) (S : Fintype) (A : finset ℤ) (s : S) :
laurent_measures_bdd r S A c → laurent_measures_bdd r ϖ A c :=
begin
  intro F,
  use λ _, F s,
  have hF := F.2,
  simp only [filtration, set.mem_set_of_eq, seval_ℒ, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at ⊢ hF,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hF,
end

lemma continuous_seval_ℒ_c (c : ℝ≥0) (s : S) : continuous (seval_ℒ_c c s) :=
begin
  rw laurent_measures.continuous_iff,
  intro A,
  let := seval_ℒ_bdd_c p c S A s,
  have h_trunc : (@truncate r ϖ c A) ∘ (seval_ℒ_c p c s) =
    (seval_ℒ_bdd_c p c S A s) ∘ (@truncate r S c A),
  { ext ⟨F, hF⟩ π k,
    dsimp only [seval_ℒ_bdd_c, seval_ℒ_c],
    refl },
  rw h_trunc,
  apply continuous.comp,
  apply continuous_of_discrete_topology,
  apply truncate_continuous,
end

section topological_generalities

open metric set

variables {X : Type*} [topological_space X]

lemma reduction_balls {c : ℝ≥0} (f : X → (closed_ball (0 : ℝ) c)) (H : ∀ y : (closed_ball 0 c),
  ∀ ε : ℝ, is_open (f⁻¹' (ball y ε))) : continuous f :=
begin
  rw continuous_def,
  intros _ hU,
  rw is_open_iff_forall_mem_open,
  intros x hx,
  obtain ⟨ε, h₀, hε⟩ := (is_open_iff.mp hU) (f x) (mem_preimage.mp hx),
  use f⁻¹' (ball (f x) ε),
  exact ⟨preimage_mono hε, H (f x) ε, mem_ball_self h₀⟩,
end

lemma mem_filtration_le_monomial (F : filtration (ℒ ϖ) c) (n : ℕ) :
 ∥ ((F.1 punit.star n) : ℝ) ∥ ≤ c * ( r⁻¹ ^ n) :=
begin
  have h_le : ∑' n : ℤ, ∥ ((F.1 punit.star n) : ℝ) ∥ * r ^ n ≤ c,
  { have := (laurent_measures.mem_filtration_iff F.1 c).mp F.2,
    rw laurent_measures.nnnorm_def at this,
    simp only [fintype.univ_punit, finset.sum_singleton, ← nnreal.coe_le_coe,
    nnreal.coe_tsum, nnreal.coe_mul, nnreal.coe_zpow, laurent_measures.coe_nnnorm] at this,
    exact this },
  have := @sum_le_tsum ℝ _ _ _ _ (λ n, ∥ ((F.1 punit.star n) : ℝ) ∥ * r ^ n) {n} _
    (F.1.summable punit.star),
  simp only [finset.sum_singleton, zpow_coe_nat] at this,
  replace h_le := this.trans h_le,
  rwa [← inv_mul_le_iff', inv_pow, inv_inv ((r : ℝ) ^ n), mul_comm],
  { apply pow_pos, rw inv_pos, apply r_pos },
  { rintros b -,
    simp only [subtype.val_eq_coe],
    exact mul_nonneg (norm_nonneg _) (zpow_nonneg (le_of_lt (nnreal.coe_pos.mpr r_pos)) b) },
end

lemma mem_filtration_sum_le_geom (F : filtration (ℒ ϖ) c) (B : ℕ) : ∥ ∑' n : {x : ℕ // B ≤ x},
  ((F.1 punit.star n) : ℝ) * 2⁻¹ ^ n.1 ∥ ≤ ∥ (c : ℝ) * ∑' n : {x : ℕ // B ≤ x}, (2⁻¹ * r⁻¹) ^ n.1 ∥ :=
begin
  have two_r_nonneg : 0 ≤ (2⁻¹ * r⁻¹ : ℝ) := by {refine mul_nonneg (inv_nonneg.2 two_pos.le) (inv_nonneg.2 r.2) },
  have h_inj : function.injective (coe : {x : ℕ // B ≤ x} → ℕ) := subtype.coe_injective,
  have geom_pos : (0 : ℝ) ≤ c * ∑' (n : {x // B ≤ x}), (2⁻¹ * r⁻¹) ^ n.1,
  { apply mul_nonneg c.2 (tsum_nonneg _),
    intro b,
    apply pow_nonneg (two_r_nonneg) },
  nth_rewrite 1 [real.norm_eq_abs],
  rw [abs_eq_self.mpr geom_pos],
    apply (norm_tsum_le_tsum_norm _).trans,
  rw [← tsum_mul_left],
  apply tsum_le_tsum,
  { intro b,
    rw [norm_mul, mul_pow, mul_comm ((2⁻¹ : ℝ) ^ b.1) _, ← mul_assoc],
    rw [norm_pow, norm_inv, real.norm_two ],
    refine (mul_le_mul_right _).mpr _,
    { simp only [one_div, inv_pos, pow_pos, zero_lt_bit0, zero_lt_one] },
    { apply mem_filtration_le_monomial p c F } },
  swap,
  { by_cases hc : (c : ℝ) ≠ 0,
    { rw [← summable_mul_left_iff hc],
      have two_r_lt : (2⁻¹ * r⁻¹ : ℝ) < 1,
      { have := (div_lt_one (nnreal.coe_lt_coe.mpr (r_pos))).mpr half_lt_r,
        simp only [← inv_eq_one_div] at this ⊢,
        rw [div_eq_mul_inv, nnreal.coe_inv] at this,
        convert this,
        assumption', },
      exact (summable_geometric_of_lt_1 two_r_nonneg two_r_lt).comp_injective h_inj,
      },
    { rw not_ne_iff at hc,
      simp_rw [hc, zero_mul],
      exact summable_zero }, },
  all_goals { simp_rw [norm_mul, norm_pow, norm_inv, real.norm_two, subtype.val_eq_coe],
    refine ((aux_thm69.summable_iff_on_nat_less F.1.d _).mp (aux_thm69.summable_smaller_radius_norm
      F.1.d (half_lt_r) (F.1.summable punit.star)
      (λ n, lt_d_eq_zero F.1 punit.star n))).comp_injective h_inj,
    intros n hn,
    rw [lt_d_eq_zero F.1 punit.star n hn, norm_zero, zero_mul] },
end

def geom_B_nat (ε : ℝ) (hε : 0 < ε) : {B : ℕ // ∀ (F : filtration (ℒ ϖ) c), ∥ tsum (λ b :
  {n : ℕ // B ≤ n }, ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 ) ∥ < ε ^ (p⁻¹ : ℝ)} :=
begin
  let g := (λ n : ℕ, (c : ℝ) * ((2⁻¹ * r⁻¹) ^ n)),
  have := tendsto_tsum_compl_at_top_zero g,
  rw tendsto_at_top at this,
  have h_pos : 0 < ε ^ (p⁻¹ : ℝ) := real.rpow_pos_of_pos hε _,
  specialize this (ε ^ (p⁻¹ : ℝ)) h_pos,
  let A := this.some,
    let B₀ : option ℕ → ℕ := λ a : (option ℕ), option.rec_on a (0 : ℕ) (λ n, n),
    set B := (B₀ A.max).succ with hB,
    use B,
    have h_incl : A ≤ finset.range B,
    rw finset.le_eq_subset,
    { by_cases H : A.nonempty,
      { intros a ha,
        obtain ⟨s, hs⟩ := finset.max_of_nonempty H,
        replace hB : s.succ = B, { simp only [*, option.mem_def], refl, },
        have h_mem := finset.mem_range_succ_iff.mpr (finset.le_max_of_mem ha hs),
        rwa hB at h_mem },
      { intros a ha,
        rw [finset.not_nonempty_iff_eq_empty] at H,
        finish }},
    let hA := this.some_spec,
    specialize hA (finset.range B) h_incl,
    rw [real.dist_0_eq_abs, ← real.norm_eq_abs] at hA,
    intro F,
    apply lt_of_le_of_lt (mem_filtration_sum_le_geom p c F B),
    convert hA using 1,
    apply congr_arg,
    simp_rw [subtype.val_eq_coe, ← tsum_mul_left],
    have set_eq : {n : ℕ | B ≤ n} = {n : ℕ | n ∉ finset.range B} :=
      by {simp only [finset.mem_range, not_lt]},
    exact tsum_congr_subtype g set_eq,
end

def eq_le_int_nat (B : ℕ) : {n : ℤ // (B : ℤ) ≤ n } ≃ {n : ℕ // B ≤ n} :=
{ to_fun :=
  begin
    intro b,
    use (int.eq_coe_of_zero_le ((int.coe_nat_nonneg B).trans b.2)).some,
    rw ← int.coe_nat_le,
    convert b.2,
    exact (Exists.some_spec (int.eq_coe_of_zero_le ((int.coe_nat_nonneg B).trans b.2))).symm,
  end,
  inv_fun := λ n, ⟨n, by {simp only [coe_coe, int.coe_nat_le], from n.2}⟩,
  left_inv :=
  begin
    rintro ⟨_, h⟩,
    simp only [coe_coe, subtype.coe_mk],
    exact (Exists.some_spec (int.eq_coe_of_zero_le ((int.coe_nat_nonneg B).trans h))).symm,
  end,
  right_inv :=
  begin
    rintro ⟨_, h⟩,
    simp only [coe_coe, subtype.coe_mk, int.coe_nat_inj'],
    exact ((@exists_eq' _ _).some_spec).symm,
  end, }

def geom_B_int (ε : ℝ) (hε : 0 < ε) : {B : ℤ // ∀ (F : filtration (ℒ ϖ) c), ∥ tsum (λ b :
  {n : ℤ // B ≤ n }, ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 ) ∥ < ε ^ (p⁻¹ : ℝ)} :=
begin
  let ℬ := geom_B_nat p c ε hε,
  let B := ℬ.1,
  let hB := ℬ.2,
  use B,
  intro F,
  specialize hB F,
  convert hB using 1,
  apply congr_arg,
  exact ((eq_le_int_nat B).symm.tsum_eq (λ b : {n : ℤ // ↑B ≤ n },
  ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 )).symm,
end

def geom_B (ε : ℝ) (hε : 0 < ε) : ℤ := (geom_B_int c ε hε).1

lemma tail_B (ε : ℝ) (hε : 0 < ε) :  ∀ (F : filtration (ℒ ϖ) c), ∥ tsum (λ b : {n : ℤ // geom_B c ε hε ≤ n },
  ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 ) ∥ < ε ^ (p⁻¹ : ℝ) :=
begin
  intro F,
  have := (geom_B_int p c ε hε).2 F,
  exact this,
end

def U (F : filtration (ℒ ϖ) c) (B : ℤ) : set (filtration (ℒ ϖ) c) :=
  λ G, ∀ s n, n < B → F s n = G s n

lemma mem_U (F : filtration (ℒ ϖ) c) (B : ℤ) : F ∈ (U c F B) := λ _ _ _, rfl

lemma explodes_pow_r (ρ : ℝ≥0) (h₀ : 0 < ρ.1) (h₁ : ρ.1 < 1) (c : ℝ≥0) :
  ∃ n₀ : ℤ, ∀ (m : ℤ), m < n₀ → c < ρ ^ m :=
begin
  convert_to ∃ n₀ : ℕ, ∀ (m : ℕ), (- m : ℤ) < - n₀ → (c : ℝ) < ρ ^ ( - m : ℤ) using 0,
  { simp only [neg_lt_neg_iff, int.coe_nat_lt, zpow_neg, zpow_coe_nat, eq_iff_iff],
    split,
    { rintro ⟨n₀, hn₀⟩,
      induction n₀,
      { use n₀,
        intros m hm,
        rw [← int.coe_nat_lt] at hm,
        replace hm := neg_lt.mpr (lt_of_le_of_lt (neg_le_self (int.coe_nat_nonneg _)) hm),
        specialize hn₀ (- m) hm,
        rwa [← nnreal.coe_lt_coe, nnreal.coe_zpow, zpow_neg] at hn₀ },
      { use n₀ + 1,
        intros m hm,
        rw [← int.coe_nat_lt, ← neg_lt_neg_iff, ← int.neg_succ_of_nat_coe] at hm,
        specialize hn₀ (- m) hm,
        rwa [← nnreal.coe_lt_coe, nnreal.coe_zpow, zpow_neg] at hn₀ },},
    { rintro ⟨n₀, hn₀⟩,
      use - n₀,
      rintro ⟨m⟩ hm,
      {  have := right.neg_nonpos_iff.mpr (int.of_nat_nonneg n₀),
        rw [int.of_nat_eq_coe] at this,
        replace := ne_of_lt (lt_of_lt_of_le (lt_of_le_of_lt (int.of_nat_nonneg m) hm) this),
        finish },
      { rw [int.neg_succ_of_nat_coe, neg_lt_neg_iff, int.coe_nat_lt] at hm,
        specialize hn₀ (m + 1) hm,
        rwa [int.neg_succ_of_nat_coe, ← nnreal.coe_lt_coe, zpow_neg, zpow_coe_nat, nnreal.coe_inv,
          nnreal.coe_pow] }}},
  have h := (tendsto_pow_at_top_nhds_within_0_of_lt_1 h₀ h₁).inv_tendsto_zero,
  simp_rw [← zpow_coe_nat] at h,
  have : (λ (n : ℕ), ρ.1 ^ (n : ℤ))⁻¹ = (λ (n : ℕ), ρ.1 ^ (- n : ℤ)) := by {ext,
  simp only [pi.inv_apply, zpow_neg] },
  rw [this, filter.tendsto_at_top] at h,
  specialize h (c + 1),
  rw [nnreal.val_eq_coe] at h,
  simp_rw [← nnreal.coe_zpow] at h,
  obtain ⟨n₀, hn₀⟩ := filter.eventually.exists_forall_of_at_top h,
  use n₀,
  intros m hm,
  rw [neg_lt_neg_iff, int.coe_nat_lt] at hm,
  replace hm := le_of_lt hm,
  specialize hn₀ m hm,
  rw nnreal.coe_zpow at hn₀,
  refine lt_of_lt_of_le _ hn₀,
  exact lt_add_one _,
end

lemma is_open_U (F : filtration (ℒ ϖ) c) (B : ℤ) : is_open (U c F B) :=
begin
  let ι : filtration (ℒ ϖ) c → Π (i : ℤ), ℤ :=
    λ t i, truncate {i} t punit.star ⟨i,by simp⟩,
  have hι : continuous ι,
  { rw continuous_pi_iff, intros i,
    dsimp [ι],
    change continuous ((λ (t : laurent_measures_bdd r ϖ {i} c),
      t punit.star ⟨i,by simp⟩) ∘ truncate {i}),
    refine continuous.comp continuous_bot (truncate_continuous «r» (Fintype.of punit) c {i}) },
  obtain ⟨n₀,h₀⟩ : ∃ n₀ : ℤ, ∀ (m : ℤ) (H : ℒ ϖ) (hH : H ∈ filtration (ℒ ϖ) c),
    m < n₀ → H punit.star m = 0,
  { obtain ⟨n₀,h₀⟩ : ∃ n₀ : ℤ, ∀ (m : ℤ), m < n₀ → c < r^m := explodes_pow_r r r_pos r_lt_one c,
    use n₀, intros m H hH hm,
    exact eq_zero_of_filtration H _ hH punit.star m (h₀ m hm) },
  classical,
  let UU : set (Π (i : ℤ), ℤ) :=
    set.pi (set.Ico n₀ B) (λ i, if i ∈ set.Ico n₀ B then { F punit.star i } else ⊤),
  have hUU : is_open UU,
  { apply is_open_set_pi, exact finite_Ico n₀ B,
    intros a ha, trivial },
  convert hUU.preimage hι,
  ext G,
  split,
  { intros hG, dsimp [U, UU, ι] at ⊢ hG,
    intros i hi, rw if_pos hi,
    simp only [mem_singleton_iff],
    symmetry,
    apply hG, exact hi.2 },
  { intros hG, dsimp [U, UU, ι] at ⊢ hG,
    rintros ⟨⟩ n hn,
    symmetry,
    by_cases hn' : n < n₀,
    { erw [h₀ n G.1 G.2 hn', h₀ n F.1 F.2 hn'] },
    push_neg at hn',
    specialize hG n, simpa [hn', hn] using hG },
end

end topological_generalities

def θ_c (c : ℝ≥0) (T : Fintype) : (filtration (laurent_measures r T) c) →
  (filtration (real_measures p T) c) :=
begin
  intro f,
  rw [← one_mul c],
  use ⟨θ f, θ_bound p c f f.2⟩,
end

lemma commute_seval_ℒ_ℳ (c : ℝ≥0) (s : S) :
  (θ_c c (Fintype.of punit)) ∘ (seval_ℒ_c c s) = (seval_ℳ_c S c s) ∘ (θ_c c S) := by simpa only
  [seval_ℳ_c, seval_ℒ_c, seval_ℒ, θ_c, one_mul, subtype.coe_mk, eq_mpr_eq_cast, set_coe_cast]

lemma continuous_of_seval_ℳ_comp_continuous (c : ℝ≥0) {X : Type*} [topological_space X]
  {f : X → (filtration (ℳ S) c)} : (∀ s, continuous ((seval_ℳ_c S c s) ∘ f)) → continuous f :=
begin
  intro H,
  replace H : ∀ (s : S), continuous (λ x : X, ((homeo_box_ϖ p S c) ∘ (α p S c)) (f x) s),
  { intro,
    rw [seval_ℳ_α_commute' p S c s],
    exact H s },
  rw ← continuous_pi_iff at H,
  convert_to (continuous (λ x, (homeo_box_ϖ p S c) (α p S c (f x)))) using 0,
  { apply eq_iff_iff.mpr,
    rw [homeomorph.comp_continuous_iff, (inducing_α p S c).continuous_iff] },
  exact H,
end

lemma tsum_subtype_sub {f g : ℤ → ℝ} {B : ℤ}
  (hf : summable (λ (b : {x // B ≤ x}), f b * 2⁻¹ ^ b.1))
  (hg : summable (λ (b : {x // B ≤ x}), g b * 2⁻¹ ^ b.1)) :
  ∥ tsum ((λ (b : ℤ), (((g b) : ℝ) - f b) * 2⁻¹ ^ b) ∘ (coe : {b | B ≤ b} → ℤ)) ∥ =
  ∥ ∑' (b : {x // B ≤ x}), (g b : ℝ) * 2⁻¹ ^ b.1 - ∑' (b : {x // B ≤ x}),
    (f b : ℝ) * 2⁻¹ ^ b.1 ∥ :=
begin
  rw [← tsum_sub hg hf, tsum_eq_tsum_of_has_sum_iff_has_sum],
  intro _,
  simp_rw [sub_mul, iff_eq_eq],
  refl,
end

lemma aux_summability_no_norm (F : filtration (ℒ ϖ) c) : summable
  (λ b : ℤ, (((F punit.star b) : ℝ) * 2⁻¹ ^ b)) := aux_thm69.summable_smaller_radius F.1.d (F.1.summable punit.star)
      (λ n, lt_d_eq_zero F.1 punit.star n) half_lt_r

lemma aux_summability_subtype (F : filtration (ℒ ϖ) c) (B : ℤ) : summable (λ b : {x : ℤ // B ≤ x},
  (((F punit.star b) : ℝ) * 2⁻¹ ^ b.1)) :=
    by {exact (aux_summability_no_norm p c F).comp_injective subtype.coe_injective}

lemma pos_ε_pow (ε : ℝ) (hε : 0 < ε) : 0 < (ε / (2 : ℝ) ^ p.1) := by {apply div_pos hε
  (real.rpow_pos_of_pos _ _), simp only [zero_lt_bit0, zero_lt_one]}

lemma dist_lt_of_mem_U (ε : ℝ≥0) (hε : 0 < ε) (F G : filtration (ℒ ϖ) c) :
  G ∈ (U c F (geom_B c (ε / (2 : ℝ) ^ p.1) (pos_ε_pow ε hε))) → ∥ ((θ_c c ϖ G) : (ℳ ϖ)) - (θ_c c ϖ) F ∥ < ε :=
begin
  intro h_mem_G,
  rw real_measures.norm_def,
  simp only [fintype.univ_punit, real_measures.sub_apply, finset.sum_singleton],
  rw [← real.rpow_lt_rpow_iff _ _ _, ← real.rpow_mul,
    mul_inv_cancel, real.rpow_one],
  rotate,
  { rw ← nnreal.coe_zero,
    exact ne_of_gt (nnreal.coe_lt_coe.mpr (fact.out _)) },
  { apply norm_nonneg },
  { apply real.rpow_nonneg_of_nonneg (norm_nonneg _) },
  { rw ← nnreal.coe_zero,
    exact ε.2 },
  { rw [inv_pos, ← nnreal.coe_zero],
    exact (nnreal.coe_lt_coe.mpr (fact.out _)) },
  simp only [θ_c, one_mul, eq_mpr_eq_cast, set_coe_cast, subtype.coe_mk],
  dsimp only [θ, ϑ],
  have h_B : ∀ b : ℤ, b < (geom_B p c (ε / 2 ^ p.1) (pos_ε_pow p ε hε)) → ((G punit.star b) : ℝ) - (F punit.star b) = 0,
  { intros b hb,
    simp only [h_mem_G punit.star b hb, sub_self] },
  rw [← tsum_sub],
  rotate,
  {exact (aux_summability_no_norm p c G)},
  {exact (aux_summability_no_norm p c F)},
  simp_rw [← sub_mul],
  set B := (geom_B p c (ε / 2 ^ p.1) (pos_ε_pow p ε hε)) with def_B,
  let f := λ b : ℤ, ((((G : (ℒ ϖ)) punit.star b) - ((F : (ℒ ϖ)) punit.star b)) : ℝ)
    * 2⁻¹ ^ b,
  let g : ({ b : ℤ | B ≤ b}) → ℝ := f ∘ coe,
  let i : function.support g → ℤ := (coe : { b : ℤ | B ≤ b} → ℤ) ∘ (coe : function.support g → { b : ℤ | B ≤ b}),
  have hi : ∀ ⦃x y : ↥(function.support g)⦄, i x = i y → ↑x = ↑y,
  {intros _ _ h,
    simp only [subtype.coe_inj] at h,
    rwa [subtype.coe_inj] },
  have hf : function.support f ⊆ set.range i,
  { intros a ha,
    simp only [f, function.mem_support, ne.def] at ha,
    have ha' : B ≤ a,
    { by_contra',
      specialize h_B a this,
      simp only [one_div, inv_zpow', zpow_neg, mul_eq_zero, inv_eq_zero, not_or_distrib] at ha,
      replace ha := ha.1,
      simpa only },
    simp only [set.mem_set_of_eq, function.mem_support, ne.def, set.mem_range, set_coe.exists],
    use [a, ha', ha, refl _] },
  have hF := tail_B p c (ε.1 / 2 ^ p.1) (pos_ε_pow p ε hε) F,
  have hG := tail_B p c (ε.1 / 2 ^ p.1) (pos_ε_pow p ε hε) G,
  have h02 : (0 : ℝ) ≤ 2 := two_pos.le,
  have h02p : (0 : ℝ) ≤ 2 ^ p.val := real.rpow_nonneg_of_nonneg h02 _,
  rw [real.div_rpow ε.2 h02p, ← real.rpow_mul h02] at hF hG,
  simp_rw [@subtype.val_eq_coe _ _ p] at hF hG,
  have hp0 : (p : ℝ) ≠ 0 := nnreal.coe_ne_zero.mpr (ne_of_gt (fact.out _)),
  rw [mul_inv_cancel hp0, real.rpow_one] at hF hG,
  rw [tsum_eq_tsum_of_ne_zero_bij i hi hf (λ _, refl _)],
  dsimp only [f, g],
  rw [tsum_subtype_sub],
  rotate,
  { exact (aux_summability_subtype p c F B) },
  { exact (aux_summability_subtype p c G B) },
  apply lt_of_le_of_lt (norm_sub_le _ _),
  convert add_lt_add hG hF,
  simp only [nnreal.val_eq_coe, add_halves'],
end

lemma coe_pow_half (η : ℝ) (η_pos' : 0 < η) (η₀ : ℝ≥0) (hη₀ : η₀ = ⟨η, le_of_lt η_pos'⟩) :
  (η / 2) ^ (p : ℝ) = ((η₀ ^ (p : ℝ) : ℝ)) / 2 ^ (p.1) := by {rw [real.div_rpow (le_of_lt η_pos') _,
     nnreal.val_eq_coe, hη₀, subtype.coe_mk], simp only [zero_le_bit0, zero_le_one]}

section
variables {c}

def ξ (F : filtration (ℒ ϖ) c) : ℝ :=
(homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)

def hξ (F : filtration (ℒ ϖ) c) :
  ξ F = (homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F) := rfl

lemma speed_aux' (ε η : ℝ) (η₀ : ℝ≥0) (hη₀ : η = η₀)
  (y : (closed_ball (0 : ℝ) (c ^ (p : ℝ)⁻¹)))
  (F G : (filtration (ℒ (Fintype.of punit)) c))
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (h_pos : 0 < (η / 2) ^ (p:ℝ))
  (hp : 0 < (p:ℝ))
  (η_pos' : 0 < η)
  (h_η_η₀ : (η / 2) ^ (p:ℝ) = ↑η₀ ^ (p:ℝ) / 2 ^ p.val) (h_pos'')
  (hG : G ∈ U c F (geom_B c ((↑η₀ ^ (p:ℝ) / 2 ^ p.val)) h_pos'')) :
  ∥(θ_c c (Fintype.of punit) G).val - (θ_c c (Fintype.of punit) F).val∥ < η ^ (p:ℝ) :=
begin
  have foo : 0 < η₀ ^ (p:ℝ),
  { apply real.rpow_pos_of_pos, rw ← hη₀, exact η_pos' },
  -- exact dist_lt_of_mem_U p c (η₀ ^ (p : ℝ)) (real.rpow_pos_of_pos η_pos' _) F G hG
  have := dist_lt_of_mem_U p c (η₀ ^ (p : ℝ)) foo F G hG,
  convert this,
end

lemma speed_aux (ε η : ℝ) (η₀ : ℝ≥0) (hη₀ : η = η₀)
  (y : (closed_ball (0 : ℝ) (c ^ (p : ℝ)⁻¹)))
  (F G : (filtration (ℒ (Fintype.of punit)) c))
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (h_pos : 0 < (η / 2) ^ (p:ℝ))
  (hp : 0 < (p:ℝ))
  (η_pos' : 0 < η)
  (h_η_η₀ : (η / 2) ^ (p:ℝ) = ↑η₀ ^ (p:ℝ) / 2 ^ p.val) (h_pos'')
  (hG : G ∈ U c F (geom_B c ((↑η₀ ^ (p:ℝ) / 2 ^ p.val)) h_pos'')) :
  |ξ G - ξ F| < ε - |ξ F - y| :=
begin
  repeat {rw hξ},
  rw [← real_measures.dist_eq,
    ← real.rpow_lt_rpow_iff
      (real.rpow_nonneg_of_nonneg (real_measures.norm_nonneg _) _) (sub_nonneg.mpr (le_of_lt hF)) hp,
    ← real.rpow_mul (real_measures.norm_nonneg _),
    inv_mul_cancel (ne_of_gt hp), real.rpow_one, ← hη],
  apply speed_aux', assumption'
end

lemma speed (ε η : ℝ) (y : closed_ball (0 : ℝ) (c ^ (p⁻¹ : ℝ)))
  (F G : filtration (ℒ ϖ) c)
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (hG : G ∈ U c F (geom_B c ((η / 2) ^ (p:ℝ)) h_pos)) :
  |(ξ G) - (ξ F)| + |(ξ F) - y| < ε - |(ξ F) - y| + |(ξ F) - y| :=
begin
  have hp : 0 < (p : ℝ), { rw [← nnreal.coe_zero, nnreal.coe_lt_coe], from fact.out _ },
  have η_pos' : 0 < η := by {rw hη, from (sub_pos.mpr hF)},
  set η₀ : ℝ≥0 := ⟨η, le_of_lt η_pos'⟩ with hη₀,
  have h_η_η₀ := @coe_pow_half p _ _ η η_pos' η₀ hη₀,
  simp_rw [h_η_η₀] at hG,
  apply add_lt_add_right,
  apply @speed_aux p _ _ c ε η η₀ _ y F G,
  assumption',
  rw hη₀, refl,
end

end

lemma U_subset_preimage' (ε η : ℝ) (y : closed_ball (0 : ℝ) (c ^ (p⁻¹ : ℝ)))
  (F : filtration (ℒ ϖ) c)
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (G : (filtration (ℒ (Fintype.of punit)) c))
  (hG : G ∈ U c F (geom_B c ((η / 2) ^ (p:ℝ)) h_pos)) :
  |ξ G - y| < ε :=
begin
  have aux : |(ξ p G) - (ξ p F)| + |(ξ p F) - y | < ε - | (ξ p F) - y | + | (ξ p F) - y |,
  { apply speed; assumption },
  replace aux : |(ξ p G) - (ξ p F)| + |(ξ p F) - y | < ε,
  { rwa [sub_add_cancel ε (| (ξ p F) - y |)] at aux },
  have := lt_of_le_of_lt (abs_sub_le (ξ p G) (ξ p F) y) aux,
  rw ← real.norm_eq_abs at this ⊢,
  exact this,
end

lemma U_subset_preimage (ε η : ℝ) (y : closed_ball (0 : ℝ) (c ^ (p⁻¹ : ℝ)))
  (F : filtration (ℒ ϖ) c)
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ)) :
  (U c F (geom_B c ((η / 2) ^ (p : ℝ)) h_pos) )  ⊆
    ((homeo_filtration_ϖ_ball c) ∘ θ_c c (ϖ) ⁻¹' (ball y ε)) :=
begin
  intros G hG,
  simp only [set.mem_preimage, one_mul, eq_self_iff_true, eq_mpr_eq_cast, set_coe_cast,
    function.comp_app, mem_ball, subtype.dist_eq, real.dist_eq],
  apply U_subset_preimage'; assumption,
end

-- This is the main continuity property needed in `ses2.lean`
theorem continuous_θ_c (c : ℝ≥0) : continuous (θ_c c S) :=
begin
  apply continuous_of_seval_ℳ_comp_continuous,
  intro s,
  rw ← commute_seval_ℒ_ℳ,
  refine continuous.comp _ (continuous_seval_ℒ_c p S c s),
  apply (homeo_filtration_ϖ_ball c).comp_continuous_iff.mp,
  apply reduction_balls,
  intros y ε,
  rw is_open_iff_forall_mem_open,
  intros F hF,
  simp only [set.mem_preimage, one_mul, eq_self_iff_true, eq_mpr_eq_cast, set_coe_cast,
    function.comp_app, mem_ball, subtype.dist_eq, real.dist_eq] at hF,
  set η := ε - |(homeo_filtration_ϖ_ball c (θ_c p c ϖ F)) - y| with hη,
  have η_pos' : 0 < η := by {rw hη, from (sub_pos.mpr hF)},
  have η_pos : 0 < (η / 2) ^ (p : ℝ) := real.rpow_pos_of_pos (half_pos η_pos') _,
  set V := U p c F (geom_B p c ((η / 2) ^ (p : ℝ)) η_pos) with hV,
  simp_rw [real.div_rpow (le_of_lt η_pos') (le_of_lt (@two_pos ℝ _ _))] at hV,
  use V,
  exact and.intro (U_subset_preimage p c ε η y F hF hη η_pos)
    (and.intro (is_open_U p c F _) (mem_U p c F _)),
end

end theta

end laurent_measures_ses


import tactic

variables {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]

-- I couldn't find this in mathlib

-- lemma alg_hom.eq_of_id (f : R →ₐ[R] A) : f = algebra.of_id R A :=
-- begin
--   have this_will_be_useful := f.commutes,
--   ext r,
--   specialize this_will_be_useful r,
--   unfold algebra_map algebra.to_ring_hom at this_will_be_useful,
--   exact this_will_be_useful,
-- end

lemma alg_hom.eq_of_id (f : R →ₐ[R] A) : f = algebra.of_id R A :=
alg_hom.ext (f.commutes)

instance alg_hom.subsingleton : subsingleton (R →ₐ[R] A) :=
subsingleton.intro $ λ f g, by { rw [alg_hom.eq_of_id f, alg_hom.eq_of_id g], }


import GroundZero.HITs.Interval
import GroundZero.Theorems.UA
import GroundZero.HITs.Merely

open GroundZero.HITs.Interval
open GroundZero.Proto (idfun)
open GroundZero.Types.Equiv
open GroundZero.Structures
open GroundZero.Types

namespace GroundZero
namespace Theorems.Equiv

universe u v w

hott def uniqDoesNotAddNewPaths {A : Type u} (a b : ∥A∥)
  (p : a = b) : HITs.Merely.uniq a b = p :=
propIsSet HITs.Merely.uniq _ _ _ _

hott def propEquiv {A : Type u} (H : prop A) : A ≃ ∥A∥ :=
propEquivLemma H HITs.Merely.uniq HITs.Merely.elem (HITs.Merely.rec H id)

hott def propFromEquiv {A : Type u} : A ≃ ∥A∥ → prop A :=
begin
  intro ⟨f, (⟨g, A⟩, _)⟩ a b; transitivity;
  exact (A a)⁻¹; symmetry; transitivity; exact (A b)⁻¹;
  apply Id.map g; exact HITs.Merely.uniq (f b) (f a)
end

hott def mapToHapply {A : Type u} {B : Type v}
  (c : A) (f g : A → B) (p : f = g) :
  Id.map (λ (f : A → B), f c) p = happly p c :=
begin induction p; reflexivity end

hott def hmtpyRewrite {A : Type u} (f : A → A) (H : f ~ id) (x : A) : H (f x) = Id.map f (H x) :=
begin have p := (Theorems.funext H)⁻¹; induction p; apply Id.symm; apply Equiv.idmap end

hott def qinvImplsIshae {A : Type u} {B : Type v} (f : A → B) : Qinv f → Ishae f :=
begin
  intro ⟨g, ⟨ε, η⟩⟩; let ε' := λ b, (ε (f (g b)))⁻¹ ⬝ (Id.map f (η (g b)) ⬝ ε b);
  existsi g; existsi η; existsi ε'; intro x; symmetry; transitivity;
  { apply Id.map (λ p, _ ⬝ (Id.map f p ⬝ _)); apply hmtpyRewrite (g ∘ f) };
  apply rewriteComp; transitivity; apply Id.map (· ⬝ _); symmetry; apply mapOverComp (g ∘ f);
  symmetry; apply @homotopySquare A B (f ∘ g ∘ f) f (λ x, ε (f x)) (g (f x)) x (η x)
end

hott def respectsEquivOverFst {A : Type u} {B : Type v}
  (φ : A ≃ B) (C : A → Type w) : (Σ x, C x) ≃ (Σ x, C (φ.left x)) :=
begin
  fapply Sigma.replaceIshae; apply qinvImplsIshae; existsi φ.1;
  apply Prod.mk; apply φ.leftForward; apply φ.forwardLeft
end

hott def fibEq {A : Type u} {B : Type v} (f : A → B) {y : B} {a b : A}
  (p : f a = y) (q : f b = y) : (Σ (γ : a = b), Id.map f γ ⬝ q = p) → @Id (fib f y) ⟨a, p⟩ ⟨b, q⟩ :=
begin
  intro ⟨γ, r⟩; fapply Sigma.prod; exact γ; transitivity; apply transportOverContrMap;
  transitivity; apply Id.map (· ⬝ p); apply Id.mapInv; apply rewriteComp; exact r⁻¹
end

hott def ishaeImplContrFib {A : Type u} {B : Type v}
  (f : A → B) : Ishae f → Π y, contr (fib f y) :=
begin
  intro ⟨g, η, ε, τ⟩ y; existsi ⟨g y, ε y⟩; intro ⟨x, p⟩; apply fibEq;
  existsi (Id.map g p)⁻¹ ⬝ η x; transitivity;
  apply Id.map (· ⬝ p); apply mapFunctoriality;
  transitivity; apply Id.map (_ ⬝ · ⬝ p); apply τ;
  transitivity; symmetry; apply Id.assoc; transitivity;
  { apply Id.map (· ⬝ _); transitivity; apply Id.mapInv;
    apply Id.map; symmetry; apply mapOverComp };
  apply rewriteComp; transitivity; apply Id.map (_ ⬝ ·);
  symmetry; apply idmap; apply homotopySquare
end

hott def compQinv₁ {A : Type u} {B : Type v} {C : Type w}
  (f : A → B) (g : B → A) (H : isQinv f g) :
  @Qinv (C → A) (C → B) (f ∘ ·) :=
begin
  existsi (g ∘ ·); apply Prod.mk <;> intro <;>
  apply Theorems.funext <;> intro; apply H.1; apply H.2
end

hott def compQinv₂ {A : Type u} {B : Type v} {C : Type w}
  (f : A → B) (g : B → A) (H : isQinv f g) :
  @Qinv (B → C) (A → C) (· ∘ f) :=
begin
  existsi (· ∘ g) <;> apply Prod.mk <;> intro G <;>
  apply Theorems.funext <;> intro <;>
  apply Id.map G; apply H.2; apply H.1
end

hott def linvContr {A : Type u} {B : Type v}
  (f : A → B) (H : Qinv f) : contr (linv f) :=
begin
  apply contrRespectsEquiv;
  { apply Equiv.symm; apply Sigma.respectsEquiv;
    intro g; symmetry; apply @Theorems.full A (λ _, A) (g ∘ f) };
  apply ishaeImplContrFib; apply qinvImplsIshae;
  fapply compQinv₂; exact H.1; exact H.2
end

hott def rinvContr {A : Type u} {B : Type v}
  (f : A → B) (H : Qinv f) : contr (rinv f) :=
begin
  apply contrRespectsEquiv;
  { apply Equiv.symm; apply Sigma.respectsEquiv;
    intro g; symmetry; apply @Theorems.full B (λ _, B) (f ∘ g) };
  apply ishaeImplContrFib; apply qinvImplsIshae;
  fapply compQinv₁; exact H.1; exact H.2
end

hott def productContr {A : Type u} {B : Type v} (h : contr A) (g : contr B) : contr (A × B) :=
begin existsi (h.1, g.1); intro p; fapply Product.prod; apply h.2; apply g.2 end

hott def biinvProp {A : Type u} {B : Type v} (f : A → B) : prop (biinv f) :=
begin
  apply lemContr; intro g; apply productContr;
  { apply linvContr; apply Qinv.ofBiinv; assumption };
  { apply rinvContr; apply Qinv.ofBiinv; assumption }
end

hott def equivHmtpyLem {A : Type u} {B : Type v}
  (f g : A ≃ B) (H : f.forward ~ g.forward) : f = g :=
begin fapply Sigma.prod; apply Theorems.funext; exact H; apply biinvProp end

hott def propEquivProp {A B : Type u} (G : prop B) : prop (A ≃ B) :=
begin intros f g; apply equivHmtpyLem; intro x; apply G end

hott def propExercise (π : Type u) : prop π ≃ (π ≃ ∥π∥) :=
begin
  existsi @propEquiv π; apply Prod.mk <;> existsi propFromEquiv;
  { intro x; apply propIsProp };
  { intro f; apply equivHmtpyLem;
    intro x; apply HITs.Merely.uniq }
end

hott def lemContrInv {A : Type u} (h : prop A) (x : A) : contr A := ⟨x, h x⟩

hott def lemContrEquiv {A : Type u} : (prop A) ≃ (A → contr A) :=
begin
  apply propEquivLemma; apply propIsProp; apply functionToContr;
  apply lemContrInv; apply lemContr
end

hott def contrToType {A : Type u} {B : A → Type v}
  (H : contr A) : (Σ x, B x) → B H.1 :=
λ w, subst (H.2 w.1)⁻¹ w.2

hott def typeToContr {A : Type u} {B : A → Type v}
  (H : contr A) : B H.1 → (Σ x, B x) :=
λ u, ⟨H.1, u⟩

-- HoTT 3.20
hott def contrFamily {A : Type u} {B : A → Type v} (H : contr A) : (Σ x, B x) ≃ B H.1 :=
begin
  existsi contrToType H; apply Prod.mk <;>
  existsi @typeToContr A B H <;> intro x;
  { fapply Sigma.prod; apply H.2; apply transportBackAndForward };
  { transitivity; apply Id.map (subst · x);
    apply propIsSet (contrImplProp H) _ _ _ (idp _);
    reflexivity }
end

hott def propset.Id (A B : Ω) (H : A.1 = B.1) : A = B :=
Sigma.prod H (propIsProp _ _)

noncomputable hott def propEqProp {A B : Type u} (G : prop B) : prop (A = B) :=
begin apply propRespectsEquiv; apply GroundZero.ua.univalence A B; apply propEquivProp G end

noncomputable hott def propsetIsSet : hset propset :=
begin
  intro ⟨x, H⟩ ⟨y, G⟩; apply transport (λ π, Π (p q : π), p = q);
  symmetry; apply GroundZero.ua; apply Sigma.sigmaPath;
  intro ⟨p, p'⟩ ⟨q, q'⟩; fapply Sigma.prod;
  { apply propEqProp; exact G };
  { apply propIsSet; apply propIsProp }
end

hott def hsetEquiv {A : Type u} {B : Type v} (g : hset B) : hset (A ≃ B) :=
begin
  fapply hsetRespectsSigma;
  { apply piHset; intro x; assumption };
  { intro x; apply propIsSet; apply biinvProp }
end

hott def bool.decode : 𝟐 ≃ 𝟐 → 𝟐 :=
λ e, e false

hott def bool.encode : 𝟐 → 𝟐 ≃ 𝟐
| false => ideqv 𝟐
| true  => ua.negBoolEquiv

hott def zeroEquiv.hset (A B : 0-Type) : hset (A ≃₀ B) :=
begin apply hsetEquiv; apply zeroEqvSet.forward; exact B.2 end

hott def boolEquivEqvBool : (𝟐 ≃ 𝟐) ≃ 𝟐 :=
begin
  existsi bool.decode; fapply Qinv.toBiinv; existsi bool.encode; apply Prod.mk;
  { intro x; induction x using Bool.casesOn <;> reflexivity };
  { intro ⟨φ, H⟩; apply equivHmtpyLem; intro x;
    match boolEqTotal (φ false), boolEqTotal (φ true) with
    | Sum.inl p₁, Sum.inl q₁ => _
    | Sum.inr p₂, Sum.inl q₁ => _
    | Sum.inl p₁, Sum.inr q₂ => _
    | Sum.inr p₂, Sum.inr q₂ => _;
    -- TODO: apply “or” here somehow
    { apply Proto.Empty.elim; apply ffNeqTt;
      apply eqvInj ⟨φ, H⟩; exact p₁ ⬝ q₁⁻¹ };
    { apply Id.trans; apply Id.map (bool.encode · x); apply p₂;
      symmetry; induction x using Bool.casesOn <;> assumption };
    { apply Id.trans; apply Id.map (bool.encode · x); apply p₁;
      symmetry; induction x using Bool.casesOn <;> assumption };
    { apply Proto.Empty.elim; apply ffNeqTt;
      apply eqvInj ⟨φ, H⟩; exact p₂ ⬝ q₂⁻¹ } }
end

hott def contrQinvFib {A : Type u} {B : Type v} (w : Qinv.eqv A B) (b : B) : contr (Σ a, b = w.1 a) :=
begin apply contrRespectsEquiv; apply respectsEquivOverFst (Qinv.toEquiv (Qinv.inv w)) (Id b); apply singl.contr end

hott def propQinvFib {A : Type u} {B : Type v} (w : Qinv.eqv A B) (b : B) : prop (Σ a, b = w.1 a) :=
contrImplProp (contrQinvFib w b)

hott def corrRev {A : Type u} {B : Type v} : Corr A B → Corr B A :=
λ w, ⟨λ a b, w.1 b a, (w.2.2, w.2.1)⟩

hott def corrOfQinv {A : Type u} {B : Type v} : Qinv.eqv A B → Corr A B :=
begin
  intro w; existsi (λ a b, b = w.1 a); apply Prod.mk <;> intros;
  apply contrRespectsEquiv; apply Sigma.hmtpyInvEqv; apply singl.contr;
  apply contrQinvFib
end

hott def qinvOfCorr {A : Type u} {B : Type v} : Corr A B → Qinv.eqv A B :=
begin
  intro w; fapply Sigma.mk; intro a; apply (w.2.1 a).1.1;
  fapply Sigma.mk; intro b; apply (w.2.2 b).1.1; apply Prod.mk;
  { intro b; apply Id.map Sigma.fst ((w.2.1 (w.2.2 b).1.1).2 ⟨b, (w.2.2 b).1.2⟩) };
  { intro a; apply Id.map Sigma.fst ((w.2.2 (w.2.1 a).1.1).2 ⟨a, (w.2.1 a).1.2⟩) }
end

section
  variable {A : Type u} {B : Type v} (e : Qinv.eqv A B)

  example : (qinvOfCorr (corrOfQinv e)).1 = e.1     := by reflexivity
  example : (qinvOfCorr (corrOfQinv e)).2.1 = e.2.1 := by reflexivity
end

section
  variable {A : Type u} {B : Type v}

  hott def corrOfBiinv : A ≃ B → Corr A B :=
  λ e, @corrOfQinv A B ⟨e.1, Qinv.ofBiinv e.1 e.2⟩

  hott def biinvOfCorr : Corr A B → A ≃ B :=
  Qinv.toEquiv ∘ qinvOfCorr

  hott def corrLem (R : A → B → Type w) (φ : A → B) (ρ : Π x, R x (φ x))
    (H : Π x y, R x y → φ x = y) (c : Π (x : A) (y : B) (w : R x y), ρ x =[H x y w] w)
    (x : A) (y : B) : (φ x = y) ≃ (R x y) :=
  begin
    fapply Sigma.mk; { intro p; apply transport (R x) p; apply ρ }; fapply Qinv.toBiinv;
    fapply Sigma.mk; intro r; exact (H x (φ x) (ρ x))⁻¹ ⬝ H x y r; apply Prod.mk;
    { intro r; dsimp; transitivity; apply Id.map; symmetry; apply c x (φ x) (ρ x);
      transitivity; apply substComp; transitivity; apply Id.map (subst (H x y r));
      apply transportForwardAndBack; apply c };
    { intro p; induction p; apply Id.invComp }
  end

  noncomputable hott def corrBiinvIdfun : corrOfBiinv ∘ @biinvOfCorr A B ~ idfun :=
  begin
    intro w; fapply Sigma.prod;
    apply Theorems.funext; intro x; apply Theorems.funext; intro y;
    change (y = (w.2.1 x).1.1) = (w.1 x y); apply ua; apply Equiv.trans;
    apply inveqv; fapply corrLem w.1 (λ x, (w.2.1 x).1.1) (λ x, (w.2.1 x).1.2)
      (λ x y ρ, Id.map Sigma.fst ((w.2.1 x).2 ⟨y, ρ⟩));
    { intros x y ρ; change _ = _; transitivity; symmetry;
      apply transportComp (w.1 x) Sigma.fst ((w.2.1 x).2 ⟨y, ρ⟩);
      apply apd Sigma.snd };
    apply productProp <;> { apply piProp; intros; apply contrIsProp }
  end

  hott def biinvCorrIdfun : biinvOfCorr ∘ @corrOfBiinv A B ~ idfun :=
  begin intro e; fapply equivHmtpyLem; intro; reflexivity end

  noncomputable hott def biinvEquivCorr : Corr A B ≃ (A ≃ B) :=
  begin
    existsi biinvOfCorr; fapply Qinv.toBiinv; existsi corrOfBiinv;
    apply Prod.mk; apply biinvCorrIdfun; apply corrBiinvIdfun
  end
end

end Theorems.Equiv
end GroundZero


-- See: https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/OO.20polymorphism.3F/near/297629381
namespace O4

inductive Geo_Type
| Point2D
| Point3D
| Point4D
| Square2D
deriving DecidableEq

open Geo_Type

structure Slots_Point2D where
  (x y : Float)
  deriving Repr

structure Slots_Point3D extends Slots_Point2D where
  z : Float
  deriving Repr

structure Slots_Point4D extends Slots_Point3D where
  w : Float
  deriving Repr

structure Slots_Square2D extends Slots_Point2D where
  width : Float
  deriving Repr

universe u

def Geo_Type.Slots : Geo_Type → Type
| Point2D => Slots_Point2D
| Point3D => Slots_Point3D
| Point4D => Slots_Point4D
| Square2D => Slots_Square2D

open Geo_Type

def toRepr : (T : Geo_Type) → Repr T.Slots
| Point2D => instReprSlots_Point2D
| Point3D => instReprSlots_Point3D
| Point4D => instReprSlots_Point4D
| Square2D => instReprSlots_Square2D

/-- Get casting function to first type from second type -/
def Geo_Type.cast : (t : Geo_Type) → (t' : Geo_Type) → Option (t'.Slots → t.Slots)
| Point2D, Point2D => some id
| Point2D, Point3D => some (λ x => x.toSlots_Point2D)
| Point3D, Point3D => some id
| Point2D, Point4D => some (λ x => x.toSlots_Point2D)
| Point3D, Point4D => some (λ x => x.toSlots_Point3D)
| Point4D, Point4D => some id
| Point2D, Square2D => some (λ x => x.toSlots_Point2D)
| Square2D, Square2D => some id
| _, _ => none

/-- Whether the second type is a subtype of the first. -/
def Geo_Type.supertype (t t' : Geo_Type) : Bool := (t.cast t').isSome

theorem Geo_Type.supertype.trans (h : Geo_Type.supertype t t') (h' : Geo_Type.supertype t' t'') :
  Geo_Type.supertype t t'' :=
by
  cases t
  all_goals
    cases t'
    all_goals
      cases t''
      all_goals
        simp at h
        try simp at h'
        try simp

def Option.get : (x : Option α) → x.isSome → α
| some v, _ => v
| none, h => by simp [Option.isSome] at h

/-- Get the cast function from a proof that `t'` is a subtype of `t`. -/
def Geo_Type.supertype.cast (h : Geo_Type.supertype t t') : t'.Slots → t.Slots :=
  Option.get (Geo_Type.cast t t') h

/-- Objects of subtype t -/
structure Obj (t : Geo_Type) where
  ty : Geo_Type
  sub : Geo_Type.supertype t ty
  slots : ty.Slots

instance : Coe Slots_Point2D (Obj Point2D) where coe s := ⟨Point2D, rfl, s⟩
instance : Coe Slots_Point3D (Obj Point3D) where coe s := ⟨Point3D, rfl, s⟩
instance : Coe Slots_Point4D (Obj Point4D) where coe s := ⟨Point4D, rfl, s⟩
instance : Coe Slots_Square2D (Obj Square2D) where coe s := ⟨Square2D, rfl, s⟩

/-- Extract the slots from an `Obj`. -/
def Obj.get (o : Obj t) : t.Slots := Geo_Type.supertype.cast o.sub o.slots

/-- Cast up, which can be done statically. -/
def Obj.cast_up (o : Obj t) (h : Geo_Type.supertype t' t := by rfl) : Obj t' where
  ty := o.ty
  sub := Geo_Type.supertype.trans h o.sub
  slots := o.slots

def Obj.can_cast (o : Obj t) (t' : Geo_Type) : Bool := Geo_Type.supertype t' o.ty

/-- Cast up or down using run-time information. -/
def Obj.cast (o : Obj t) (h : o.can_cast t') : Obj t' where
  ty := o.ty
  sub := h
  slots := o.slots

/-- Example using a run-time cast. -/
def Obj.get_w (o : Obj Point2D) : Float :=
  if h : o.can_cast Point4D then
    (o.cast h).get.w
  else
    0

#eval ({x := 1, y := 2 : Slots_Point2D} : Obj Point2D).get_w
-- 0.000000

#eval Id.run do
  let p := ({x := 1, y := 2, z := 3, w := 4 : Slots_Point4D} : Obj Point4D)
  return p.cast_up.get_w
-- 4.000000

def s2: Slots_Point2D := {x := 1, y := 2}
#eval s2

def o2: Obj Point2D := s2
#eval o2.slots

end O4


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

# Preorder homomorphisms

Bundled monotone functions, `x ≤ y → f x ≤ f y`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.function.iterate
import Mathlib.order.basic
import Mathlib.order.bounded_lattice
import Mathlib.order.complete_lattice
import Mathlib.tactic.monotonicity.default
import Mathlib.PostPort

universes u_1 u_2 l u_3

namespace Mathlib

/-! # Category of preorders -/

/-- Bundled monotone (aka, increasing) function -/
structure preorder_hom (α : Type u_1) (β : Type u_2) [preorder α] [preorder β] where
  to_fun : α → β
  monotone' : monotone to_fun

infixr:25 " →ₘ " => Mathlib.preorder_hom

namespace preorder_hom

protected instance has_coe_to_fun {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] :
    has_coe_to_fun (α →ₘ β) :=
  has_coe_to_fun.mk (fun (f : α →ₘ β) => α → β) to_fun

theorem monotone {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) :
    monotone ⇑f :=
  monotone' f

@[simp] theorem coe_fun_mk {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] {f : α → β}
    (hf : monotone f) (x : α) : coe_fn (mk f hf) x = f x :=
  rfl

theorem ext {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) (g : α →ₘ β)
    (h : ∀ (a : α), coe_fn f a = coe_fn g a) : f = g :=
  sorry

theorem coe_inj {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) (g : α →ₘ β)
    (h : ⇑f = ⇑g) : f = g :=
  ext f g
    fun (a : α) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f a = coe_fn g a)) h)) (Eq.refl (coe_fn g a))

/-- The identity function as bundled monotone function. -/
def id {α : Type u_1} [preorder α] : α →ₘ α := mk id monotone_id

protected instance inhabited {α : Type u_1} [preorder α] : Inhabited (α →ₘ α) := { default := id }

@[simp] theorem coe_id {α : Type u_1} [preorder α] : ⇑id = ⇑id := rfl

/-- The composition of two bundled monotone functions. -/
def comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [preorder α] [preorder β] [preorder γ]
    (g : β →ₘ γ) (f : α →ₘ β) : α →ₘ γ :=
  mk (⇑g ∘ ⇑f) sorry

@[simp] theorem comp_id {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) :
    comp f id = f :=
  ext (comp f id) f fun (a : α) => Eq.refl (coe_fn (comp f id) a)

@[simp] theorem id_comp {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) :
    comp id f = f :=
  ext (comp id f) f fun (a : α) => Eq.refl (coe_fn (comp id f) a)

/-- `subtype.val` as a bundled monotone function.  -/
def subtype.val {α : Type u_1} [preorder α] (p : α → Prop) : Subtype p →ₘ α := mk subtype.val sorry

/-- The preorder structure of `α →ₘ β` is pointwise inequality: `f ≤ g ↔ ∀ a, f a ≤ g a`. -/
protected instance preorder {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] :
    preorder (α →ₘ β) :=
  preorder.lift to_fun

protected instance partial_order {α : Type u_1} [preorder α] {β : Type u_2} [partial_order β] :
    partial_order (α →ₘ β) :=
  partial_order.lift to_fun sorry

protected instance has_sup {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_sup β] :
    has_sup (α →ₘ β) :=
  has_sup.mk fun (f g : α →ₘ β) => mk (fun (a : α) => coe_fn f a ⊔ coe_fn g a) sorry

protected instance semilattice_sup {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_sup β] :
    semilattice_sup (α →ₘ β) :=
  semilattice_sup.mk has_sup.sup partial_order.le partial_order.lt sorry sorry sorry sorry sorry
    sorry

@[simp] theorem has_inf_inf_to_fun {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_inf β]
    (f : α →ₘ β) (g : α →ₘ β) (a : α) : coe_fn (f ⊓ g) a = coe_fn f a ⊓ coe_fn g a :=
  Eq.refl (coe_fn (f ⊓ g) a)

protected instance semilattice_inf {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_inf β] :
    semilattice_inf (α →ₘ β) :=
  semilattice_inf.mk has_inf.inf partial_order.le partial_order.lt sorry sorry sorry sorry sorry
    sorry

protected instance lattice {α : Type u_1} [preorder α] {β : Type u_2} [lattice β] :
    lattice (α →ₘ β) :=
  lattice.mk semilattice_sup.sup semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf.inf sorry sorry sorry

protected instance has_bot {α : Type u_1} [preorder α] {β : Type u_2} [order_bot β] :
    has_bot (α →ₘ β) :=
  has_bot.mk (mk (fun (a : α) => ⊥) sorry)

protected instance order_bot {α : Type u_1} [preorder α] {β : Type u_2} [order_bot β] :
    order_bot (α →ₘ β) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

@[simp] theorem has_top_top_to_fun {α : Type u_1} [preorder α] {β : Type u_2} [order_top β]
    (a : α) : coe_fn ⊤ a = ⊤ :=
  Eq.refl (coe_fn ⊤ a)

protected instance order_top {α : Type u_1} [preorder α] {β : Type u_2} [order_top β] :
    order_top (α →ₘ β) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance has_Inf {α : Type u_1} [preorder α] {β : Type u_2} [complete_lattice β] :
    has_Inf (α →ₘ β) :=
  has_Inf.mk
    fun (s : set (α →ₘ β)) => mk (fun (x : α) => Inf ((fun (f : α →ₘ β) => coe_fn f x) '' s)) sorry

@[simp] theorem has_Sup_Sup_to_fun {α : Type u_1} [preorder α] {β : Type u_2} [complete_lattice β]
    (s : set (α →ₘ β)) (x : α) : coe_fn (Sup s) x = Sup ((fun (f : α →ₘ β) => coe_fn f x) '' s) :=
  Eq.refl (coe_fn (Sup s) x)

protected instance complete_lattice {α : Type u_1} [preorder α] {β : Type u_2}
    [complete_lattice β] : complete_lattice (α →ₘ β) :=
  complete_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry Sup Inf sorry sorry sorry
    sorry

theorem iterate_sup_le_sup_iff {α : Type u_1} [semilattice_sup α] (f : α →ₘ α) :
    (∀ (n₁ n₂ : ℕ) (a₁ a₂ : α),
          nat.iterate (⇑f) (n₁ + n₂) (a₁ ⊔ a₂) ≤ nat.iterate (⇑f) n₁ a₁ ⊔ nat.iterate (⇑f) n₂ a₂) ↔
        ∀ (a₁ a₂ : α), coe_fn f (a₁ ⊔ a₂) ≤ coe_fn f a₁ ⊔ a₂ :=
  sorry

end Mathlib


class Inc (α : Type) :=
(inc : α → α)

export Inc (inc)

instance {α} [Inc α] : Inc (List α) :=
{ inc := (·.map inc) }

instance : Inc Nat :=
{ inc := Nat.succ }

#eval inc 10
#eval inc [1, 2, 3]

theorem ex1 : [(1, "hello"), (2, "world")].map (·.1) = [1, 2] :=
rfl

theorem ex2 : [(1, "hello"), (2, "world")].map (·.snd) = ["hello", "world"] :=
rfl

def sum (xs : List Nat) : Nat :=
(·.2) $ Id.run $ StateT.run (s:=0) do
  xs.forM fun x => modify (· + x)

#eval sum [1, 2, 3, 4]

theorem ex3 : sum [1, 2, 3] = 6 :=
rfl

theorem ex4 : sum [1, 2, 3, 4] = 10 :=
rfl


example (p : Prop) [Decidable p] (hnp : ¬ p) :
    if decide p then 0 = 1 else 1 = 1 := by
  simp [hnp, decideEqFalse Unit]


example (b : let n : Nat := 2; (n = 13)) : Bool := by
  simp_all

example (b : let n : Nat := 2; (n = 13)) : n + 1 = 14 := by
  simp_all


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot

! This file was ported from Lean 3 source module tactic.rename_var
! leanprover-community/mathlib commit 591a0a006de5e8fe75b1c55258123d91dd416b2d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Interactive

/-!
# Rename bound variable tactic

This files defines a tactic `rename_var` whose main purpose is to teach
renaming of bound variables.

* `rename_var old new` renames all bound variables named `old` to `new` in the goal.
* `rename_var old new at h` does the same in hypothesis `h`.

```lean
example (P : ℕ →  ℕ → Prop) (h : ∀ n, ∃ m, P n m) : ∀ l, ∃ m, P l m :=
begin
  rename_var n q at h, -- h is now ∀ (q : ℕ), ∃ (m : ℕ), P q m,
  rename_var m n, -- goal is now ∀ (l : ℕ), ∃ (n : ℕ), P k n,
  exact h -- Lean does not care about those bound variable names
end
```

## Tags

teaching, tactic
-/

open Expr

/-- Rename bound variable `old` to `new` in an `expr`-/
unsafe def expr.rename_var (old new : Name) : expr → expr
  | pi n bi t b => pi (if n = old then new else n) bi (expr.rename_var t) (expr.rename_var b)
  | lam n bi t b => lam (if n = old then new else n) bi (expr.rename_var t) (expr.rename_var b)
  | app t b => app (expr.rename_var t) (expr.rename_var b)
  | e => e
#align expr.rename_var expr.rename_var

namespace Tactic

/-- Rename bound variable `old` to `new` in goal -/
unsafe def rename_var_at_goal (old new : Name) : tactic Unit := do
  let old_tgt ← target
  tactic.change (expr.rename_var old new old_tgt)
#align tactic.rename_var_at_goal tactic.rename_var_at_goal

/-- Rename bound variable `old` to `new` in assumption `h` -/
unsafe def rename_var_at_hyp (old new : Name) (e : expr) : tactic Unit := do
  let old_e ← infer_type e
  tactic.change_core (expr.rename_var old new old_e) (some e)
#align tactic.rename_var_at_hyp tactic.rename_var_at_hyp

end Tactic

namespace Tactic.Interactive

open Tactic

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- `rename_var old new` renames all bound variables named `old` to `new` in the goal.
`rename_var old new at h` does the same in hypothesis `h`.
-/
unsafe def rename_var (old : parse ident) (new : parse ident) (l : parse location) : tactic Unit :=
  l.apply (rename_var_at_hyp old new) (rename_var_at_goal old new)
#align tactic.interactive.rename_var tactic.interactive.rename_var

end Tactic.Interactive

/-- `rename_var old new` renames all bound variables named `old` to `new` in the goal.
`rename_var old new at h` does the same in hypothesis `h`.
This is meant for teaching bound variables only. Such a renaming should never be relevant to Lean.

```lean
example (P : ℕ →  ℕ → Prop) (h : ∀ n, ∃ m, P n m) : ∀ l, ∃ m, P l m :=
begin
  rename_var n q at h, -- h is now ∀ (q : ℕ), ∃ (m : ℕ), P q m,
  rename_var m n, -- goal is now ∀ (l : ℕ), ∃ (n : ℕ), P k n,
  exact h -- Lean does not care about those bound variable names
end
```
-/
add_tactic_doc
  { Name := "rename_var"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.rename_var]
    tags := ["renaming"] }


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.mul_add
import Mathlib.algebra.field
import Mathlib.algebra.opposites
import Mathlib.PostPort

universes u_4 u_5 l u_1 u_2 u_3

namespace Mathlib

/-!
# (Semi)ring equivs

In this file we define extension of `equiv` called `ring_equiv`, which is a datatype representing an
isomorphism of `semiring`s, `ring`s, `division_ring`s, or `field`s. We also introduce the
corresponding group of automorphisms `ring_aut`.

## Notations

The extended equiv have coercions to functions, and the coercion is the canonical notation when
treating the isomorphism as maps.

## Implementation notes

The fields for `ring_equiv` now avoid the unbundled `is_mul_hom` and `is_add_hom`, as these are
deprecated.

Definition of multiplication in the groups of automorphisms agrees with function composition,
multiplication in `equiv.perm`, and multiplication in `category_theory.End`, not with
`category_theory.comp`.

## Tags

equiv, mul_equiv, add_equiv, ring_equiv, mul_aut, add_aut, ring_aut
-/

/-- An equivalence between two (semi)rings that preserves the algebraic structure. -/
structure ring_equiv (R : Type u_4) (S : Type u_5) [Mul R] [Add R] [Mul S] [Add S]
extends R ≃* S, R ≃ S, R ≃+ S
where

infixl:25 " ≃+* " => Mathlib.ring_equiv

/-- The "plain" equivalence of types underlying an equivalence of (semi)rings. -/
/-- The equivalence of additive monoids underlying an equivalence of (semi)rings. -/
/-- The equivalence of multiplicative monoids underlying an equivalence of (semi)rings. -/
namespace ring_equiv

protected instance has_coe_to_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] : has_coe_to_fun (R ≃+* S) :=
  has_coe_to_fun.mk (fun (x : R ≃+* S) => R → S) to_fun

@[simp] theorem to_fun_eq_coe_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R ≃+* S) : to_fun f = ⇑f :=
  rfl

/-- A ring isomorphism preserves multiplication. -/
@[simp] theorem map_mul {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : R) (y : R) : coe_fn e (x * y) = coe_fn e x * coe_fn e y :=
  map_mul' e x y

/-- A ring isomorphism preserves addition. -/
@[simp] theorem map_add {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : R) (y : R) : coe_fn e (x + y) = coe_fn e x + coe_fn e y :=
  map_add' e x y

/-- Two ring isomorphisms agree if they are defined by the
    same underlying function. -/
theorem ext {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {g : R ≃+* S} (h : ∀ (x : R), coe_fn f x = coe_fn g x) : f = g := sorry

protected theorem congr_arg {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {x : R} {x' : R} : x = x' → coe_fn f x = coe_fn f x' := sorry

protected theorem congr_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {g : R ≃+* S} (h : f = g) (x : R) : coe_fn f x = coe_fn g x :=
  h ▸ rfl

theorem ext_iff {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {g : R ≃+* S} : f = g ↔ ∀ (x : R), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : R) => h ▸ rfl, mpr := ext }

protected instance has_coe_to_mul_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] : has_coe (R ≃+* S) (R ≃* S) :=
  has_coe.mk to_mul_equiv

protected instance has_coe_to_add_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] : has_coe (R ≃+* S) (R ≃+ S) :=
  has_coe.mk to_add_equiv

theorem coe_mul_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R ≃+* S) (a : R) : coe_fn (↑f) a = coe_fn f a :=
  rfl

theorem coe_add_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R ≃+* S) (a : R) : coe_fn (↑f) a = coe_fn f a :=
  rfl

/-- The identity map is a ring isomorphism. -/
protected def refl (R : Type u_1) [Mul R] [Add R] : R ≃+* R :=
  mk (mul_equiv.to_fun (mul_equiv.refl R)) (mul_equiv.inv_fun (mul_equiv.refl R)) sorry sorry sorry sorry

@[simp] theorem refl_apply (R : Type u_1) [Mul R] [Add R] (x : R) : coe_fn (ring_equiv.refl R) x = x :=
  rfl

@[simp] theorem coe_add_equiv_refl (R : Type u_1) [Mul R] [Add R] : ↑(ring_equiv.refl R) = add_equiv.refl R :=
  rfl

@[simp] theorem coe_mul_equiv_refl (R : Type u_1) [Mul R] [Add R] : ↑(ring_equiv.refl R) = mul_equiv.refl R :=
  rfl

protected instance inhabited (R : Type u_1) [Mul R] [Add R] : Inhabited (R ≃+* R) :=
  { default := ring_equiv.refl R }

/-- The inverse of a ring isomorphism is a ring isomorphism. -/
protected def symm {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : S ≃+* R :=
  mk (mul_equiv.to_fun (mul_equiv.symm (to_mul_equiv e))) (mul_equiv.inv_fun (mul_equiv.symm (to_mul_equiv e))) sorry
    sorry sorry sorry

/-- See Note [custom simps projection] -/
def simps.inv_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : S → R :=
  ⇑(ring_equiv.symm e)

@[simp] theorem symm_symm {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : ring_equiv.symm (ring_equiv.symm e) = e :=
  ext fun (x : R) => rfl

@[simp] theorem coe_symm_mk {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R → S) (g : S → R) (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) (h₃ : ∀ (x y : R), f (x * y) = f x * f y) (h₄ : ∀ (x y : R), f (x + y) = f x + f y) : ⇑(ring_equiv.symm (mk f g h₁ h₂ h₃ h₄)) = g :=
  rfl

/-- Transitivity of `ring_equiv`. -/
protected def trans {R : Type u_1} {S : Type u_2} {S' : Type u_3} [Mul R] [Add R] [Mul S] [Add S] [Mul S'] [Add S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') : R ≃+* S' :=
  mk (mul_equiv.to_fun (mul_equiv.trans (to_mul_equiv e₁) (to_mul_equiv e₂)))
    (mul_equiv.inv_fun (mul_equiv.trans (to_mul_equiv e₁) (to_mul_equiv e₂))) sorry sorry sorry sorry

@[simp] theorem trans_apply {A : Type u_1} {B : Type u_2} {C : Type u_3} [semiring A] [semiring B] [semiring C] (e : A ≃+* B) (f : B ≃+* C) (a : A) : coe_fn (ring_equiv.trans e f) a = coe_fn f (coe_fn e a) :=
  rfl

protected theorem bijective {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : function.bijective ⇑e :=
  equiv.bijective (to_equiv e)

protected theorem injective {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : function.injective ⇑e :=
  equiv.injective (to_equiv e)

protected theorem surjective {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : function.surjective ⇑e :=
  equiv.surjective (to_equiv e)

@[simp] theorem apply_symm_apply {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : S) : coe_fn e (coe_fn (ring_equiv.symm e) x) = x :=
  equiv.apply_symm_apply (to_equiv e)

@[simp] theorem symm_apply_apply {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : R) : coe_fn (ring_equiv.symm e) (coe_fn e x) = x :=
  equiv.symm_apply_apply (to_equiv e)

theorem image_eq_preimage {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (s : set R) : ⇑e '' s = ⇑(ring_equiv.symm e) ⁻¹' s :=
  equiv.image_eq_preimage (to_equiv e) s

/-- A commutative ring is isomorphic to its opposite. -/
def to_opposite (R : Type u_1) [comm_semiring R] : R ≃+* (Rᵒᵖ) :=
  mk (equiv.to_fun opposite.equiv_to_opposite) (equiv.inv_fun opposite.equiv_to_opposite) sorry sorry sorry sorry

@[simp] theorem to_opposite_apply (R : Type u_1) [comm_semiring R] (r : R) : coe_fn (to_opposite R) r = opposite.op r :=
  rfl

@[simp] theorem to_opposite_symm_apply (R : Type u_1) [comm_semiring R] (r : Rᵒᵖ) : coe_fn (ring_equiv.symm (to_opposite R)) r = opposite.unop r :=
  rfl

/-- A ring isomorphism sends one to one. -/
@[simp] theorem map_one {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) : coe_fn f 1 = 1 :=
  mul_equiv.map_one ↑f

/-- A ring isomorphism sends zero to zero. -/
@[simp] theorem map_zero {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) : coe_fn f 0 = 0 :=
  add_equiv.map_zero ↑f

@[simp] theorem map_eq_one_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x = 1 ↔ x = 1 :=
  mul_equiv.map_eq_one_iff ↑f

@[simp] theorem map_eq_zero_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x = 0 ↔ x = 0 :=
  add_equiv.map_eq_zero_iff ↑f

theorem map_ne_one_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x ≠ 1 ↔ x ≠ 1 :=
  mul_equiv.map_ne_one_iff ↑f

theorem map_ne_zero_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x ≠ 0 ↔ x ≠ 0 :=
  add_equiv.map_ne_zero_iff ↑f

/-- Produce a ring isomorphism from a bijective ring homomorphism. -/
def of_bijective {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R →+* S) (hf : function.bijective ⇑f) : R ≃+* S :=
  mk (equiv.to_fun (equiv.of_bijective (⇑f) hf)) (equiv.inv_fun (equiv.of_bijective (⇑f) hf)) sorry sorry
    (ring_hom.map_mul' f) (ring_hom.map_add' f)

@[simp] theorem map_neg {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R ≃+* S) (x : R) : coe_fn f (-x) = -coe_fn f x :=
  add_equiv.map_neg (↑f) x

@[simp] theorem map_sub {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R ≃+* S) (x : R) (y : R) : coe_fn f (x - y) = coe_fn f x - coe_fn f y :=
  add_equiv.map_sub (↑f) x y

@[simp] theorem map_neg_one {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R ≃+* S) : coe_fn f (-1) = -1 :=
  map_one f ▸ map_neg f 1

/-- Reinterpret a ring equivalence as a ring homomorphism. -/
def to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : R →+* S :=
  ring_hom.mk (monoid_hom.to_fun (mul_equiv.to_monoid_hom (to_mul_equiv e))) sorry sorry sorry sorry

theorem to_ring_hom_injective {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] : function.injective to_ring_hom :=
  fun (f g : R ≃+* S) (h : to_ring_hom f = to_ring_hom g) => ext (iff.mp ring_hom.ext_iff h)

protected instance has_coe_to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] : has_coe (R ≃+* S) (R →+* S) :=
  has_coe.mk to_ring_hom

theorem coe_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) (a : R) : coe_fn (↑f) a = coe_fn f a :=
  rfl

theorem coe_ring_hom_inj_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) (g : R ≃+* S) : f = g ↔ ↑f = ↑g :=
  { mp := congr_arg fun (f : R ≃+* S) => ↑f, mpr := fun (h : ↑f = ↑g) => ext (iff.mp ring_hom.ext_iff h) }

/-- Reinterpret a ring equivalence as a monoid homomorphism. -/
def to_monoid_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : R →* S :=
  ring_hom.to_monoid_hom (to_ring_hom e)

/-- Reinterpret a ring equivalence as an `add_monoid` homomorphism. -/
def to_add_monoid_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : R →+ S :=
  ring_hom.to_add_monoid_hom (to_ring_hom e)

@[simp] theorem to_ring_hom_refl {R : Type u_1} [semiring R] : to_ring_hom (ring_equiv.refl R) = ring_hom.id R :=
  rfl

@[simp] theorem to_monoid_hom_refl {R : Type u_1} [semiring R] : to_monoid_hom (ring_equiv.refl R) = monoid_hom.id R :=
  rfl

@[simp] theorem to_add_monoid_hom_refl {R : Type u_1} [semiring R] : to_add_monoid_hom (ring_equiv.refl R) = add_monoid_hom.id R :=
  rfl

@[simp] theorem to_ring_hom_apply_symm_to_ring_hom_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) (y : S) : coe_fn (to_ring_hom e) (coe_fn (to_ring_hom (ring_equiv.symm e)) y) = y :=
  equiv.apply_symm_apply (to_equiv e)

@[simp] theorem symm_to_ring_hom_apply_to_ring_hom_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) (x : R) : coe_fn (to_ring_hom (ring_equiv.symm e)) (coe_fn (to_ring_hom e) x) = x :=
  equiv.symm_apply_apply (to_equiv e)

@[simp] theorem to_ring_hom_trans {R : Type u_1} {S : Type u_2} {S' : Type u_3} [semiring R] [semiring S] [semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') : to_ring_hom (ring_equiv.trans e₁ e₂) = ring_hom.comp (to_ring_hom e₂) (to_ring_hom e₁) :=
  rfl

@[simp] theorem to_ring_hom_comp_symm_to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : ring_hom.comp (to_ring_hom e) (to_ring_hom (ring_equiv.symm e)) = ring_hom.id S := sorry

@[simp] theorem symm_to_ring_hom_comp_to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : ring_hom.comp (to_ring_hom (ring_equiv.symm e)) (to_ring_hom e) = ring_hom.id R := sorry

/--
Construct an equivalence of rings from homomorphisms in both directions, which are inverses.
-/
def of_hom_inv {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (hom : R →+* S) (inv : S →+* R) (hom_inv_id : ring_hom.comp inv hom = ring_hom.id R) (inv_hom_id : ring_hom.comp hom inv = ring_hom.id S) : R ≃+* S :=
  mk (ring_hom.to_fun hom) ⇑inv sorry sorry (ring_hom.map_mul' hom) (ring_hom.map_add' hom)

@[simp] theorem of_hom_inv_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (hom : R →+* S) (inv : S →+* R) (hom_inv_id : ring_hom.comp inv hom = ring_hom.id R) (inv_hom_id : ring_hom.comp hom inv = ring_hom.id S) (r : R) : coe_fn (of_hom_inv hom inv hom_inv_id inv_hom_id) r = coe_fn hom r :=
  rfl

@[simp] theorem of_hom_inv_symm_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (hom : R →+* S) (inv : S →+* R) (hom_inv_id : ring_hom.comp inv hom = ring_hom.id R) (inv_hom_id : ring_hom.comp hom inv = ring_hom.id S) (s : S) : coe_fn (ring_equiv.symm (of_hom_inv hom inv hom_inv_id inv_hom_id)) s = coe_fn inv s :=
  rfl

end ring_equiv

namespace mul_equiv

/-- Gives a `ring_equiv` from a `mul_equiv` preserving addition.-/
def to_ring_equiv {R : Type u_1} {S : Type u_2} [Add R] [Add S] [Mul R] [Mul S] (h : R ≃* S) (H : ∀ (x y : R), coe_fn h (x + y) = coe_fn h x + coe_fn h y) : R ≃+* S :=
  ring_equiv.mk (equiv.to_fun (to_equiv h)) (equiv.inv_fun (to_equiv h)) sorry sorry (map_mul' h) sorry

end mul_equiv

namespace ring_equiv

@[simp] theorem trans_symm {R : Type u_1} {S : Type u_2} [Add R] [Add S] [Mul R] [Mul S] (e : R ≃+* S) : ring_equiv.trans e (ring_equiv.symm e) = ring_equiv.refl R :=
  ext (left_inv e)

@[simp] theorem symm_trans {R : Type u_1} {S : Type u_2} [Add R] [Add S] [Mul R] [Mul S] (e : R ≃+* S) : ring_equiv.trans (ring_equiv.symm e) e = ring_equiv.refl S :=
  ext (right_inv e)

/-- If two rings are isomorphic, and the second is an integral domain, then so is the first. -/
protected theorem is_integral_domain {A : Type u_1} (B : Type u_2) [ring A] [ring B] (hB : is_integral_domain B) (e : A ≃+* B) : is_integral_domain A := sorry

/-- If two rings are isomorphic, and the second is an integral domain, then so is the first. -/
protected def integral_domain {A : Type u_1} (B : Type u_2) [ring A] [integral_domain B] (e : A ≃+* B) : integral_domain A :=
  integral_domain.mk ring.add ring.add_assoc ring.zero ring.zero_add ring.add_zero ring.neg ring.sub ring.add_left_neg
    ring.add_comm ring.mul ring.mul_assoc ring.one ring.one_mul ring.mul_one ring.left_distrib ring.right_distrib sorry
    sorry sorry

end ring_equiv

namespace equiv

/-- In a division ring `K`, the unit group `units K`
is equivalent to the subtype of nonzero elements. -/
-- TODO: this might already exist elsewhere for `group_with_zero`

-- deduplicate or generalize

def units_equiv_ne_zero (K : Type u_4) [division_ring K] : units K ≃ ↥(set_of fun (a : K) => a ≠ 0) :=
  mk (fun (a : units K) => { val := units.val a, property := sorry })
    (fun (a : ↥(set_of fun (a : K) => a ≠ 0)) => units.mk0 (subtype.val a) sorry) sorry sorry

@[simp] theorem coe_units_equiv_ne_zero {K : Type u_4} [division_ring K] (a : units K) : ↑(coe_fn (units_equiv_ne_zero K) a) = ↑a :=
  rfl


import Saturn.FinSeq
import Saturn.Vector
import Saturn.Clause
import Saturn.Solverstep
open Nat
open FinSeq

/-
The inductive step for adding a new clause when it should be dropped. The new clauses and maps
are defined. All the witnesses for the relations between the old and new clauses are also
constructed.
-/
def addPositiveClause{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
            ReductionClauses branch focus focusLt (head +: clauses) :=
          fun rc head pos =>
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          let forwardVecN := none +: rc.forwardVec
          let forwardN: (k : Nat) →  k < domN → Option Nat  :=
            fun k  =>
            match k with
            | zero => fun _ => none
            | l + 1 =>
              fun w : l + 1 < domN   =>  rc.forward l (le_of_succ_le_succ w)
          have forwardNEq : forwardVecN.coords = forwardN := by
                  apply funext
                  intro j
                  cases j with
                  | zero =>
                    apply funext
                    intro jw
                    rfl
                  | succ i =>
                    apply funext
                    intro jw
                    have tl :forwardVecN.coords (succ i) jw =
                        forwardVecN.coords.tail i (Nat.le_of_succ_le_succ jw) := by rfl
                    rw [tl]
                    rw [tail_commutes none rc.forwardVec]
          have forwardWitN : (k: Nat) → (w: k < domN) → boundOpt codomN (forwardN k w) :=
            fun k  =>
            match k with
            | zero => fun w =>
              let resolve : forwardN zero w = none := by rfl
              by
                rw [resolve]
                exact True.intro
                done
            | l + 1 =>
              fun w : l + 1 < domN   =>
                let lem : forwardN (l + 1) w = rc.forward l (le_of_succ_le_succ w) := by rfl
                by
                  rw [lem]
                  exact (rc.forwardWit l (le_of_succ_le_succ w))
                  done
          let reverseVecN := rc.reverseVec.map (. + 1)
          let reverseN : (k : Nat) →  k < codomN → Nat :=
            fun k w => (rc.reverse k w) + 1
          have reverseNEq : reverseVecN.coords = reverseN := by
                  apply funext
                  intro j
                  apply funext
                  intro jw
                  apply map_coords_commute
                  done
          have reverseWitN : (k : Nat) → (w : k < codomN) → reverseN k w < domN :=
            fun k w => succ_le_succ (rc.reverseWit k  w)
          ReductionClauses.mk codomN rc.restClauses
                    (forwardVecN)
                    (forwardNEq ▸ forwardWitN)
                    reverseVecN
                    (reverseNEq ▸ reverseWitN)

namespace PosResClause

def droppedProof{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          DroppedProof rc →
          DroppedProof (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos drc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          let droppedN :
              (k : Nat) → (w: k < domN) → rcN.forward k w = none →
                  (clausesN.coords k w).coords focus focusLt = some branch := by
                  intro k
                  match k with
                  | zero =>
                    intro _ _
                    exact pos
                  | l + 1 =>
                      intro w nw
                      let resolve : rcN.forward (l + 1) w =
                        rc.forward l (le_of_succ_le_succ w) := by rfl
                      rw [resolve] at nw
                      let lem3 := drc.dropped l (le_of_succ_le_succ w) nw
                      exact lem3
          ⟨droppedN⟩

def forwardRelation{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          ForwardRelation rc →
          ForwardRelation (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos frc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          have forwardRelationN : (k : Nat) → (w: k < domN) → (j: Nat) →  rcN.forward k w = some j →
              (jw : j < codomN) →  delete focus focusLt ((clausesN.coords k w).coords) =
                (rcN.restClauses.coords j jw).coords := by
                intro k
                match k with
                | zero =>
                  intro w j sw
                  exact Option.noConfusion sw
                | l + 1 =>
                  intro w j sw
                  exact frc.forwardRelation l (le_of_succ_le_succ w) j sw
          ⟨forwardRelationN⟩

theorem reverseResolve{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : (head.coords focus focusLt = some branch)) →
        (l: Nat) → (w : l  < rc.codom ) →
          (addPositiveClause  branch focus focusLt clauses rc head pos).reverse l w =
            (rc.reverse l w) + 1 := by
            intro rc head neg l w
            let rcN := addPositiveClause  branch focus focusLt clauses rc head neg
            have res1 : rcN.reverse l w =
                                      rcN.reverseVec.coords l w := by rfl
            have res2 : rc.reverse l w =
                    rc.reverseVec.coords l w := by rfl
            rw [res1]
            rw [res2]
            have res3 :rcN.reverseVec =
              (rc.reverseVec.map (. + 1)) := by rfl
            rw [res3]
            have res4 :
                ( (rc.reverseVec.map (. + 1)) ).coords l w =
                  (zero +:
                  (rc.reverseVec.map (. + 1)) ).coords.tail
                  l w := by rfl
            rw [res4]
            rw [(tail_commutes
                zero (rc.reverseVec.map (. + 1)))]
            rw [map_coords_commute]

def reverseRelation{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          ReverseRelation rc →
          ReverseRelation (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos rrc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          have relationN : (k : Nat) → (w: k < codomN) →
                 (rcN.restClauses.coords k w).coords =
                  delete focus focusLt
                    (clausesN.coords (rcN.reverse k w) (rcN.reverseWit k w)).coords :=
                  by
                    intro l
                    intro w
                    let lem1 : rcN.restClauses.coords l w =
                              rc.restClauses.coords l w := by rfl
                    let lem2 := rrc.relation l w
                    rw [lem1]
                    rw [lem2]
                    have rs0 : clausesN.coords (rcN.reverse l w)
                                (rcN.reverseWit l w) =
                                  clausesN.coords
                                    (rc.reverse l w + 1)
                                    (succ_le_succ
                                      (rc.reverseWit l w)) := by
                                    apply witness_independent
                                    apply reverseResolve
                    rw [rs0]
                    rfl
          ⟨relationN⟩

def pureReverse{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          NonPosReverse rc →
          NonPosReverse (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos prc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          have pureN : (k : Nat) → (w: k < codomN)  →
                Not (
                  (clausesN.coords (rcN.reverse k w) (rcN.reverseWit k w)).coords
                     focus focusLt = some branch) :=
                  by
                    intro l w hyp
                    have rs0 : clausesN.coords (rcN.reverse l w)
                                (rcN.reverseWit l w) =
                                  clausesN.coords
                                    (rc.reverse l w + 1)
                                    (succ_le_succ
                                      (rc.reverseWit l w)) := by
                                    apply witness_independent
                                    apply reverseResolve
                    rw [rs0] at hyp
                    have rs1 : clausesN.coords
                                    (rc.reverse l w + 1)
                                    (succ_le_succ
                                      (rc.reverseWit l w)) =
                                        clauses.coords (rc.reverse l w)
                                        (rc.reverseWit l w) := by rfl
                    rw [rs1] at hyp
                    let prev := prc.nonPosRev l w
                    exact absurd hyp prev
          ⟨pureN⟩

def prependResData{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
        (rd : ReductionData branch focus focusLt clauses) →
        ReductionData branch focus focusLt (head +: clauses) :=
          fun head pos rd =>
          let rc := addPositiveClause branch focus focusLt clauses rd.restrictionClauses head pos
          ⟨rc,
          droppedProof branch focus focusLt clauses rd.restrictionClauses head pos rd.droppedProof,
          forwardRelation branch focus focusLt clauses rd.restrictionClauses head pos rd.forwardRelation,
          reverseRelation branch focus focusLt clauses rd.restrictionClauses head pos rd.reverseRelation,
          pureReverse branch focus focusLt clauses rd.restrictionClauses head pos rd.nonPosReverse⟩

end PosResClause


import library_dev.data.list.sort

open list

@[reducible] def pre_pdmap (K : Type) (V : K → Type) := list (Σ (k : K), V k)

namespace pre_pdmap
variables {K : Type} {V : K → Type}

def get [decidable_eq K] [∀ k, inhabited (V k)] (k₀ : K) : pre_pdmap K V → V k₀
| []           := default _
| (⟨k,v⟩::kvs) := if H : k = k₀ then eq.rec_on H v else get kvs

def has_key [decidable_eq K] (k₀ : K) : pre_pdmap K V → Prop
| []           := false
| (⟨k,v⟩::kvs) := if k₀ = k then true else has_key kvs

instance decidable_has_key [decidable_eq K]  (k₀ : K) : Π (kvs : pre_pdmap K V), decidable (has_key k₀ kvs)
| [] := is_false (λ f, f)
| (⟨k, v⟩::kvs) :=
begin
dunfold has_key,
apply (@decidable.by_cases (k₀ = k)),
{ intro H_eq, simp [H_eq], exact decidable.true },
{ intro H_neq, simp [H_neq], apply decidable_has_key }
end

def rm_key [decidable_eq K] (k₀ : K) : pre_pdmap K V → pre_pdmap K V
| []             := []
| (⟨k,v⟩::kvs) := if k₀ = k then kvs else ⟨k,v⟩ :: rm_key kvs

def insert [decidable_eq K] (k₀ : K) (v₀ : V k₀) (pdm : pre_pdmap K V) : pre_pdmap K V :=
if has_key k₀ pdm then ⟨k₀, v₀⟩ :: rm_key k₀ pdm else ⟨k₀, v₀⟩ :: pdm

def keys : pre_pdmap K V → list K
| [] := []
| (⟨k,v⟩::kvs) := k::keys kvs

def erase_dup_keys [decidable_eq K] : pre_pdmap K V → pre_pdmap K V
| []        :=  []
| (⟨k,v⟩ :: kvs) := if has_key k kvs then erase_dup_keys kvs else ⟨k,v⟩ :: erase_dup_keys kvs

end pre_pdmap

def pdmap (K : Type) (V : K → Type) : Type := {xs : pre_pdmap K V // nodup (pre_pdmap.keys xs)}

namespace pdmap
variables {K : Type} {V : K → Type}

-- TODO(dhs): nodup nil
def mk : pdmap K V := ⟨[], sorry⟩

def get [decidable_eq K] [∀ k, inhabited (V k)] (k₀ : K) : pdmap K V → V k₀
| ⟨kvs, H⟩ := pre_pdmap.get k₀ kvs

def has_key [decidable_eq K] (k₀ : K) : pdmap K V → Prop
| ⟨kvs, H⟩ := pre_pdmap.has_key k₀ kvs

instance decidable_has_key [decidable_eq K]  (k₀ : K) : Π (kvs : pdmap K V), decidable (has_key k₀ kvs)
| ⟨kvs, H⟩ := begin dunfold has_key, apply_instance end

-- TODO(dhs): removing does not introduce a duplicate
def rm_key [decidable_eq K] (k₀ : K) : pdmap K V → pdmap K V
| ⟨kvs, H⟩ := ⟨pre_pdmap.rm_key k₀ kvs, sorry⟩

-- TODO(dhs): removing does not introduce a duplicate, and means not in, and consing when not in does not introduce a duplicate
def insert [decidable_eq K] (k₀ : K) (v₀ : V k₀) : pdmap K V → pdmap K V
| ⟨kvs, H⟩ := ⟨pre_pdmap.insert k₀ v₀ kvs, sorry⟩

def keys : pdmap K V → list K
| ⟨kvs, H⟩ := pre_pdmap.keys kvs

definition eqv (l₁ l₂ : pdmap K V) :=
perm l₁.1 l₂.1

local infix ~ := eqv

definition eqv.refl (l : pdmap K V) : l ~ l :=
perm.refl l.1

definition eqv.symm (l₁ l₂ : pdmap K V) : l₁ ~ l₂ → l₂ ~ l₁ :=
perm.symm

definition eqv.trans (l₁ l₂ l₃ : pdmap K V) : l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃ :=
perm.trans

instance pdmap.eqv_setoid : setoid (pdmap K V) :=
setoid.mk eqv (mk_equivalence eqv eqv.refl eqv.symm eqv.trans)

end pdmap

def dmap (K : Type) (V : K → Type) : Type := quot (@pdmap.eqv K V)

namespace dmap
variables {K : Type} {V : K → Type}

def mk : dmap K V := quotient.mk pdmap.mk

def has_key [decidable_eq K] (k₀ : K) (dm : dmap K V) : Prop :=
quot.lift_on dm (λ pdm, pdmap.has_key k₀ pdm) (λ l₁ l₂ (e : pdmap.eqv l₁ l₂), sorry)

instance decidable_has_key [decidable_eq K] (k₀ : K) (dm : dmap K V) : decidable (has_key k₀ dm) :=
quot.rec_on dm (λ pdm, pdmap.decidable_has_key k₀ pdm) (λ l₁ l₂ (e : pdmap.eqv l₁ l₂), sorry)

def get [decidable_eq K] [∀ k, inhabited (V k)] (k₀ : K) (dm : dmap K V) : V k₀ :=
quot.lift_on dm (λ pdm, pdmap.get k₀ pdm) (λ l₁ l₂ (H_eqv : pdmap.eqv l₁ l₂), sorry)

def insert [decidable_eq K] (k₀ : K) (v₀ : V k₀) (dm : dmap K V) : dmap K V :=
quot.lift_on dm (λ pdm, quotient.mk $ pdmap.insert k₀ v₀ pdm) (λ l₁ l₂ (H_eqv : pdmap.eqv l₁ l₂), sorry)

def keys [has_lt K] [decidable_rel (@has_lt.lt K _)] (dm : dmap K V) : list K :=
quot.lift_on dm (λ pdm, insertion_sort has_lt.lt (pdmap.keys pdm)) (λ l₁ l₂ (H_eqv : pdmap.eqv l₁ l₂), sorry)

lemma has_key_mem_keys [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k : K} {dm : dmap K V} :
  has_key k dm → k ∈ keys dm := sorry

lemma has_key_insert [decidable_eq K] {k₁ k₂ : K} {v₂ : V k₂} {dm : dmap K V} :
  has_key k₁ dm → has_key k₁ (insert k₂ v₂ dm) := sorry

lemma has_key_insert_same [decidable_eq K] (k : K) {v : V k} (dm : dmap K V) :
  has_key k (insert k v dm) := sorry

lemma get_insert_same [decidable_eq K] [∀ k, inhabited (V k)] (k : K) (v : V k) (dm : dmap K V) :
  get k (insert k v dm) = v := sorry

lemma get_insert_diff [decidable_eq K] [∀ k, inhabited (V k)] {k₁ k₂ : K} (v₂ : V k₂) (dm : dmap K V) :
  k₁ ≠ k₂ → get k₁ (insert k₂ v₂ dm) = get k₁ dm := sorry

lemma insert_get_same [decidable_eq K] [∀ k, inhabited (V k)] (k : K) (dm : dmap K V) :
  insert k (get k dm) dm = dm := sorry

lemma insert_insert_flip [decidable_eq K] [∀ k, inhabited (V k)] {k₁ k₂ : K} (v₁ : V k₁) (v₂ : V k₂) (dm : dmap K V) :
  k₁ ≠ k₂ → insert k₁ v₁ (insert k₂ v₂ dm) = insert k₂ v₂ (insert k₁ v₁ dm) := sorry

lemma insert_insert_same [decidable_eq K] (k : K) (v₁ v₂ : V k) (dm : dmap K V) :
  insert k v₁ (insert k v₂ dm) = insert k v₁ dm := sorry

lemma nodup_insert [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k : K} {v : V k} {ks : list K} {dm : dmap K V} :
  nodup (dmap.keys dm ++ (k :: ks)) → nodup (dmap.keys (dmap.insert k v dm) ++ ks) := sorry

lemma not_mem_of_insert [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k₀ k : K} {v : V k} {ks : list K} {dm : dmap K V} :
  k₀ ∉ (dmap.keys dm ++ (k :: ks)) → k₀ ∉ (dmap.keys (dmap.insert k v dm) ++ ks) := sorry

lemma not_mem_of_insert_symm [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k₀ k : K} {v : V k} {ks : list K} {dm : dmap K V} :
  k₀ ∉ (dmap.keys (dmap.insert k v dm) ++ ks) → k₀ ∉ (dmap.keys dm ++ (k :: ks)) := sorry

end dmap