import Radon.LC_limit
import analysis.normed_space.weak_dual

open_locale nnreal big_operators classical

noncomputable theory

open category_theory
open category_theory.limits
open topological_space

local attribute [instance]
  locally_constant.seminormed_add_comm_group
  locally_constant.pseudo_metric_space

namespace Profinite

/-- The weak dual of `C(X,ℝ)` is linearly equivalent to
the weak dual of `locally_constant X ℝ`. -/
def weak_dual_C_equiv_LC (X : Profinite.{0}) :
  weak_dual ℝ C(X,ℝ) ≃ₗ[ℝ] weak_dual ℝ (locally_constant X ℝ) :=
{ inv_fun := X.weak_dual_LC_to_C,
  left_inv := begin
    intros f, ext t,
    show (locally_constant.pkg X ℝ).extend _ _ = _,
    --  `dsimp [weak_dual_C_to_LC, weak_dual_LC_to_C]` works instead of `show` but is slower
    apply (locally_constant.pkg X ℝ).induction_on t,
    { apply is_closed_eq,
      refine (locally_constant.pkg X ℝ).continuous_extend,
      exact f.2 },
    { intros e,
      rw (locally_constant.pkg X ℝ).extend_coe, refl,
      apply continuous_linear_map.uniform_continuous,
      apply_instance }
  end,
  right_inv := begin
    intros f, ext t,
    show (locally_constant.pkg X ℝ).extend _ _ = _,
--  `dsimp [weak_dual_C_to_LC, weak_dual_LC_to_C, weak_dual.comap]` works instead of `show`,
--  but is slower,
    erw (locally_constant.pkg X ℝ).extend_coe,
    apply continuous_linear_map.uniform_continuous,
    apply_instance,
  end,
  ..(X.weak_dual_C_to_LC) }

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_to_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon p c ⟶ X.Radon_LC p c :=
{ to_fun := λ μ, ⟨weak_dual_C_to_LC _ μ.1, μ.2⟩,
  continuous_to_fun := begin
    apply continuous.subtype_mk,
    refine continuous.comp _ continuous_subtype_coe,
    exact continuous_linear_map.continuous _,
  end }

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_to_Radon (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon_LC p c → X.Radon p c :=
λ μ, ⟨weak_dual_LC_to_C _ μ.1, begin
    change (weak_dual_C_to_LC _ (weak_dual_LC_to_C _ μ.1)).bdd_LC p c,
    erw X.weak_dual_C_equiv_LC.apply_symm_apply,
    exact μ.2,
  end⟩

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_to_weak_dual (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon_LC p c → weak_dual ℝ (locally_constant X ℝ) := subtype.val

/-- An auxiliary definition to be used in the constructions below. -/
def weak_dual_LC_to_fun (X : Profinite.{0}) :
  weak_dual ℝ (locally_constant X ℝ) → locally_constant X ℝ → ℝ := λ μ x, μ x

lemma continuous_weak_dual_LC_to_fun (X : Profinite.{0}) :
  continuous X.weak_dual_LC_to_fun :=
begin
  apply continuous_pi, intros e,
  exact weak_dual.eval_continuous _,
end

instance t2_space_weak_dual (X : Profinite.{0}) :
  t2_space (weak_dual ℝ (locally_constant X ℝ)) :=
⟨λ x y h, separated_by_continuous (X.continuous_weak_dual_LC_to_fun) $
  λ c, h $ by { ext t, apply_fun (λ e, e t) at c, exact c } ⟩

lemma Radon_LC_closed_embedding (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  closed_embedding (X.Radon_LC_to_weak_dual p c) :=
closed_embedding_subtype_coe
begin
  apply is_compact.is_closed,
  let S := _, change is_compact S,
  have : S = set.range (X.Radon_LC_to_weak_dual p c),
  { erw subtype.range_val, refl },
  rw this, clear this,
  apply is_compact_range,
  exact continuous_subtype_coe,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_to_weak_dual (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon p c → weak_dual ℝ C(X,ℝ) := subtype.val

lemma Radon_closed_embedding (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  closed_embedding (X.Radon_to_weak_dual p c) :=
closed_embedding_subtype_coe
begin
  let T : set (weak_dual ℝ (locally_constant X ℝ)) :=
    { f | f.bdd_LC p c },
  change is_closed (X.weak_dual_C_to_LC ⁻¹' T),
  apply is_closed.preimage,
  exact (weak_dual_C_to_LC X).continuous,
  convert (X.Radon_LC_closed_embedding p c).closed_range,
  erw subtype.range_val, refl,
end

lemma Radon_closed_embedding_range_bdd (X : Profinite) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] : metric.bounded
  (normed_space.dual.to_weak_dual ⁻¹' set.range (X.Radon_to_weak_dual p c)) :=
begin
  -- Use c^(1/p)
  letI : uniform_space (locally_constant.pkg X ℝ).space :=
    (locally_constant.pkg X ℝ).uniform_struct,
  refine (metric.bounded_iff_subset_ball 0).mpr _,
  refine ⟨c^(1/(p : ℝ)), λ μ hμ, mem_closed_ball_zero_iff.mpr _⟩,
  apply continuous_linear_map.op_norm_le_bound,
  refine (nnreal.coe_nonneg _).trans_eq (nnreal.coe_rpow _ _),
  intros f,
  apply (locally_constant.pkg X ℝ).induction_on f,
  { apply is_closed_le,
    refine continuous.comp (continuous_norm) _,
    exact μ.continuous,
    refine continuous.comp (continuous_mul_left _) continuous_norm },
  { intros e,
    let γ : weak_dual ℝ (locally_constant X ℝ) :=
      X.weak_dual_C_to_LC μ,
    dsimp [locally_constant.pkg],
    have : μ e = γ e, refl, rw this, clear this,
    have : ∥ e.to_continuous_map ∥ = ∥ e ∥,
    { simp only [continuous_map.norm_eq_supr_norm,
        locally_constant.norm_def, locally_constant.to_continuous_map_eq_coe,
        locally_constant.coe_continuous_map] },
    erw this, clear this,
    suffices : ∥ γ e ∥₊ ≤ c^(1 / (p : ℝ)) * ∥ e ∥₊, by exact_mod_cast this,
    have hp : 0 < (p : ℝ) := nnreal.coe_pos.mpr (fact.out (0 < p)),
    have hp' : (p : ℝ) ≠ 0,
    { exact ne_of_gt hp },
    rw [← nnreal.rpow_le_rpow_iff hp, nnreal.mul_rpow, ← nnreal.rpow_mul],
    rw [(show 1 / (p : ℝ) * p = 1, from (eq_div_iff hp').mp rfl), nnreal.rpow_one],
    obtain ⟨δ,hδ⟩ := hμ,
    have H := δ.2 e.discrete_quotient,
    replace H := mul_le_mul H (le_refl (∥ e ∥₊^(p : ℝ))) (zero_le _) (zero_le _),
    refine le_trans _ H, clear H,
    rw [mul_comm, finset.mul_sum],
    nth_rewrite 0 e.eq_sum,

    simp_rw [γ.map_sum, γ.map_smul],
    refine le_trans (real.pow_nnnorm_sum_le _ _ _) _,

    apply finset.sum_le_sum, rintros x -,
    rw [smul_eq_mul, nnnorm_mul, nnreal.mul_rpow],
    refine mul_le_mul _ (le_of_eq _) (zero_le _) (zero_le _),
    apply nnreal.rpow_le_rpow _ (le_of_lt hp),
    obtain ⟨x,rfl⟩ := discrete_quotient.proj_surjective _ x,
    change ∥ e x ∥₊ ≤ _,
    apply locally_constant.nnnorm_apply_le_nnnorm,
    congr' 2,
    change _ = X.Radon_to_weak_dual p c δ _, rw hδ, refl },
end

instance compact_space_Radon (X : Profinite) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  compact_space (X.Radon p c) :=
begin
  let e : X.Radon p c ≃ₜ set.range (X.Radon_to_weak_dual p c) :=
    homeomorph.of_embedding _ (X.Radon_closed_embedding p c).to_embedding,
  suffices : compact_space (set.range (X.Radon_to_weak_dual p c)),
  { resetI, apply e.symm.compact_space },
  rw ← is_compact_iff_compact_space,
  apply weak_dual.is_compact_of_bounded_of_closed,
  apply Radon_closed_embedding_range_bdd,
  exact (X.Radon_closed_embedding p c).closed_range,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_equiv_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon p c ≃ X.Radon_LC p c :=
{ to_fun := X.Radon_to_Radon_LC p c,
  inv_fun := X.Radon_LC_to_Radon p c,
  left_inv := begin
    intros t, ext1,
    apply X.weak_dual_C_equiv_LC.symm_apply_apply,
  end,
  right_inv := begin
    intros t, ext1,
    apply X.weak_dual_C_equiv_LC.apply_symm_apply,
  end }

lemma continuous_Radon_equiv_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0) :
  continuous (X.Radon_equiv_Radon_LC p c) :=
continuous_map.continuous _

lemma continuous_Radon_equiv_Radon_LC_symm (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  continuous (X.Radon_equiv_Radon_LC p c).symm :=
begin
  rw continuous_iff_is_closed,
  intros T hT,
  rw ← equiv.image_eq_preimage,
  apply is_compact.is_closed,
  apply is_compact.image,
  exact is_closed.is_compact hT,
  exact continuous_map.continuous _,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_homeomorph_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  X.Radon p c ≃ₜ X.Radon_LC p c :=
{ continuous_to_fun := continuous_Radon_equiv_Radon_LC _ _ _,
  continuous_inv_fun := continuous_Radon_equiv_Radon_LC_symm _ _ _,
  ..(X.Radon_equiv_Radon_LC p c) }

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_iso_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  X.Radon p c ≅ X.Radon_LC p c :=
Top.iso_of_homeo (X.Radon_homeomorph_Radon_LC p c)

/-- The functor `X ↦ X.Radon p c` is isomorphic to its locally constant variant. -/
def Radon_functor_iso_Radon_LC_functor (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_functor p c ≅ Radon_LC_functor p c :=
nat_iso.of_components
(λ X, X.Radon_iso_Radon_LC p c)
begin
  intros X Y f, ext, refl,
end

/-- A `CompHaus` variant of `Radon_functor`. -/
def Radon_CompHaus_functor (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Profinite.{0} ⥤ CompHaus.{0} :=
{ obj := λ X, CompHaus.of $ X.Radon p c,
  map := λ X Y f, (Radon_functor p c).map f,
  map_id' := (Radon_functor p c).map_id,
  map_comp' := λ _ _ _ f g, (Radon_functor p c).map_comp f g }

/-- The functor `X ↦ X.Radon p c` is isomorphic to its locally constant variant.
This is a variant taking values in `CompHaus` as opposed to `Top`. -/
def Radon_CompHaus_functor_iso_Radon_LC_CompHaus_functor (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_CompHaus_functor p c ≅ Radon_LC_CompHaus_functor p c :=
nat_iso.of_components
(λ X,
{ hom := (Radon_functor_iso_Radon_LC_functor p c).hom.app X,
  inv := (Radon_functor_iso_Radon_LC_functor p c).inv.app X,
  hom_inv_id' := begin
    erw [← nat_trans.comp_app, iso.hom_inv_id], refl,
  end,
  inv_hom_id' := begin
    erw [← nat_trans.comp_app, iso.inv_hom_id], refl,
  end })
begin
  intros, ext, refl,
end

/-- The cone exhibiting `X.Radon p c` as the limit of `T.Radon p c` where
`T` varies over the discrete quotients of `X`. -/
def Radon_CompHaus_cone (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  cone (X.diagram ⋙ Radon_CompHaus_functor p c) :=
(Radon_CompHaus_functor p c).map_cone X.as_limit_cone

/-- X.Radon_CompHaus_cone p c` is a limit cone, as promised. -/
def is_limit_Radon_CompHaus_cone (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  is_limit (X.Radon_CompHaus_cone p c) :=
{ lift := λ S,
    (X.is_limit_Radon_LC_CompHaus_cone p c).lift
    ⟨S.X, S.π ≫ whisker_left _ (Radon_CompHaus_functor_iso_Radon_LC_CompHaus_functor p c).hom⟩ ≫
    (Radon_CompHaus_functor_iso_Radon_LC_CompHaus_functor p c).inv.app _,
  fac' := begin
    intros S j,
    erw [category.assoc, ← nat_trans.naturality,
      (X.is_limit_Radon_LC_CompHaus_cone p c).fac_assoc,
      ← nat_iso.app_inv, iso.comp_inv_eq], refl,
  end,
  uniq' := begin
    intros S m hm,
    rw [← nat_iso.app_inv, iso.eq_comp_inv],
    apply (X.is_limit_Radon_LC_CompHaus_cone p c).hom_ext, intros j,
    erw (X.is_limit_Radon_LC_CompHaus_cone p c).fac,
    dsimp, rw ← hm,
    simp only [category.assoc],
    erw ← nat_trans.naturality,
  end }

/-- The comparison between `Radon_LC` and `real_measures p` taking
values in `CompHaus` instead of `Top`, and restricted to the discrete quotients of `X`. -/
def Radon_LC_CompHaus_comparison (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  X.diagram ⋙ Radon_LC_CompHaus_functor p c ≅
  X.fintype_diagram ⋙ real_measures.functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c :=
nat_iso.of_components
(λ T,
{ hom := (X.Radon_LC_comparison p c).hom.app _,
  inv := (X.Radon_LC_comparison p c).inv.app _,
  hom_inv_id' := begin
    erw [← nat_trans.comp_app, iso.hom_inv_id], refl,
  end,
  inv_hom_id' := begin
    erw [← nat_trans.comp_app, iso.inv_hom_id], refl,
  end })
begin
  intros S T i, dsimp,
  erw ((X.Radon_LC_comparison p c).hom).naturality, refl,
end

/-- The comparison between `Radon` and `real_measures p`
restricted to the discrete quotients of `X`. -/
def Radon_CompHaus_comparison (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  X.diagram ⋙ Radon_CompHaus_functor p c ≅
  X.fintype_diagram ⋙ real_measures.functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c :=
iso_whisker_left _ (Radon_CompHaus_functor_iso_Radon_LC_CompHaus_functor _ _) ≪≫
Radon_LC_CompHaus_comparison _ _ _

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_iso_limit (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  CompHaus.of (X.Radon p c) ≅
  limit (X.fintype_diagram ⋙ real_measures.functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c) :=
(X.is_limit_Radon_CompHaus_cone p c).cone_point_unique_up_to_iso (limit.is_limit _) ≪≫
has_limit.iso_of_nat_iso (Radon_CompHaus_comparison _ _ _)

/-- The compact Hausdorff space `X.Radon p c` is isomorphic to the limit of
`real_measures p T` as `T` varies over the discrete quotients of `X`.
-/
def Radon_iso_real_measures (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  CompHaus.of (X.Radon p c) ≅
  (CompHausFiltPseuNormGrp₁.level.obj c).obj
  ((Profinite.extend (real_measures.functor p)).obj X) :=
Radon_iso_limit _ _ _ ≪≫
has_limit.iso_of_nat_iso (functor.associator _ _ _).symm ≪≫
(limit.is_limit _).cone_point_unique_up_to_iso
(is_limit_of_preserves ((CompHausFiltPseuNormGrp₁.level.obj c))
  (limit.is_limit (X.fintype_diagram ⋙ real_measures.functor p)))

end Profinite


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.fin_category
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.wide_pullbacks
import category_theory.limits.shapes.pullbacks
import data.fintype.basic

/-!
# Categories with finite limits.

A typeclass for categories with all finite (co)limits.
-/

universes w' w v' u' v u

noncomputable theory

open category_theory

namespace category_theory.limits

variables (C : Type u) [category.{v} C]

/--
A category has all finite limits if every functor `J ⥤ C` with a `fin_category J`
instance and `J : Type` has a limit.

This is often called 'finitely complete'.
-/
-- We can't just made this an `abbreviation`
-- because of https://github.com/leanprover-community/lean/issues/429
class has_finite_limits : Prop :=
(out (J : Type) [𝒥 : small_category J] [@fin_category J 𝒥] : @has_limits_of_shape J 𝒥 C _)

@[priority 100]
instance has_limits_of_shape_of_has_finite_limits
  (J : Type w) [small_category J] [fin_category J] [has_finite_limits C] :
  has_limits_of_shape J C :=
begin
  apply has_limits_of_shape_of_equivalence (fin_category.equiv_as_type J),
  apply has_finite_limits.out
end

@[priority 100]
instance has_finite_limits_of_has_limits_of_size [has_limits_of_size.{v' u'} C] :
  has_finite_limits C :=
⟨λ J hJ hJ', by { haveI := has_limits_of_size_shrink.{0 0} C,
  exact has_limits_of_shape_of_equivalence (fin_category.equiv_as_type J) }⟩

/-- If `C` has all limits, it has finite limits. -/
@[priority 100]
instance has_finite_limits_of_has_limits [has_limits C] : has_finite_limits C :=
infer_instance

/-- We can always derive `has_finite_limits C` by providing limits at an
arbitrary universe. -/
lemma has_finite_limits_of_has_finite_limits_of_size
  (h : ∀ (J : Type w) {𝒥 : small_category J} (hJ : @fin_category J 𝒥),
    by { resetI, exact has_limits_of_shape J C }) :
  has_finite_limits C :=
⟨λ J hJ hhJ,
  begin
    resetI,
    letI : category.{w w} (ulift_hom.{w} (ulift.{w 0} J)),
    { apply ulift_hom.category.{0}, exact category_theory.ulift_category J },
    haveI := h (ulift_hom.{w} (ulift.{w} J)) category_theory.fin_category_ulift,
    exact has_limits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{w w} J).symm
  end ⟩

/--
A category has all finite colimits if every functor `J ⥤ C` with a `fin_category J`
instance and `J : Type` has a colimit.

This is often called 'finitely cocomplete'.
-/
class has_finite_colimits : Prop :=
(out (J : Type) [𝒥 : small_category J] [@fin_category J 𝒥] : @has_colimits_of_shape J 𝒥 C _)

@[priority 100]
instance has_colimits_of_shape_of_has_finite_colimits
  (J : Type w) [small_category J] [fin_category J] [has_finite_colimits C] :
  has_colimits_of_shape J C :=
begin
  apply has_colimits_of_shape_of_equivalence (fin_category.equiv_as_type J),
  apply has_finite_colimits.out
end

@[priority 100]
instance has_finite_colimits_of_has_colimits_of_size [has_colimits_of_size.{v' u'} C] :
  has_finite_colimits C :=
⟨λ J hJ hJ', by { haveI := has_colimits_of_size_shrink.{0 0} C,
  exact has_colimits_of_shape_of_equivalence (fin_category.equiv_as_type J) }⟩

/-- We can always derive `has_finite_colimits C` by providing colimits at an
arbitrary universe. -/
lemma has_finite_colimits_of_has_finite_colimits_of_size
  (h : ∀ (J : Type w) {𝒥 : small_category J} (hJ : @fin_category J 𝒥),
    by { resetI, exact has_colimits_of_shape J C }) :
  has_finite_colimits C :=
⟨λ J hJ hhJ,
  begin
    resetI,
    letI : category.{w w} (ulift_hom.{w} (ulift.{w 0} J)),
    { apply ulift_hom.category.{0}, exact category_theory.ulift_category J },
    haveI := h (ulift_hom.{w} (ulift.{w} J)) category_theory.fin_category_ulift,
    exact has_colimits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{w w} J).symm
  end ⟩
section

open walking_parallel_pair walking_parallel_pair_hom

instance fintype_walking_parallel_pair : fintype walking_parallel_pair :=
{ elems := [walking_parallel_pair.zero, walking_parallel_pair.one].to_finset,
  complete := λ x, by { cases x; simp } }

local attribute [tidy] tactic.case_bash

instance (j j' : walking_parallel_pair) : fintype (walking_parallel_pair_hom j j') :=
{ elems := walking_parallel_pair.rec_on j
    (walking_parallel_pair.rec_on j' [walking_parallel_pair_hom.id zero].to_finset
      [left, right].to_finset)
    (walking_parallel_pair.rec_on j' ∅ [walking_parallel_pair_hom.id one].to_finset),
  complete := by tidy }

end

instance : fin_category walking_parallel_pair := { }

/-- Equalizers are finite limits, so if `C` has all finite limits, it also has all equalizers -/
example [has_finite_limits C] : has_equalizers C := by apply_instance

/-- Coequalizers are finite colimits, of if `C` has all finite colimits, it also has all
    coequalizers -/
example [has_finite_colimits C] : has_coequalizers C := by apply_instance

variables {J : Type v}

local attribute [tidy] tactic.case_bash

namespace wide_pullback_shape

instance fintype_obj [fintype J] : fintype (wide_pullback_shape J) :=
by { rw wide_pullback_shape, apply_instance }

instance fintype_hom (j j' : wide_pullback_shape J) : fintype (j ⟶ j') :=
{ elems :=
  begin
    cases j',
    { cases j,
      { exact {hom.id none} },
      { exact {hom.term j} } },
    { by_cases some j' = j,
      { rw h,
        exact {hom.id j} },
      { exact ∅ } }
  end,
  complete := by tidy }

end wide_pullback_shape

namespace wide_pushout_shape

instance fintype_obj [fintype J] : fintype (wide_pushout_shape J) :=
by { rw wide_pushout_shape, apply_instance }

instance fintype_hom (j j' : wide_pushout_shape J) : fintype (j ⟶ j') :=
{ elems :=
  begin
    cases j,
    { cases j',
      { exact {hom.id none} },
      { exact {hom.init j'} } },
    { by_cases some j = j',
      { rw h,
        exact {hom.id j'} },
      { exact ∅ } }
  end,
  complete := by tidy }

end wide_pushout_shape

instance fin_category_wide_pullback [fintype J] : fin_category (wide_pullback_shape J) :=
{ fintype_hom := wide_pullback_shape.fintype_hom }

instance fin_category_wide_pushout [fintype J] :
  fin_category (wide_pushout_shape J) :=
{ fintype_hom := wide_pushout_shape.fintype_hom }

/--
`has_finite_wide_pullbacks` represents a choice of wide pullback
for every finite collection of morphisms
-/
-- We can't just made this an `abbreviation`
-- because of https://github.com/leanprover-community/lean/issues/429
class has_finite_wide_pullbacks : Prop :=
(out (J : Type) [fintype J] : has_limits_of_shape (wide_pullback_shape J) C)

instance has_limits_of_shape_wide_pullback_shape
  (J : Type) [fintype J] [has_finite_wide_pullbacks C] :
  has_limits_of_shape (wide_pullback_shape J) C :=
by { haveI := @has_finite_wide_pullbacks.out C _ _ J, apply_instance }

/--
`has_finite_wide_pushouts` represents a choice of wide pushout
for every finite collection of morphisms
-/
class has_finite_wide_pushouts : Prop :=
(out (J : Type) [fintype J] : has_colimits_of_shape (wide_pushout_shape J) C)

instance has_colimits_of_shape_wide_pushout_shape
  (J : Type) [fintype J] [has_finite_wide_pushouts C] :
  has_colimits_of_shape (wide_pushout_shape J) C :=
by { haveI := @has_finite_wide_pushouts.out C _ _ J, apply_instance }

/--
Finite wide pullbacks are finite limits, so if `C` has all finite limits,
it also has finite wide pullbacks
-/
lemma has_finite_wide_pullbacks_of_has_finite_limits [has_finite_limits C] :
  has_finite_wide_pullbacks C :=
⟨λ J _, by exactI has_finite_limits.out _⟩

/--
Finite wide pushouts are finite colimits, so if `C` has all finite colimits,
it also has finite wide pushouts
-/
lemma has_finite_wide_pushouts_of_has_finite_limits [has_finite_colimits C] :
  has_finite_wide_pushouts C :=
⟨λ J _, by exactI has_finite_colimits.out _⟩

instance fintype_walking_pair : fintype walking_pair :=
{ elems := {walking_pair.left, walking_pair.right},
  complete := λ x, by { cases x; simp } }

/-- Pullbacks are finite limits, so if `C` has all finite limits, it also has all pullbacks -/
example [has_finite_wide_pullbacks C] : has_pullbacks C := by apply_instance

/-- Pushouts are finite colimits, so if `C` has all finite colimits, it also has all pushouts -/
example [has_finite_wide_pushouts C] : has_pushouts C := by apply_instance

end category_theory.limits


structure A where
  private x : Nat := 10

def g (a : Nat) : A :=
  {}

theorem ex1 (a : Nat) : (g a |>.x) = 10 :=
  rfl

structure B extends A where
  y : Nat
  x := 20

def f (a : Nat) : B :=
  { y := a }

theorem ex2 (a : Nat) : (f a |>.x) = 20 :=
  rfl


import data.nat.basic

-- The next lemma won't be used, it's a warming up exercise for the one below.
-- It could go to mathlib.
lemma exists_by_induction {α : Type*} {P : ℕ → α → Prop}
  (h₀ : ∃ a, P 0 a)
  (ih : ∀ n a, P n a → ∃ a', P (n+1) a') :
  ∃ f : ℕ → α, ∀ n, P n (f n) :=
begin
  choose f₀ hf₀ using h₀,
  choose! F hF using ih,
  exact ⟨λ n, nat.rec_on n f₀ F, λ n, nat.rec hf₀ (λ n ih, hF n _ ih) n⟩
end

-- We make `P` and `Q` explicit to help the elaborator when applying the lemma
-- (elab_as_eliminator isn't enough).
lemma exists_by_induction' {α : Type*} (P : ℕ → α → Prop) (Q : ℕ → α → α → Prop)
  (h₀ : ∃ a, P 0 a)
  (ih : ∀ n a, P n a → ∃ a', P (n+1) a' ∧ Q n a a') :
  ∃ f : ℕ → α, ∀ n, P n (f n) ∧ Q n (f n) (f $ n+1) :=
begin
  choose f₀ hf₀ using h₀,
  choose! F hF hF' using ih,
  have key : ∀ n, P n (nat.rec_on n f₀ F), from λ n, nat.rec hf₀ (λ n ih, hF n _ ih) n,
  exact ⟨λ n, nat.rec_on n f₀ F, λ n, ⟨key n, hF' n _ (key n)⟩⟩
end


--  An abstract formalization of "isomorphism is equality up to relabeling"
-- -------------------------------------------------------------------------
--
-- See `README.md` for more info.
--
-- Definitions related to `functorStructure`.

import Structure.Basic
import Structure.UniverseFunctor
import Structure.ProductStructure

open Morphisms
open HasStructure

set_option autoBoundImplicitLocal false

namespace StructureFunctor.functorStructure

-- `universeStructure` enables us to define functors for the two maps from a structure `T` to the
-- functor structure with `T` on one side.
--
-- In other words, `functorStructure` is functorial in both arguments.

section OneSided

variable (S : Structure)

def outgoingToFun {T₁ T₂ : Structure} (e : T₁ ≃ T₂) :
  StructureFunctor (functorStructure S T₁) (functorStructure S T₂) :=
compFun.congrArg_right.functor S e.toFun

namespace outgoingToFun

def respectsEquiv {T₁ T₂ : Structure} :
  GeneralizedFunctor.Functor (S := StructureEquiv.equivStructure T₁ T₂)
                             (T := functorStructure (functorStructure S T₁) (functorStructure S T₂))
                             (outgoingToFun S) :=
(compFun.congrArg_right.functor.functorFunctor S ⊙ StructureEquiv.toFunProj T₁ T₂).functor

def respectsComp {T₁ T₂ T₃ : Structure} (e : T₁ ≃ T₂) (f : T₂ ≃ T₃) :
  outgoingToFun S (f • e) ≃ outgoingToFun S f ⊙ outgoingToFun S e :=
compFun.congrArg_right.functor.respectsCompFun S e.toFun f.toFun

theorem respectsComp.nat {T₁ T₂ T₃ : Structure} {e₁ e₂ : T₁ ≃ T₂} {f₁ f₂ : T₂ ≃ T₃} (η : e₁ ≃ e₂) (θ : f₁ ≃ f₂) :
  compFun.congrArg (respectsEquiv S η) (respectsEquiv S θ) • respectsComp S e₁ f₁ ≈ respectsComp S e₂ f₂ • respectsEquiv S (StructureEquiv.comp_congrArg η θ) :=
compFun.congrArg_right.functor.respectsCompFun.nat S η.toFunEquiv θ.toFunEquiv

def respectsId (T : Structure) :
  outgoingToFun S (id_ T) ≃ @idFun (functorStructure S T) :=
compFun.congrArg_right.functor.respectsIdFun S T

end outgoingToFun

def outgoingFunctorDesc : UniverseStructureFunctorDesc :=
{ map             := λ T => functorStructure S T,
  toFun           := outgoingToFun                  S,
  respectsEquiv   := outgoingToFun.respectsEquiv    S,
  respectsComp    := outgoingToFun.respectsComp     S,
  respectsCompNat := outgoingToFun.respectsComp.nat S,
  respectsId      := outgoingToFun.respectsId       S }

def outgoingFunctorFunctor' : UniverseStructureFunctor :=
UniverseStructureFunctorDesc.universeStructureFunctor (outgoingFunctorDesc S)

def outgoingFunctorFunctor : UniverseFunctor universeStructure :=
UniverseStructureFunctorDesc.universeFunctor (outgoingFunctorDesc S)

def incomingToFun {T₁ T₂ : Structure} (e : T₁ ≃ T₂) :
  StructureFunctor (functorStructure T₁ S) (functorStructure T₂ S) :=
compFun.congrArg_left.functor S e.invFun

namespace incomingToFun

def respectsEquiv {T₁ T₂ : Structure} :
  GeneralizedFunctor.Functor (S := StructureEquiv.equivStructure T₁ T₂)
                             (T := functorStructure (functorStructure T₁ S) (functorStructure T₂ S))
                             (incomingToFun S) :=
(compFun.congrArg_left.functor.functorFunctor S ⊙ StructureEquiv.invFunProj T₁ T₂).functor

def respectsComp {T₁ T₂ T₃ : Structure} (e : T₁ ≃ T₂) (f : T₂ ≃ T₃) :
  incomingToFun S (f • e) ≃ incomingToFun S f ⊙ incomingToFun S e :=
compFun.congrArg_left.functor.respectsCompFun S f.invFun e.invFun

theorem respectsComp.nat {T₁ T₂ T₃ : Structure} {e₁ e₂ : T₁ ≃ T₂} {f₁ f₂ : T₂ ≃ T₃} (η : e₁ ≃ e₂) (θ : f₁ ≃ f₂) :
  compFun.congrArg (respectsEquiv S η) (respectsEquiv S θ) • respectsComp S e₁ f₁ ≈ respectsComp S e₂ f₂ • respectsEquiv S (StructureEquiv.comp_congrArg η θ) :=
compFun.congrArg_left.functor.respectsCompFun.nat S θ.invFunEquiv η.invFunEquiv

def respectsId (T : Structure) :
  incomingToFun S (id_ T) ≃ @idFun (functorStructure T S) :=
compFun.congrArg_left.functor.respectsIdFun S T

end incomingToFun

def incomingFunctorDesc : UniverseStructureFunctorDesc :=
{ map             := λ T => functorStructure T S,
  toFun           := incomingToFun                  S,
  respectsEquiv   := incomingToFun.respectsEquiv    S,
  respectsComp    := incomingToFun.respectsComp     S,
  respectsCompNat := incomingToFun.respectsComp.nat S,
  respectsId      := incomingToFun.respectsId       S }

def incomingFunctorFunctor' : UniverseStructureFunctor :=
UniverseStructureFunctorDesc.universeStructureFunctor (incomingFunctorDesc S)

def incomingFunctorFunctor : UniverseFunctor universeStructure :=
UniverseStructureFunctorDesc.universeFunctor (incomingFunctorDesc S)

end OneSided

-- `outgoingFunctorFunctor` and `incomingFunctorFunctor` are themselves functors.

def outgoingFunctorFunctorFunctor :
  StructureFunctor universeStructure (functorStructure universeStructure universeStructure) :=
{ map     := outgoingFunctorFunctor,
  functor := { mapEquiv  := λ e => { ext := λ T => congrArg (incomingFunctorFunctor T) e,
                                     nat := sorry },
               isFunctor := sorry } }

def incomingFunctorFunctorFunctor :
  StructureFunctor universeStructure (functorStructure universeStructure universeStructure) :=
{ map     := incomingFunctorFunctor,
  functor := { mapEquiv  := λ e => { ext := λ T => congrArg (outgoingFunctorFunctor T) e,
                                     nat := sorry },
               isFunctor := sorry } }

-- By uncurrying, we can obtain a `UniverseFunctor` that outputs arbitrary functor structures, i.e.
-- `(S, T) ↦ (S → T)`.

section TwoSided

def functorStructureFunctor : UniverseFunctor (StructureProduct.productStructure universeStructure universeStructure) :=
FunctorProductEquivalences.uncurry outgoingFunctorFunctorFunctor

end TwoSided

end StructureFunctor.functorStructure


import analysis.special_functions.pow

import polyhedral_lattice.cosimplicial
import combinatorial_lemma
import breen_deligne.eg

import thm95.constants.spectral_constants

import for_mathlib.nnreal

/-!
# Explicit formulas for the constants used in Theorem 9.5 of Analytic.pdf

Fix the following notation.

* `r` and `r'` are real numbers satisfying `0 < r < r' ≤ 1`
* `BD` denotes a Breen-Deligne package
* `κ'` is a sequence of nonnegative real numbers
* `Λ` denotes a polyhedral lattice

The main goal of this file is to define sequences of constants `k₁`, `K₁`, `k'`, `N₂`, `b`, `H`,
satisfying the inequalities below.
But first we make some abbreviations:

* `k₀ m := normed_spectral.k₀ m (k₁ m)`
* `K₀ m := normed_spectral.K₀ m (K₁ m)`
* `ε m := normed_spectral.ε m (K₁ m)`
* `k m := (k' m)^2`
* `K m := 2 * K₀ m * H m`

It is known that:

* `normed_spectral.k₀` always returns a number larger or equal to `1`.
* `normed_spectral.K₀` always returns a number larger or equal to `1`.
* `normed_spectral.ε` always returns a positive number.

The following inequalities are imposed on these constants
by the normed homological algebra of the rest of the proof:

* `1 < k₁ m`
* `1 ≤ K₁ m`
* `1 ≤ k' m`
* `k (m - 1) ≤ k₁ m`, for `m > 0`
* `K (m - 1) ≤ K₁ m`, for `m > 0`
* `m + 2 + (r + 1) / (r * (1 - r)) * (m + 2) ^ 2 ≤ K₁ m`
* `k₀ m ≤ k' m`
* `κ' i ≤ k' m` for all `i ≤ m+1`
* `(2 * k' m) * (r / r') ^ (b m) ≤ ε m`
* `k' m ≤ 2 ^ N₂ m`
* `k' m / (2 ^ N₂ m) ≤ r' ^ (b m)`
* `r ^ (b m) * (2 ^ N₂ m) ≤ 2 * k' m * (r / r') ^ (b m)`
* For `q ≤ m`, the technical condition
  `((BD.data.homotopy_mul BD.homotopy (N₂ m)).hom q (q + 1)).bound_by (H m)`
  saying that `H m` should be larger than a list of `m + 1` numbers depending on `BD` and `N₂ m`.

-/

noncomputable theory

open_locale nnreal

open real finset

namespace helper

/-- Given real numbers `r`, `r'`, `k'`, and `ε`, we define `b` to be the smallest natural number
larger than `log(ε / (2 * k')) / log(r/r')`. -/
def b (r r' k' ε : ℝ) : ℕ := nat.ceil ((log $ ε/(2 * k')) / log (r/r'))

/-- Under the constraints that `r`, `r'`, `k'`, and `ε` are positive real numbers
satisfying `r < r'`, the natural number `b = b r r' k' ε` satisfies
`(2 * k') * (r/r') ^ b ≤ ε`. -/
lemma b_spec {r r' k' ε : ℝ} (hr : 0 < r) (hr' : 0 < r') (hrr' : r < r')
  (hk' : 0 < k') (hε : 0 < ε) : (2 * k') * (r / r') ^ (b r r' k' ε) ≤ ε :=
begin
  have f₁ : 0 < 2*k' := mul_pos zero_lt_two hk',
  have f₂ : r/r' < 1 := (div_lt_one hr').mpr hrr',
  have f₃ : 0 < r/r' := div_pos hr hr',
  have f₄ :0 < (r / r') ^ b r r' k' ε := pow_pos f₃ _,
  rw [← le_div_iff' f₁, ← log_le_log f₄ (div_pos hε f₁), log_pow, ← div_le_iff_of_neg (log_neg f₃ f₂)],
  exact nat.le_ceil (log (ε / (2 * k')) / log (r / r')),
end

/-- Given real numbers `r'`, `k'`, and `b`, we define `N₂` to be the smallest natural number
larger than `log(k' / r'^b) / log(2)`. -/
def N₂ (r' k' b : ℝ) := nat.ceil (log (k'/r'^b) / log 2)

/-- Under the constraints that `r'` and `k'` are positive real numbers,
the natural number `N₂ = N₂ r' k' b` satisfies `k' / (2 ^ N₂) ≤ r' ^ b`. -/
lemma N₂_spec {r' k' b : ℝ} (hr' : 0 < r') (hk' : 0 < k') : k'/ (2 ^ (N₂ r' k' b)) ≤ r' ^ b :=
begin
  have f₁ : (0 : ℝ) < 2 ^ N₂ r' k' b := pow_pos zero_lt_two _,
  have f₂ : (0 : ℝ) < r' ^ b := rpow_pos_of_pos hr' _,
  have f₃ : 0 < k' / r' ^ b := div_pos hk' f₂,
  have f₄ : 0 < log 2 := log_pos one_lt_two,
  rw [div_le_iff' f₁, ← div_le_iff f₂,  ← log_le_log f₃ f₁, log_pow, ← div_le_iff f₄],
  apply nat.le_ceil,
end

/-- Under the constraints that `r'` is a positive real number and `k'` is nonnegative,
the natural number `N₂ = N₂ r' k' b` satisfies `r' ^b < 2 * k' / (2 ^ N₂)`. -/
lemma N₂_spec_of_pos' {r' k' b} (h : 0 < N₂ r' k' b) (hr' : 0 < r') (hk' : 0 ≤ k') :
  r' ^ b < 2 * k'  / 2 ^ N₂ r' k' b :=
begin
  have h' := nat.lt_ceil.mp h,
  have : 0 < log (k'/r'^b)/ log 2,
  { exact_mod_cast nat.lt_ceil.mp h },
  have f₁ : 0 < 2 ^ N₂ r' k' b := pow_pos zero_lt_two _,
  have Hk' : k' ≠ 0,
  { intro H,
    simpa [H, N₂] using h },
  have f₂ : 0 < r' ^ b := rpow_pos_of_pos hr' b,

  have f₃ : 0 < k' / r' ^ b := div_pos ((ne.symm Hk').le_iff_lt.mp hk') f₂,
  have f₃' : k' / r' ^ b ≠ 0 := f₃.ne.symm,
  have f₄ : (N₂ r' k' b : ℝ) < _ := nat.ceil_lt_add_one this.le,

  rwa [lt_div_iff, ← lt_div_iff', mul_div_assoc, ← log_lt_log_iff, log_mul, log_pow,
       ← lt_div_iff (log_pos one_lt_two), add_div, div_self (log_pos one_lt_two).ne.symm, add_comm],
  all_goals { assumption <|> norm_num  },
  assumption
end

end helper

section

/-!
In the rest of this file, we fix once and for all the following parameters:

* `r` and `r'` are nonnegative real numbers
* `BD` denotes a Breen-Deligne package
* `κ` and `κ'` are sequences of nonnegative real numbers,
  that are assumed to be "adept" with respect to `BD`
  and "very suitable" with respect to `BD`, `r`, and `r'`.
* `Λ` denotes a polyhedral lattice
-/

parameters (r r' : ℝ≥0)
parameters (BD : breen_deligne.package) (κ κ' : ℕ → ℝ≥0)
parameters (Λ : PolyhedralLattice)

/-!
We also let `m` denote a variable natural number.
-/

variables  (m : ℕ)

namespace thm95

open system_of_double_complexes

namespace universal_constants

open breen_deligne

/-- `k₁ m` is a sequence of nonnegative real numbers, defined recursively via
* `k₁ 0 = 2` (the important property being `k₁ 0 > 1`) and
* `k₁ (m+1)` is the maximum of `2` and `c`,
  where `c` is the square of the maximum of `k₀ m (k₁ m)`, and `κ' 0`, `κ' 1`, ..., `κ' (m+1)`.
  Here `k₀ m k` is the sequence of constants used in the proof of `normed_spectral`. -/
noncomputable def k₁ : ℕ → ℝ≥0
| 0     := 2 -- should be anything > 1
| (m+1) := max 2 ((max (normed_spectral.k₀ m (k₁ m)) $ (range $ m+2).sup κ')^2)

/-- All the numbers `k₁ m` are larger than `1`. -/
instance one_lt_k₁ : Π (m : ℕ), fact (1 < k₁ m)
| 0     := ⟨one_lt_two⟩
| (m+1) := ⟨lt_of_lt_of_le one_lt_two (le_max_left _ _)⟩

/-- `k₀ m` is the constant `k₀ m (k m)` used in the proof of `normed_spectral`. -/
abbreviation k₀ : ℝ≥0 := normed_spectral.k₀ m (k₁ m)

/-- `k' m` is the maximum of `k₀ m` and the constants `κ' 0`, `κ' 1`, ..., `κ' m`, `κ' (m+1)` -/
def k' : ℝ≥0 := max (k₀ m) $ (range $ m+2).sup κ'

/-- For indices `i` ranging over `0` up to `m+1`, we have `κ' i ≤ k' m`. -/
lemma κ'_le_k' {i : ℕ} (hi : i ≤ m+1) : κ' i ≤ k' m :=
le_max_iff.mpr $ or.inr $ le_sup $ mem_range.mpr $ nat.lt_succ_iff.mpr hi

-- A different way of telling Lean the same fact as the previous lemma.
instance fact_κ'_le_k' {i : ℕ} (hi : fact (i ≤ m+1)) : fact (κ' i ≤ k' m) := ⟨κ'_le_k' _ hi.1⟩

/-- We always have `1 ≤ k' m` for all `m`, since `1 ≤ k₀ m`. -/
instance one_le_k' : fact (1 ≤ k' m) := ⟨le_trans (fact.out _) $ le_max_left _ _⟩

/-- We always `k₀ m ≤ k' m`. -/
instance k₀_le_k' : fact (k₀ m ≤ k' m) := ⟨le_max_left _ _⟩

/-- `k m` is the square of `k' m`. -/
def k : ℝ≥0 := k' m * k' m

instance one_le_k : fact (1 ≤ k m) := by { delta k, apply_instance }

/-- For positive `m`, we have `k (m-1) ≤ k₁ m`. -/
instance k_le_k₁ [fact (0 < m)] : fact (k (m - 1) ≤ k₁ m) :=
begin
  unfreezingI {cases m},
  { exact false.elim (lt_irrefl 0 (fact.elim infer_instance)) },
  { apply fact.mk,
    simp only [k₁],
    convert le_max_right _ _,
    rw pow_two,
    refl }
end

/-- `k₁_sqrt m` denotes the square root of `k₁ m`. -/
def k₁_sqrt : ℝ≥0 := ⟨real.sqrt (k₁ m), real.sqrt_nonneg _⟩

instance one_lt_k₁_sqrt : fact (1 < k₁_sqrt m) := ⟨begin
  change (1 : ℝ) < real.sqrt (k₁ κ' m),
  rw [real.lt_sqrt zero_le_one, pow_two, mul_one],
  exact (universal_constants.one_lt_k₁ κ' m).elim,
end⟩

/-- `y m r` denotes `m + 2 + (r + 1) / (r - r^2) * (m + 2)^2`. -/
def y (m : ℕ) (r : ℝ≥0) := (m + 2 : ℝ≥0) + (r + 1) / (r * (1 - r)) * (m + 2)^2

/-- `H' m n` is the maximum of `1` and `c`, where `c` bounds the first `m+1` maps in the
`n`-th iteration of the homotopy of the Breen-Deligne package `BD`. -/
def H' (n : ℕ) :=
max 1 ((range $ m+1).sup $ λ q, ((BD.data.homotopy_mul BD.homotopy n).hom q (q + 1)).bound)

/-- `K₁` is a sequence of nonnegative real numbers, defined recursively via
* `K₁ 0 = 2 + (r + 1) / (r * (1 - r)) * 4`
* `K₁ (m+1) = max (y (m+1) r) c`, where
  - `y (m+1) r` is defined to be `m + 3 + (r + 1) / (r - r^2) * (m + 3)^2`
  - `c` is `2 * K₀ m (K₁ m) * (H' m N₂)`
  - `K₀ m K₁` denotes one of the constants used in the proof of `normed_spectral`
  - `N₂` denotes the natural number `N₂ r' (k' m) (b r r' (k' m) ε)` defined before
  - `ε` denotes the constant `ε m (K₁ m)` used in the proof of `normed_spectral`. -/
noncomputable def K₁ : ℕ → ℝ≥0
| 0     := 2 + (r + 1) / (r * (1 - r)) * 4
| (m+1) :=
max (y (m+1) r)
    (2 * normed_spectral.K₀ m (K₁ m) *
         (H' m $ helper.N₂ r' (k' m) (helper.b r r' (k' m) (normed_spectral.ε m (K₁ m)))))

/-- For all `m`, the number `K₁ m` is larger than `1`. -/
instance one_le_K₁ : ∀ m, fact (1 ≤ K₁ m)
| 0     := ⟨begin
             dsimp [K₁],
             apply le_add_right,
             exact one_le_two
            end⟩
| (m+1) := ⟨begin
              dsimp [K₁],
              refine le_max_iff.mpr (or.inl _),
              dsimp [y],
              apply le_add_right,
              norm_cast,
              exact le_add_self
            end⟩

/-- `K₀ m` is the constant `K₀ m (K m)` used in the proof of `normed_spectral` -/
abbreviation K₀ : ℝ≥0 := normed_spectral.K₀ m (K₁ m)

/-- `ε m` is the constant `ε m (K m)` used in the proof of `normed_spectral` -/
abbreviation ε : ℝ≥0 := normed_spectral.ε m (K₁ m)

instance ε_pos : fact (0 < ε m) := ⟨normed_spectral.ε_pos _ _⟩

variables [fact (0 < r)] [fact (0 < r')] [fact (r < r')] [fact (r' ≤ 1)]

/-- `b κ' r r' m` is the smallest `b` such that `2 * (k' m) * (r / r') ^ b ≤ (ε m)`. -/
def b : ℕ := helper.b r r' (k' m) (ε m)

/-- `b κ' r r' m` is the smallest `b` such that `2 * (k' m) * (r / r') ^ b ≤ (ε m)`.
This lemma proves that `b` indeed satisfies the property claimed at its definition. -/
lemma b_spec : (2 * k' m) * (r / r') ^ (b m) ≤ ε m :=
begin
  suffices : 2 * (k' κ' m : ℝ) * (r / r') ^ b r r' BD κ' m ≤ ε r r' BD κ' m,
  exact_mod_cast this,
  apply helper.b_spec ‹fact (0 < r)›.out ‹fact (0 < r')›.out ‹fact (r < r')›.out ; norm_cast ;
  apply fact.out
end

/-- `N₂ κ' r r' m` is the smallest `N₂` such that `N = 2 ^ N₂` satisfies
`(k' m) / N ≤ r' ^ (b κ' r r' m)`. -/
def N₂ : ℕ := helper.N₂ r' (k' m) (b m)

/-- `N₂ κ' r r' m` is the smallest `N₂` such that `N = 2 ^ N₂` satisfies
`(k' m) / N ≤ r' ^ (b κ' r r' m)`.
This lemma proves that `N₂` indeed satisfies the property claimed at its definition. -/
lemma N₂_spec : (k' m) / (2 ^ (N₂ m)) ≤ r' ^ b m :=
begin
  suffices : (k' κ' m : ℝ) / 2 ^ N₂ r r' BD κ' m ≤ r' ^ (b r r' BD κ' m : ℝ),
  exact_mod_cast this,
  apply helper.N₂_spec ‹fact (0 < r')›.out ; norm_cast ;
  apply fact.out
end

/-- `N₂ = N₂ κ' r r' m` is defined in such a way that `r' ^ b < 2 * k' m / 2 ^ N₂`,
where `b = b κ' r r' m`. -/
lemma N₂_spec_of_pos' (h : 0 < N₂ m) :
  r' ^ b m < 2 * k' m / 2 ^ N₂ m :=
begin
  suffices : (r' : ℝ) ^ (b r r' BD κ' m : ℝ) < 2 * k' κ' m / 2 ^ N₂ r r' BD κ' m,
  exact_mod_cast this,
  apply helper.N₂_spec_of_pos' h,
  { norm_cast,
    exact ‹fact (0 < r')›.out },
  apply nnreal.coe_nonneg
end

lemma k'_eq_one_of_N₂_spec_eq_zero (h : N₂ m = 0) : k' m = 1 :=
begin
  refine le_antisymm _ (universal_constants.one_le_k' _ _).1,
  obtain F := N₂_spec r r' BD κ' m,
  rw [h, pow_zero, div_one] at F,
  refine F.trans (pow_le_one (b r r' BD κ' m) (le_of_lt _) _);
  { apply fact.out _,
    assumption }
end

/-- `N m = 2 ^ N₂ m` is the smallest `N` that satisfies `(k' m) / N ≤ r' ^ (b m)` -/
def N : ℕ := 2 ^ N₂ m

instance N_pos : fact (0 < N m) := ⟨pow_pos zero_lt_two _⟩

/-- For all `m` we have `k' m ≤ N m = 2 ^ N₂ m`. -/
instance k'_le_two_pow_N : fact (k' m ≤ 2 ^ N₂ m) :=
{ out := begin
  rw [← mul_one ((2 : ℝ≥0) ^ _)],
  obtain F := N₂_spec r r' BD κ' m,
  rw [nnreal.div_le_iff (pow_pos zero_lt_two _).ne', mul_comm] at F,
  refine F.trans (mul_le_mul rfl.le _ _ _),
  { refine pow_le_one _ (zero_le r') _,
    apply fact.out _,
    assumption },
  repeat { exact pow_nonneg (zero_le _) _ }
end }

/-- For all `m` we have `r ^ (b m) * (N m) ≤ 2 * k' m * (r / r') ^ (b m)`. -/
lemma r_pow_b_mul_N_le : r ^ (b m) * (N m) ≤ 2 * k' m * (r / r') ^ (b m) :=
begin
  rw [mul_comm _ (_ ^ _), N, div_pow, nat.cast_pow, nat.cast_bit0, nat.cast_one, div_eq_mul_one_div,
    mul_assoc, div_mul_comm, mul_one],
  refine mul_le_mul_left' _ _,
  rw [nnreal.le_div_iff_mul_le, mul_comm, ← nnreal.le_div_iff_mul_le],
  { by_cases N0 : N₂ r r' BD κ' m = 0,
    { rw [k'_eq_one_of_N₂_spec_eq_zero _ _ BD _ _ N0, mul_one, N0, pow_zero, div_one],
      refine le_trans (pow_le_one _ (nnreal.coe_nonneg _) _) one_le_two,
      apply fact.out _,
      assumption },
    { exact le_of_lt (N₂_spec_of_pos' _ _ BD _ _ (zero_lt_iff.mpr N0)) } },
  { exact pow_ne_zero _ two_ne_zero },
  { exact pow_ne_zero _ (ne_of_gt (fact.out _)) }
end

/-- For all `m` we have `r ^ b m * N m ≤ ε m`. -/
lemma r_pow_b_le_ε : r ^ b m * N m ≤ ε m := (r_pow_b_mul_N_le _).trans (b_spec _)

/-- For all `m` we have `k' m * (2 ^ N₂ m)⁻¹ ≤ r' ^ b m`. -/
lemma N₂_spec' : k' m * (2 ^ N₂ m)⁻¹ ≤ r' ^ b m :=
by { rw [inv_eq_one_div, mul_one_div], exact N₂_spec r r' BD κ' m }

/-- `H BD κ' r r' m` is the universal bound on the norm of the `N₂`th Breen--Deligne homotopy
in the first `m` degrees. Here `N₂ = N₂ κ' r r' m`. -/
def H : ℕ := H' m (N₂ m)

lemma one_le_H : 1 ≤ H m := le_max_left _ _

instance H_pos : fact (0 < H m) := ⟨zero_lt_one.trans_le $ one_le_H _⟩
instance H_pos' : fact ((0:ℝ≥0) < H m) := by { norm_cast, apply_instance }

lemma bound_by_H {q : ℕ} (h : q ≤ m) :
  ((BD.data.homotopy_mul BD.homotopy (N₂ m)).hom q (q + 1)).bound_by (H m) :=
begin
  rw [H, H', universal_map.bound_by, le_max_iff],
  right,
  refine @le_sup _ _ _ _ (range $ m+1)
    (λ q, ((BD.data.homotopy_mul BD.homotopy (N₂ r r' BD κ' m)).hom q (q + 1)).bound) _ _,
  rwa [mem_range, nat.lt_succ_iff],
end

/-- `K m` is defined to be `2 * K₀ m (K₁ m) * H m`,
where `K₀ m (K₁ m)` is one of the constants used in the proof of `normed_spectral`. -/
def K : ℝ≥0 := 2 * normed_spectral.K₀ m (K₁ m) * H m

instance one_le_K : fact (1 ≤ K m) := fact.mk $
calc 1 = 1 * 1 * 1 : by simp
... ≤ 2 * normed_spectral.K₀ m (K₁ m) * H m :
begin
  refine mul_le_mul' (mul_le_mul' one_le_two $ (normed_spectral.one_le_K₀ _ _).1) _,
  norm_cast,
  apply one_le_H
end

/-- For all positive `m`, we have `K (m - 1) ≤ K₁ m`. -/
instance K_le_K₁ [fact (0 < m)] : fact (K (m - 1) ≤ K₁ m) :=
⟨begin
  tactic.unfreeze_local_instances,
  have hm : 0 < m, from fact.out _,
  cases m,
  { exfalso, exact nat.lt_asymm hm hm, },
  simp only [K₁, nat.succ_sub_succ_eq_sub, nat.sub_zero, le_max_iff],
  right,
  apply le_refl
end⟩

lemma K₁_spec : (m + 2 + (r + 1) / (r * (1 - r)) * (m + 2)^2 : ℝ≥0) ≤ K₁ m :=
begin
  cases m,
  { norm_num [K₁] },
  { simp only [K₁, le_max_iff],
    left,
    apply le_refl }
end

section open simplex_category

def c₀_aux (m : ℕ) (Λ : PolyhedralLattice) : ℝ≥0 :=
N m * lem98.d Λ (N m) / (k₁_sqrt m - 1) / r' / (range $ m+1).inf' ⟨0, by simp⟩ κ

-- define this such that the lemmas below hold
noncomputable def c₀ : ℕ → PolyhedralLattice → ℝ≥0
| 0 Λ := c₀_aux 0 Λ
| (m+1) Λ := max (c₀_aux (m+1) Λ)
    (max (c₀ m Λ)
    (max (c₀ m ((Λ.cosimplicial (N (m+1))).obj (mk 0)))
      ((range (m+1)).sup (λ i, c₀ m ((Λ.cosimplicial (N (m+1))).obj (mk (i + 1)))))))

lemma c₀_mono : fact (c₀ (m - 1) Λ ≤ c₀ m Λ) :=
begin
  fsplit,
  cases m,
  { apply le_refl, },
  { dsimp [c₀],
    apply le_trans _ (le_max_right _ _),
    apply le_trans _ (le_max_left _ _),
    simp, }
end

lemma c₀_pred_le (hm : 0 < m) : fact (c₀ (m - 1) ((Λ.cosimplicial (N m)).obj (mk 0)) ≤  c₀ m Λ) :=
begin
  fsplit,
  cases m,
  { cases hm, },
  { dsimp [c₀],
    apply le_trans _ (le_max_right _ _),
    apply le_trans _ (le_max_right _ _),
    apply le_trans _ (le_max_left _ _),
    simp, }
end

lemma c₀_pred_le_of_le (i : ℕ) (hi : i + 2 ≤ m + 1) :
  fact (c₀ (m - 1) ((Λ.cosimplicial (N m)).obj (mk (i + 1))) ≤ c₀ m Λ) :=
begin
  fsplit,
  cases m,
  { simpa using nat.succ_le_succ_iff.mp hi, },
  { dsimp [c₀],
    replace hi : i ∈ range (m + 1) :=
      mem_range.mpr (nat.succ_le_iff.mp (nat.succ_le_succ_iff.mp hi)),
    apply le_trans _ (le_max_right _ _),
    apply le_trans _ (le_max_right _ _),
    apply le_trans _ (le_max_right _ _),
    simp only [nat.succ_sub_succ_eq_sub, nat.sub_zero, nat.succ_eq_add_one],
    exact le_sup hi, }
end

lemma fix_this_in_mathlib :
  nnreal.semilattice_inf = lattice.to_semilattice_inf ℝ≥0 :=
begin
  apply semilattice_inf.ext, intros, refl,
end

lemma c₀_spec [BD.data.very_suitable r r' κ] (j : ℕ) (hj : j ≤ m) :
  lem98.d Λ (N m) ≤ (k₁_sqrt m - 1) * (r' * (κ j * c₀ m Λ)) / (N m) :=
begin
  have w := BD.data.pos κ,
  rw [nnreal.le_div_iff', ←nnreal.div_le_iff', ←nnreal.div_le_iff', ←nnreal.div_le_iff'],
  rotate,
  { exact (w _).ne' },
  { apply ne_of_gt, exact fact.out _ },
  { rw [← pos_iff_ne_zero, ←add_lt_add_iff_right (1 : ℝ≥0), tsub_add_cancel_of_le, zero_add]; apply fact.out, },
  { apply ne_of_gt, exact fact.out _ },
  cases m, { cases hj, apply le_refl, },
  refine le_trans _ (le_max_left _ _),
  dsimp [c₀_aux],
  apply nnreal.div_le_div_left_of,
  { rw [fix_this_in_mathlib, lt_inf'_iff], intros b mem, exact w b },
  { refine inf'_le _ _, exact mem_range_succ_iff.mpr hj },
end

end

end universal_constants

end thm95

end