import convex convex_body multiset brunn_minkowski microid set_pi
  lfe init.data.fin.ops

open_locale pointwise
open_locale topological_space
open_locale nat

-- needed to get decidable_eq for sets!
open classical
local attribute [instance] prop_decidable

variables {V : Type} [inner_product_space ℝ V] [finite_dimensional ℝ V]

noncomputable def translate_gen {k : ℕ} (v : V) (G : unbounded_microid_generator V k) :
unbounded_microid_generator V k :=
λ l, G l + v

noncomputable def scale_gen {k : ℕ} (c : ℝ) (G : unbounded_microid_generator V k) :
unbounded_microid_generator V k :=
λ l, c • G l

noncomputable def scale_translate_gen {k : ℕ} (c : ℝ) (v : V) (G : unbounded_microid_generator V k) :
unbounded_microid_generator V k :=
scale_gen c (translate_gen v G)

def chop_generator' {k₁ k₂ : ℕ}
(φ : fin k₁.succ → fin k₂.succ)
(G : unbounded_microid_generator V k₂) :
unbounded_microid_generator V k₁ := G ∘ φ

def chop_generator {k : ℕ} {c : ℕ}
(φ : fin c.succ → fin k.succ)
(G : microid_generator_space V k) :
microid_generator_space V c :=
begin
  have Gprop := G.property,
  refine ⟨chop_generator' φ G, _⟩,
  simp only [chop_generator', subtype.val_eq_coe, mem_ball_zero_iff],
  simp only [metric.mem_closed_ball, dist_zero_right] at Gprop ⊢,
  rw [pi_norm_le_iff zero_le_one] at Gprop ⊢,
  intro b,
  apply Gprop,
end

lemma chop_def {k : ℕ} {c : ℕ}
{φ : fin c.succ → fin k.succ} :
(chop_generator φ : microid_generator_space V k → microid_generator_space V c)
= (λ G, chop_generator φ G) := rfl

/- lemma chop_smul {k₁ k₂ : ℕ}  {c : ℝ}
(φ : fin k₁.succ → fin k₂.succ)
(G : microid_generator_space V k₂) :
chop -/

noncomputable def diam_generator' {k : ℕ}
(G : unbounded_microid_generator V k) : ℝ :=
metric.diam (G '' set.univ)

lemma pi_range_bounded {α : Type} [fintype α]
(f : α → V) : metric.bounded (set.range f) :=
begin
  let C := finset.sup finset.univ (has_nnnorm.nnnorm ∘f),
  refine ⟨C + C, _⟩,
  intros x hx y hy,
  rcases set.mem_range.mp hx with ⟨x, rfl⟩,
  rcases set.mem_range.mp hy with ⟨y, rfl⟩,
  have nx : ∥ f x ∥₊ ≤ C := finset.le_sup (finset.mem_univ x),
  have ny : ∥ f y ∥₊ ≤ C := finset.le_sup (finset.mem_univ y),
  refine le_trans _ (add_le_add nx ny),
  apply dist_le_norm_add_norm,
end

lemma generator_range_bounded {k : ℕ}
(G : microid_generator_space V k) :
metric.bounded (set.range G.val) :=
begin
  apply pi_range_bounded,
end

lemma h_diam_continuous {k : ℕ} {ε : ℝ} (hε : ε > 0)
(x y : unbounded_microid_generator V k) (h : dist x y < ε / 4) :
diam_generator' x < ε + diam_generator' y :=
begin
  have hh : ε / 2 < ε := half_lt_self hε,
  have hδ' : 0 ≤ ε / 2 := div_nonneg (le_of_lt hε) (by simp only [zero_le_bit0, zero_le_one]),
  refine lt_of_le_of_lt _ (add_lt_add_right hh (diam_generator' y)),
  simp only [diam_generator'],
  apply metric.diam_le_of_forall_dist_le,
  {
    rw [←@add_zero ℝ _ 0],
    exact add_le_add hδ' metric.diam_nonneg,
  },
  {
    intros u hu v hv,
    rcases (set.mem_image _ _ _).mp hu with ⟨pu, hpu, rfl⟩,
    rcases (set.mem_image _ _ _).mp hv with ⟨pv, hpv, rfl⟩,
    simp only [dist_eq_norm],
    have : x pu - x pv = ((x - y) pu - (x - y) pv) + (y pu - y pv),
    {
      simp only [pi.sub_apply],
      abel,
    },
    rw [this],
    refine le_trans (norm_add_le _ _) _,
    refine add_le_add _ _,
    {
      refine le_trans (norm_sub_le _ _) _,
      refine le_trans (add_le_add (norm_le_pi_norm _ _) (norm_le_pi_norm _ _)) _,
      -- have : ∀ x : ℝ, x + x = 2 * x := sorry,
      -- have two_gt: 2 > 0 := by positivity,
      -- rw [this],
      rw [←dist_eq_norm],
      have := metric.mem_ball.mp h,
      -- rw [dist_comm] at this,
      change dist x y + dist x y ≤ ε / 2,
      refine le_of_lt (lt_of_lt_of_le (add_lt_add this this) _),
      apply le_of_eq,
      ring,
    },
    {
      rw[←dist_eq_norm],
      refine metric.dist_le_diam_of_mem _ _ _,
      {
        simp only [set.image_univ],
        apply pi_range_bounded,
      },
      all_goals {
        refine (set.mem_image _ _ _).mp _,
        simp only [set.image_univ, set.mem_range_self],
      },
    },
  },
end

lemma diam_continuous (k : ℕ) :
continuous (diam_generator' : unbounded_microid_generator V k → ℝ) :=
begin
  simp only [continuous_def],
  simp only [metric.is_open_iff],
  intros U hU x hxU,
  replace hxU := set.mem_preimage.mp hxU,
  rcases hU _ hxU with ⟨ε, hε, hx⟩,
  let δ := ε / 2,
  have hδ : δ > 0 := half_pos hε,
  have hδ' : δ ≥ 0 := le_of_lt hδ,
  let γ := ε / 4,
  have hγ : γ > 0,
  {
    apply div_pos hε,
    simp only [zero_lt_bit0, zero_lt_one],
  },
  have hγ' : γ ≥ 0 := le_of_lt hγ,
  have hh : δ < ε := half_lt_self hε,
  refine ⟨γ, hγ, _⟩,
  intros y hy,
  simp only [set.mem_preimage],
  apply hx,
  simp only [metric.mem_ball, real.dist_eq],
  refine abs_lt.mpr ⟨_, _⟩,
  {
    simp only [neg_lt_sub_iff_lt_add],
    replace hy := metric.mem_ball.mp hy,
    rw [dist_comm] at hy,
    refine h_diam_continuous hε _ _ hy,
  },
  {
    simp only [sub_lt_iff_lt_add],
    replace hy := metric.mem_ball.mp hy,
    refine h_diam_continuous hε _ _ hy,
  },
end

lemma const_of_diam_zero {k : ℕ}
{G : unbounded_microid_generator V k}
(h : diam_generator' G = 0) (m n : fin k.succ) :
G m = G n :=
begin
  simp only [diam_generator', set.image_univ] at h,
  apply dist_le_zero.mp,
  {
    rw [←h],
    refine metric.dist_le_diam_of_mem _ _ _,
    {apply pi_range_bounded},
    {simp only [set.mem_range_self]},
    {simp only [set.mem_range_self]},
  },
end

noncomputable def norm_generator' {k : ℕ}
(G : unbounded_microid_generator V k) : unbounded_microid_generator V k :=
scale_translate_gen (diam_generator' G)⁻¹ (-(G 0)) G

noncomputable def norm_generator {k : ℕ}
(G : microid_generator_space V k) : microid_generator_space V k :=
begin
  refine ⟨norm_generator' G.val, _⟩,
  simp only [norm_generator', set.image_univ, one_div, mem_closed_ball_zero_iff],
  simp only [pi.norm_def, nnnorm_smul],
  have : ∀ b : fin k.succ, ∥G.val b - G.val 0∥ ≤ diam_generator' G.val,
  {
    intro b,
    rw [←dist_eq_norm],
    refine metric.dist_le_diam_of_mem _ _ _,
    {rw [set.image_univ], apply generator_range_bounded},
    all_goals {
      rw [set.image_univ],
      simp only [subtype.val_eq_coe, set.mem_range_self],
    },
  },
  rw [←real.coe_to_nnreal 1 zero_le_one],
  rw [nnreal.coe_le_coe],
  simp only [real.to_nnreal_one, finset.sup_le_iff, finset.mem_univ, forall_true_left],
  intro b,
  simp only [scale_translate_gen, scale_gen, translate_gen],
  rw [nnnorm_smul, nnnorm_inv, ←sub_eq_add_neg],
  have lem: ∀ r : nnreal, r⁻¹ * r ≤ 1,
  {
    intro r,
    by_cases hr : r = 0,
    {
      simp only [hr, mul_zero, zero_le'],
    },
    {
      rw [inv_mul_cancel hr],
    },
  },
  refine le_trans _ (lem ∥diam_generator' G.val∥₊),
  apply mul_le_mul_of_nonneg_left,
  {
    rw [←nnreal.coe_le_coe, coe_nnnorm, coe_nnnorm],
    rw [real.norm_eq_abs],
    refine le_trans (this b) _,
    apply le_abs_self,
  },
  {
    rw [←nnreal.coe_le_coe],
    simp only [nonneg.coe_zero, nonneg.coe_inv, coe_nnnorm,
      real.norm_eq_abs, inv_nonneg, abs_nonneg],
  },
end

lemma norm_generator_factor {k : ℕ}
(G : unbounded_microid_generator V k) :
norm_generator' G =
scale_translate_gen (diam_generator' G)⁻¹ (-(G 0)) G :=
begin
  funext,
  simp only [norm_generator', one_div, pi.smul_apply, pi.sub_apply],
end

lemma norm_generator_positive_factor₁ {k : ℕ}
(G : unbounded_microid_generator V k) (h : diam_generator' G = 0) :
norm_generator' G = scale_translate_gen 1 (-(G 0)) G :=
begin
  funext,
  simp only [norm_generator', scale_translate_gen, scale_gen, translate_gen,
    one_div, pi.sub_apply,
    function.const_apply, one_smul],
  rw [←sub_eq_add_neg],
  have : G l - G 0 = 0,
  {
    rw [const_of_diam_zero h _ 0],
    simp only [sub_self],
  },
  simp only [this, smul_zero],
end

lemma norm_generator_positive_factor₂ {k : ℕ}
(G : unbounded_microid_generator V k) (h : diam_generator' G ≠ 0) :
(diam_generator' G)⁻¹ > 0 ∧
norm_generator' G =
scale_translate_gen (diam_generator' G)⁻¹ (-(G 0)) G :=
begin
  replace h : diam_generator' G > 0,
  {
    simp only [diam_generator'] at h,
    exact ne.lt_of_le' h metric.diam_nonneg,
  },
  refine ⟨_, _⟩,
  {
    exact inv_pos_of_pos h,
  },
  {
    funext,
    simp only [norm_generator', one_div, pi.smul_apply, pi.sub_apply],
  },
end

lemma norm_generator_positive_factor {k : ℕ}
(G : unbounded_microid_generator V k) :
∃ c : ℝ, c > 0 ∧
norm_generator' G = scale_translate_gen c (-(G 0)) G :=
begin
  by_cases h : diam_generator' G = 0,
  {
    refine ⟨1, zero_lt_one, _⟩,
    exact norm_generator_positive_factor₁ G h,
  },
  {
    refine ⟨(diam_generator' G)⁻¹, _⟩,
    exact norm_generator_positive_factor₂ G h,
  }
end

lemma scale_translate_scale_translate {k : ℕ}
{c₁ c₂ : ℝ} {v₁ v₂ : V} {G : unbounded_microid_generator V k} (hc₂ : c₂ ≠ 0) :
scale_translate_gen c₁ v₁ (scale_translate_gen c₂ v₂ G) =
scale_translate_gen (c₁ * c₂) (c₂⁻¹ • v₁ + v₂) G :=
begin
  funext,
  simp only [scale_translate_gen, scale_gen, translate_gen],
  rw [←smul_eq_mul, smul_assoc],
  congr,
  simp only [smul_add, smul_inv_smul₀ hc₂],
  ac_refl,
end

lemma scale_translate_scale_translate' {k : ℕ}
{c₁ c₂ : ℝ} {v₁ v₂ : V} {G : unbounded_microid_generator V k} :
scale_translate_gen c₁ v₁ (scale_translate_gen c₂ v₂ G) =
translate_gen (c₁ • v₁ + (c₁ • c₂ • v₂)) (scale_gen (c₁ * c₂) G) :=
begin
  funext,
  simp only [scale_translate_gen, scale_gen, translate_gen],
  simp only [←smul_eq_mul, smul_assoc, smul_add],
  ac_refl,
end

lemma scale_translate_eq_translate_scale {k : ℕ}
{c : ℝ} {v : V} {G : unbounded_microid_generator V k} :
scale_gen c (translate_gen v G) = translate_gen (c • v) (scale_gen c G) :=
begin
  funext,
  simp only [scale_gen, translate_gen],
  simp only [←smul_eq_mul, smul_assoc, smul_add],
end

lemma scale_scale {k : ℕ}
{c₁ c₂ : ℝ} {G : unbounded_microid_generator V k} :
scale_gen c₁ (scale_gen c₂ G) = scale_gen (c₁ * c₂) G :=
begin
  funext,
  simp only [scale_gen],
  simp only [←smul_eq_mul, smul_assoc],
end

lemma translate_translate {k : ℕ}
{v₁ v₂ : V} {G : unbounded_microid_generator V k} :
translate_gen v₁ (translate_gen v₂ G) = translate_gen (v₁ + v₂) G :=
begin
  funext,
  simp only [translate_gen],
  ac_refl,
end

lemma translate_zero_scale_1 {k : ℕ}
(G : unbounded_microid_generator V k) :
G = translate_gen 0 (scale_gen 1 G) :=
begin
  funext,
  simp only [translate_gen, scale_gen],
  simp only [one_smul, add_zero],
end

lemma translate_zero {k : ℕ}
(G : unbounded_microid_generator V k) :
G = translate_gen 0 G :=
begin
  funext,
  simp only [translate_gen, add_zero],
end

lemma dist_times_norm {k : ℕ}
(G : unbounded_microid_generator V k) :
∃ v : V, G = translate_gen v (scale_gen (diam_generator' G) (norm_generator' G)) :=
begin
  simp only [norm_generator', scale_translate_gen],
  rw [scale_scale, scale_translate_eq_translate_scale],
  simp only [translate_translate], -- rw not working...
  by_cases h : diam_generator' G = 0,
  {
    refine ⟨_, _⟩, rotate,
    {
      simp only [translate_gen, scale_gen],
      simp only [h, zero_mul, zero_smul, add_zero, zero_add],
      funext,
      exact const_of_diam_zero h x 0,
    },
  },
  {
    refine ⟨_, _⟩, rotate,
    {
      convert translate_zero_scale_1 G,
      {refine neg_add_self _},
      {
        exact mul_inv_cancel h,
      },
    },
  },
end

lemma smul_set_bounded (c : ℝ) {A : set V} (hA : metric.bounded A) :
metric.bounded (c • A) :=
begin
  rcases hA with ⟨C, hC⟩,
  refine ⟨∥c∥ * C, _⟩,
  intros x hx y hy,
  rcases set.mem_smul_set.mp hx with ⟨px, hpx, rfl⟩,
  rcases set.mem_smul_set.mp hy with ⟨py, hpy, rfl⟩,
  rw [dist_smul],
  refine mul_le_mul_of_nonneg_left _ _,
  {exact hC px hpx py hpy},
  {apply norm_nonneg},
end

lemma set_bounded_of_smul {c : ℝ} (h : c > 0) {A : set V} (hA : metric.bounded (c • A)) :
metric.bounded A :=
begin
  convert smul_set_bounded c⁻¹ hA,
  rw [inv_smul_smul₀ (ne_of_gt h)],
end

lemma translate_set_bounded {A : set V} (hA : metric.bounded A) (v : V) :
metric.bounded (A + {v}) :=
begin
  rcases hA with ⟨C, hC⟩,
  refine ⟨C, _⟩,
  intros x hx y hy,
  rcases hx with ⟨xa, xv, hxa, hxv, rfl⟩,
  rcases hy with ⟨ya, yv, hya, hyv, rfl⟩,
  cases set.eq_of_mem_singleton hxv,
  cases set.eq_of_mem_singleton hyv,
  rw [dist_add_right],
  tauto,
end

lemma diam_smul {A : set V}  (hA : metric.bounded A) {c : ℝ} (h : c ≥ 0) :
metric.diam (c • A) = c * (metric.diam A) :=
begin
  revert A c,
  suffices hle : ∀ {A : set V} (hA : metric.bounded A) {c : ℝ}, c ≥ 0 → metric.diam (c • A) ≤ c * metric.diam A,
  {
    intros A c hA hc,
    apply le_antisymm,
    {exact hle hA hc},
    {
      by_cases h : c = 0,
      {
        rw [h, zero_mul],
        exact metric.diam_nonneg,
      },
      {
        replace hc := ne.lt_of_le (h ∘ eq.symm) hc,
        have := hle (smul_set_bounded c hA) (le_of_lt (inv_pos_of_pos hc)),
        rw [←mul_le_mul_left (inv_pos_of_pos hc), ←mul_assoc],
        rw [inv_mul_cancel (ne_of_gt hc), one_mul],
        convert this,
        rw [inv_smul_smul₀ (ne_of_gt hc)],
      }
    },
  },
  {
    intros A hA c hc,
    refine metric.diam_le_of_forall_dist_le _ _,
    {
      have : metric.diam A ≥ 0 := metric.diam_nonneg,
      positivity,
    },
    {
      intros x hx y hy,
      rcases set.mem_smul_set.mp hx with ⟨px, hpx, rfl⟩,
      rcases set.mem_smul_set.mp hy with ⟨py, hpy, rfl⟩,
      rw [dist_smul, real.norm_eq_abs, abs_of_nonneg hc],
      apply mul_le_mul_of_nonneg_left _ hc,
      exact metric.dist_le_diam_of_mem hA hpx hpy,
    },
  },
end

lemma diam_translate {A : set V} (hA : metric.bounded A) (v : V) :
metric.diam (A + {v}) = metric.diam A :=
begin
  revert A v,
  suffices h : ∀ {A : set V} (hA : metric.bounded A) (v : V), metric.diam (A + {v}) ≤ metric.diam A,
  {
    intros A v hA,
    apply le_antisymm,
    {
      exact h hA v,
    },
    {
      convert h (translate_set_bounded hA v) (-v),
      simp only [add_assoc, set.singleton_add_singleton, add_neg_self],
      simp only [set.add_singleton, add_zero, set.image_id'],
    },
  },
  {
    intros A hA v,
    refine metric.diam_le_of_forall_dist_le _ _,
    {exact metric.diam_nonneg},
    {
      intros x hx y hy,
      rcases hx with ⟨xa, xv, hxa, hxv, rfl⟩,
      rcases hy with ⟨ya, yv, hya, hyv, rfl⟩,
      cases set.eq_of_mem_singleton hxv,
      cases set.eq_of_mem_singleton hyv,
      rw [dist_add_right],
      exact metric.dist_le_diam_of_mem hA hxa hya,
    },
  },
end

lemma chop_scale_translate {k₁ k₂ : ℕ} {c : ℝ} (v : V)
(φ : fin k₁.succ → fin k₂.succ)
(G : unbounded_microid_generator V k₂) :
chop_generator' φ (scale_translate_gen c v G) = scale_translate_gen c v (chop_generator' φ G) :=
begin
  simp only [chop_generator', scale_translate_gen, scale_gen, translate_gen],
end

lemma chop_scale_translate' {k₁ k₂ : ℕ} {c : ℝ} (v : V)
(φ : fin k₁.succ → fin k₂.succ)
(G : unbounded_microid_generator V k₂) :
(scale_translate_gen c v G) ∘ φ = scale_translate_gen c v (G ∘ φ) :=
begin
  simp only [chop_generator', scale_translate_gen, scale_gen, translate_gen],
end

lemma diam_scale_translate {k : ℕ} {c : ℝ} (hc : c ≥ 0) (v : V)
(G : unbounded_microid_generator V k) :
diam_generator' (scale_translate_gen c v G) = c * diam_generator' G :=
begin
  simp only [scale_translate_gen, scale_gen, translate_gen],
  simp only [←pi.smul_def, diam_generator'],
  simp only [set_image_smul'],
  simp only [diam_generator', set.image_univ],
  rw [diam_smul (pi_range_bounded (λ i, G i + v)) hc, set.image_univ.symm],
  simp only [set_image_translate],
  rw [set.image_univ, diam_translate (pi_range_bounded G)],
end

lemma diam_chop_zero_of_diam_zero {k₁ k₂ : ℕ}
(φ : fin k₁.succ → fin k₂.succ)
(G : unbounded_microid_generator V k₂) :
diam_generator' G = 0 → diam_generator' (chop_generator' φ G) = 0 :=
begin
  simp only [diam_generator', chop_generator'],
  rw [set.image_comp],
  intro h,
  refine le_antisymm _ metric.diam_nonneg,
  refine le_trans (metric.diam_mono _ _) (le_of_eq h),
  {
    simp only [function.comp_app, set.image_univ, set.range_id'],
    apply set.range_comp_subset_range,
  },
  {
    rw [←set.image_comp, set.image_univ],
    apply pi_range_bounded,
  }
end

lemma scale_translate_zero {k : ℕ} {v : V} {G : unbounded_microid_generator V k} :
scale_translate_gen 0 v G = 0 :=
begin
  simp only [scale_translate_gen, scale_gen, translate_gen, zero_smul],
  refl,
end

lemma norm_chop_norm_eq_norm_chop {k₁ k₂ : ℕ}
(φ : fin k₁.succ → fin k₂.succ)
(G : unbounded_microid_generator V k₂) :
norm_generator' (chop_generator' φ (norm_generator' G)) = norm_generator' (chop_generator' φ G) :=
begin
  simp only [norm_generator_factor, chop_scale_translate, diam_scale_translate],
  by_cases h : diam_generator' G = 0,
  {
    simp only [h, inv_zero, zero_mul, diam_chop_zero_of_diam_zero _ _ h,
      scale_translate_zero],
    simp only [scale_translate_gen, translate_gen],
    simp only [pi.zero_apply, neg_zero, add_zero],
    simp only [scale_gen, smul_zero],
    refl,
  },
  {
    rw [scale_translate_scale_translate (inv_ne_zero h)],
    congr,
    {
      simp only [mul_inv, inv_inv],
      rw [diam_scale_translate _],
      rw [mul_comm, mul_inv, inv_inv],
      rw [←mul_assoc, inv_mul_cancel h, one_mul],
      apply inv_nonneg_of_nonneg,
      exact metric.diam_nonneg,
    },
    {
      rw [inv_inv],
      simp only [scale_translate_gen, scale_gen, translate_gen],
      simp only [chop_generator'],
      simp only [smul_neg, smul_inv_smul₀ h, neg_add, neg_neg, add_assoc,
        add_neg_self, add_zero],
    },
  },
end

noncomputable def prunenorm_generator {k : ℕ} {c : ℕ}
(φ : fin c.succ → fin k.succ)
(G : microid_generator_space V k) : microid_generator_space V c :=
norm_generator (chop_generator φ G)

lemma prunenorm_def {k : ℕ} {c : ℕ}
(φ : fin c.succ → fin k.succ) :
(prunenorm_generator φ : microid_generator_space V k → microid_generator_space V c) =
norm_generator ∘ chop_generator φ := rfl

lemma norm_generator_idempotent {k : ℕ} (G : unbounded_microid_generator V k) :
norm_generator' (norm_generator' G) = norm_generator' G :=
begin
  simp only [norm_generator'],
  by_cases h : diam_generator' G = 0,
  {
    simp only [inv_zero, h],
    simp only [diam_generator'],
    simp only [set.image_univ],
    simp only [scale_translate_zero, pi.zero_apply, neg_zero],
    simp only [scale_translate_gen, scale_gen, translate_gen],
    simp only [pi.zero_apply, add_zero, smul_zero],
    refl,
  },
  {
    simp only [scale_translate_scale_translate (inv_ne_zero h)],
    congr,
    {
      have dnn: diam_generator' G ≥ 0 := metric.diam_nonneg,
      have idnn: (diam_generator' G)⁻¹ ≥ 0,
      {
        apply inv_nonneg_of_nonneg,
        exact metric.diam_nonneg,
      },
      rw [diam_scale_translate idnn, mul_inv, inv_inv],
      rw [←inv_inv (diam_generator' G)],
      generalize : (diam_generator' G)⁻¹ = x,
      rw [inv_inv],
      apply inv_mul_mul_self,
    },
    {
      rw [inv_inv, scale_translate_gen, scale_gen, translate_gen],
      simp only [add_right_neg, smul_zero, neg_zero, zero_add],
    },
  },
end

lemma diam_norm_generator {k : ℕ}
(G : unbounded_microid_generator V k) :
diam_generator' (norm_generator' G) = 1 ∨ diam_generator' G = 0 :=
begin
  simp only [norm_generator_factor],
  rw [diam_scale_translate _],
  {
    by_cases h : diam_generator' G = 0,
    {
      right,
      exact h,
    },
    {
      left,
      exact inv_mul_cancel h,
    },
  },
  {
    exact inv_nonneg_of_nonneg metric.diam_nonneg,
  },
end

lemma norm_generator_apply_zero {k : ℕ}
(G : unbounded_microid_generator V k) :
(norm_generator' G) 0 = 0 :=
begin
  simp only [norm_generator', scale_translate_gen, scale_gen, translate_gen],
  rw [←sub_eq_add_neg, sub_self, smul_zero],
end

/- lemma translate_scale_eq_norm_generator {k : ℕ}
{c : ℝ} (hc : c ≥ 0) (v : V) (G : unbounded_microid_generator V k) :
diam_generator' (scale_translate_gen c v G) = 1 ∧ (scale_translate_gen c v G 0 = 0) →
translate_gen v (scale_gen c G) = norm_generator' G :=
begin
  admit,
end -/

lemma translate_scale_eq_norm_generator' {k : ℕ} {c : ℝ} {v : V}
(G H : unbounded_microid_generator V k)
(h : H = translate_gen v (scale_gen c G)) (hc : c ≥ 0) :
(diam_generator' H = 1 ∨ diam_generator' G = 0) → H 0 = 0 → H = norm_generator' G :=
begin
  intros hd hz,
  cases hd,
  {
    simp only [h, norm_generator_factor, scale_translate_gen, scale_gen, translate_gen] at hz hd ⊢,
    replace hz := eq_neg_of_add_eq_zero_right hz,
    simp only [hz],
    funext,
    rw [←sub_eq_add_neg],
    rw [←sub_eq_add_neg],
    rw [←smul_sub],
    congr,
    apply eq_inv_of_mul_eq_one_left,
    rw [diam_generator', set.image_univ, ←diam_smul (pi_range_bounded _) hc],
    rw [←set.image_univ],
    rw [←set_image_smul', set.image_univ],
    rw [←diam_translate (pi_range_bounded _), ←set.image_univ],
    simp only [set_image_translate, diam_generator'] at hd,
    exact hd,
    all_goals {apply_instance},
  },
  {
    simp only [norm_generator', hd, h, scale_translate_gen, scale_gen, translate_gen] at hz ⊢,
    replace hz := eq_neg_of_add_eq_zero_right hz,
    simp only [hz],
    funext,
    rw [const_of_diam_zero hd l 0, ←sub_eq_add_neg, ←sub_eq_add_neg],
    simp only [sub_self, smul_zero],
  }
end

lemma diam_zero_of_diam_norm_zero {k : ℕ}
(G : unbounded_microid_generator V k) :
diam_generator' (norm_generator' G) = 0 → diam_generator' G = 0 :=
begin
  intro h,
  rcases diam_norm_generator G,
  {linarith},
  {assumption},
end

lemma diam_norm_one_of_diam_ne_zero {k : ℕ}
(G : unbounded_microid_generator V k) :
diam_generator' G ≠ 0 → diam_generator' (norm_generator' G) = 1 :=
begin
  intro h,
  rcases diam_norm_generator G,
  {assumption},
  {contradiction},
end

--set_option pp.all true
lemma prunenorm_prunenorm {c₁ c₂ c₃: ℕ}
(φ₁ : fin c₁.succ → fin c₂.succ) (φ₂ : fin c₂.succ → fin c₃.succ)
(G : microid_generator_space V c₃) :
prunenorm_generator φ₁ (prunenorm_generator φ₂ G) =
prunenorm_generator (φ₂ ∘ φ₁) G :=
begin
  simp only [prunenorm_generator, norm_generator, chop_generator],
  simp only [subtype.coe_mk, subtype.mk_eq_mk],
  simp only [norm_chop_norm_eq_norm_chop, chop_generator'],
  refine translate_scale_eq_norm_generator' _ _
    _ _ _ _, rotate, rotate,
  {
    conv {to_lhs, simp only [norm_generator']},
    have := chop_scale_translate,
    simp only [chop_generator'] at this,
    rw [this],
    rw [scale_translate_scale_translate'],
  },
  {
    simp only [diam_generator'],
    refine mul_nonneg _ _,
    all_goals {exact inv_nonneg_of_nonneg metric.diam_nonneg},
  },
  {
    by_cases h: diam_generator' (↑G ∘ φ₂ ∘ φ₁) = 0,
    {
      right,
      exact h,
    },
    {
      left,
      apply diam_norm_one_of_diam_ne_zero,
      simp only [norm_generator'],
      have : diam_generator' ((coe G : fin c₃.succ → V) ∘ φ₂) > 0,
      {
        simp only [diam_generator', set.image_univ],
        rw [diam_generator'] at h,
        replace h := ne.lt_of_le' h metric.diam_nonneg,
        rw [set.image_univ, ←function.comp.assoc] at h,
        refine lt_of_lt_of_le h _,
        refine metric.diam_mono _ (pi_range_bounded _),
        apply set.range_comp_subset_range,
      },
      rw [chop_scale_translate', diam_scale_translate],
      {
        apply mul_ne_zero,
        {exact ne_of_gt (inv_pos_of_pos this)},
        {rw [function.comp.assoc], exact h},
      },
      {exact le_of_lt (inv_pos_of_pos this)},
    },
  },
  {
    apply norm_generator_apply_zero,
  },
end

lemma sub_singleton_eq_add_singleton (A : set V) (v : V) :
A - {v} = A + {-v} :=
begin
  ext,
  simp only [set.mem_add, set.mem_sub, set.mem_singleton_iff],
  split,
  all_goals {
    intro h,
    rcases h with ⟨a, vv, ha, rfl, rfl⟩,
    refine ⟨a, _, ha, rfl, _⟩,
    rw [←sub_eq_add_neg],
  },
end

lemma diam_norm_generator_eq {k : ℕ}
(G : unbounded_microid_generator V k) :
diam_generator' G ≠ 0 → diam_generator' (norm_generator' G) = 1 :=
begin
  intro h,
  rcases norm_generator_positive_factor₂ G h with ⟨hgt, heq⟩,
  simp only [diam_generator', scale_translate_gen, scale_gen, translate_gen, heq],
  rw [←pi.smul_def, set_image_smul'],
  rw [diam_smul],
  {
    simp only [←sub_eq_add_neg],
    simp only [←pi.sub_def],
    rw [set_image_sub'],
    rw [sub_singleton_eq_add_singleton],
    rw [diam_translate],
    {
      convert inv_mul_cancel h,
    },
    {
      convert (pi_range_bounded G),
      exact set.image_univ,
    }
  },
  {
    rw [set.image_univ],
    refine pi_range_bounded _,
  },
  {
    apply inv_nonneg_of_nonneg,
    exact metric.diam_nonneg,
  },
end

lemma range_scale_translate {k : ℕ}
{c : ℝ} {v : V} {G : unbounded_microid_generator V k} :
(scale_translate_gen c v G) '' set.univ = c • ((G '' set.univ) + {v}) :=
begin
  simp only [scale_translate_gen, scale_gen, translate_gen],
  ext,
  simp only [set.mem_image, set.mem_smul, set.mem_add],
  split,
  {
    intro h,
    rcases h with ⟨l, -, rfl⟩,
    apply set.smul_mem_smul_set,
    refine ⟨G l, v, _, _, rfl⟩,
    {exact ⟨l, set.mem_univ _, rfl⟩},
    {apply set.mem_singleton},
  },
  {
    intro h,
    rcases h with ⟨y, ⟨py, vv, ⟨ppy, -, rfl⟩, hvv, rfl⟩, rfl⟩,
    cases set.eq_of_mem_singleton hvv,
    refine ⟨ppy, set.mem_univ _, rfl⟩,
  },
end

lemma polytope_of_norm_generator_smul {k : ℕ}
(G : microid_generator_space V k) :
∃ c : ℝ, c > 0 ∧
(polytope_of_microid_generator (norm_generator G)).val =
c • ((polytope_of_microid_generator G).val + {-(G.val 0)}) :=
begin
  rcases norm_generator_positive_factor G.val with ⟨c, hc₁, hc₂⟩,
  refine ⟨c, hc₁, _⟩,
  simp only [polytope_of_microid_generator, hc₂, norm_generator],
  rw [←set.image_univ],
  rw [range_scale_translate],
  rw [/- set_image_smul', -/ convex_hull_smul],
  congr,
  conv {to_rhs, rw [←@convex_hull_singleton ℝ V _ _ _ (-(G.val 0))]},
  rw [←convex_hull_add, set.image_univ],
end

lemma h_vector_span_homothety (A : set V) {c : ℝ} (v : V)
(h : c > 0) :
vector_span ℝ A ≥ vector_span ℝ (c • (A + {v})) :=
begin
  refine submodule.span_le.mpr _,
  simp only [vector_span],
  rintro x ⟨a₁, a₂, ha₁, ha₂, rfl⟩,
  rcases set.mem_smul_set.mp ha₁ with ⟨d₁, ⟨e₁, v₁, he₁, hv₁, rfl⟩, rfl⟩,
  rcases set.mem_smul_set.mp ha₂ with ⟨d₂, ⟨e₂, v₂, he₂, hv₂, rfl⟩, rfl⟩,
  rcases set.eq_of_mem_singleton hv₁,
  rcases set.eq_of_mem_singleton hv₂,
  simp only [vsub_eq_sub],
  rw [←smul_sub],
  change c • (e₁ + v - (e₂ + v)) ∈ /- need change to remove ↑ here -/ (submodule.span ℝ (A -ᵥ A)),
  refine submodule.smul_mem _ c _,
  rw [add_sub_add_right_eq_sub],
  apply submodule.subset_span,
  refine ⟨e₁, e₂, he₁, he₂, rfl⟩,
end

lemma vector_span_homothety {A : set V} {c : ℝ} (v : V)
(h : c > 0) :
vector_span ℝ (c • (A + {v})) = vector_span ℝ A :=
begin
  apply le_antisymm,
  {
    exact h_vector_span_homothety A v h,
  },
  {
    -- might become a separate lemma!
    have : A = c⁻¹ • ((c • (A + {v})) + {-c • v}),
    {
      simp only [smul_add, neg_smul, set.smul_set_singleton, smul_neg],
      simp only [inv_smul_smul₀ (ne_of_gt h)],
      rw [add_assoc],
      -- Worked with squeeze_simp, but doesn't work now: simp only [set.singleton_add_singleton, set.singleton_add_singleton, add_right_neg, set.add_singleton, add_zero, set.image_id', eq_self_iff_true],
      simp only [set.singleton_add_singleton, add_right_neg, add_zero],
      simp only [set.add_singleton, add_zero, set.image_id'],
    },
    convert h_vector_span_homothety (c • (A + {v})) (-c • v) (inv_pos_of_pos h),
  },
end

lemma gen_lfe_norm {k : ℕ}
(G : microid_generator_space V k) :
lfe ⊤ (polytope_of_microid_generator G) (polytope_of_microid_generator (norm_generator G)) :=
begin
  apply lfe_symm,
  rcases polytope_of_norm_generator_smul G with ⟨c, hc₁, hc₂⟩,
  refine ⟨c • (-G.val 0), c, hc₁, _⟩,
  simp only [bm.τ, convex_body_of_polytope, hc₂],
  --simp only [face_smul hc₁, face_translate],
  simp only [normal_face_homothety _ hc₁],
  simp only [smul_add],
  simp only [set.smul_set_Union₂],
  simp only [set.add_Union₂],
  simp only [set.smul_set_singleton],
  congr, funext, congr, funext,
  nth_rewrite 0 [add_comm],
end

lemma lim_norm_gen {k : ℕ}
{t : ℕ → unbounded_microid_generator V k}
{tl : unbounded_microid_generator V k }
(htt : filter.tendsto t filter.at_top (𝓝 tl))
(hd : ∀ n : ℕ, diam_generator' (t n) = 1) :
diam_generator' tl = 1 :=
begin
  simp only [diam_generator'],
  have tt₁ : filter.tendsto (λ n : ℕ, diam_generator' (t n)) filter.at_top (𝓝 (diam_generator' tl)),
  {
    have := @continuous.continuous_at (unbounded_microid_generator V k) ℝ _ _ _ _ (diam_continuous k),
    convert (filter.tendsto.comp this htt),
  },
  have tt₂ : filter.tendsto (λ n : ℕ, diam_generator' (t n)) filter.at_top (𝓝 1),
  {
    simp only [hd],
    exact tendsto_const_nhds,
  },
  exact tendsto_nhds_unique tt₁ tt₂,
end

lemma prunenorm_id_eq_norm {k : ℕ} :
(prunenorm_generator id : microid_generator_space V k → microid_generator_space V k) =
norm_generator :=
begin
  funext,
  simp only [prunenorm_generator, chop_generator, subtype.val_eq_coe,
  function.comp.right_id, subtype.coe_eta],
  simp only [chop_generator', function.comp.right_id, subtype.coe_eta],
end


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Additional theorems about the `vector` type.
-/
import data.vector data.list.basic data.sigma data.equiv.basic
       category.traversable

namespace vector
variables {α : Type*} {n : ℕ}

attribute [simp] head_cons tail_cons

instance [inhabited α] : inhabited (vector α n) :=
⟨of_fn (λ _, default α)⟩

theorem to_list_injective : function.injective (@to_list α n) :=
subtype.val_injective

@[simp] theorem to_list_of_fn : ∀ {n} (f : fin n → α), to_list (of_fn f) = list.of_fn f
| 0     f := rfl
| (n+1) f := by rw [of_fn, list.of_fn_succ, to_list_cons, to_list_of_fn]

@[simp] theorem mk_to_list :
  ∀ (v : vector α n) h, (⟨to_list v, h⟩ : vector α n) = v
| ⟨l, h₁⟩ h₂ := rfl

theorem nth_eq_nth_le : ∀ (v : vector α n) (i),
  nth v i = v.to_list.nth_le i.1 (by rw to_list_length; exact i.2)
| ⟨l, h⟩ i := rfl

@[simp] theorem nth_of_fn {n} (f : fin n → α) (i) : nth (of_fn f) i = f i :=
by rw [nth_eq_nth_le, ← list.nth_le_of_fn f];
   congr; apply to_list_of_fn

@[simp] theorem of_fn_nth (v : vector α n) : of_fn (nth v) = v :=
begin
  rcases v with ⟨l, rfl⟩,
  apply to_list_injective,
  change nth ⟨l, eq.refl _⟩ with λ i, nth ⟨l, rfl⟩ i,
  simp [nth, list.of_fn_nth_le]
end

@[simp] theorem nth_tail : ∀ (v : vector α n.succ) (i : fin n),
  nth (tail v) i = nth v i.succ
| ⟨a::l, e⟩ ⟨i, h⟩ := by simp [nth_eq_nth_le]; refl

@[simp] theorem tail_of_fn {n : ℕ} (f : fin n.succ → α) :
  tail (of_fn f) = of_fn (λ i, f i.succ) :=
(of_fn_nth _).symm.trans $ by congr; funext i; simp

theorem head'_to_list : ∀ (v : vector α n.succ),
  (to_list v).head' = some (head v)
| ⟨a::l, e⟩ := rfl

def reverse (v : vector α n) : vector α n :=
⟨v.to_list.reverse, by simp⟩

@[simp] theorem nth_zero : ∀ (v : vector α n.succ), nth v 0 = head v
| ⟨a::l, e⟩ := rfl

@[simp] theorem head_of_fn
  {n : ℕ} (f : fin n.succ → α) : head (of_fn f) = f 0 :=
by rw [← nth_zero, nth_of_fn]

@[simp] theorem nth_cons_zero
  (a : α) (v : vector α n) : nth (a :: v) 0 = a :=
by simp [nth_zero]

@[simp] theorem nth_cons_succ
  (a : α) (v : vector α n) (i : fin n) : nth (a :: v) i.succ = nth v i :=
by rw [← nth_tail, tail_cons]

def {u} m_of_fn {m} [monad m] {α : Type u} : ∀ {n}, (fin n → m α) → m (vector α n)
| 0     f := pure nil
| (n+1) f := do a ← f 0, v ← m_of_fn (λi, f i.succ), pure (a :: v)

theorem m_of_fn_pure {m} [monad m] [is_lawful_monad m] {α} :
  ∀ {n} (f : fin n → α), @m_of_fn m _ _ _ (λ i, pure (f i)) = pure (of_fn f)
| 0     f := rfl
| (n+1) f := by simp [m_of_fn, @m_of_fn_pure n, of_fn]

def {u} mmap {m} [monad m] {α} {β : Type u} (f : α → m β) :
  ∀ {n}, vector α n → m (vector β n)
| _ ⟨[], rfl⟩   := pure nil
| _ ⟨a::l, rfl⟩ := do h' ← f a, t' ← mmap ⟨l, rfl⟩, pure (h' :: t')

@[simp] theorem mmap_nil {m} [monad m] {α β} (f : α → m β) :
  mmap f nil = pure nil := rfl

@[simp] theorem mmap_cons {m} [monad m] {α β} (f : α → m β) (a) :
  ∀ {n} (v : vector α n), mmap f (a::v) =
  do h' ← f a, t' ← mmap f v, pure (h' :: t')
| _ ⟨l, rfl⟩ := rfl

@[extensionality] theorem ext : ∀ {v w : vector α n}
  (h : ∀ m : fin n, vector.nth v m = vector.nth w m), v = w
| ⟨v, hv⟩ ⟨w, hw⟩ h := subtype.eq (list.ext_le (by rw [hv, hw])
  (λ m hm hn, h ⟨m, hv ▸ hm⟩))

def to_array : vector α n → array n α
| ⟨xs, h⟩ := cast (by rw h) xs.to_array

end vector

namespace vector

universes u
variables {n : ℕ}

section traverse

variables {F G : Type u → Type u}
variables [applicative F] [applicative G]

open applicative functor
open list (cons) nat

private def traverse_aux {α β : Type u} (f : α → F β) :
  Π (x : list α), F (vector β x.length)
| []      := pure vector.nil
| (x::xs) := vector.cons <$> f x <*> traverse_aux xs

protected def traverse {α β : Type u} (f : α → F β) : vector α n → F (vector β n)
| ⟨v, Hv⟩ := cast (by rw Hv) $ traverse_aux f v

variables [is_lawful_applicative F] [is_lawful_applicative G]
variables {α β γ : Type u}

@[simp] protected lemma traverse_def
  (f : α → F β) (x : α) : ∀ (xs : vector α n),
  (x :: xs).traverse f = cons <$> f x <*> xs.traverse f :=
by rintro ⟨xs, rfl⟩; refl

protected lemma id_traverse : ∀ (x : vector α n), x.traverse id.mk = x :=
begin
  rintro ⟨x, rfl⟩, dsimp [vector.traverse, cast],
  induction x with x xs IH, {refl},
  simp! [IH], refl
end

open function

protected lemma comp_traverse (f : β → F γ) (g : α → G β) : ∀ (x : vector α n),
  vector.traverse (comp.mk ∘ functor.map f ∘ g) x =
  comp.mk (vector.traverse f <$> vector.traverse g x) :=
by rintro ⟨x, rfl⟩; dsimp [vector.traverse, cast];
   induction x with x xs; simp! [cast, *] with functor_norm;
   [refl, simp [(∘)]]

protected lemma traverse_eq_map_id {α β} (f : α → β) : ∀ (x : vector α n),
  x.traverse (id.mk ∘ f) = id.mk (map f x) :=
by rintro ⟨x, rfl⟩; simp!;
   induction x; simp! * with functor_norm; refl

variable (η : applicative_transformation F G)

protected lemma naturality {α β : Type*}
  (f : α → F β) : ∀ (x : vector α n),
  η (x.traverse f) = x.traverse (@η _ ∘ f) :=
by rintro ⟨x, rfl⟩; simp! [cast];
   induction x with x xs IH; simp! * with functor_norm

end traverse

instance : traversable.{u} (flip vector n) :=
{ traverse := @vector.traverse n,
  map := λ α β, @vector.map.{u u} α β n }

instance : is_lawful_traversable.{u} (flip vector n) :=
{ id_traverse := @vector.id_traverse n,
  comp_traverse := @vector.comp_traverse n,
  traverse_eq_map_id := @vector.traverse_eq_map_id n,
  naturality := @vector.naturality n,
  id_map := by intros; cases x; simp! [(<$>)],
  comp_map := by intros; cases x; simp! [(<$>)] }

end vector


/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Data.Nat.Linear
import Init.Data.List.BasicAux

theorem List.sizeOf_get_lt [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
  match as, i with
  | [],    i      => apply Fin.elim0 i
  | a::as, ⟨0, _⟩ => simp_arith [get]
  | a::as, ⟨i+1, h⟩ =>
    simp [get]
    have h : i < as.length := Nat.lt_of_succ_lt_succ h
    have ih := sizeOf_get_lt as ⟨i, h⟩
    exact Nat.lt_of_lt_of_le ih (Nat.le_add_left ..)

namespace Array

instance [DecidableEq α] : Membership α (Array α) where
  mem a as := as.contains a

theorem sizeOf_get_lt [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
  cases as; rename_i as
  simp [get]
  have ih := List.sizeOf_get_lt as i
  exact Nat.lt_trans ih (by simp_arith)

theorem sizeOf_lt_of_mem [DecidableEq α] [SizeOf α] {as : Array α} (h : a ∈ as) : sizeOf a < sizeOf as := by
  simp [Membership.mem, contains, any, Id.run, BEq.beq, anyM] at h
  let rec aux (j : Nat) (h : anyM.loop (m := Id) (fun b => decide (a = b)) as as.size (Nat.le_refl ..) j = true) : sizeOf a < sizeOf as := by
    unfold anyM.loop at h
    split at h
    · simp [Bind.bind, pure] at h; split at h
      next he => subst a; apply sizeOf_get_lt
      next => have ih := aux (j+1) h; assumption
    · contradiction
  apply aux 0 h
termination_by aux j _ => as.size - j

@[simp] theorem sizeOf_get [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
  cases as
  simp [get]
  apply Nat.lt_trans (List.sizeOf_get ..)
  simp_arith

/-- This tactic, added to the `decreasing_trivial` toolbox, proves that
`sizeOf arr[i] < sizeOf arr`, which is useful for well founded recursions
over a nested inductive like `inductive T | mk : Array T → T`. -/
macro "array_get_dec" : tactic =>
  `(tactic| first
    | apply sizeOf_get
    | apply Nat.lt_trans (sizeOf_get ..); simp_arith)

macro_rules | `(tactic| decreasing_trivial) => `(tactic| array_get_dec)

end Array


/-
Copyright (c) 2015 Leonardo de Moura. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

Finite type (type class).
-/
import data.list.perm data.list.as_type data.bool data.equiv
open list bool unit decidable option function

structure fintype [class] (A : Type) : Type :=
(elems : list A) (unique : nodup elems) (complete : ∀ a, a ∈ elems)

definition elements_of (A : Type) [h : fintype A] : list A :=
@fintype.elems A h

section
open equiv
definition fintype_of_equiv {A B : Type} [h : fintype A] : A ≃ B → fintype B
| (mk f g l r) :=
  fintype.mk
    (map f (elements_of A))
    (nodup_map (injective_of_left_inverse l) !fintype.unique)
    (λ b,
      have g b ∈ elements_of A, from fintype.complete (g b),
      have f (g b) ∈ map f (elements_of A), from mem_map f this,
      by rewrite r at this; exact this)
end

definition fintype_unit [instance] : fintype unit :=
fintype.mk [star] dec_trivial (λ u, match u with star := dec_trivial end)

definition fintype_bool [instance] : fintype bool :=
fintype.mk [ff, tt]
  dec_trivial
  (λ b, match b with | tt := dec_trivial | ff := dec_trivial end)

definition fintype_product [instance] {A B : Type} : Π [h₁ : fintype A] [h₂ : fintype B], fintype (A × B)
| (fintype.mk e₁ u₁ c₁) (fintype.mk e₂ u₂ c₂) :=
  fintype.mk
    (product e₁ e₂)
    (nodup_product u₁ u₂)
    (λ p,
      match p with
      (a, b) := mem_product (c₁ a) (c₂ b)
      end)

/- auxiliary function for finding 'a' s.t. f a ≠ g a -/
section find_discr
variables {A B : Type}
variable  [h : decidable_eq B]
include h
definition find_discr (f g : A → B) : list A → option A
| []     := none
| (a::l) := if f a = g a then find_discr l else some a

theorem find_discr_nil (f g : A → B) : find_discr f g [] = none :=
rfl

theorem find_discr_cons_of_ne {f g : A → B} {a : A} (l : list A) : f a ≠ g a → find_discr f g (a::l) = some a :=
assume ne, if_neg ne

theorem find_discr_cons_of_eq {f g : A → B} {a : A} (l : list A) : f a = g a → find_discr f g (a::l) = find_discr f g l :=
assume eq, if_pos eq

theorem ne_of_find_discr_eq_some {f g : A → B} {a : A} : ∀ {l}, find_discr f g l = some a → f a ≠ g a
| []     e := by contradiction
| (x::l) e := by_cases
  (suppose f x = g x,
     have find_discr f g l = some a, by rewrite [find_discr_cons_of_eq l this at e]; exact e,
     ne_of_find_discr_eq_some this)
  (assume h : f x ≠ g x,
     have some x = some a, by rewrite [find_discr_cons_of_ne l h at e]; exact e,
     by clear ne_of_find_discr_eq_some; injection this; subst a; exact h)

theorem all_eq_of_find_discr_eq_none {f g : A → B} : ∀ {l}, find_discr f g l = none → ∀ a, a ∈ l → f a = g a
| []     e a i := absurd i !not_mem_nil
| (x::l) e a i := by_cases
  (assume fx_eq_gx : f x = g x,
    or.elim (eq_or_mem_of_mem_cons i)
      (suppose a = x, by rewrite [-this at fx_eq_gx]; exact fx_eq_gx)
      (suppose a ∈ l,
        have aux : find_discr f g l = none, by rewrite [find_discr_cons_of_eq l fx_eq_gx at e]; exact e,
        all_eq_of_find_discr_eq_none aux a this))
  (suppose f x ≠ g x,
    by rewrite [find_discr_cons_of_ne l this at e]; contradiction)
end find_discr

definition decidable_eq_fun [instance] {A B : Type} [h₁ : fintype A] [h₂ : decidable_eq B] : decidable_eq (A → B) :=
λ f g,
  match h₁ with
  | fintype.mk e u c :=
    match find_discr f g e with
    | some a := λ h : find_discr f g e = some a, inr (λ f_eq_g : f = g, absurd (by rewrite f_eq_g; reflexivity) (ne_of_find_discr_eq_some h))
    | none   := λ h : find_discr f g e = none, inl (show f = g, from funext (λ a : A, all_eq_of_find_discr_eq_none h a (c a)))
    end rfl
  end

section check_pred
variables {A : Type}

definition check_pred (p : A → Prop) [h : decidable_pred p] : list A → bool
| []     := tt
| (a::l) := if p a then check_pred l else ff

theorem check_pred_cons_of_pos {p : A → Prop} [h : decidable_pred p] {a : A} (l : list A) : p a → check_pred p (a::l) = check_pred p l :=
assume pa, if_pos pa

theorem check_pred_cons_of_neg {p : A → Prop} [h : decidable_pred p] {a : A} (l : list A) : ¬ p a → check_pred p (a::l) = ff :=
assume npa, if_neg npa

theorem all_of_check_pred_eq_tt {p : A → Prop} [h : decidable_pred p] : ∀ {l : list A}, check_pred p l = tt → ∀ {a}, a ∈ l → p a
| []     eqtt a ainl := absurd ainl !not_mem_nil
| (b::l) eqtt a ainbl := by_cases
  (suppose p b, or.elim (eq_or_mem_of_mem_cons ainbl)
    (suppose a = b, by rewrite [this]; exact `p b`)
    (suppose a ∈ l,
      have check_pred p l = tt, by rewrite [check_pred_cons_of_pos _ `p b` at eqtt]; exact eqtt,
      all_of_check_pred_eq_tt this `a ∈ l`))
  (suppose ¬ p b,
    by rewrite [check_pred_cons_of_neg _ this at eqtt]; exact (bool.no_confusion eqtt))

theorem ex_of_check_pred_eq_ff {p : A → Prop} [h : decidable_pred p] : ∀ {l : list A}, check_pred p l = ff → ∃ w, ¬ p w
| []     eqtt := bool.no_confusion eqtt
| (a::l) eqtt := by_cases
  (suppose p a,
    have check_pred p l = ff, by rewrite [check_pred_cons_of_pos _ this at eqtt]; exact eqtt,
    ex_of_check_pred_eq_ff this)
  (suppose ¬ p a, exists.intro a this)
end check_pred

definition decidable_forall_finite [instance] {A : Type} {p : A → Prop} [h₁ : fintype A] [h₂ : decidable_pred p]
           : decidable (∀ x : A, p x) :=
match h₁ with
| fintype.mk e u c :=
  match check_pred p e with
  | tt := suppose check_pred p e = tt, inl (take a : A, all_of_check_pred_eq_tt this (c a))
  | ff := suppose check_pred p e = ff,
    inr (suppose ∀ x, p x,
         obtain (a : A) (w : ¬ p a), from ex_of_check_pred_eq_ff `check_pred p e = ff`,
         absurd (this a) w)
  end rfl
end

definition decidable_exists_finite [instance] {A : Type} {p : A → Prop} [h₁ : fintype A] [h₂ : decidable_pred p]
           : decidable (∃ x : A, p x) :=
match h₁ with
| fintype.mk e u c :=
  match check_pred (λ a, ¬ p a) e with
  | tt := λ h : check_pred (λ a, ¬ p a) e = tt, inr (λ ex : (∃ x, p x),
          obtain x px, from ex,
          absurd px (all_of_check_pred_eq_tt h (c x)))
  | ff := λ h : check_pred (λ a, ¬ p a) e = ff, inl (
          have ∃ x, ¬¬p x, from ex_of_check_pred_eq_ff h,
          obtain x nnpx, from this, exists.intro x (not_not_elim nnpx))
  end rfl
end

open list.as_type
-- Auxiliary function for returning a list with all elements of the type: (list.as_type l)
-- Remark ⟪s⟫ is notation for (list.as_type l)
-- We use this function to define the instance for (fintype ⟪s⟫)
private definition ltype_elems {A : Type} {s : list A} : Π {l : list A}, l ⊆ s → list ⟪s⟫
| []     h := []
| (a::l) h := lval a (h a !mem_cons) :: ltype_elems (sub_of_cons_sub h)

private theorem mem_of_mem_ltype_elems {A : Type} {a : A} {s : list A}
                : Π {l : list A} {h : l ⊆ s} {m : a ∈ s}, mk a m ∈ ltype_elems h → a ∈ l
| []     h m lin := absurd lin !not_mem_nil
| (b::l) h m lin := or.elim (eq_or_mem_of_mem_cons lin)
  (suppose mk a m = mk b (h b (mem_cons b l)),
     as_type.no_confusion this (λ aeqb em, by rewrite [aeqb]; exact !mem_cons))
  (suppose mk a m ∈ ltype_elems (sub_of_cons_sub h),
     have a ∈ l, from mem_of_mem_ltype_elems this,
     mem_cons_of_mem _ this)

private theorem nodup_ltype_elems {A : Type} {s : list A} : Π {l : list A} (d : nodup l) (h : l ⊆ s), nodup (ltype_elems h)
| []     d h := nodup_nil
| (a::l) d h :=
  have d₁    : nodup l, from nodup_of_nodup_cons d,
  have nainl : a ∉ l, from not_mem_of_nodup_cons d,
  let  h₁    : l ⊆ s := sub_of_cons_sub h in
  have d₂    : nodup (ltype_elems h₁), from nodup_ltype_elems d₁ h₁,
  have nin   : mk a (h a (mem_cons a l)) ∉ ltype_elems h₁, from
    assume ab, absurd (mem_of_mem_ltype_elems ab) nainl,
  nodup_cons nin d₂

private theorem mem_ltype_elems {A : Type} {s : list A} {a : ⟪s⟫}
                : Π {l : list A} (h : l ⊆ s), value a ∈ l → a ∈ ltype_elems h
| []     h vainl  := absurd vainl !not_mem_nil
| (b::l) h vainbl := or.elim (eq_or_mem_of_mem_cons vainbl)
  (λ vaeqb : value a = b,
   begin
      revert vaeqb h,
      -- TODO(Leo): check why 'cases a with va, ma' produces an incorrect proof
      eapply as_type.cases_on a,
      intro va ma vaeqb,
      rewrite -vaeqb, intro h,
      apply mem_cons
   end)
  (λ vainl : value a ∈ l,
     have aux : a ∈ ltype_elems (sub_of_cons_sub h), from mem_ltype_elems (sub_of_cons_sub h) vainl,
     mem_cons_of_mem _ aux)

definition fintype_list_as_type [instance] {A : Type} [h : decidable_eq A] {s : list A} : fintype ⟪s⟫ :=
let  nds   : list A := erase_dup s in
have sub₁  : nds ⊆ s,   from erase_dup_sub s,
have sub₂  : s ⊆ nds,   from sub_erase_dup s,
have dnds  : nodup nds, from nodup_erase_dup s,
let  e     : list ⟪s⟫ := ltype_elems sub₁ in
fintype.mk
  e
  (nodup_ltype_elems dnds sub₁)
  (take a : ⟪s⟫,
   show a ∈ e, from
     have value a ∈ s,   from is_member a,
     have value a ∈ nds, from sub₂ this,
     mem_ltype_elems sub₁ this)


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.real.cau_seq
! leanprover-community/mathlib commit 9116dd6709f303dcf781632e15fdef382b0fc579
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupPower.Lemmas
import Mathlib.Algebra.Order.AbsoluteValue
import Mathlib.Algebra.Order.Group.MinMax
import Mathlib.Algebra.Order.Field.Basic
import Mathlib.Algebra.Ring.Pi
import Mathlib.GroupTheory.GroupAction.Pi
import Mathlib.Tactic.Ring
import Mathlib.Tactic.Set

/-!
# Cauchy sequences

A basic theory of Cauchy sequences, used in the construction of the reals and p-adic numbers. Where
applicable, lemmas that will be reused in other contexts have been stated in extra generality.
There are other "versions" of Cauchyness in the library, in particular Cauchy filters in topology.
This is a concrete implementation that is useful for simplicity and computability reasons.

## Important definitions

* `IsCauSeq`: a predicate that says `f : ℕ → β` is Cauchy.
* `CauSeq`: the type of Cauchy sequences valued in type `β` with respect to an absolute value
  function `abv`.

## Tags

sequence, cauchy, abs val, absolute value
-/

open IsAbsoluteValue

theorem exists_forall_ge_and {α} [LinearOrder α] {P Q : α → Prop} :
    (∃ i, ∀ j ≥ i, P j) → (∃ i, ∀ j ≥ i, Q j) → ∃ i, ∀ j ≥ i, P j ∧ Q j
  | ⟨a, h₁⟩, ⟨b, h₂⟩ =>
    let ⟨c, ac, bc⟩ := exists_ge_of_linear a b
    ⟨c, fun _ hj => ⟨h₁ _ (le_trans ac hj), h₂ _ (le_trans bc hj)⟩⟩
#align exists_forall_ge_and exists_forall_ge_and

section

variable [LinearOrderedField α] [Ring β] (abv : β → α) [IsAbsoluteValue abv]

theorem rat_add_continuous_lemma {ε : α} (ε0 : 0 < ε) :
    ∃ δ > 0, ∀ {a₁ a₂ b₁ b₂ : β}, abv (a₁ - b₁) < δ → abv (a₂ - b₂) < δ →
      abv (a₁ + a₂ - (b₁ + b₂)) < ε :=
  ⟨ε / 2, half_pos ε0, fun {a₁ a₂ b₁ b₂} h₁ h₂ => by
    simpa [add_halves, sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using
      lt_of_le_of_lt (abv_add abv _ _) (add_lt_add h₁ h₂)⟩
#align rat_add_continuous_lemma rat_add_continuous_lemma

theorem rat_mul_continuous_lemma {ε K₁ K₂ : α} (ε0 : 0 < ε) :
    ∃ δ > 0, ∀ {a₁ a₂ b₁ b₂ : β}, abv a₁ < K₁ → abv b₂ < K₂ → abv (a₁ - b₁) < δ →
      abv (a₂ - b₂) < δ → abv (a₁ * a₂ - b₁ * b₂) < ε := by
  have K0 : (0 : α) < max 1 (max K₁ K₂) := lt_of_lt_of_le zero_lt_one (le_max_left _ _)
  have εK := div_pos (half_pos ε0) K0
  refine' ⟨_, εK, fun {a₁ a₂ b₁ b₂} ha₁ hb₂ h₁ h₂ => _⟩
  replace ha₁ := lt_of_lt_of_le ha₁ (le_trans (le_max_left _ K₂) (le_max_right 1 _))
  replace hb₂ := lt_of_lt_of_le hb₂ (le_trans (le_max_right K₁ _) (le_max_right 1 _))
  have :=
    add_lt_add (mul_lt_mul' (le_of_lt h₁) hb₂ (abv_nonneg abv _) εK)
      (mul_lt_mul' (le_of_lt h₂) ha₁ (abv_nonneg abv _) εK)
  rw [← abv_mul abv, mul_comm, div_mul_cancel _ (ne_of_gt K0), ← abv_mul abv, add_halves] at this
  simpa [sub_eq_add_neg, mul_add, add_mul, add_left_comm] using
    lt_of_le_of_lt (abv_add abv _ _) this
#align rat_mul_continuous_lemma rat_mul_continuous_lemma

theorem rat_inv_continuous_lemma {β : Type _} [DivisionRing β] (abv : β → α) [IsAbsoluteValue abv]
    {ε K : α} (ε0 : 0 < ε) (K0 : 0 < K) :
    ∃ δ > 0, ∀ {a b : β}, K ≤ abv a → K ≤ abv b → abv (a - b) < δ → abv (a⁻¹ - b⁻¹) < ε := by
  refine' ⟨K * ε * K, mul_pos (mul_pos K0 ε0) K0, fun {a b} ha hb h => _⟩
  have a0 := K0.trans_le ha
  have b0 := K0.trans_le hb
  rw [inv_sub_inv' ((abv_pos abv).1 a0) ((abv_pos abv).1 b0), abv_mul abv, abv_mul abv, abv_inv abv,
    abv_inv abv, abv_sub abv]
  refine' lt_of_mul_lt_mul_left (lt_of_mul_lt_mul_right _ b0.le) a0.le
  rw [mul_assoc, inv_mul_cancel_right₀ b0.ne', ← mul_assoc, mul_inv_cancel a0.ne', one_mul]
  refine' h.trans_le _
  exact mul_le_mul (mul_le_mul ha le_rfl ε0.le a0.le) hb K0.le (mul_nonneg a0.le ε0.le)
#align rat_inv_continuous_lemma rat_inv_continuous_lemma

end

/-- A sequence is Cauchy if the distance between its entries tends to zero. -/
def IsCauSeq {α : Type _} [LinearOrderedField α] {β : Type _} [Ring β] (abv : β → α) (f : ℕ → β) :
    Prop :=
  ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j - f i) < ε
#align is_cau_seq IsCauSeq

namespace IsCauSeq

variable [LinearOrderedField α] [Ring β] {abv : β → α} [IsAbsoluteValue abv] {f g : ℕ → β}

-- see Note [nolint_ge]
--@[nolint ge_or_gt] -- Porting note: restore attribute
theorem cauchy₂ (hf : IsCauSeq abv f) {ε : α} (ε0 : 0 < ε) :
    ∃ i, ∀ j ≥ i, ∀ k ≥ i, abv (f j - f k) < ε := by
  refine' (hf _ (half_pos ε0)).imp fun i hi j ij k ik => _
  rw [← add_halves ε]
  refine' lt_of_le_of_lt (abv_sub_le abv _ _ _) (add_lt_add (hi _ ij) _)
  rw [abv_sub abv]; exact hi _ ik
#align is_cau_seq.cauchy₂ IsCauSeq.cauchy₂

theorem cauchy₃ (hf : IsCauSeq abv f) {ε : α} (ε0 : 0 < ε) :
    ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - f j) < ε :=
  let ⟨i, H⟩ := hf.cauchy₂ ε0
  ⟨i, fun _ ij _ jk => H _ (le_trans ij jk) _ ij⟩
#align is_cau_seq.cauchy₃ IsCauSeq.cauchy₃

theorem add (hf : IsCauSeq abv f) (hg : IsCauSeq abv g) : IsCauSeq abv (f + g) := fun _ ε0 =>
  let ⟨_, δ0, Hδ⟩ := rat_add_continuous_lemma abv ε0
  let ⟨i, H⟩ := exists_forall_ge_and (hf.cauchy₃ δ0) (hg.cauchy₃ δ0)
  ⟨i, fun _ ij =>
    let ⟨H₁, H₂⟩ := H _ le_rfl
    Hδ (H₁ _ ij) (H₂ _ ij)⟩
#align is_cau_seq.add IsCauSeq.add

end IsCauSeq

/-- `CauSeq β abv` is the type of `β`-valued Cauchy sequences, with respect to the absolute value
function `abv`. -/
def CauSeq {α : Type _} [LinearOrderedField α] (β : Type _) [Ring β] (abv : β → α) : Type _ :=
  { f : ℕ → β // IsCauSeq abv f }
#align cau_seq CauSeq

namespace CauSeq

variable [LinearOrderedField α]

section Ring

variable [Ring β] {abv : β → α}

instance : CoeFun (CauSeq β abv) fun _ => ℕ → β :=
  ⟨Subtype.val⟩

-- Porting note: Remove coeFn theorem
/-@[simp]
theorem mk_to_fun (f) (hf : IsCauSeq abv f) : @coeFn (CauSeq β abv) _ _ ⟨f, hf⟩ = f :=
  rfl -/
#noalign cau_seq.mk_to_fun

theorem ext {f g : CauSeq β abv} (h : ∀ i, f i = g i) : f = g :=
  Subtype.eq (funext h)
#align cau_seq.ext CauSeq.ext

theorem isCauSeq (f : CauSeq β abv) : IsCauSeq abv f :=
  f.2
#align cau_seq.is_cau CauSeq.isCauSeq

theorem cauchy (f : CauSeq β abv) : ∀ {ε}, 0 < ε → ∃ i, ∀ j ≥ i, abv (f j - f i) < ε := @f.2
#align cau_seq.cauchy CauSeq.cauchy

/-- Given a Cauchy sequence `f`, create a Cauchy sequence from a sequence `g` with
the same values as `f`. -/
def ofEq (f : CauSeq β abv) (g : ℕ → β) (e : ∀ i, f i = g i) : CauSeq β abv :=
  ⟨g, fun ε => by rw [show g = f from (funext e).symm]; exact f.cauchy⟩
#align cau_seq.of_eq CauSeq.ofEq

variable [IsAbsoluteValue abv]

-- see Note [nolint_ge]
-- @[nolint ge_or_gt] -- Porting note: restore attribute
theorem cauchy₂ (f : CauSeq β abv) {ε} :
    0 < ε → ∃ i, ∀ (j) (_ : j ≥ i) (k) (_ : k ≥ i), abv (f j - f k) < ε :=
  f.2.cauchy₂
#align cau_seq.cauchy₂ CauSeq.cauchy₂

theorem cauchy₃ (f : CauSeq β abv) {ε} : 0 < ε → ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - f j) < ε :=
  f.2.cauchy₃
#align cau_seq.cauchy₃ CauSeq.cauchy₃

theorem bounded (f : CauSeq β abv) : ∃ r, ∀ i, abv (f i) < r := by
  cases' f.cauchy zero_lt_one with i h
  set R : ℕ → α := @Nat.rec (fun _ => α) (abv (f 0)) fun i c => max c (abv (f i.succ)) with hR
  have : ∀ i, ∀ j ≤ i, abv (f j) ≤ R i := by
    refine' Nat.rec (by simp [hR]) _
    rintro i hi j (rfl | hj)
    · simp
    exact (hi j hj).trans (le_max_left _ _)
  refine' ⟨R i + 1, fun j => _⟩
  cases' lt_or_le j i with ij ij
  · exact lt_of_le_of_lt (this i _ (le_of_lt ij)) (lt_add_one _)
  · have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add_of_le_of_lt (this i _ le_rfl) (h _ ij))
    rw [add_sub, add_comm] at this
    simpa using this
#align cau_seq.bounded CauSeq.bounded

theorem bounded' (f : CauSeq β abv) (x : α) : ∃ r > x, ∀ i, abv (f i) < r :=
  let ⟨r, h⟩ := f.bounded
  ⟨max r (x + 1), lt_of_lt_of_le (lt_add_one _) (le_max_right _ _), fun i =>
    lt_of_lt_of_le (h i) (le_max_left _ _)⟩
#align cau_seq.bounded' CauSeq.bounded'

instance : Add (CauSeq β abv) :=
  ⟨fun f g => ⟨f + g, f.2.add g.2⟩⟩

@[simp, norm_cast]
theorem coe_add (f g : CauSeq β abv) : ⇑(f + g) = (f : ℕ → β) + g :=
  rfl
#align cau_seq.coe_add CauSeq.coe_add

@[simp, norm_cast]
theorem add_apply (f g : CauSeq β abv) (i : ℕ) : (f + g) i = f i + g i :=
  rfl
#align cau_seq.add_apply CauSeq.add_apply

variable (abv)

/-- The constant Cauchy sequence. -/
def const (x : β) : CauSeq β abv :=
  ⟨fun _ => x, fun ε ε0 => ⟨0, fun j _ => by simpa [abv_zero] using ε0⟩⟩
#align cau_seq.const CauSeq.const

variable {abv}

/-- The constant Cauchy sequence -/
local notation "const" => const abv

@[simp, norm_cast]
theorem coe_const (x : β) : (const x : ℕ → β) = Function.const ℕ x :=
  rfl
#align cau_seq.coe_const CauSeq.coe_const

@[simp, norm_cast]
theorem const_apply (x : β) (i : ℕ) : (const x : ℕ → β) i = x :=
  rfl
#align cau_seq.const_apply CauSeq.const_apply

theorem const_inj {x y : β} : (const x : CauSeq β abv) = const y ↔ x = y :=
  ⟨fun h => congr_arg (fun f : CauSeq β abv => (f : ℕ → β) 0) h, congr_arg _⟩
#align cau_seq.const_inj CauSeq.const_inj

instance : Zero (CauSeq β abv) :=
  ⟨const 0⟩

instance : One (CauSeq β abv) :=
  ⟨const 1⟩

instance : Inhabited (CauSeq β abv) :=
  ⟨0⟩

@[simp, norm_cast]
theorem coe_zero : ⇑(0 : CauSeq β abv) = 0 :=
  rfl
#align cau_seq.coe_zero CauSeq.coe_zero

@[simp, norm_cast]
theorem coe_one : ⇑(1 : CauSeq β abv) = 1 :=
  rfl
#align cau_seq.coe_one CauSeq.coe_one

@[simp, norm_cast]
theorem zero_apply (i) : (0 : CauSeq β abv) i = 0 :=
  rfl
#align cau_seq.zero_apply CauSeq.zero_apply

@[simp, norm_cast]
theorem one_apply (i) : (1 : CauSeq β abv) i = 1 :=
  rfl
#align cau_seq.one_apply CauSeq.one_apply

@[simp]
theorem const_zero : const 0 = 0 :=
  rfl
#align cau_seq.const_zero CauSeq.const_zero

@[simp]
theorem const_one : const 1 = 1 :=
  rfl
#align cau_seq.const_one CauSeq.const_one

theorem const_add (x y : β) : const (x + y) = const x + const y :=
  rfl
#align cau_seq.const_add CauSeq.const_add

instance : Mul (CauSeq β abv) :=
  ⟨fun f g =>
    ⟨f * g, fun _ ε0 =>
      let ⟨_, _, hF⟩ := f.bounded' 0
      let ⟨_, _, hG⟩ := g.bounded' 0
      let ⟨_, δ0, Hδ⟩ := rat_mul_continuous_lemma abv ε0
      let ⟨i, H⟩ := exists_forall_ge_and (f.cauchy₃ δ0) (g.cauchy₃ δ0)
      ⟨i, fun j ij =>
        let ⟨H₁, H₂⟩ := H _ le_rfl
        Hδ (hF j) (hG i) (H₁ _ ij) (H₂ _ ij)⟩⟩⟩

@[simp, norm_cast]
theorem coe_mul (f g : CauSeq β abv) : ⇑(f * g) = (f : ℕ → β) * g :=
  rfl
#align cau_seq.coe_mul CauSeq.coe_mul

@[simp, norm_cast]
theorem mul_apply (f g : CauSeq β abv) (i : ℕ) : (f * g) i = f i * g i :=
  rfl
#align cau_seq.mul_apply CauSeq.mul_apply

theorem const_mul (x y : β) : const (x * y) = const x * const y :=
  rfl
#align cau_seq.const_mul CauSeq.const_mul

instance : Neg (CauSeq β abv) :=
  ⟨fun f => ofEq (const (-1) * f) (fun x => -f x) fun i => by simp⟩

@[simp, norm_cast]
theorem coe_neg (f : CauSeq β abv) : ⇑(-f) = -f :=
  rfl
#align cau_seq.coe_neg CauSeq.coe_neg

@[simp, norm_cast]
theorem neg_apply (f : CauSeq β abv) (i) : (-f) i = -f i :=
  rfl
#align cau_seq.neg_apply CauSeq.neg_apply

theorem const_neg (x : β) : const (-x) = -const x :=
  rfl
#align cau_seq.const_neg CauSeq.const_neg

instance : Sub (CauSeq β abv) :=
  ⟨fun f g => ofEq (f + -g) (fun x => f x - g x) fun i => by simp [sub_eq_add_neg]⟩

@[simp, norm_cast]
theorem coe_sub (f g : CauSeq β abv) : ⇑(f - g) = (f : ℕ → β) - g :=
  rfl
#align cau_seq.coe_sub CauSeq.coe_sub

@[simp, norm_cast]
theorem sub_apply (f g : CauSeq β abv) (i : ℕ) : (f - g) i = f i - g i :=
  rfl
#align cau_seq.sub_apply CauSeq.sub_apply

theorem const_sub (x y : β) : const (x - y) = const x - const y :=
  rfl
#align cau_seq.const_sub CauSeq.const_sub

section SMul

variable [SMul G β] [IsScalarTower G β β]

instance : SMul G (CauSeq β abv) :=
  ⟨fun a f => (ofEq (const (a • (1 : β)) * f) (a • (f : ℕ → β))) fun _ => smul_one_mul _ _⟩

@[simp, norm_cast]
theorem coe_smul (a : G) (f : CauSeq β abv) : ⇑(a • f) = a • (f : ℕ → β) :=
  rfl
#align cau_seq.coe_smul CauSeq.coe_smul

@[simp, norm_cast]
theorem smul_apply (a : G) (f : CauSeq β abv) (i : ℕ) : (a • f) i = a • f i :=
  rfl
#align cau_seq.smul_apply CauSeq.smul_apply

theorem const_smul (a : G) (x : β) : const (a • x) = a • const x :=
  rfl
#align cau_seq.const_smul CauSeq.const_smul

instance : IsScalarTower G (CauSeq β abv) (CauSeq β abv) :=
  ⟨fun a f g => Subtype.ext <| smul_assoc a (f : ℕ → β) (g : ℕ → β)⟩

end SMul

instance addGroup : AddGroup (CauSeq β abv) :=
  Function.Injective.addGroup Subtype.val Subtype.val_injective rfl coe_add coe_neg coe_sub
    (fun _ _ => coe_smul _ _) fun _ _ => coe_smul _ _

instance instNatCast : NatCast (CauSeq β abv) := ⟨fun n => const n⟩

instance instIntCast : IntCast (CauSeq β abv) := ⟨fun n => const n⟩

instance addGroupWithOne : AddGroupWithOne (CauSeq β abv) :=
  Function.Injective.addGroupWithOne Subtype.val Subtype.val_injective rfl rfl
  coe_add coe_neg coe_sub
  (by intros; rfl)
  (by intros; rfl)
  (by intros; rfl)
  (by intros; rfl)

instance : Pow (CauSeq β abv) ℕ :=
  ⟨fun f n =>
    (ofEq (npowRec n f) fun i => f i ^ n) <| by induction n <;> simp [*, npowRec, pow_succ]⟩

@[simp, norm_cast]
theorem coe_pow (f : CauSeq β abv) (n : ℕ) : ⇑(f ^ n) = (f : ℕ → β) ^ n :=
  rfl
#align cau_seq.coe_pow CauSeq.coe_pow

@[simp, norm_cast]
theorem pow_apply (f : CauSeq β abv) (n i : ℕ) : (f ^ n) i = f i ^ n :=
  rfl
#align cau_seq.pow_apply CauSeq.pow_apply

theorem const_pow (x : β) (n : ℕ) : const (x ^ n) = const x ^ n :=
  rfl
#align cau_seq.const_pow CauSeq.const_pow

instance ring : Ring (CauSeq β abv) :=
  Function.Injective.ring Subtype.val Subtype.val_injective rfl rfl coe_add coe_mul coe_neg coe_sub
    (fun _ _ => coe_smul _ _) (fun _ _ => coe_smul _ _) coe_pow (fun _ => rfl) fun _ => rfl

instance {β : Type _} [CommRing β] {abv : β → α} [IsAbsoluteValue abv] : CommRing (CauSeq β abv) :=
  { CauSeq.ring with
    mul_comm := fun a b => ext $ fun n => by simp [mul_left_comm, mul_comm] }

/-- `LimZero f` holds when `f` approaches 0. -/
def LimZero {abv : β → α} (f : CauSeq β abv) : Prop :=
  ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j) < ε
#align cau_seq.lim_zero CauSeq.LimZero

theorem add_limZero {f g : CauSeq β abv} (hf : LimZero f) (hg : LimZero g) : LimZero (f + g)
  | ε, ε0 =>
    (exists_forall_ge_and (hf _ <| half_pos ε0) (hg _ <| half_pos ε0)).imp fun i H j ij => by
      let ⟨H₁, H₂⟩ := H _ ij
      simpa [add_halves ε] using lt_of_le_of_lt (abv_add abv _ _) (add_lt_add H₁ H₂)
#align cau_seq.add_lim_zero CauSeq.add_limZero

theorem mul_limZero_right (f : CauSeq β abv) {g} (hg : LimZero g) : LimZero (f * g)
  | ε, ε0 =>
    let ⟨F, F0, hF⟩ := f.bounded' 0
    (hg _ <| div_pos ε0 F0).imp fun i H j ij => by
      have := mul_lt_mul' (le_of_lt <| hF j) (H _ ij) (abv_nonneg abv _) F0
      rwa [mul_comm F, div_mul_cancel _ (ne_of_gt F0), ← abv_mul] at this
#align cau_seq.mul_lim_zero_right CauSeq.mul_limZero_right

theorem mul_limZero_left {f} (g : CauSeq β abv) (hg : LimZero f) : LimZero (f * g)
  | ε, ε0 =>
    let ⟨G, G0, hG⟩ := g.bounded' 0
    (hg _ <| div_pos ε0 G0).imp fun i H j ij => by
      have := mul_lt_mul'' (H _ ij) (hG j) (abv_nonneg abv _) (abv_nonneg abv _)
      rwa [div_mul_cancel _ (ne_of_gt G0), ← abv_mul] at this
#align cau_seq.mul_lim_zero_left CauSeq.mul_limZero_left

theorem neg_limZero {f : CauSeq β abv} (hf : LimZero f) : LimZero (-f) := by
  rw [← neg_one_mul f]
  exact mul_limZero_right _ hf
#align cau_seq.neg_lim_zero CauSeq.neg_limZero

theorem sub_limZero {f g : CauSeq β abv} (hf : LimZero f) (hg : LimZero g) : LimZero (f - g) := by
  simpa only [sub_eq_add_neg] using add_limZero hf (neg_limZero hg)
#align cau_seq.sub_lim_zero CauSeq.sub_limZero

theorem limZero_sub_rev {f g : CauSeq β abv} (hfg : LimZero (f - g)) : LimZero (g - f) := by
  simpa using neg_limZero hfg
#align cau_seq.lim_zero_sub_rev CauSeq.limZero_sub_rev

theorem zero_limZero : LimZero (0 : CauSeq β abv)
  | ε, ε0 => ⟨0, fun j _ => by simpa [abv_zero abv] using ε0⟩
#align cau_seq.zero_lim_zero CauSeq.zero_limZero

theorem const_limZero {x : β} : LimZero (const x) ↔ x = 0 :=
  ⟨fun H =>
    (abv_eq_zero abv).1 <|
      (eq_of_le_of_forall_le_of_dense (abv_nonneg abv _)) fun _ ε0 =>
        let ⟨_, hi⟩ := H _ ε0
        le_of_lt <| hi _ le_rfl,
    fun e => e.symm ▸ zero_limZero⟩
#align cau_seq.const_lim_zero CauSeq.const_limZero

instance equiv : Setoid (CauSeq β abv) :=
  ⟨fun f g => LimZero (f - g),
    ⟨fun f => by simp [zero_limZero],
    fun f ε hε => by simpa using neg_limZero f ε hε,
    fun fg gh => by simpa using add_limZero fg gh⟩⟩
#align cau_seq.equiv CauSeq.equiv

theorem add_equiv_add {f1 f2 g1 g2 : CauSeq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) :
    f1 + g1 ≈ f2 + g2 := by simpa only [← add_sub_add_comm] using add_limZero hf hg
#align cau_seq.add_equiv_add CauSeq.add_equiv_add

theorem neg_equiv_neg {f g : CauSeq β abv} (hf : f ≈ g) : -f ≈ -g := by
  simpa only [neg_sub'] using neg_limZero hf
#align cau_seq.neg_equiv_neg CauSeq.neg_equiv_neg

theorem sub_equiv_sub {f1 f2 g1 g2 : CauSeq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) :
    f1 - g1 ≈ f2 - g2 := by simpa only [sub_eq_add_neg] using add_equiv_add hf (neg_equiv_neg hg)
#align cau_seq.sub_equiv_sub CauSeq.sub_equiv_sub

theorem equiv_def₃ {f g : CauSeq β abv} (h : f ≈ g) {ε : α} (ε0 : 0 < ε) :
    ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - g j) < ε :=
  (exists_forall_ge_and (h _ <| half_pos ε0) (f.cauchy₃ <| half_pos ε0)).imp fun i H j ij k jk => by
    let ⟨h₁, h₂⟩ := H _ ij
    have := lt_of_le_of_lt (abv_add abv (f j - g j) _) (add_lt_add h₁ (h₂ _ jk))
    rwa [sub_add_sub_cancel', add_halves] at this
#align cau_seq.equiv_def₃ CauSeq.equiv_def₃

theorem limZero_congr {f g : CauSeq β abv} (h : f ≈ g) : LimZero f ↔ LimZero g :=
  ⟨fun l => by simpa using add_limZero (Setoid.symm h) l, fun l => by simpa using add_limZero h l⟩
#align cau_seq.lim_zero_congr CauSeq.limZero_congr

theorem abv_pos_of_not_limZero {f : CauSeq β abv} (hf : ¬LimZero f) :
    ∃ K > 0, ∃ i, ∀ j ≥ i, K ≤ abv (f j) := by
  haveI := Classical.propDecidable
  by_contra nk
  refine' hf fun ε ε0 => _
  simp [not_forall] at nk
  cases' f.cauchy₃ (half_pos ε0) with i hi
  rcases nk _ (half_pos ε0) i with ⟨j, ij, hj⟩
  refine' ⟨j, fun k jk => _⟩
  have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add (hi j ij k jk) hj)
  rwa [sub_add_cancel, add_halves] at this
#align cau_seq.abv_pos_of_not_lim_zero CauSeq.abv_pos_of_not_limZero

theorem of_near (f : ℕ → β) (g : CauSeq β abv) (h : ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j - g j) < ε) :
    IsCauSeq abv f
  | ε, ε0 =>
    let ⟨i, hi⟩ := exists_forall_ge_and (h _ (half_pos <| half_pos ε0)) (g.cauchy₃ <| half_pos ε0)
    ⟨i, fun j ij => by
      cases' hi _ le_rfl with h₁ h₂; rw [abv_sub abv] at h₁
      have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add (hi _ ij).1 h₁)
      have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add this (h₂ _ ij))
      rwa [add_halves, add_halves, add_right_comm, sub_add_sub_cancel, sub_add_sub_cancel] at this⟩
#align cau_seq.of_near CauSeq.of_near

theorem not_limZero_of_not_congr_zero {f : CauSeq _ abv} (hf : ¬f ≈ 0) : ¬LimZero f := by
  intro h
  have : LimZero (f - 0) := by simp [h]
  exact hf this
#align cau_seq.not_lim_zero_of_not_congr_zero CauSeq.not_limZero_of_not_congr_zero

theorem mul_equiv_zero (g : CauSeq _ abv) {f : CauSeq _ abv} (hf : f ≈ 0) : g * f ≈ 0 :=
  have : LimZero (f - 0) := hf
  have : LimZero (g * f) := mul_limZero_right _ <| by simpa
  show LimZero (g * f - 0) by simpa
#align cau_seq.mul_equiv_zero CauSeq.mul_equiv_zero

theorem mul_equiv_zero' (g : CauSeq _ abv) {f : CauSeq _ abv} (hf : f ≈ 0) : f * g ≈ 0 :=
  have : LimZero (f - 0) := hf
  have : LimZero (f * g) := mul_limZero_left _ <| by simpa
  show LimZero (f * g - 0) by simpa
#align cau_seq.mul_equiv_zero' CauSeq.mul_equiv_zero'

theorem mul_not_equiv_zero {f g : CauSeq _ abv} (hf : ¬f ≈ 0) (hg : ¬g ≈ 0) : ¬f * g ≈ 0 :=
  fun (this : LimZero (f * g - 0)) => by
  have hlz : LimZero (f * g) := by simpa
  have hf' : ¬LimZero f := by simpa using show ¬LimZero (f - 0) from hf
  have hg' : ¬LimZero g := by simpa using show ¬LimZero (g - 0) from hg
  rcases abv_pos_of_not_limZero hf' with ⟨a1, ha1, N1, hN1⟩
  rcases abv_pos_of_not_limZero hg' with ⟨a2, ha2, N2, hN2⟩
  have : 0 < a1 * a2 := mul_pos ha1 ha2
  cases' hlz _ this with N hN
  let i := max N (max N1 N2)
  have hN' := hN i (le_max_left _ _)
  have hN1' := hN1 i (le_trans (le_max_left _ _) (le_max_right _ _))
  have hN1' := hN2 i (le_trans (le_max_right _ _) (le_max_right _ _))
  apply not_le_of_lt hN'
  change _ ≤ abv (_ * _)
  rw [abv_mul abv]
  apply mul_le_mul <;> try assumption
  · exact le_of_lt ha2
  · exact abv_nonneg abv _
#align cau_seq.mul_not_equiv_zero CauSeq.mul_not_equiv_zero

theorem const_equiv {x y : β} : const x ≈ const y ↔ x = y :=
  show LimZero _ ↔ _ by rw [← const_sub, const_limZero, sub_eq_zero]
#align cau_seq.const_equiv CauSeq.const_equiv

theorem mul_equiv_mul {f1 f2 g1 g2 : CauSeq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) :
    f1 * g1 ≈ f2 * g2 := by
  change LimZero (f1 * g1 - f2 * g2)
  convert add_limZero (mul_limZero_left g1 hf) (mul_limZero_right f2 hg) using 1
  rw [mul_sub, sub_mul]
  -- Porting note: doesn't work with `rw`, but did in Lean 3
  exact (sub_add_sub_cancel (f1*g1) (f2*g1) (f2*g2)).symm
  -- Porting note: was
  /-
  simpa only [mul_sub, sub_mul, sub_add_sub_cancel] using
    add_lim_zero (mul_limZero_left g1 hf) (mul_limZero_right f2 hg)
  -/
#align cau_seq.mul_equiv_mul CauSeq.mul_equiv_mul

theorem smul_equiv_smul [SMul G β] [IsScalarTower G β β] {f1 f2 : CauSeq β abv} (c : G)
    (hf : f1 ≈ f2) : c • f1 ≈ c • f2 := by
  simpa [const_smul, smul_one_mul _ _] using
    mul_equiv_mul (const_equiv.mpr <| Eq.refl <| c • (1 : β)) hf
#align cau_seq.smul_equiv_smul CauSeq.smul_equiv_smul

theorem pow_equiv_pow {f1 f2 : CauSeq β abv} (hf : f1 ≈ f2) (n : ℕ) : f1 ^ n ≈ f2 ^ n := by
  induction' n with n ih
  · simp only [Nat.zero_eq, pow_zero, Setoid.refl]
  · simpa only [pow_succ] using mul_equiv_mul hf ih
#align cau_seq.pow_equiv_pow CauSeq.pow_equiv_pow

end Ring

section IsDomain

variable [Ring β] [IsDomain β] (abv : β → α) [IsAbsoluteValue abv]

theorem one_not_equiv_zero : ¬const abv 1 ≈ const abv 0 := fun h =>
  have : ∀ ε > 0, ∃ i, ∀ k, i ≤ k → abv (1 - 0) < ε := h
  have h1 : abv 1 ≤ 0 :=
    le_of_not_gt fun h2 : 0 < abv 1 =>
      (Exists.elim (this _ h2)) fun i hi => lt_irrefl (abv 1) <| by simpa using hi _ le_rfl
  have h2 : 0 ≤ abv 1 := abv_nonneg abv _
  have : abv 1 = 0 := le_antisymm h1 h2
  have : (1 : β) = 0 := (abv_eq_zero abv).mp this
  absurd this one_ne_zero
#align cau_seq.one_not_equiv_zero CauSeq.one_not_equiv_zero

end IsDomain

section DivisionRing

variable [DivisionRing β] {abv : β → α} [IsAbsoluteValue abv]

theorem inv_aux {f : CauSeq β abv} (hf : ¬LimZero f) :
    ∀ ε > 0, ∃ i, ∀ j ≥ i, abv ((f j)⁻¹ - (f i)⁻¹) < ε
  | _, ε0 =>
    let ⟨_, K0, HK⟩ := abv_pos_of_not_limZero hf
    let ⟨_, δ0, Hδ⟩ := rat_inv_continuous_lemma abv ε0 K0
    let ⟨i, H⟩ := exists_forall_ge_and HK (f.cauchy₃ δ0)
    ⟨i, fun _ ij =>
      let ⟨iK, H'⟩ := H _ le_rfl
      Hδ (H _ ij).1 iK (H' _ ij)⟩
#align cau_seq.inv_aux CauSeq.inv_aux

/-- Given a Cauchy sequence `f` with nonzero limit, create a Cauchy sequence with values equal to
the inverses of the values of `f`. -/
def inv (f : CauSeq β abv) (hf : ¬LimZero f) : CauSeq β abv :=
  ⟨_, inv_aux hf⟩
#align cau_seq.inv CauSeq.inv

@[simp, norm_cast]
theorem coe_inv {f : CauSeq β abv} (hf) : ⇑(inv f hf) = (f : ℕ → β)⁻¹ :=
  rfl
#align cau_seq.coe_inv CauSeq.coe_inv

@[simp, norm_cast]
theorem inv_apply {f : CauSeq β abv} (hf i) : inv f hf i = (f i)⁻¹ :=
  rfl
#align cau_seq.inv_apply CauSeq.inv_apply

theorem inv_mul_cancel {f : CauSeq β abv} (hf) : inv f hf * f ≈ 1 := fun ε ε0 =>
  let ⟨K, K0, i, H⟩ := abv_pos_of_not_limZero hf
  ⟨i, fun j ij => by simpa [(abv_pos abv).1 (lt_of_lt_of_le K0 (H _ ij)), abv_zero abv] using ε0⟩
#align cau_seq.inv_mul_cancel CauSeq.inv_mul_cancel

theorem mul_inv_cancel {f : CauSeq β abv} (hf) : f * inv f hf ≈ 1 := fun ε ε0 =>
  let ⟨K, K0, i, H⟩ := abv_pos_of_not_limZero hf
  ⟨i, fun j ij => by simpa [(abv_pos abv).1 (lt_of_lt_of_le K0 (H _ ij)), abv_zero abv] using ε0⟩
#align cau_seq.mul_inv_cancel CauSeq.mul_inv_cancel

theorem const_inv {x : β} (hx : x ≠ 0) :
    const abv x⁻¹ = inv (const abv x) (by rwa [const_limZero]) :=
  rfl
#align cau_seq.const_inv CauSeq.const_inv

end DivisionRing

section Abs

/-- The constant Cauchy sequence -/
local notation "const" => const abs

/-- The entries of a positive Cauchy sequence eventually have a positive lower bound. -/
def Pos (f : CauSeq α abs) : Prop :=
  ∃ K > 0, ∃ i, ∀ j ≥ i, K ≤ f j
#align cau_seq.pos CauSeq.Pos

theorem not_limZero_of_pos {f : CauSeq α abs} : Pos f → ¬LimZero f
  | ⟨_, F0, hF⟩, H =>
    let ⟨_, h⟩ := exists_forall_ge_and hF (H _ F0)
    let ⟨h₁, h₂⟩ := h _ le_rfl
    not_lt_of_le h₁ (abs_lt.1 h₂).2
#align cau_seq.not_lim_zero_of_pos CauSeq.not_limZero_of_pos

theorem const_pos {x : α} : Pos (const x) ↔ 0 < x :=
  ⟨fun ⟨_, K0, _, h⟩ => lt_of_lt_of_le K0 (h _ le_rfl), fun h => ⟨x, h, 0, fun _ _ => le_rfl⟩⟩
#align cau_seq.const_pos CauSeq.const_pos

theorem add_pos {f g : CauSeq α abs} : Pos f → Pos g → Pos (f + g)
  | ⟨_, F0, hF⟩, ⟨_, G0, hG⟩ =>
    let ⟨i, h⟩ := exists_forall_ge_and hF hG
    ⟨_, _root_.add_pos F0 G0, i, fun _ ij =>
      let ⟨h₁, h₂⟩ := h _ ij
      add_le_add h₁ h₂⟩
#align cau_seq.add_pos CauSeq.add_pos

theorem pos_add_limZero {f g : CauSeq α abs} : Pos f → LimZero g → Pos (f + g)
  | ⟨F, F0, hF⟩, H =>
    let ⟨i, h⟩ := exists_forall_ge_and hF (H _ (half_pos F0))
    ⟨_, half_pos F0, i, fun j ij => by
      cases' h j ij with h₁ h₂
      have := add_le_add h₁ (le_of_lt (abs_lt.1 h₂).1)
      rwa [← sub_eq_add_neg, sub_self_div_two] at this⟩
#align cau_seq.pos_add_lim_zero CauSeq.pos_add_limZero

protected theorem mul_pos {f g : CauSeq α abs} : Pos f → Pos g → Pos (f * g)
  | ⟨_, F0, hF⟩, ⟨_, G0, hG⟩ =>
    let ⟨i, h⟩ := exists_forall_ge_and hF hG
    ⟨_, mul_pos F0 G0, i, fun _ ij =>
      let ⟨h₁, h₂⟩ := h _ ij
      mul_le_mul h₁ h₂ (le_of_lt G0) (le_trans (le_of_lt F0) h₁)⟩
#align cau_seq.mul_pos CauSeq.mul_pos

theorem trichotomy (f : CauSeq α abs) : Pos f ∨ LimZero f ∨ Pos (-f) := by
  cases' Classical.em (LimZero f) with h h <;> simp [*]
  rcases abv_pos_of_not_limZero h with ⟨K, K0, hK⟩
  rcases exists_forall_ge_and hK (f.cauchy₃ K0) with ⟨i, hi⟩
  refine' (le_total 0 (f i)).imp _ _ <;>
    refine' fun h => ⟨K, K0, i, fun j ij => _⟩ <;>
    have := (hi _ ij).1 <;>
    cases' hi _ le_rfl with h₁ h₂
  · rwa [abs_of_nonneg] at this
    rw [abs_of_nonneg h] at h₁
    exact
      (le_add_iff_nonneg_right _).1
        (le_trans h₁ <| neg_le_sub_iff_le_add'.1 <| le_of_lt (abs_lt.1 <| h₂ _ ij).1)
  · rwa [abs_of_nonpos] at this
    rw [abs_of_nonpos h] at h₁
    rw [← sub_le_sub_iff_right, zero_sub]
    exact le_trans (le_of_lt (abs_lt.1 <| h₂ _ ij).2) h₁
#align cau_seq.trichotomy CauSeq.trichotomy

instance : LT (CauSeq α abs) :=
  ⟨fun f g => Pos (g - f)⟩

instance : LE (CauSeq α abs) :=
  ⟨fun f g => f < g ∨ f ≈ g⟩

theorem lt_of_lt_of_eq {f g h : CauSeq α abs} (fg : f < g) (gh : g ≈ h) : f < h :=
  show Pos (h - f) by
    convert pos_add_limZero fg (neg_limZero gh) using 1
    simp

#align cau_seq.lt_of_lt_of_eq CauSeq.lt_of_lt_of_eq

theorem lt_of_eq_of_lt {f g h : CauSeq α abs} (fg : f ≈ g) (gh : g < h) : f < h := by
  have := pos_add_limZero gh (neg_limZero fg)
  rwa [← sub_eq_add_neg, sub_sub_sub_cancel_right] at this
#align cau_seq.lt_of_eq_of_lt CauSeq.lt_of_eq_of_lt

theorem lt_trans {f g h : CauSeq α abs} (fg : f < g) (gh : g < h) : f < h :=
  show Pos (h - f) by
    convert add_pos fg gh using 1
    simp
#align cau_seq.lt_trans CauSeq.lt_trans

theorem lt_irrefl {f : CauSeq α abs} : ¬f < f
  | h => not_limZero_of_pos h (by simp [zero_limZero])
#align cau_seq.lt_irrefl CauSeq.lt_irrefl

theorem le_of_eq_of_le {f g h : CauSeq α abs} (hfg : f ≈ g) (hgh : g ≤ h) : f ≤ h :=
  hgh.elim (Or.inl ∘ CauSeq.lt_of_eq_of_lt hfg) (Or.inr ∘ Setoid.trans hfg)
#align cau_seq.le_of_eq_of_le CauSeq.le_of_eq_of_le

theorem le_of_le_of_eq {f g h : CauSeq α abs} (hfg : f ≤ g) (hgh : g ≈ h) : f ≤ h :=
  hfg.elim (fun h => Or.inl (CauSeq.lt_of_lt_of_eq h hgh)) fun h => Or.inr (Setoid.trans h hgh)
#align cau_seq.le_of_le_of_eq CauSeq.le_of_le_of_eq

instance : Preorder (CauSeq α abs) where
  lt := (· < ·)
  le f g := f < g ∨ f ≈ g
  le_refl _ := Or.inr (Setoid.refl _)
  le_trans _ _ _ fg gh :=
    match fg, gh with
    | Or.inl fg, Or.inl gh => Or.inl <| lt_trans fg gh
    | Or.inl fg, Or.inr gh => Or.inl <| lt_of_lt_of_eq fg gh
    | Or.inr fg, Or.inl gh => Or.inl <| lt_of_eq_of_lt fg gh
    | Or.inr fg, Or.inr gh => Or.inr <| Setoid.trans fg gh
  lt_iff_le_not_le _ _ :=
    ⟨fun h => ⟨Or.inl h, not_or_of_not (mt (lt_trans h) lt_irrefl) (not_limZero_of_pos h)⟩,
      fun ⟨h₁, h₂⟩ => h₁.resolve_right (mt (fun h => Or.inr (Setoid.symm h)) h₂)⟩

theorem le_antisymm {f g : CauSeq α abs} (fg : f ≤ g) (gf : g ≤ f) : f ≈ g :=
  fg.resolve_left (not_lt_of_le gf)
#align cau_seq.le_antisymm CauSeq.le_antisymm

theorem lt_total (f g : CauSeq α abs) : f < g ∨ f ≈ g ∨ g < f :=
  (trichotomy (g - f)).imp_right fun h =>
    h.imp (fun h => Setoid.symm h) fun h => by rwa [neg_sub] at h
#align cau_seq.lt_total CauSeq.lt_total

theorem le_total (f g : CauSeq α abs) : f ≤ g ∨ g ≤ f :=
  (or_assoc.2 (lt_total f g)).imp_right Or.inl
#align cau_seq.le_total CauSeq.le_total

theorem const_lt {x y : α} : const x < const y ↔ x < y :=
  show Pos _ ↔ _ by rw [← const_sub, const_pos, sub_pos]
#align cau_seq.const_lt CauSeq.const_lt

theorem const_le {x y : α} : const x ≤ const y ↔ x ≤ y := by
  rw [le_iff_lt_or_eq]; exact or_congr const_lt const_equiv
#align cau_seq.const_le CauSeq.const_le

theorem le_of_exists {f g : CauSeq α abs} (h : ∃ i, ∀ j ≥ i, f j ≤ g j) : f ≤ g :=
  let ⟨i, hi⟩ := h
  (or_assoc.2 (CauSeq.lt_total f g)).elim id fun hgf =>
    False.elim
      (let ⟨_, hK0, j, hKj⟩ := hgf
      not_lt_of_ge (hi (max i j) (le_max_left _ _))
        (sub_pos.1 (lt_of_lt_of_le hK0 (hKj _ (le_max_right _ _)))))
#align cau_seq.le_of_exists CauSeq.le_of_exists

theorem exists_gt (f : CauSeq α abs) : ∃ a : α, f < const a :=
  let ⟨K, H⟩ := f.bounded
  ⟨K + 1, 1, zero_lt_one, 0, fun i _ => by
    rw [sub_apply, const_apply, le_sub_iff_add_le', add_le_add_iff_right]
    exact le_of_lt (abs_lt.1 (H _)).2⟩
#align cau_seq.exists_gt CauSeq.exists_gt

theorem exists_lt (f : CauSeq α abs) : ∃ a : α, const a < f :=
  let ⟨a, h⟩ := (-f).exists_gt
  ⟨-a, show Pos _ by rwa [const_neg, sub_neg_eq_add, add_comm, ← sub_neg_eq_add]⟩
#align cau_seq.exists_lt CauSeq.exists_lt

-- so named to match `rat_add_continuous_lemma`
theorem rat_sup_continuous_lemma {ε : α} {a₁ a₂ b₁ b₂ : α} :
    abs (a₁ - b₁) < ε → abs (a₂ - b₂) < ε → abs (a₁ ⊔ a₂ - b₁ ⊔ b₂) < ε := fun h₁ h₂ =>
  (abs_max_sub_max_le_max _ _ _ _).trans_lt (max_lt h₁ h₂)
#align rat_sup_continuous_lemma CauSeq.rat_sup_continuous_lemma

-- so named to match `rat_add_continuous_lemma`
theorem rat_inf_continuous_lemma {ε : α} {a₁ a₂ b₁ b₂ : α} :
    abs (a₁ - b₁) < ε → abs (a₂ - b₂) < ε → abs (a₁ ⊓ a₂ - b₁ ⊓ b₂) < ε := fun h₁ h₂ =>
  (abs_min_sub_min_le_max _ _ _ _).trans_lt (max_lt h₁ h₂)
#align rat_inf_continuous_lemma CauSeq.rat_inf_continuous_lemma

instance : Sup (CauSeq α abs) :=
  ⟨fun f g =>
    ⟨f ⊔ g, fun _ ε0 =>
      (exists_forall_ge_and (f.cauchy₃ ε0) (g.cauchy₃ ε0)).imp fun _ H _ ij =>
        let ⟨H₁, H₂⟩ := H _ le_rfl
        rat_sup_continuous_lemma (H₁ _ ij) (H₂ _ ij)⟩⟩

instance : Inf (CauSeq α abs) :=
  ⟨fun f g =>
    ⟨f ⊓ g, fun _ ε0 =>
      (exists_forall_ge_and (f.cauchy₃ ε0) (g.cauchy₃ ε0)).imp fun _ H _ ij =>
        let ⟨H₁, H₂⟩ := H _ le_rfl
        rat_inf_continuous_lemma (H₁ _ ij) (H₂ _ ij)⟩⟩

@[simp, norm_cast]
theorem coe_sup (f g : CauSeq α abs) : ⇑(f ⊔ g) = (f : ℕ → α) ⊔ g :=
  rfl
#align cau_seq.coe_sup CauSeq.coe_sup

@[simp, norm_cast]
theorem coe_inf (f g : CauSeq α abs) : ⇑(f ⊓ g) = (f : ℕ → α) ⊓ g :=
  rfl
#align cau_seq.coe_inf CauSeq.coe_inf

theorem sup_limZero {f g : CauSeq α abs} (hf : LimZero f) (hg : LimZero g) : LimZero (f ⊔ g)
  | ε, ε0 =>
    (exists_forall_ge_and (hf _ ε0) (hg _ ε0)).imp fun i H j ij => by
      let ⟨H₁, H₂⟩ := H _ ij
      rw [abs_lt] at H₁ H₂⊢
      exact ⟨lt_sup_iff.mpr (Or.inl H₁.1), sup_lt_iff.mpr ⟨H₁.2, H₂.2⟩⟩
#align cau_seq.sup_lim_zero CauSeq.sup_limZero

theorem inf_limZero {f g : CauSeq α abs} (hf : LimZero f) (hg : LimZero g) : LimZero (f ⊓ g)
  | ε, ε0 =>
    (exists_forall_ge_and (hf _ ε0) (hg _ ε0)).imp fun i H j ij => by
      let ⟨H₁, H₂⟩ := H _ ij
      rw [abs_lt] at H₁ H₂⊢
      exact ⟨lt_inf_iff.mpr ⟨H₁.1, H₂.1⟩, inf_lt_iff.mpr (Or.inl H₁.2)⟩
#align cau_seq.inf_lim_zero CauSeq.inf_limZero

theorem sup_equiv_sup {a₁ b₁ a₂ b₂ : CauSeq α abs} (ha : a₁ ≈ a₂) (hb : b₁ ≈ b₂) :
    a₁ ⊔ b₁ ≈ a₂ ⊔ b₂ := by
  intro ε ε0
  obtain ⟨ai, hai⟩ := ha ε ε0
  obtain ⟨bi, hbi⟩ := hb ε ε0
  exact
    ⟨ai ⊔ bi, fun i hi =>
      (abs_max_sub_max_le_max (a₁ i) (b₁ i) (a₂ i) (b₂ i)).trans_lt
        (max_lt (hai i (sup_le_iff.mp hi).1) (hbi i (sup_le_iff.mp hi).2))⟩
#align cau_seq.sup_equiv_sup CauSeq.sup_equiv_sup

protected theorem sup_lt {a b c : CauSeq α abs} (ha : a < c) (hb : b < c) : a ⊔ b < c := by
  obtain ⟨⟨εa, εa0, ia, ha⟩, ⟨εb, εb0, ib, hb⟩⟩ := ha, hb
  refine' ⟨εa ⊓ εb, lt_inf_iff.mpr ⟨εa0, εb0⟩, ia ⊔ ib, fun i hi => _⟩
  have := min_le_min (ha _ (sup_le_iff.mp hi).1) (hb _ (sup_le_iff.mp hi).2)
  exact this.trans_eq (min_sub_sub_left _ _ _)
#align cau_seq.sup_lt CauSeq.sup_lt

protected theorem lt_inf {a b c : CauSeq α abs} (hb : a < b) (hc : a < c) : a < b ⊓ c := by
  obtain ⟨⟨εb, εb0, ib, hb⟩, ⟨εc, εc0, ic, hc⟩⟩ := hb, hc
  refine' ⟨εb ⊓ εc, lt_inf_iff.mpr ⟨εb0, εc0⟩, ib ⊔ ic, fun i hi => _⟩
  have := min_le_min (hb _ (sup_le_iff.mp hi).1) (hc _ (sup_le_iff.mp hi).2)
  exact this.trans_eq (min_sub_sub_right _ _ _)
#align cau_seq.lt_inf CauSeq.lt_inf

@[simp]
protected theorem sup_idem (a : CauSeq α abs) : a ⊔ a = a :=
  Subtype.ext sup_idem
#align cau_seq.sup_idem CauSeq.sup_idem

@[simp]
protected theorem inf_idem (a : CauSeq α abs) : a ⊓ a = a :=
  Subtype.ext inf_idem
#align cau_seq.inf_idem CauSeq.inf_idem

protected theorem sup_comm (a b : CauSeq α abs) : a ⊔ b = b ⊔ a :=
  Subtype.ext sup_comm
#align cau_seq.sup_comm CauSeq.sup_comm

protected theorem inf_comm (a b : CauSeq α abs) : a ⊓ b = b ⊓ a :=
  Subtype.ext inf_comm
#align cau_seq.inf_comm CauSeq.inf_comm

protected theorem sup_eq_right {a b : CauSeq α abs} (h : a ≤ b) : a ⊔ b ≈ b := by
  obtain ⟨ε, ε0 : _ < _, i, h⟩ | h := h
  · intro _ _
    refine' ⟨i, fun j hj => _⟩
    dsimp
    erw [← max_sub_sub_right]
    rwa [sub_self, max_eq_right, abs_zero]
    rw [sub_nonpos, ← sub_nonneg]
    exact ε0.le.trans (h _ hj)
  · refine' Setoid.trans (sup_equiv_sup h (Setoid.refl _)) _
    rw [CauSeq.sup_idem]
    exact Setoid.refl _
#align cau_seq.sup_eq_right CauSeq.sup_eq_right

protected theorem inf_eq_right {a b : CauSeq α abs} (h : b ≤ a) : a ⊓ b ≈ b := by
  obtain ⟨ε, ε0 : _ < _, i, h⟩ | h := h
  · intro _ _
    refine' ⟨i, fun j hj => _⟩
    dsimp
    erw [← min_sub_sub_right]
    rwa [sub_self, min_eq_right, abs_zero]
    exact ε0.le.trans (h _ hj)
  · refine' Setoid.trans (inf_equiv_inf (Setoid.symm h) (Setoid.refl _)) _
    rw [CauSeq.inf_idem]
    exact Setoid.refl _
#align cau_seq.inf_eq_right CauSeq.inf_eq_right

protected theorem sup_eq_left {a b : CauSeq α abs} (h : b ≤ a) : a ⊔ b ≈ a := by
  simpa only [CauSeq.sup_comm] using CauSeq.sup_eq_right h
#align cau_seq.sup_eq_left CauSeq.sup_eq_left

protected theorem inf_eq_left {a b : CauSeq α abs} (h : a ≤ b) : a ⊓ b ≈ a := by
  simpa only [CauSeq.inf_comm] using CauSeq.inf_eq_right h
#align cau_seq.inf_eq_left CauSeq.inf_eq_left

protected theorem le_sup_left {a b : CauSeq α abs} : a ≤ a ⊔ b :=
  le_of_exists ⟨0, fun _ _ => le_sup_left⟩
#align cau_seq.le_sup_left CauSeq.le_sup_left

protected theorem inf_le_left {a b : CauSeq α abs} : a ⊓ b ≤ a :=
  le_of_exists ⟨0, fun _ _ => inf_le_left⟩
#align cau_seq.inf_le_left CauSeq.inf_le_left

protected theorem le_sup_right {a b : CauSeq α abs} : b ≤ a ⊔ b :=
  le_of_exists ⟨0, fun _ _ => le_sup_right⟩
#align cau_seq.le_sup_right CauSeq.le_sup_right

protected theorem inf_le_right {a b : CauSeq α abs} : a ⊓ b ≤ b :=
  le_of_exists ⟨0, fun _ _ => inf_le_right⟩
#align cau_seq.inf_le_right CauSeq.inf_le_right

protected theorem sup_le {a b c : CauSeq α abs} (ha : a ≤ c) (hb : b ≤ c) : a ⊔ b ≤ c := by
  cases' ha with ha ha
  · cases' hb with hb hb
    · exact Or.inl (CauSeq.sup_lt ha hb)
    · replace ha := le_of_le_of_eq ha.le (Setoid.symm hb)
      refine' le_of_le_of_eq (Or.inr _) hb
      exact CauSeq.sup_eq_right ha
  · replace hb := le_of_le_of_eq hb (Setoid.symm ha)
    refine' le_of_le_of_eq (Or.inr _) ha
    exact CauSeq.sup_eq_left hb
#align cau_seq.sup_le CauSeq.sup_le

protected theorem le_inf {a b c : CauSeq α abs} (hb : a ≤ b) (hc : a ≤ c) : a ≤ b ⊓ c := by
  cases' hb with hb hb
  · cases' hc with hc hc
    · exact Or.inl (CauSeq.lt_inf hb hc)
    · replace hb := le_of_eq_of_le (Setoid.symm hc) hb.le
      refine' le_of_eq_of_le hc (Or.inr _)
      exact Setoid.symm (CauSeq.inf_eq_right hb)
  · replace hc := le_of_eq_of_le (Setoid.symm hb) hc
    refine' le_of_eq_of_le hb (Or.inr _)
    exact Setoid.symm (CauSeq.inf_eq_left hc)
#align cau_seq.le_inf CauSeq.le_inf

/-! Note that `DistribLattice (CauSeq α abs)` is not true because there is no `PartialOrder`. -/

protected theorem sup_inf_distrib_left (a b c : CauSeq α abs) : a ⊔ b ⊓ c = (a ⊔ b) ⊓ (a ⊔ c) :=
  Subtype.ext <| funext fun _ => max_min_distrib_left
#align cau_seq.sup_inf_distrib_left CauSeq.sup_inf_distrib_left

protected theorem sup_inf_distrib_right (a b c : CauSeq α abs) : a ⊓ b ⊔ c = (a ⊔ c) ⊓ (b ⊔ c) :=
  Subtype.ext <| funext fun _ => max_min_distrib_right
#align cau_seq.sup_inf_distrib_right CauSeq.sup_inf_distrib_right

end Abs

end CauSeq


def foo1(bar : Nat) : Bool := true
                     --^ textDocument/documentHighlight

#eval foo1 2
#eval foo1 3
     --^ textDocument/documentHighlight

def foo2 : Nat :=
  let bar := 2
  bar + 3
 --^ textDocument/documentHighlight

structure Baz where
  bar : Nat
  bar' : Nat
 --^ textDocument/documentHighlight

def foo3 (baz : Baz) : Nat :=
  baz.bar
     --^ textDocument/documentHighlight

def foo4 (bar : Nat) : Baz :=
  { bar := bar, bar' := bar }
   --^ textDocument/documentHighlight
          --^ textDocument/documentHighlight

example : Nat := Id.run do
  let mut x := 1
  x := 2
  x
--^ textDocument/documentHighlight

example : Nat := Id.run do
  let mut y : Nat := 0
  for x in [0] do
    y := y + x
  if true then
    y := y + 1
  else
    return y
  pure y
     --^ textDocument/documentHighlight

example : Nat := Id.run do
  let mut y := 0
  if true then
    y := 1
  return y  -- TODO: definition should be first `y`
       --^ textDocument/documentHighlight

example (x : Option Nat) : Nat :=
  match x with
  | some x => 1
       --^ textDocument/documentHighlight
  | none   => 0


/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison, Bhavik Mehta, Jakob von Raumer
-/
import category_theory.monoidal.coherence

/-!
# Lemmas which are consequences of monoidal coherence

These lemmas are all proved `by coherence`.

## Future work
Investigate whether these lemmas are really needed,
or if they can be replaced by use of the `coherence` tactic.
-/

open category_theory
open category_theory.category
open category_theory.iso

namespace category_theory.monoidal_category

variables {C : Type*} [category C] [monoidal_category C]

-- See Proposition 2.2.4 of <http://www-math.mit.edu/~etingof/egnobookfinal.pdf>
@[reassoc]
lemma left_unitor_tensor' (X Y : C) :
  ((α_ (𝟙_ C) X Y).hom) ≫ ((λ_ (X ⊗ Y)).hom) = ((λ_ X).hom ⊗ (𝟙 Y)) :=
by coherence

@[reassoc, simp]
lemma left_unitor_tensor (X Y : C) :
  ((λ_ (X ⊗ Y)).hom) = ((α_ (𝟙_ C) X Y).inv) ≫ ((λ_ X).hom ⊗ (𝟙 Y)) :=
by coherence

@[reassoc]
lemma left_unitor_tensor_inv (X Y : C) :
  (λ_ (X ⊗ Y)).inv = ((λ_ X).inv ⊗ (𝟙 Y)) ≫ (α_ (𝟙_ C) X Y).hom :=
by coherence

@[reassoc]
lemma id_tensor_right_unitor_inv (X Y : C) : 𝟙 X ⊗ (ρ_ Y).inv = (ρ_ _).inv ≫ (α_ _ _ _).hom :=
by coherence

@[reassoc]
lemma left_unitor_inv_tensor_id (X Y : C) : (λ_ X).inv ⊗ 𝟙 Y = (λ_ _).inv ≫ (α_ _ _ _).inv :=
by coherence

@[reassoc]
lemma pentagon_inv_inv_hom (W X Y Z : C) :
  (α_ W (X ⊗ Y) Z).inv ≫ ((α_ W X Y).inv ⊗ (𝟙 Z)) ≫ (α_ (W ⊗ X) Y Z).hom
  = ((𝟙 W) ⊗ (α_ X Y Z).hom) ≫ (α_ W X (Y ⊗ Z)).inv :=
by coherence

@[simp, reassoc] lemma triangle_assoc_comp_right_inv (X Y : C) :
  ((ρ_ X).inv ⊗ 𝟙 Y) ≫ (α_ X (𝟙_ C) Y).hom = ((𝟙 X) ⊗ (λ_ Y).inv) :=
by coherence

lemma unitors_equal : (λ_ (𝟙_ C)).hom = (ρ_ (𝟙_ C)).hom :=
by coherence

lemma unitors_inv_equal : (λ_ (𝟙_ C)).inv = (ρ_ (𝟙_ C)).inv :=
by coherence

@[reassoc]
lemma pentagon_hom_inv {W X Y Z : C} :
  (α_ W X (Y ⊗ Z)).hom ≫ (𝟙 W ⊗ (α_ X Y Z).inv)
  = (α_ (W ⊗ X) Y Z).inv ≫ ((α_ W X Y).hom ⊗ 𝟙 Z) ≫ (α_ W (X ⊗ Y) Z).hom :=
by coherence

@[reassoc]
lemma pentagon_inv_hom (W X Y Z : C) :
  (α_ (W ⊗ X) Y Z).inv ≫ ((α_ W X Y).hom ⊗ 𝟙 Z)
  = (α_ W X (Y ⊗ Z)).hom ≫ (𝟙 W ⊗ (α_ X Y Z).inv) ≫ (α_ W (X ⊗ Y) Z).inv :=
by coherence

end category_theory.monoidal_category