import counit_ker_abelian
import pq_induction_principles
import group_theory.abelianization

universe u

section commutator_counit_kernel

variables {G : Type u} [group G]

theorem commutator_intersect_counit_kernel_trivial (x y : pq_group G) (hxy : counit (x * y * x⁻¹ * y⁻¹) = 1) : x * y * x⁻¹ * y⁻¹ = 1 :=
begin
  simp only [counit_of, monoid_hom.map_mul, monoid_hom.map_mul_inv] at hxy,
  rw ←rhd_def_group,
  rw inner_aut_eq,
  generalize ha : counit x = a,
  rw ha at hxy,
  clear ha x,
  suffices : of a ▷ y = y,
  {
    rw this,
    simp only [mul_right_inv],
  },
  have hya : a ▷ (counit y) = counit y,
  {
    rw ←rhd_def_group at hxy,
    exact mul_inv_eq_one.mp hxy,
  },
  clear hxy,
  suffices : (of a) ▷ (y * (of (counit y))⁻¹) = y * (of (counit y))⁻¹,
  {
    rw rhd_mul at this,
    suffices this2 : (of a▷(of (counit y))⁻¹) = (of (counit y))⁻¹,
    {
      rw this2 at this,
      simp only [mul_left_inj] at this,
      exact this,
    },
    clear this,
    rw of_inv,
    rw rhd_of_eq_of_rhd,
    apply congr_arg,
    rw ←power_quandle.pow_rhd,
    rw hya,
  },
  suffices : (y * (of (counit y))⁻¹) ▷ (of a) = of a,
  {
    generalize ha1 : of a = a1,
    generalize ha2 : (y * (of (counit y))⁻¹) = a2,
    rw ha1 at this,
    rw ha2 at this,
    clear ha1 ha2 hya a y,
    rw rhd_def_group at *,
    rw ←center_reformulate at *,
    symmetry,
    exact this,
  },
  rw inner_aut_eq,
  simp only [counit_of, mul_right_inv, monoid_hom.map_mul_inv],
  rw of_one,
  rw power_quandle.one_rhd,
end

end commutator_counit_kernel


import lib.tactics
import lib.nat
import data.list.basic

universe u

open list

lemma filter_hd {α : Type u} {x : α} {xs : list α} {p : α → Prop} [decidable_pred p]
: p x → list.filter p (x :: xs) = x :: list.filter p xs :=
by {intros, simp [‹p x›]}

lemma iota_succ (n : ℕ) : iota (n + 1) = (n + 1) :: iota n := rfl

lemma sum_cons (x : ℕ) (xs : list ℕ) : list.sum (x :: xs) = x + sum xs := begin
  delta list.sum,
  rw [foldl_eq_foldr, foldl_eq_foldr],
  refl,
  exact nat.add_comm,
  exact nat.add_assoc,
  exact nat.add_comm,
  exact nat.add_assoc
end

@[simp]
lemma iota_nil : list.iota 0 = [] := by trivial

lemma sum_map_of_sum_mul {xs} {d : ℕ} : list.sum xs * d = list.sum (list.map (λ n, n * d) xs) := begin
  induction xs with x xs ih,
  { simp },
  { rw [list.sum_cons, nat.right_distrib],
     rw [list.map_cons, list.sum_cons],
     simp [ih] }
end


/-
Copyright (c) 2022 María Inés de Frutos-Fernández, Filippo A. E. Nuccio. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández, Filippo A. E. Nuccio
-/
import algebra.order.hom.monoid
-- import algebra.hom.group
import for_mathlib.num_denom_away
import for_mathlib.polynomial
import ring_theory.dedekind_domain.adic_valuation
import ring_theory.laurent_series
import ring_theory.power_series.well_known

import algebra_comp

open polynomial is_dedekind_domain.height_one_spectrum topological_space ratfunc
  sequentially_complete filter
open_locale big_operators discrete_valuation uniformity filter topology

variables (K : Type*) [field K]

noncomputable theory
def completion_of_ratfunc := adic_completion (ratfunc K) (ideal_X K)

/- noncomputable! lemma completion_of_ratfunc_def :
  completion_of_ratfunc K = adic_completion (ratfunc K) (polynomial.ideal_X K) := sorry -/

instance : field (completion_of_ratfunc K) := adic_completion.field (ratfunc K) (ideal_X K)

instance : algebra K (polynomial K) := infer_instance

--Now in the polynomial file
/- instance : valued (ratfunc K) ℤₘ₀ :=
begin
 use @adic_valued (polynomial K) _ _ _ (ratfunc K) _ _ _ (ideal_X K),
end -/

-- instance : uniform_space (ratfunc K) :=
--   (@adic_valued (polynomial K) _ _ _ (ratfunc K) _ _ _ (ideal_X K)).to_uniform_space

-- example : valued (ratfunc K) ℤₘ₀ :=
-- begin
--   have := adic_valued (ideal_X K),
-- end
  -- (@adic_valued (polynomial K) _ _ _ (ratfunc K) _ _ _ (ideal_X K)).to_uniform_space

instance already : valued (completion_of_ratfunc K) ℤₘ₀ :=
  @valued.valued_completion _ _ _ _ (ideal_X K).adic_valued

-- #exit

instance : uniform_space (completion_of_ratfunc K) := infer_instance

variable (F : completion_of_ratfunc K)

-- --*FAE* The one below is one I am trying on Mar14th at night
-- def entourage (d : ℤ) : set (ratfunc K × ratfunc K) :=
--   {P | (ideal_X K).valuation (P.1 - P.2) < ↑(multiplicative.of_add d)}

--*FAE* The one below is the one that works perfectly but gives something crazy
def entourage (d : ℤ) : set (ratfunc K × ratfunc K) :=
  {P | (ideal_X K).valuation (P.1 - P.2) < ↑(multiplicative.of_add (- d))}

-- *FAE* This was the old definition, but I think I got the inequalities wrong, since I did not
-- know yet how to play with `multiplicative.of_add`. It does not work
-- def entourage_bad (d : ℤ) : set (ratfunc K × ratfunc K) :=
--   {P | ↑(multiplicative.of_add d) ≤ (ideal_X K).valuation (P.1 - P.2)}

lemma fae_for_pol (f  : polynomial K) (d : ℕ) (hf : (ideal_X K).int_valuation f ≤
  ↑(multiplicative.of_add (- (d+(1 : ℕ)) : ℤ))) : f.coeff d = 0 :=
begin
  erw [int_valuation_le_pow_iff_dvd _ _ (d+1)] at hf,
  simp only [ideal_X_span, ideal.dvd_span_singleton, ideal.span_singleton_pow,
    ideal.mem_span_singleton'] at hf,
  cases hf with a ha,
  simp only [← ha, coeff_mul_X_pow', add_le_iff_nonpos_right, le_zero_iff, nat.one_ne_zero,
    if_false],
end

open laurent_series hahn_series

lemma val_X_fae : ((X : ratfunc K): laurent_series K).order = 1 :=
by simp only [ratfunc.coe_X, hahn_series.order_single, ne.def, one_ne_zero, not_false_iff]

lemma fae_X_pow (n : ℕ) : (hahn_series.single (n : ℤ) 1) =
  ((X :ratfunc K) : laurent_series K) ^ n :=
begin
induction n with n h_ind ,
    { simp only [nat.nat_zero_eq_zero, int.of_nat_eq_coe, zmod.nat_cast_self, zpow_zero],
     refl, },
    { rw ← int.coe_nat_add_one_out,
      rw [← one_mul (1 : K)],
      rw ← hahn_series.single_mul_single,
      rw h_ind,
      rw ratfunc.coe_X,
      rw pow_succ' },
end

lemma fae_single_inv (d : ℤ) (α : K) (hα : α ≠ 0) : (hahn_series.single (d : ℤ) (α : K))⁻¹
  = hahn_series.single (-d) (α⁻¹ : K) :=
by {rw [inv_eq_of_mul_eq_one_left], simpa only [hahn_series.single_mul_single,
  add_left_neg, inv_mul_cancel hα]}

lemma fae_X_zpow (n : ℤ) : (hahn_series.single (n : ℤ) 1) =
  ((X :ratfunc K) : laurent_series K) ^ n :=
begin
  induction n with n_pos n_neg,
  apply fae_X_pow,
  rw ratfunc.coe_X,
  have := fae_single_inv K ((n_neg + 1) : ℤ) 1 one_ne_zero,
  rw int.neg_succ_of_nat_coe,
  rw int.coe_nat_add,
  rw nat.cast_one,
  nth_rewrite 0 [← inv_one],
  rw ← this,
  rw zpow_neg,
  rw ← nat.cast_one,
  rw ← int.coe_nat_add,
  rw fae_X_pow,
  rw ratfunc.coe_X,
  rw [algebra_map.coe_one, inv_inj],
  rw zpow_coe_nat,
end

-- example (X Y : Type) [preorder X] [has_lt X] (S : set X) (hS : S.is_wf)

-- lemma uno {X Y : Type} [preorder X] [preorder Y] {S : set X} (hS : S.is_pwo)
--   (f : X ↪o Y) : set.is_wf (f '' S) :=
-- begin
--   apply set.is_pwo.is_wf,
--   apply set.is_pwo.image_of_monotone hS f.monotone,
-- end

-- lemma due {X Y : Type} [preorder X] [preorder Y] {S : set X} (hS : S.is_pwo) (H : S.nonempty)
--   (f : X ↪o Y) : f (set.is_wf.min (hS.is_wf) H) =
--     set.is_wf.min (uno hS f) (set.nonempty_image_iff.2 H) :=
-- begin
--   sorry,
-- end

-- namespace function

-- variables {Γ Γ' : Type} [linear_ordered_cancel_add_comm_monoid Γ]
--   [linear_ordered_cancel_add_comm_monoid Γ'] {ι : Γ →+o Γ'}

-- @[simps]
-- def injective.order_embedding (hι : function.injective ι) : Γ ↪o Γ' :=
--   order_embedding.of_strict_mono _ ((order_hom_class.mono ι).strict_mono_of_injective hι)

-- end function

-- lemma order_emb_domain {R Γ Γ' : Type} [comm_ring R] [is_domain R]
-- [linear_ordered_cancel_add_comm_monoid Γ]
-- [linear_ordered_cancel_add_comm_monoid Γ']
-- (ι : Γ →+o Γ') (hι : function.injective ι) (φ : hahn_series Γ R) :
--   (with_top.map (↑ι : _ →+ _)) (hahn_series.add_val Γ R φ) = hahn_series.add_val Γ' R
--   (emb_domain hι.order_embedding φ) :=
-- begin
--   sorry,
-- end

namespace hahn_series
open set
variables {Γ Γ' R : Type*}

lemma eq_order_of_emb_domain [has_zero R] [linear_order Γ] [linear_order Γ'] [has_zero Γ] [has_zero Γ'] (φ : hahn_series Γ R) {ι : Γ ↪o Γ'}  (hι : ι 0 = 0) :
  (emb_domain ι φ).order = ι φ.order :=
begin
  by_cases h : φ = 0,
  { simp [h, hι] },
  have : emb_domain ι φ ≠ 0,
  { intro h0,
    rw [← @emb_domain_zero Γ _ _ _ _ _ ι] at h0,
    exact h (emb_domain_injective h0) },
  rw [order_of_ne h, order_of_ne this],
  refine le_antisymm (is_wf.min_le _ _ _) ((is_wf.le_min_iff _ _).2 (λ b hb, _)),
  { simp only [mem_support, emb_domain_coeff, ne.def],
    intro h0,
    rw [← order_of_ne h] at h0,
    exact coeff_order_ne_zero h h0 },
  { simp only [mem_support, ne.def] at hb,
    replace hb : b ∈ ι '' φ.support,
    { by_contra' habs,
      exact hb (emb_domain_notin_image_support habs) },
    obtain ⟨c, hcmem, hbc⟩ := hb,
    rw [← hbc, ι.le_iff_le],
    exact is_wf.min_le _ _ hcmem },
end

-- **This looks
-- lemma of_power_series_tower (φ : power_series R) [strict_ordered_semiring Γ]
--   [strict_ordered_semiring Γ'] {ι : Γ →+ Γ'} (hinj : function.injective ι)
--   (hι : ∀ g g' : Γ, ι g ≤ ι g' ↔ g ≤ g') [semiring R] :
--   (emb_domain ⟨⟨ι, hinj⟩, hι⟩ (of_power_series Γ R φ )) = (of_power_series Γ' R φ) :=
-- begin
--   -- simp,
--   ext g,
--   have := @emb_domain_coeff Γ R _ _ Γ' _ ⟨⟨ι, hinj⟩, hι⟩ (of_power_series Γ R φ),
-- end

lemma order_eq_of_power_series {R : Type*} [semiring R] {φ : power_series R} (hφ : φ ≠ 0) :
  power_series.order φ = (hahn_series.of_power_series ℕ R φ).order :=
begin
  -- by_cases hφ : φ = 0,
  -- { rw hφ,
  --   rw power_series.order_zero,
  --   rw map_zero,
  --   rw hahn_series.order_zero,
  --   simp,
  --   sorry--and it is false
  -- },
  obtain ⟨_, ⟨H, hm⟩⟩ := part.dom_iff_mem.mp ((power_series.order_finite_iff_ne_zero).mpr hφ),
    rw [← @part_enat.coe_get _ H],
    apply congr_arg,
    apply le_antisymm _ (hahn_series.order_le_of_coeff_ne_zero _),
    { rw [← part_enat.coe_le_coe, part_enat.coe_get],
      apply power_series.order_le,
      erw [← @hahn_series.of_power_series_apply_coeff ℕ _ _ _ _ _],
      apply hahn_series.coeff_order_ne_zero,
      exact (map_ne_zero_iff (hahn_series.of_power_series ℕ R)
        (hahn_series.of_power_series_injective)).mpr hφ,
    },
    { erw [hahn_series.of_power_series_apply_coeff φ],
      apply power_series.coeff_order, },
end

lemma to_power_series_of_power_series {R : Type*} [semiring R] {φ : hahn_series ℕ R} :
  of_power_series ℕ R (to_power_series φ) = φ :=
begin
  ext,
  convert of_power_series_apply_coeff (to_power_series φ) _,
  simp only [finsupp.single_eq_same],
end

lemma order_eq_to_power_series {R : Type*} [comm_ring R] {φ : hahn_series ℕ R} (hφ : φ ≠ 0) :
  power_series.order (to_power_series φ) = φ.order :=
by rw [order_eq_of_power_series ((map_ne_zero_iff _ (@to_power_series R _).injective).mpr hφ), to_power_series_of_power_series]

lemma nat_order_eq_of_power_series {R : Type*} [semiring R] {φ : power_series R} (hφ : φ ≠ 0) :
  (φ.order).get (power_series.order_finite_iff_ne_zero.mpr hφ) =
    (hahn_series.of_power_series ℕ R φ).order :=
by simp only [order_eq_of_power_series hφ, part_enat.get_coe']

-- lemma emb_domain_comp {R Γ : Type*} [strict_ordered_semiring Γ] [comm_semiring R] (ι : ℕ ↪o Γ)
--   (φ : power_series R) : emb_domain ι (of_power_series ℕ R φ) = of_power_series Γ R φ := sorry

-- `[FAE]` The proof is **disgusting**, need to isolate (at least) `emb_domain_comp`
lemma order_eq_of_power_series_Z {R : Type*} [comm_semiring R] {φ : power_series R} (hφ : φ ≠ 0) :
  ((φ.order).get (power_series.order_finite_iff_ne_zero.mpr hφ) : ℤ) =
    (hahn_series.of_power_series ℤ R φ).order :=
begin
  let ι : ℕ ↪o ℤ := ⟨⟨(nat.cast_add_monoid_hom ℤ).1, nat.strict_mono_cast.injective⟩, λ _ _, nat.cast_le⟩,
  have := @hahn_series.eq_order_of_emb_domain ℕ ℤ R _ _ _ _ _ (of_power_series ℕ R φ) ι nat.cast_zero,
  have emb_domain_comp' : emb_domain ι (of_power_series ℕ R φ) = of_power_series ℤ R φ,
  { ext n,
    induction n with n m,
    { have uno := @emb_domain_coeff ℕ R _ _ ℤ _ ι (of_power_series ℕ R φ) n,
      erw uno,
      have tre := @of_power_series_apply_coeff ℕ R _ _ φ n,
      simp only [nat.cast_id] at tre,
      rw tre,
      have quattro := @of_power_series_apply_coeff ℤ R _ _ φ n,
      exact quattro.symm},
    { have : (emb_domain ι ((of_power_series ℕ R) φ)).coeff -[1+ m] = 0,
      { apply emb_domain_notin_range,
        simp only [add_monoid_hom.to_fun_eq_coe, nat.coe_cast_add_monoid_hom, rel_embedding.coe_fn_mk, function.embedding.coe_fn_mk,
          mem_range, not_exists],
        intros x H,
        have hx : (0 : ℤ) ≤ x := x.cast_nonneg,
        rw H at hx,
        exact (le_not_le_of_lt (int.neg_succ_of_nat_lt_zero m)).2 hx},
      rw this,
      have h_dif := (@of_power_series_alg_apply_coeff ℤ R _ R _ _ _ φ -[1+m]).symm,
      rwa dif_neg at h_dif,
      simp only [not_exists, not_and],
      rintros x - H,
      have hx : (0 : ℤ) ≤ x := x.cast_nonneg,
      rw H at hx,
      exact (le_not_le_of_lt (int.neg_succ_of_nat_lt_zero m)).2 hx}, },
  rw emb_domain_comp' at this,--use `emb_domain_comp` instead, once it is proved
  rw nat_order_eq_of_power_series,
  symmetry,
  exact this,
end
end hahn_series

-- FAE for `mathlib`?
lemma fae_int_valuation_apply (f : polynomial K) :
  ((ideal_X K).int_valuation f) = ((ideal_X K).int_valuation_def f) := refl _

-- `FAE` The two lemmas that follow are not `refl` because the iso `to_power_series` is an iso with
-- Hahn series indexed on `ℕ` while `of_power_series` embeds the power series in any ring of Hahn
-- series indexed on a linearly ordered monoid (or blablabla).

lemma of_power_series_to_power_series {R : Type*} [semiring R] {φ : power_series R} :
  to_power_series (of_power_series ℕ R φ) = φ :=
begin
  ext,
  convert @coeff_to_power_series _ _ (of_power_series ℕ R φ) _,
  exact (of_power_series_apply_coeff φ n).symm,
end

-- ***TO DO*** understand what to do with `φ = 0`

lemma X_pow_dvd_pol_iff_dvd_power_series (A : Type*) [comm_ring A] (P : polynomial A) (n : ℕ) :
  (polynomial.X)^n ∣ P ↔ (power_series.X)^n ∣ (P : power_series A) := by
 simp only [power_series.X_pow_dvd_iff, polynomial.X_pow_dvd_iff, coeff_coe]

/-
`FAE`: The strategy for the lemma below should now be to use that
* the order of the hahn_series
* orders of power_series and of hahn_series ℕ _ are the same by some lemma above
* the order of a power_series is the minimum of the non-zero-coefficients
* this is equivalent to the power series being divisible exactly by X^{ord} by
`power_series.X_pow_dvd_iff`
* this is equivalent to the polynomial being divisible exactly by by X^{ord} by
`X_pow_dvd_pol_iff_dvd_power_series` (that need not be a lemma? or yes?)
* this coincides with the definition of the valuation.
-/

local attribute [instance] classical.prop_decidable

open multiplicity

lemma fae_pol_ps_order_mul {f : polynomial K} :
  (↑f : power_series K).order = multiplicity polynomial.X f :=
begin
  by_cases hf_pol : f = 0,
  { simp only [hf_pol, polynomial.coe_zero, power_series.order_zero, multiplicity.zero] },
  { rw power_series.order_eq_multiplicity_X,
    have hf_ps : finite (power_series.X : power_series K) ↑f,
    { simpa only [X_pow_dvd_pol_iff_dvd_power_series, multiplicity.finite_def, map_zero, sub_zero]
        using multiplicity_X_sub_C_finite 0 hf_pol },
    set d_ps := (multiplicity power_series.X ↑f).get hf_ps with hd_ps,
    replace hf_pol: finite polynomial.X f,
    { simpa only [multiplicity.finite_def, map_zero, sub_zero]
        using multiplicity_X_sub_C_finite 0 hf_pol },
    set d_pol := (multiplicity polynomial.X f).get hf_pol with hd_pol,
    obtain ⟨P, hfP, -⟩ := exists_eq_pow_mul_and_not_dvd hf_pol,
    rw ← hd_pol at hfP,
    obtain ⟨φ, hfφ, -⟩ := exists_eq_pow_mul_and_not_dvd hf_ps,
    rw ← hd_ps at hfφ,
    apply le_antisymm,
    { have Hpol := @pow_dvd_iff_le_multiplicity (polynomial K) _ _ X f d_ps,
      rw [X_pow_dvd_pol_iff_dvd_power_series] at Hpol,
      replace Hpol := Hpol.mp (dvd_of_mul_right_eq _ hfφ.symm),
      rwa [hd_ps, part_enat.coe_get] at Hpol },
    { have Hps := @pow_dvd_iff_le_multiplicity (power_series K) _ _ power_series.X f d_pol,
      rw [← X_pow_dvd_pol_iff_dvd_power_series] at Hps,
      replace Hps := Hps.mp (dvd_of_mul_right_eq _ hfP.symm),
      rwa [hd_pol, part_enat.coe_get] at Hps }}
end

variable {K}
lemma polynomial.coe_ne_zero {f : polynomial K} : f ≠ 0 → (↑f : (power_series K)) ≠ 0 :=
by simp only [ne.def, coe_eq_zero_iff, imp_self]
variable (K)

--mathlib
variable {K}
lemma finite_multiplicity_of_ne_zero {f : polynomial K} (hf : f ≠ 0) :
  multiplicity.finite polynomial.X f :=
@multiplicity.finite_prime_left (polynomial K) _ _ _ _ prime_X hf

variable (K)
lemma fae_pol_ps_nat_order_mul {f : polynomial K} (hf : f ≠ 0) :
  ((↑f : power_series K).order).get (power_series.order_finite_iff_ne_zero.mpr
    (polynomial.coe_ne_zero hf)) =
    (multiplicity polynomial.X f).get (finite_multiplicity_of_ne_zero hf) :=
by simpa only [fae_pol_ps_order_mul]

-- section nat_order
-- namespace power_series

-- variable {K}
-- def nat_order {φ : power_series K} (h : φ ≠ 0) : ℕ :=
--   nat.find (exists_coeff_ne_zero_iff_ne_zero.mpr h)

-- lemma nat_order_eq_order {φ : power_series K} (h : φ ≠ 0) : ↑(nat_order h) = φ.order :=
-- begin
--   simp only [order, ne.def],
--   rw [dif_neg h],
--   simp only [part_enat.coe_inj],
--   sorry,
--   -- apply eq.symm,
--   -- simp,
--   -- refl,
-- end

-- end power_series
-- end nat_order

variable (K)
-- lemma fae_pol_ps_order_val {f : polynomial K} (hf : f ≠ 0) :
--  ↑(multiplicative.of_add (- (power_series.nat_order (polynomial.coe_ne_zero hf )) : ℤ)) =
--     ((ideal_X K).int_valuation f) :=
-- begin
--   have := fae_pol_ps_order_mul,
--   have := power_series.nat_order_eq_order (polynomial.coe_ne_zero hf),
--   sorry,
-- end

--open unique_factorization_monoid
lemma count_normalized_factors_eq_count_normalized_factors_span {R : Type*} [comm_ring R]
  [is_domain R] [is_principal_ideal_ring R] [normalization_monoid R][unique_factorization_monoid R]
    {r X : R} (hr : r ≠ 0) (hX₀ : X ≠ 0) (hX₁ : norm_unit X = 1 )(hX : prime X) :
  multiset.count X (unique_factorization_monoid.normalized_factors r) =
  multiset.count (ideal.span {X} : ideal R )
    (unique_factorization_monoid.normalized_factors (ideal.span {r})) :=
begin
  replace hX₁ : X = normalize X,
  { simp only [normalize_apply, hX₁, units.coe_one, mul_one] },
  have : (ideal.span {normalize X} : ideal  R) = normalize (ideal.span {X}),
  { simp only [normalize_apply, normalize_eq],
    apply ideal.span_singleton_mul_right_unit (units.is_unit _) },
  rw [← part_enat.coe_inj, hX₁,
    ← unique_factorization_monoid.multiplicity_eq_count_normalized_factors hX.irreducible hr, this,
    ← multiplicity_eq_multiplicity_span,
    ← unique_factorization_monoid.multiplicity_eq_count_normalized_factors],
  refine prime.irreducible (ideal.prime_of_is_prime _ _),
  {rwa [ne.def, ideal.span_singleton_eq_bot] },
  {rwa ideal.span_singleton_prime hX₀ },
  {rwa [ne.def, ideal.zero_eq_bot, ideal.span_singleton_eq_bot] },
end

--GOLF IT!
lemma count_normalized_factors_eq_associates_count {I J : ideal (polynomial K)} (hI : I ≠ 0) (hJ : J.is_prime ) (hJ₀ : J ≠ ⊥) : multiset.count J (unique_factorization_monoid.normalized_factors I) =
  (associates.mk J).count (associates.mk I).factors :=
begin
  replace hI : associates.mk I ≠ 0,
  { apply associates.mk_ne_zero.mpr hI },
  have hJ' : irreducible (associates.mk J),
  { rw associates.irreducible_mk,
    apply prime.irreducible,
    apply ideal.prime_of_is_prime hJ₀ hJ },
  apply ideal.count_normalized_factors_eq,
  rw [← ideal.dvd_iff_le, ← associates.mk_dvd_mk, associates.mk_pow],
  rw associates.dvd_eq_le,
  rw associates.prime_pow_dvd_iff_le hI hJ',
  { rw ← ideal.dvd_iff_le,
    rw ← associates.mk_dvd_mk,
    rw associates.mk_pow,
    rw associates.dvd_eq_le,
    rw associates.prime_pow_dvd_iff_le hI hJ',
    linarith,
  },
end

lemma order_as_power_series_eq_int_valuation {f : polynomial K} (hf : f ≠ 0) :
  ↑(multiplicative.of_add
  (-((↑f : power_series K).order).get (power_series.order_finite_iff_ne_zero.mpr
    (polynomial.coe_ne_zero hf)) : ℤ)) = ((ideal_X K).int_valuation f) :=
begin
  rw [fae_pol_ps_nat_order_mul, fae_int_valuation_apply, int_valuation_def_if_neg _ hf],
  simp only [of_add_neg, ideal_X_span, inv_inj, with_zero.coe_inj, embedding_like.apply_eq_iff_eq,
    nat.cast_inj],
  simp_rw [@unique_factorization_monoid.multiplicity_eq_count_normalized_factors (polynomial K)
    _ _ _ _ _ _ polynomial.X f (irreducible_X) hf],
  simp only [normalize_apply, coe_norm_unit, leading_coeff_X, norm_unit_one, units.coe_one, map_one,
    mul_one, part_enat.get_coe'],
  rw count_normalized_factors_eq_count_normalized_factors_span hf X_ne_zero _ prime_X,
  { have span_ne_zero : (ideal.span {f} : ideal (polynomial K)) ≠ 0 ∧
    (ideal.span {polynomial.X} : ideal (polynomial K)) ≠ 0 := by simp only [ideal.zero_eq_bot,
    ne.def, ideal.span_singleton_eq_bot, hf, polynomial.X_ne_zero, not_false_iff, and_self],
    have span_X_prime : (ideal.span {polynomial.X} : ideal (polynomial K)).is_prime,
    { apply (@ideal.span_singleton_prime (polynomial K) _ _ polynomial.X_ne_zero).mpr prime_X },
    convert @count_normalized_factors_eq_associates_count K _ (ideal.span {f})
    (ideal.span {polynomial.X}) span_ne_zero.1 ((@ideal.span_singleton_prime (polynomial K) _ _
    polynomial.X_ne_zero).mpr prime_X) span_ne_zero.2 },
  { simp only [← units.coe_eq_one, coe_norm_unit, leading_coeff_X, norm_unit_one,
    units.coe_one, map_one] },
end

lemma cruciale (f : polynomial K) :
  (hahn_series.of_power_series ℕ K (↑f : power_series K)) = (↑f : hahn_series ℕ K) :=
begin
  refl,
end

example (f : polynomial K) :
  (hahn_series.of_power_series ℤ K (↑f : power_series K)) = (↑f : power_series K) :=
begin
  refl,
end

lemma order_as_nat_hahn_series_eq_int_valuation {f : polynomial K} (hf : f ≠ 0) :
 ↑(multiplicative.of_add (- (↑f : (hahn_series ℕ K)).order : ℤ)) = ((ideal_X K).int_valuation f) :=
begin
  have := order_as_power_series_eq_int_valuation K hf,
  rw hahn_series.nat_order_eq_of_power_series at this,
  rw ← this,
  simpa only [of_add_neg, of_power_series_apply, inv_inj, with_zero.coe_inj,
    embedding_like.apply_eq_iff_eq, nat.cast_inj],
end

lemma order_as_hahn_series_eq_int_valuation {f : polynomial K} (hf : f ≠ 0) :
 ↑(multiplicative.of_add (- (f : laurent_series K).order)) = ((ideal_X K).int_valuation f) :=
begin
  simp only [← order_as_nat_hahn_series_eq_int_valuation K hf, coe_coe, of_add_neg, inv_inj,
    with_zero.coe_inj, embedding_like.apply_eq_iff_eq],
  replace hf := polynomial.coe_ne_zero hf,
  erw [← hahn_series.order_eq_of_power_series_Z hf, hahn_series.nat_order_eq_of_power_series hf],
  refl,
end

variable {K}
lemma fae_order_inv {a : laurent_series K} (ha : a ≠ 0) : a⁻¹.order = - a.order :=
  by {simp only [eq_neg_iff_add_eq_zero, ← hahn_series.order_mul  (inv_ne_zero ha) ha,
    inv_mul_cancel ha, hahn_series.order_one]}

lemma fae_order_div {a b : laurent_series K} (ha : a ≠ 0) (hb : b ≠ 0) : (a / b).order =
  a.order - b.order :=
by rwa [div_eq_mul_inv, hahn_series.order_mul ha (inv_ne_zero hb), fae_order_inv, sub_eq_add_neg]

-- `FAE` for mathlib?
lemma fae_coe (P : polynomial K) : (P : laurent_series K) = (↑P : ratfunc K) :=
  by { erw [ratfunc.coe_def, ratfunc.coe_alg_hom, lift_alg_hom_apply, ratfunc.num_algebra_map,
    ratfunc.denom_algebra_map P, map_one, div_one], refl}

-- `FAE` for mathlib?
@[simp]
lemma ratfunc.coe_ne_zero_iff {f : ratfunc K} : f ≠ 0 ↔ (↑f : laurent_series K) ≠ 0 :=
⟨λ h, by simp only [h, ne.def, algebra_map.lift_map_eq_zero_iff, not_false_iff],
  λ h, by {apply (ratfunc.coe_injective.ne_iff).mp, simpa only [ratfunc.coe_zero]}⟩

variable (K)
lemma order_as_hahn_series_eq_valuation {f : ratfunc K} (hf : f ≠ 0) :
 ↑(multiplicative.of_add (- (f : laurent_series K).order)) = ((ideal_X K).valuation f) :=
begin
  obtain ⟨P, ⟨Q, hQ, hfPQ⟩⟩ := @is_fraction_ring.div_surjective (polynomial K) _ _ (ratfunc K) _ _ _ f,
  replace hfPQ : is_localization.mk' (ratfunc K) P ⟨Q, hQ⟩ = f := by simp only [hfPQ, is_fraction_ring.mk'_eq_div, set_like.coe_mk],
  have hP : P ≠ 0 :=  by {rw ← hfPQ at hf, exact is_localization.ne_zero_of_mk'_ne_zero hf},
  have hQ₀ : Q ≠ 0 := by rwa [← mem_non_zero_divisors_iff_ne_zero],
  have val_P_Q := @valuation_of_mk' (polynomial K) _ _ _ (ratfunc K) _ _ _ (ideal_X K) P ⟨Q, hQ⟩,
  rw hfPQ at val_P_Q,
  rw val_P_Q,
  simp only [← subtype.val_eq_coe],
  rw [← (order_as_hahn_series_eq_int_valuation _ hP)],
  rw [← (order_as_hahn_series_eq_int_valuation _ hQ₀)],
  rw ← with_zero.coe_div,
  rw with_zero.coe_inj,
  rw ← of_add_sub,
  replace hQ₀ : (↑Q : ratfunc K) ≠ 0,
  { exact λ hneQ, hQ₀ ((@ratfunc.algebra_map_eq_zero_iff K _ _ Q).mp hneQ) },
  apply congr_arg,
  rw neg_eq_iff_neg_eq,
  rw neg_sub_neg,
  rw neg_sub,
  rw ← fae_order_div,
  rw ← hfPQ,
  apply congr_arg,
  convert_to ((↑P : ratfunc K) : laurent_series K)/ (↑Q : ratfunc K) =
    ↑(is_localization.mk' (ratfunc K) P ⟨Q, hQ⟩),
  { have := ratfunc.coe_div (↑P : ratfunc K) (↑Q : ratfunc K),
    rw ← this,
    rw div_eq_iff,
    { rw fae_coe,
      rw fae_coe,
      rw ← ratfunc.coe_mul,
      apply congr_arg,
      rwa [div_mul_cancel] },
    { rwa [fae_coe, ← ratfunc.coe_ne_zero_iff] },
  },
  rw ← coe_div,
  apply congr_arg,
  simpa only [mk_eq_div, is_fraction_ring.mk'_eq_div, set_like.coe_mk],
  { intro hneP,
    have hinj := @_root_.polynomial.algebra_map_hahn_series_injective ℤ K _ _,
    exact hP ( ((@injective_iff_map_eq_zero' _ _ _ _ _ _ (_ : (polynomial K) →+*
      (laurent_series K))).mp hinj P).mp hneP),
     },
  { rwa [fae_coe, ← ratfunc.coe_ne_zero_iff], },
end

-- `FAE` Depends on `fae_order_eq_val`
lemma fae_order_eq_val' {f : ratfunc K} (hf : f ≠ 0) :
 ↑(multiplicative.of_add ((f : laurent_series K).order)) = ((ideal_X K).valuation f)⁻¹ :=
begin
  have := order_as_hahn_series_eq_valuation K (neg_ne_zero.mpr hf),
  nth_rewrite 0 [← neg_neg f],
  rw ratfunc.coe_def,
  rw (ratfunc.coe_alg_hom K).map_neg,
  rw ← ratfunc.coe_def,
  rw order_neg,
  rw of_add_neg at this,
  rw [← with_zero.coe_unzero $((ideal_X K).valuation).ne_zero_iff.mpr hf],
  rw ← with_zero.coe_inv,
  rw with_zero.coe_inj,
  rw eq_inv_iff_eq_inv,
  rw ← with_zero.coe_inj,
  simp only [this, with_zero.coe_unzero, valuation.map_neg],
end

namespace ratfunc

variable {K}
def coeff (f : ratfunc K) (d : ℤ) : K := (f : laurent_series K).coeff d

@[simp]
lemma coeff_zero (d : ℤ) : (0 : ratfunc K).coeff d = 0 :=
by {simp only [coeff, coe_zero], from hahn_series.zero_coeff}

variable (K)
def coeff_map (d : ℤ) : ratfunc K → K := λ x, coeff x d

lemma coeff_map_apply (d : ℤ) (f : ratfunc K) : coeff_map K d f = coeff f d := refl _

end ratfunc

lemma entourage_uniformity_mem (d : ℤ) : entourage K d ∈ 𝓤 (ratfunc K) :=
begin
  simp only [entourage, of_add_neg, with_zero.coe_inv, mem_comap, exists_prop],
  use {P | ((ideal_X K).valuation) P < (multiplicative.of_add d)⁻¹},
  split,
  { apply (@valued.mem_nhds_zero (ratfunc K) _ ℤₘ₀ _ _ _).mpr,
    use ⟨↑(multiplicative.of_add d)⁻¹, ↑(multiplicative.of_add d), by {simp only [with_zero.coe_inv,
      inv_mul_cancel, ne.def, with_zero.coe_ne_zero, not_false_iff]}, by {simp only
      [with_zero.coe_inv, _root_.mul_inv_cancel, ne.def, with_zero.coe_ne_zero, not_false_iff]}⟩,
    simp only [units.coe_mk, with_zero.coe_inv, set.set_of_subset_set_of],
    exact λ _ ha, ha },
  { simp only [set.preimage_set_of_eq, set.set_of_subset_set_of, prod.forall],
    intros _ _ h,
    rwa [← valuation.map_neg, neg_sub] },
end

variable {K}
lemma eq_coeff_of_mem_entourage {d n : ℤ} {x y : ratfunc K} (H : (x, y) ∈ (entourage K d)) :
 n ≤ d → x.coeff n = y.coeff n :=
 begin
  by_cases triv : x = y,
  { intro _,
    rw triv },
  { dsimp only [entourage] at H,
    intro hn,
    apply eq_of_sub_eq_zero,
    erw [← hahn_series.sub_coeff],
    rw [← coe_sub],
    apply hahn_series.coeff_eq_zero_of_lt_order,
    suffices : d < (↑(x - y) : laurent_series K).order,
    { exact lt_of_le_of_lt hn this },
    { rw [← multiplicative.of_add_lt, ← with_zero.coe_lt_coe,
      fae_order_eq_val' K (sub_ne_zero_of_ne triv)],
      rw [of_add_neg] at H,
      replace triv : ((ideal_X K).valuation) (x - y) ≠ 0 :=
        (valuation.ne_zero_iff _).mpr (sub_ne_zero_of_ne triv),
      rwa [← with_zero.coe_unzero triv, ← with_zero.coe_inv, with_zero.coe_lt_coe, lt_inv',
        ← with_zero.coe_lt_coe, with_zero.coe_unzero triv] }},
end

lemma eq_coeff_of_mem_entourage' {d : ℤ} {x y : ratfunc K} (H : (x, y) ∈ (entourage K d)) :
 ∀ᶠ n in at_bot, x.coeff n = y.coeff n :=
eventually_at_bot.mpr ⟨d, λ _ h, eq_coeff_of_mem_entourage H h⟩

-- example (a b c : ℤ) (h : a ≤ c -1) (H : b ≤ c) : a ≤ b - 1 :=
-- begin
--   apply h.trans,
-- end

-- `[FAE] The lemmas below are true, but possibly useless
lemma bounded_supp_of_mem_entourage (x : ratfunc K) (d : ℤ) : ∃ N : ℤ, ∀ y : ratfunc K,
  (x, y) ∈ (entourage K d) → ∀ n ≤ N, y.coeff n = 0 :=
begin
  by_cases hx : x = 0,
  { use d,
    intros _ hy _ hn,
    rw [← eq_coeff_of_mem_entourage hy hn, hx, ratfunc.coeff_zero] },
  { replace hx := ratfunc.coe_ne_zero_iff.mp hx,
    use min ((x : laurent_series K).2.is_wf.min (hahn_series.support_nonempty_iff.mpr hx)) d - 1,
    intros _ hy _ hn,
    have hn' : x.coeff n = 0 := function.nmem_support.mp ( λ h, set.is_wf.not_lt_min
      (x : laurent_series K).2.is_wf (support_nonempty_iff.mpr hx) h _),--(lt_min_iff.mp hn).1),
    rwa ← eq_coeff_of_mem_entourage hy _,
    { exact hn.trans (le_of_lt (int.sub_one_lt_of_le (min_le_right _ _))) },
    { exact int.lt_of_le_sub_one (hn.trans (sub_le_sub (min_le_left _ _) (le_of_eq (refl _)))) }},
end

-- lemma bounded_supp_of_mem_entourage' (x : ratfunc K) (d : ℤ) : ∀ᶠ n in at_bot, ∀ y : ratfunc K,
--   (x, y) ∈ (entourage K d) → y.coeff n = 0 :=
-- begin
--   obtain ⟨N, hN⟩ := bounded_supp_of_mem_entourage x d,
--   apply eventually_at_bot.mpr ⟨N - 1, _⟩,
--   intros n hn y hy,
--   exact hN y hy n (int.lt_of_le_sub_one hn),
-- end

lemma uniform_continuous_coeff_map {uK : uniform_space K} (h : uniformity K = 𝓟 id_rel) (d : ℤ)
: uniform_continuous (ratfunc.coeff_map K d) :=
begin
  refine uniform_continuous_iff_eventually.mpr _,
  intros S hS,
  rw h at hS,
  refine eventually_iff_exists_mem.mpr ⟨entourage K d, ⟨entourage_uniformity_mem K d, λ x hx, hS _⟩⟩,
  exact eq_coeff_of_mem_entourage hx (le_of_eq (refl _)),
end

namespace set

lemma prod_subset_diag_singleton_left {X : Type*} [nonempty X] {S T : set X} (hS : S.nonempty)
  (hT : T.nonempty) (h_diag : S ×ˢ T ⊆ id_rel) : ∃ x, S = {x} :=
begin
  rcases ⟨hS, hT⟩ with ⟨⟨s, hs⟩, ⟨t, ht⟩⟩,
  refine ⟨s, (eq_singleton_iff_nonempty_unique_mem.mpr ⟨⟨s, hs⟩, _⟩)⟩,
  intros x hx,
  rw prod_subset_iff at h_diag,
  replace hs := h_diag s hs t ht,
  replace hx := h_diag x hx t ht,
  simp only [id_rel, mem_set_of_eq] at hx hs,
  rwa [← hs] at hx,
end

lemma prod_subset_diag_singleton_right {X : Type*} [nonempty X] {S T : set X} (hS : S.nonempty) (hT : T.nonempty)
  (h_diag : S ×ˢ T ⊆ id_rel) : ∃ x, T = {x} :=
begin
  rw set.prod_subset_iff at h_diag,
  replace h_diag := λ x hx y hy, (h_diag y hy x hx).symm,
  exact prod_subset_diag_singleton_left hT hS ((prod_subset_iff).mpr h_diag),
end

lemma prod_subset_diag_singleton_eq {X : Type*} [nonempty X] {S T : set X} (hS : S.nonempty) (hT : T.nonempty)
  (h_diag : S ×ˢ T ⊆ id_rel) : ∃ x, S = {x} ∧ T = {x} :=
begin
  obtain ⟨⟨x, hx⟩, ⟨y, hy⟩⟩ := ⟨prod_subset_diag_singleton_left hS hT h_diag,
    prod_subset_diag_singleton_right hS hT h_diag⟩,
  refine ⟨x, ⟨hx, _⟩⟩,
  rw [hy, set.singleton_eq_singleton_iff],
  exact (set.prod_subset_iff.mp h_diag x (by simp only [hx, set.mem_singleton]) y
    (by simp only [hy, set.mem_singleton])).symm,
end

end set

open set

lemma cauchy_discrete_le_principal {X : Type*} [nonempty X] {uX : uniform_space X}
(hX : uniformity X = 𝓟 id_rel) {α : filter X} (hα : cauchy α) : ∃ x : X, α ≤ 𝓟 {x} :=
begin
  rcases hα with ⟨α_ne_bot, α_le⟩,
  rw [filter.le_def] at α_le,
  specialize α_le id_rel,
  simp only [filter.le_def, hX, mem_principal, id_rel_subset, mem_id_rel, eq_self_iff_true,
    implies_true_iff, forall_true_left, filter.mem_prod_iff] at α_le,
  obtain ⟨_, ⟨hS, ⟨_, ⟨hT, H⟩⟩⟩⟩ := α_le,
  obtain ⟨x, hx⟩ := prod_subset_diag_singleton_left (@filter.nonempty_of_mem X α α_ne_bot _ hS)
    (@filter.nonempty_of_mem _ _ α_ne_bot _ hT) H,
  use x,
  rwa [filter.le_principal_iff, ← hx],
end

def cauchy_discrete_is_constant {X : Type*} [nonempty X] {uX : uniform_space X}
  (hX : uniformity X = 𝓟 id_rel) {α : filter X} (hα : cauchy α) : X :=
(cauchy_discrete_le_principal hX hα).some

lemma cauchy_discrete_le  {X : Type*} [nonempty X] {uX : uniform_space X}
  (hX : uniformity X = 𝓟 id_rel) {α : filter X} (hα : cauchy α) :
  α ≤ 𝓟 {cauchy_discrete_is_constant hX hα} := Exists.some_spec (cauchy_discrete_le_principal hX hα)

lemma ne_bot_unique_principal {X : Type*} [uniform_space X] (hX : uniformity X = 𝓟 id_rel)
  {α : filter X} (hα : α.ne_bot) {x y : X} (hx : α ≤ 𝓟 {x}) (hy : α ≤ 𝓟 {y}) : x = y :=
begin
  have h_disc : discrete_topology X,
  apply discrete_topology_of_discrete_uniformity hX,
  have t2X := @discrete_topology.to_t2_space X _ h_disc,
  apply @eq_of_nhds_ne_bot X _ t2X x y,
  simp only [discrete_topology_iff_nhds.mp h_disc],
  apply @ne_bot_of_le _ _ _ hα,
  simp only [le_inf_iff, le_pure_iff],
  exact ⟨le_principal_iff.mp hx, le_principal_iff.mp hy⟩,
end

/- The definition below avoids the assumption that `K` be endowed with the trivial uniformity,
  rather putting this in the proof.
-/
def cauchy.coeff_map {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) : ℤ → K :=
begin
  letI : uniform_space K :=  ⊥,
  have hK : uniformity K = filter.principal id_rel, refl,
  use λ d, (cauchy_discrete_is_constant hK (hℱ.map (uniform_continuous_coeff_map hK d))),
end

@[simp]
lemma cauchy.coeff_map_le {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) (n : ℤ) :
  ℱ.map (ratfunc.coeff_map K n) ≤ 𝓟 {hℱ.coeff_map n} :=
begin
  letI : uniform_space K := ⊥,
  have hK : uniformity K = filter.principal id_rel, refl,
  exact cauchy_discrete_le _ _,
end

lemma coeff_eventually_zero_cauchy {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) : ∃ N,
  ∀ᶠ y in ℱ, ∀ n ≤ N, ratfunc.coeff y n = (0 : K) :=
begin
  obtain ⟨S, ⟨hS, ⟨T, ⟨hT, H⟩⟩⟩⟩ := filter.mem_prod_iff.mp (filter.le_def.mp hℱ.2 (entourage K 0)
    (entourage_uniformity_mem _ _)),
  obtain ⟨x, hx⟩ := filter.forall_mem_nonempty_iff_ne_bot.mpr hℱ.1 (S ∩ T)
    (by {exact inter_mem_iff.mpr ⟨hS, hT⟩}),
  obtain ⟨N, hN⟩ := bounded_supp_of_mem_entourage x 0,
  use N,
  rw filter.eventually,
  apply mem_of_superset (inter_mem hS hT),
  suffices : (S ∩ T) ×ˢ (S ∩ T) ⊆ entourage K 0,
  { intros y hy,
    have h_prod : (x, y) ∈ entourage K 0,
    { refine this (mem_prod.mpr _),
      exact ⟨hx, hy⟩ },
    exact hN y h_prod },
  exact (prod_mono (inter_subset_left S T) (inter_subset_right S T)).trans H,
end

lemma cauchy.coeff_map_zero_at_bot {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) : ∃ N,
  ∀ n ≤ N, ℱ.map (ratfunc.coeff_map K n) ≤ filter.principal {0} :=
begin
  simp only [principal_singleton, pure_zero, nonpos_iff, mem_map],
  obtain ⟨N, hN⟩ := coeff_eventually_zero_cauchy hℱ,
  use  N,
  intros n hn,
  apply filter.mem_of_superset hN,
  intros a ha,
  exact ha n hn,
end

lemma cauchy.coeff_map_zero_at_bot' {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) : ∀ᶠ n in at_bot,
  ℱ.map (ratfunc.coeff_map K n) ≤ filter.principal {0} :=
eventually_at_bot.mpr (cauchy.coeff_map_zero_at_bot hℱ)

-- lemma cauchy.coeff_map_zero_at_bot'' {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) : ∀ᶠ n in at_bot,
--   hℱ.coeff_map n = 0 :=
-- begin
--   have := hℱ.coeff_map_zero_at_bot,
--   simp only [principal_singleton, pure_zero, nonpos_iff, mem_map] at this,
--   -- simp,
-- end

lemma cauchy.coeff_map_support_bdd {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) : ∃ N, ∀ n,
  n ≤ N → (hℱ.coeff_map n) = 0 :=
begin
  letI : uniform_space K := ⊥,
  have hK : uniformity K = filter.principal id_rel, refl,
  obtain ⟨N, hN⟩ := hℱ.coeff_map_zero_at_bot,
  use N,
  intros n hn,
  exact ne_bot_unique_principal hK (hℱ.map (uniform_continuous_coeff_map hK n)).1
    (hℱ.coeff_map_le n) (hN n hn),
end

lemma cauchy.coeff_map_support_bdd' {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) :
  bdd_below (hℱ.coeff_map.support) :=
begin
  obtain ⟨N, hN⟩ := hℱ.coeff_map_support_bdd,
  use N,
  intros n hn,
  rw function.mem_support at hn,
  contrapose! hn,
  exact hN _ (le_of_lt hn),
end

-- lemma eventually_constant {uK : uniform_space K} (h : uniformity K = 𝓟 id_rel)
--   {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) (n : ℤ) :
--   ∀ᶠ x in ℱ, ratfunc.coeff x n = cauchy_discrete_is_constant h
--     (hℱ.map (uniform_continuous_coeff_map h n)) := by simpa only [comap_principal, le_principal_iff]
--     using tendsto.le_comap (cauchy_discrete_converges _ (hℱ.map (uniform_continuous_coeff_map _ _)))

-- lemma coeff_entually_zero {uK : uniform_space K} (h : uniformity K = 𝓟 id_rel)
--   {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) :
--   ∀ᶠ x in ℱ, ∀ᶠ d in (at_bot : filter ℤ), ratfunc.coeff x d = (0 : K) :=
-- begin
--   simp only [eventually_at_bot],
--   apply eventually_of_forall,
--   intro x,
--   by_cases hx : x = 0,
--   { simp only [hx, ratfunc.coeff_zero, eq_self_iff_true, implies_true_iff, exists_const] },
--   { replace hx := ratfunc.coe_ne_zero_iff.mp hx,
--     use ((x : laurent_series K).2.is_wf.min (hahn_series.support_nonempty_iff.mpr
--     hx)) - 1,
--     intros,
--     apply function.nmem_support.mp ( λ h, set.is_wf.not_lt_min
--       (x : laurent_series K).2.is_wf (support_nonempty_iff.mpr hx) h _),
--     linarith },
-- end

-- lemma support_bdd_below {uK : uniform_space K} (h : uniformity K = 𝓟 id_rel)
--   {ℱ : filter (ratfunc K)} (hℱ : cauchy ℱ) : support coeff_map := sorry

-- #check λ d : ℤ, filter.map (ratfunc.coeff d)

-- `[FAE]` This is `#18604`
lemma bdd_below.well_founded_on_lt {X : Type} [preorder X] {s : set X} :
  bdd_below s → s.well_founded_on (<) := sorry

def laurent_series.equiv : (completion_of_ratfunc K) ≃ (laurent_series K) :=
{ to_fun :=
  begin
    intro α,
    obtain ⟨ℱ, hℱ⟩ := (quot.exists_rep α).some,
    apply hahn_series.mk,
    exact is_wf.is_pwo ((hℱ.coeff_map_support_bdd').well_founded_on_lt),
  end,
  inv_fun :=
  begin
    intro f,
    sorry,
  end,
  left_inv := sorry,
  right_inv := sorry }

noncomputable! def laurent_series.ring_equiv :
  ring_equiv (completion_of_ratfunc K) (laurent_series K) :=
sorry

instance : algebra (ratfunc K) (completion_of_ratfunc K) :=
adic_completion.algebra (polynomial K) (ratfunc K) (ideal_X K)

instance completion_of_ratfunc.K_algebra : algebra K (completion_of_ratfunc K) :=
algebra.comp K (ratfunc K) (completion_of_ratfunc K)

noncomputable! def laurent_series.alg_equiv :
  alg_equiv K (completion_of_ratfunc K) (laurent_series K) :=
{ to_fun    := laurent_series.equiv.to_fun,
  inv_fun   := laurent_series.equiv.inv_fun,
  map_mul'  := sorry,
  map_add'  := sorry,
  commutes' := sorry,
  ..(laurent_series.equiv) }

/- **OLD THINGS**

  -- is_dedekind_domain.height_one_spectrum.uniform_space_adic_completion (ratfunc K) _

-- lemma foo : (nhds (0 : ratfunc K)).has_basis set.univ (λ n : ℕ,
--   {F : (ratfunc K) | ↑(multiplicative.of_add (n : ℤ)) ≤ (ideal_X K).valuation F}) :=
-- begin
--   sorry
-- end

-- lemma foo' : (nhds (0 : ratfunc K)).has_basis set.univ (λ n : ℤ,
--   {F : (ratfunc K) | ↑(multiplicative.of_add n) ≤ (ideal_X K).valuation F}) :=
-- begin
--   sorry
-- end

-- def boo := filter.has_basis.uniformity_of_nhds_zero (foo K)

-- #check boo K

-- lemma boo_subset (n : ℕ) : (boo K n) ∈ (𝓤 (ratfunc K)) :=
-- variable (d : ℤ)
-- #check foo K

-- lemma uff : true := sorry
-- include K F

-- def ss (F : completion_of_ratfunc K) : ℕ → (ratfunc K) := seq ((quot.exists_rep F).some).2
--     (λ n, @filter.has_basis.mem_of_mem _ _ _ _ _ n
--     (filter.has_basis.uniformity_of_nhds_zero (foo K)) trivial)

  -- is_dedekind_domain.height_one_spectrum.uniform_space_adic_completion (ratfunc K) _

-- lemma foo : (nhds (0 : ratfunc K)).has_basis set.univ (λ n : ℕ,
--   {F : (ratfunc K) | ↑(multiplicative.of_add (n : ℤ)) ≤ (ideal_X K).valuation F}) :=
-- begin
--   sorry
-- end

-- lemma foo' : (nhds (0 : ratfunc K)).has_basis set.univ (λ n : ℤ,
--   {F : (ratfunc K) | ↑(multiplicative.of_add n) ≤ (ideal_X K).valuation F}) :=
-- begin
--   sorry
-- end

-- def boo := filter.has_basis.uniformity_of_nhds_zero (foo K)

-- #check boo K

-- lemma boo_subset (n : ℕ) : (boo K n) ∈ (𝓤 (ratfunc K)) :=
-- variable (d : ℤ)
-- #check foo K

-- lemma uff : true := sorry
-- include K F

-- def ss (F : completion_of_ratfunc K) : ℕ → (ratfunc K) := seq ((quot.exists_rep F).some).2
--     (λ n, @filter.has_basis.mem_of_mem _ _ _ _ _ n
--     (filter.has_basis.uniformity_of_nhds_zero (foo K)) trivial)

-- #check ss K F
-- --   use this,
-- -- end
-- -- #check @filter.has_basis.mem_of_mem (ratfunc K) ℕ (nhds 0) (λ n, true) _ d (foo K)

-- -- #check boo

-- lemma boo_subset (n : ℕ) : (boo K n) ∈ (𝓤 (ratfunc K)) :=

-- def entourage : ℕ → set ((ratfunc K) × (ratfunc K)):= λ n,
--   {x | ↑(multiplicative.of_add (n : ℤ)) ≤ ((ideal_X K).valuation x) } ×ˢ
--   { x | ↑(multiplicative.of_add (n : ℤ)) ≤ ((ideal_X K).valuation x) }

-- example : add_group (ratfunc K) :=
-- begin
--   apply_instance,
-- end

-- -- local attribute [instance] topological_add_group.to_uniform_add_group

-- example (G : Type*) [_inst_1 : add_group G] [_inst_2 : topological_space G] [_inst_3 : topological_add_group G] :
--     𝓤 G = filter.comap (λ (p : G × G), p.snd - p.fst) (nhds 0) :=
-- begin
--   apply uniformity_eq_comap_nhds_zero',
-- end

-- lemma entourage_subset (n : ℕ) : entourage K n ∈ (𝓤 (ratfunc K)) :=
-- begin
--   rw uniformity_eq_comap_nhds_zero' (ratfunc K),
--   rw filter.mem_comap',
--   rw entourage,
--   simp,
--   rw mem_nhds_iff,
--   use {F : (ratfunc K) | ↑(multiplicative.of_add (n : ℤ)) ≤ (ideal_X K).valuation F},
--   split,
--   { simp only [set.set_of_subset_set_of],

--   },

  -- intro,
    -- have one : is_open ({y :
  --  ratfunc K | ∀ (a b : ratfunc K),
  --  b - a = y → (multiplicative.of_add (n : ℤ)) ≤ ((ideal_X K).valuation) a ∧
  --    (multiplicative.of_add (n : ℤ)) ≤ ((ideal_X K).valuation) b}),
  --     sorry,

-- end

-- #check seq ((quot.exists_rep F).some).2 (entourage_subset K)

-- def ss_int : ℤ → laurent_series K
-- |(n : nat) := ss K F n
-- | _ := 0

-- lemma foo2 (α : Type*) (u : ℕ → α) (N : ℕ) (hu : ∀ m : ℕ, N ≤ m → u m = u N) :
--   at_top.map u ≤ pure (u N) := --at_top.map u ≤ 𝓟 ({u N}) :=
-- begin
--   simp only [le_pure_iff, mem_map, mem_at_top_sets, ge_iff_le, set.mem_preimage,
--     set.mem_singleton_iff],
--   exact ⟨N, hu⟩,
-- end

-- lemma bar (α : Type*) (u : ℕ → α) (N : ℕ) (H : at_top.map u ≤ pure (u N)) :
--   ∃ d, ∀ m : ℕ, d ≤ m → u m = u d :=
--   --  := --at_top.map u ≤ 𝓟 ({u N}) :=
-- begin
--   -- intros m hm,
--   -- simp only [le_pure_iff, mem_map, mem_at_top_sets, ge_iff_le, set.mem_preimage,
--   --   set.mem_singleton_iff] at H,
--   simp at H,
--   obtain ⟨a, ha⟩ := H,
--   use a,
--   intros m hm,
--   by_cases a ≤ N,
--   { have : u a = u N,
--     exact ha a (le_of_eq (refl _)),
--     rw this,
--     exact ha _ hm },
--   { replace h : N < a, sorry, sorry,  },
--   -- let A := min a N,
--   -- have hm' : A ≤ m,
--   -- simp * at *,
--   -- apply ha,
--   -- have := (le_of_eq (refl a)),
--   -- specialize ha b (le_max_iff.mpr _),
--   -- apply or.intro_left _,
--   -- exact this,

--   -- simp only [this, true_or],
--   -- have := (true_or (le_of_eq (refl a))),

--   -- squeeze_simp [b],
--   -- simp only [le_pure_iff, mem_map, mem_at_top_sets, ge_iff_le, set.mem_preimage,
--   --   set.mem_singleton_iff],
--   -- exact ⟨N, hu⟩,
-- end

-- def eventual_coeff (ℱ : filter (ratfunc K)) (h : cauchy ℱ) (d : ℤ) : K :=
-- -- ∃ (t : set (laurent_series K)), t ∈ ℱ.map (ratfunc.coe_alg_hom K) ∧ t ≠ ∅ ∧ (∀ F G : (laurent_series K), F ∈ t → G ∈ t → F.coeff d = G.coeff d),
--   sorry

-- def temp_coeff : ℤ → (laurent_series K → K) := λ i F, F.coeff i

-- lemma eventually_eq_eventual_coeff (ℱ : filter (ratfunc K)) (h : cauchy ℱ) (d : ℤ) :
--   -- ( T : set (completion_of_ratfunc K)) :
--   ∀ T ∈ ℱ, (ℱ.map (ratfunc.coe_alg_hom K)).map (temp_coeff K d) = (ℱ.map (ratfunc.coe_alg_hom K)).map (temp_coeff K d) :=
-- begin
--   sorry,
-- end

-- example (X : Type*) [uniform_space X] (ℱ : filter X) (hF : cauchy ℱ) :
--   ∃ x : uniform_space.completion X, ℱ.map coe ≤ 𝓝 x :=
-- begin
--   refine complete_space.complete _,
--   refine cauchy.map hF _,
--   refine uniform_space.completion.uniform_continuous_coe X,
-- end

-- variable [decidable_rel (has_dvd.dvd : (polynomial K) → (polynomial K) → Prop)]
-- variable [decidable_rel (has_dvd.dvd : (power_series K) → (power_series K) → Prop)]

-- lemma multiplicity_pol_eq_multiplicity_power_series {f : polynomial K} (hf :f ≠ 0) :
--   multiplicity power_series.X (↑f : power_series K) = multiplicity polynomial.X f :=
-- begin
--   sorry,
-- end

-- -- variable [decidable_rel (has_dvd.dvd : (hahn_series ℕ K) → (hahn_series ℕ K) → Prop)]

-- -- lemma multiplicity_pol_eq_multiplicity_hahn_series {f : polynomial K} (hf :f ≠ 0) :
-- --   multiplicity power_series.X (↑f : power_series K) = multiplicity polynomial.X f :=
-- -- begin
-- --   sorry,
-- -- end

-- -- lemma multiplicity_hahn_series_eq_multiplicity_pow_series {φ : hahn_series ℕ K} (hφ : φ ≠ 0) :
-- --   multiplicity (single 1 1) φ = multiplicity power_series.X (to_power_series φ) :=
-- -- begin
-- --   sorry,
-- -- end

instance discrete_fae : uniform_space K := ⊤
section ratfunc_coeff

lemma discrete_complete_fae (d : ℤ) {uK : uniform_space K}
  (h : uniformity K = 𝓟 id_rel) : is_complete (⊤ : (set K)) :=
begin
  sorry
end

def eval_compl_fae (d : ℤ) {uK : uniform_space K}
  (h : uniformity K = 𝓟 id_rel) : (completion_of_ratfunc K) → K :=
  uniform_space.completion.extension (eval_fae K d)

the `instance : uniform_space (completion_of_ratfunc K) :=` is needed for the `lemma` below
lemma cauchy_fae (d : ℤ) {uK : uniform_space K} (h : uniformity K = 𝓟 id_rel)
  (α : filter (ratfunc K)) (hα : cauchy α) :
  cauchy (α.map (ratfunc.coeff_map K d)) := hα.map (unif_cnts_fae K d h)

lemma constant_cauchy_fae_principal {uK : uniform_space K}
  (h : uniformity K = 𝓟 id_rel) (α : filter K) (hα : cauchy α) :
  α ≤ filter.principal {constant_cauchy_fae K h α hα} := sorry

-/


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying

! This file was ported from Lean 3 source module probability.martingale.optional_stopping
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Process.HittingTime
import Mathbin.Probability.Martingale.Basic

/-! # Optional stopping theorem (fair game theorem)

The optional stopping theorem states that an adapted integrable process `f` is a submartingale if
and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`.

This file also contains Doob's maximal inequality: given a non-negative submartingale `f`, for all
`ε : ℝ≥0`, we have `ε • μ {ε ≤ f* n} ≤ ∫ ω in {ε ≤ f* n}, f n` where `f* n ω = max_{k ≤ n}, f k ω`.

### Main results

* `measure_theory.submartingale_iff_expected_stopped_value_mono`: the optional stopping theorem.
* `measure_theory.submartingale.stopped_process`: the stopped process of a submartingale with
  respect to a stopping time is a submartingale.
* `measure_theory.maximal_ineq`: Doob's maximal inequality.

 -/

open NNReal ENNReal MeasureTheory ProbabilityTheory

namespace MeasureTheory

variable {Ω : Type _} {m0 : MeasurableSpace Ω} {μ : Measure Ω} {𝒢 : Filtration ℕ m0} {f : ℕ → Ω → ℝ}
  {τ π : Ω → ℕ}

-- We may generalize the below lemma to functions taking value in a `normed_lattice_add_comm_group`.
-- Similarly, generalize `(super/)submartingale.set_integral_le`.
/-- Given a submartingale `f` and bounded stopping times `τ` and `π` such that `τ ≤ π`, the
expectation of `stopped_value f τ` is less than or equal to the expectation of `stopped_value f π`.
This is the forward direction of the optional stopping theorem. -/
theorem Submartingale.expected_stoppedValue_mono [SigmaFiniteFiltration μ 𝒢]
    (hf : Submartingale f 𝒢 μ) (hτ : IsStoppingTime 𝒢 τ) (hπ : IsStoppingTime 𝒢 π) (hle : τ ≤ π)
    {N : ℕ} (hbdd : ∀ ω, π ω ≤ N) : μ[stoppedValue f τ] ≤ μ[stoppedValue f π] :=
  by
  rw [← sub_nonneg, ← integral_sub', stopped_value_sub_eq_sum' hle hbdd]
  · simp only [Finset.sum_apply]
    have : ∀ i, measurable_set[𝒢 i] { ω : Ω | τ ω ≤ i ∧ i < π ω } :=
      by
      intro i
      refine' (hτ i).inter _
      convert(hπ i).compl
      ext x
      simpa
    rw [integral_finset_sum]
    · refine' Finset.sum_nonneg fun i hi => _
      rw [integral_indicator (𝒢.le _ _ (this _)), integral_sub', sub_nonneg]
      · exact hf.set_integral_le (Nat.le_succ i) (this _)
      · exact (hf.integrable _).IntegrableOn
      · exact (hf.integrable _).IntegrableOn
    intro i hi
    exact
      integrable.indicator (integrable.sub (hf.integrable _) (hf.integrable _)) (𝒢.le _ _ (this _))
  · exact hf.integrable_stopped_value hπ hbdd
  · exact hf.integrable_stopped_value hτ fun ω => le_trans (hle ω) (hbdd ω)
#align measure_theory.submartingale.expected_stopped_value_mono MeasureTheory.Submartingale.expected_stoppedValue_mono

/-- The converse direction of the optional stopping theorem, i.e. an adapted integrable process `f`
is a submartingale if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
theorem submartingaleOfExpectedStoppedValueMono [IsFiniteMeasure μ] (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ)
    (hf :
      ∀ τ π : Ω → ℕ,
        IsStoppingTime 𝒢 τ →
          IsStoppingTime 𝒢 π →
            τ ≤ π → (∃ N, ∀ ω, π ω ≤ N) → μ[stoppedValue f τ] ≤ μ[stoppedValue f π]) :
    Submartingale f 𝒢 μ :=
  by
  refine' submartingale_of_set_integral_le hadp hint fun i j hij s hs => _
  classical
    specialize
      hf (s.piecewise (fun _ => i) fun _ => j) _ (is_stopping_time_piecewise_const hij hs)
        (is_stopping_time_const 𝒢 j) (fun x => (ite_le_sup _ _ _).trans (max_eq_right hij).le)
        ⟨j, fun x => le_rfl⟩
    rwa [stopped_value_const, stopped_value_piecewise_const,
      integral_piecewise (𝒢.le _ _ hs) (hint _).IntegrableOn (hint _).IntegrableOn, ←
      integral_add_compl (𝒢.le _ _ hs) (hint j), add_le_add_iff_right] at hf
#align measure_theory.submartingale_of_expected_stopped_value_mono MeasureTheory.submartingaleOfExpectedStoppedValueMono

/-- **The optional stopping theorem** (fair game theorem): an adapted integrable process `f`
is a submartingale if and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
theorem submartingale_iff_expected_stoppedValue_mono [IsFiniteMeasure μ] (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ) :
    Submartingale f 𝒢 μ ↔
      ∀ τ π : Ω → ℕ,
        IsStoppingTime 𝒢 τ →
          IsStoppingTime 𝒢 π →
            τ ≤ π → (∃ N, ∀ x, π x ≤ N) → μ[stoppedValue f τ] ≤ μ[stoppedValue f π] :=
  ⟨fun hf _ _ hτ hπ hle ⟨N, hN⟩ => hf.expected_stoppedValue_mono hτ hπ hle hN,
    submartingaleOfExpectedStoppedValueMono hadp hint⟩
#align measure_theory.submartingale_iff_expected_stopped_value_mono MeasureTheory.submartingale_iff_expected_stoppedValue_mono

/-- The stopped process of a submartingale with respect to a stopping time is a submartingale. -/
@[protected]
theorem Submartingale.stoppedProcess [IsFiniteMeasure μ] (h : Submartingale f 𝒢 μ)
    (hτ : IsStoppingTime 𝒢 τ) : Submartingale (stoppedProcess f τ) 𝒢 μ :=
  by
  rw [submartingale_iff_expected_stopped_value_mono]
  · intro σ π hσ hπ hσ_le_π hπ_bdd
    simp_rw [stopped_value_stopped_process]
    obtain ⟨n, hπ_le_n⟩ := hπ_bdd
    exact
      h.expected_stopped_value_mono (hσ.min hτ) (hπ.min hτ) (fun ω => min_le_min (hσ_le_π ω) le_rfl)
        fun ω => (min_le_left _ _).trans (hπ_le_n ω)
  · exact adapted.stopped_process_of_discrete h.adapted hτ
  ·
    exact fun i =>
      h.integrable_stopped_value ((is_stopping_time_const _ i).min hτ) fun ω => min_le_left _ _
#align measure_theory.submartingale.stopped_process MeasureTheory.Submartingale.stoppedProcess

section Maximal

open Finset

theorem smul_le_stoppedValue_hitting [IsFiniteMeasure μ] (hsub : Submartingale f 𝒢 μ) {ε : ℝ≥0}
    (n : ℕ) :
    ε • μ { ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω } ≤
      ENNReal.ofReal
        (∫ ω in { ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω },
          stoppedValue f (hitting f { y : ℝ | ↑ε ≤ y } 0 n) ω ∂μ) :=
  by
  have hn : Set.Icc 0 n = { k | k ≤ n } := by
    ext x
    simp
  have :
    ∀ ω,
      ((ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω) →
        (ε : ℝ) ≤ stopped_value f (hitting f { y : ℝ | ↑ε ≤ y } 0 n) ω :=
    by
    intro x hx
    simp_rw [le_sup'_iff, mem_range, Nat.lt_succ_iff] at hx
    refine' stopped_value_hitting_mem _
    simp only [Set.mem_setOf_eq, exists_prop, hn]
    exact
      let ⟨j, hj₁, hj₂⟩ := hx
      ⟨j, hj₁, hj₂⟩
  have h :=
    set_integral_ge_of_const_le
      (measurableSet_le measurable_const
        (Finset.measurable_range_sup'' fun n _ =>
          (hsub.strongly_measurable n).Measurable.le (𝒢.le n)))
      (measure_ne_top _ _) this
      (integrable.integrable_on
        (hsub.integrable_stopped_value (hitting_is_stopping_time hsub.adapted measurableSet_Ici)
          hitting_le))
  rw [ENNReal.le_ofReal_iff_toReal_le, ENNReal.toReal_smul]
  · exact h
  · exact ENNReal.mul_ne_top (by simp) (measure_ne_top _ _)
  · exact le_trans (mul_nonneg ε.coe_nonneg ENNReal.toReal_nonneg) h
#align measure_theory.smul_le_stopped_value_hitting MeasureTheory.smul_le_stoppedValue_hitting

/-- **Doob's maximal inequality**: Given a non-negative submartingale `f`, for all `ε : ℝ≥0`,
we have `ε • μ {ε ≤ f* n} ≤ ∫ ω in {ε ≤ f* n}, f n` where `f* n ω = max_{k ≤ n}, f k ω`.

In some literature, the Doob's maximal inequality refers to what we call Doob's Lp inequality
(which is a corollary of this lemma and will be proved in an upcomming PR). -/
theorem maximal_ineq [IsFiniteMeasure μ] (hsub : Submartingale f 𝒢 μ) (hnonneg : 0 ≤ f) {ε : ℝ≥0}
    (n : ℕ) :
    ε • μ { ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω } ≤
      ENNReal.ofReal
        (∫ ω in { ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω },
          f n ω ∂μ) :=
  by
  suffices
    ε • μ { ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω } +
        ENNReal.ofReal
          (∫ ω in { ω | ((range (n + 1)).sup' nonempty_range_succ fun k => f k ω) < ε }, f n ω ∂μ) ≤
      ENNReal.ofReal (μ[f n])
    by
    have hadd :
      ENNReal.ofReal (∫ ω, f n ω ∂μ) =
        ENNReal.ofReal
            (∫ ω in { ω | ↑ε ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω },
              f n ω ∂μ) +
          ENNReal.ofReal
            (∫ ω in { ω | ((range (n + 1)).sup' nonempty_range_succ fun k => f k ω) < ↑ε },
              f n ω ∂μ) :=
      by
      rw [← ENNReal.ofReal_add, ← integral_union]
      · conv_lhs => rw [← integral_univ]
        convert rfl
        ext ω
        change (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ) ↔ _
        simp only [le_or_lt, true_iff_iff]
      · rw [disjoint_iff_inf_le]
        rintro ω ⟨hω₁ : _ ≤ _, hω₂ : _ < _⟩
        exact (not_le.2 hω₂) hω₁
      ·
        exact
          measurableSet_lt
            (Finset.measurable_range_sup'' fun n _ =>
              (hsub.strongly_measurable n).Measurable.le (𝒢.le n))
            measurable_const
      exacts[(hsub.integrable _).IntegrableOn, (hsub.integrable _).IntegrableOn,
        integral_nonneg (hnonneg _), integral_nonneg (hnonneg _)]
    rwa [hadd, ENNReal.add_le_add_iff_right ENNReal.ofReal_ne_top] at this
  calc
    ε • μ { ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω } +
          ENNReal.ofReal
            (∫ ω in { ω | ((range (n + 1)).sup' nonempty_range_succ fun k => f k ω) < ε },
              f n ω ∂μ) ≤
        ENNReal.ofReal
            (∫ ω in { ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ fun k => f k ω },
              stopped_value f (hitting f { y : ℝ | ↑ε ≤ y } 0 n) ω ∂μ) +
          ENNReal.ofReal
            (∫ ω in { ω | ((range (n + 1)).sup' nonempty_range_succ fun k => f k ω) < ε },
              stopped_value f (hitting f { y : ℝ | ↑ε ≤ y } 0 n) ω ∂μ) :=
      by
      refine'
        add_le_add (smul_le_stopped_value_hitting hsub _)
          (ENNReal.ofReal_le_ofReal
            (set_integral_mono_on (hsub.integrable n).IntegrableOn
              (integrable.integrable_on
                (hsub.integrable_stopped_value
                  (hitting_is_stopping_time hsub.adapted measurableSet_Ici) hitting_le))
              (measurableSet_lt
                (Finset.measurable_range_sup'' fun n _ =>
                  (hsub.strongly_measurable n).Measurable.le (𝒢.le n))
                measurable_const)
              _))
      intro ω hω
      rw [Set.mem_setOf_eq] at hω
      have : hitting f { y : ℝ | ↑ε ≤ y } 0 n ω = n :=
        by
        simp only [hitting, Set.mem_setOf_eq, exists_prop, Pi.coe_nat, Nat.cast_id,
          ite_eq_right_iff, forall_exists_index, and_imp]
        intro m hm hεm
        exact
          False.elim
            ((not_le.2 hω) ((le_sup'_iff _).2 ⟨m, mem_range.2 (Nat.lt_succ_of_le hm.2), hεm⟩))
      simp_rw [stopped_value, this]
    _ = ENNReal.ofReal (∫ ω, stopped_value f (hitting f { y : ℝ | ↑ε ≤ y } 0 n) ω ∂μ) :=
      by
      rw [← ENNReal.ofReal_add, ← integral_union]
      · conv_rhs => rw [← integral_univ]
        convert rfl
        ext ω
        change _ ↔ (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ)
        simp only [le_or_lt, iff_true_iff]
      · rw [disjoint_iff_inf_le]
        rintro ω ⟨hω₁ : _ ≤ _, hω₂ : _ < _⟩
        exact (not_le.2 hω₂) hω₁
      ·
        exact
          measurableSet_lt
            (Finset.measurable_range_sup'' fun n _ =>
              (hsub.strongly_measurable n).Measurable.le (𝒢.le n))
            measurable_const
      ·
        exact
          integrable.integrable_on
            (hsub.integrable_stopped_value (hitting_is_stopping_time hsub.adapted measurableSet_Ici)
              hitting_le)
      ·
        exact
          integrable.integrable_on
            (hsub.integrable_stopped_value (hitting_is_stopping_time hsub.adapted measurableSet_Ici)
              hitting_le)
      exacts[integral_nonneg fun x => hnonneg _ _, integral_nonneg fun x => hnonneg _ _]
    _ ≤ ENNReal.ofReal (μ[f n]) :=
      by
      refine' ENNReal.ofReal_le_ofReal _
      rw [← stopped_value_const f n]
      exact
        hsub.expected_stopped_value_mono (hitting_is_stopping_time hsub.adapted measurableSet_Ici)
          (is_stopping_time_const _ _) (fun ω => hitting_le ω) (fun ω => le_rfl : ∀ ω, n ≤ n)

#align measure_theory.maximal_ineq MeasureTheory.maximal_ineq

end Maximal

end MeasureTheory


import analysis.normed_space.basic
import data.complex.is_R_or_C

variables {m n : ℕ} {α : Type*} [is_R_or_C α]

open_locale complex_conjugate matrix

local attribute [instance] matrix.normed_group

/- here for convenience, do not load into mathlib again! -/
lemma norm_entry_le_entrywise_sup_norm (M : matrix (fin m) (fin n) α) (i : (fin m)) (j : (fin n)) :
  ∥M i j∥ ≤ ∥M∥ := @le_trans _ _ _ _ _ (norm_le_pi_norm (M i) j) (norm_le_pi_norm M i)

lemma entrywise_sup_norm_star_eq_norm (M : matrix (fin n) (fin n) α) : ∥star M∥ = ∥M∥ :=
begin
  have star_le : ∥star M∥ ≤ ∥M∥ :=
  begin
    rw [matrix.star_eq_conj_transpose, norm_matrix_le_iff (norm_nonneg M)],
    intros i j,
    simp only [matrix.conj_transpose_apply, normed_star_monoid.norm_star],
    apply norm_entry_le_entrywise_sup_norm,
  end,
  have no_star_le : ∥M∥ ≤ ∥star M∥ :=
  begin
    rw matrix.star_eq_conj_transpose,
    rw norm_matrix_le_iff (norm_nonneg Mᴴ),
    intros i j,
    have : ∥M i j∥ = ∥Mᴴ j i∥ :=
      by simp only [matrix.conj_transpose_apply, eq_self_iff_true,normed_star_monoid.norm_star],
    rw this,
    apply norm_entry_le_entrywise_sup_norm,
  end,
  exact ge_antisymm no_star_le star_le,
end

noncomputable def matrix_normed_star_monoid : normed_star_monoid (matrix (fin n) (fin n) α) :=
{
  norm_star := entrywise_sup_norm_star_eq_norm
}


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.reverse
import Mathlib.algebra.associated
import Mathlib.tactic.omega.default
import Mathlib.PostPort

universes u v y

namespace Mathlib

/-!
# Theory of monic polynomials

We give several tools for proving that polynomials are monic, e.g.
`monic_mul`, `monic_map`.
-/

namespace polynomial

theorem monic.as_sum {R : Type u} [semiring R] {p : polynomial R} (hp : monic p) : p = X ^ nat_degree p + finset.sum (finset.range (nat_degree p)) fun (i : ℕ) => coe_fn C (coeff p i) * X ^ i := sorry

theorem ne_zero_of_monic_of_zero_ne_one {R : Type u} [semiring R] {p : polynomial R} (hp : monic p) (h : 0 ≠ 1) : p ≠ 0 := sorry

theorem ne_zero_of_ne_zero_of_monic {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hp : p ≠ 0) (hq : monic q) : q ≠ 0 := sorry

theorem monic_map {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (hp : monic p) : monic (map f p) := sorry

theorem monic_mul_C_of_leading_coeff_mul_eq_one {R : Type u} [semiring R] {p : polynomial R} [nontrivial R] {b : R} (hp : leading_coeff p * b = 1) : monic (p * coe_fn C b) := sorry

theorem monic_of_degree_le {R : Type u} [semiring R] {p : polynomial R} (n : ℕ) (H1 : degree p ≤ ↑n) (H2 : coeff p n = 1) : monic p := sorry

theorem monic_X_pow_add {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (H : degree p ≤ ↑n) : monic (X ^ (n + 1) + p) := sorry

theorem monic_X_add_C {R : Type u} [semiring R] (x : R) : monic (X + coe_fn C x) :=
  pow_one X ▸ monic_X_pow_add degree_C_le

theorem monic_mul {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hp : monic p) (hq : monic q) : monic (p * q) := sorry

theorem monic_pow {R : Type u} [semiring R] {p : polynomial R} (hp : monic p) (n : ℕ) : monic (p ^ n) := sorry

theorem monic_add_of_left {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hp : monic p) (hpq : degree q < degree p) : monic (p + q) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (monic (p + q))) (monic.equations._eqn_1 (p + q))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (leading_coeff (p + q) = 1)) (add_comm p q)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (leading_coeff (q + p) = 1)) (leading_coeff_add_of_degree_lt hpq))) hp))

theorem monic_add_of_right {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hq : monic q) (hpq : degree p < degree q) : monic (p + q) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (monic (p + q))) (monic.equations._eqn_1 (p + q))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (leading_coeff (p + q) = 1)) (leading_coeff_add_of_degree_lt hpq))) hq)

namespace monic

@[simp] theorem degree_eq_zero_iff_eq_one {R : Type u} [semiring R] {p : polynomial R} (hp : monic p) : nat_degree p = 0 ↔ p = 1 := sorry

theorem nat_degree_mul {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hp : monic p) (hq : monic q) : nat_degree (p * q) = nat_degree p + nat_degree q := sorry

theorem next_coeff_mul {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hp : monic p) (hq : monic q) : next_coeff (p * q) = next_coeff p + next_coeff q := sorry

end monic

theorem monic_prod_of_monic {R : Type u} {ι : Type y} [comm_semiring R] (s : finset ι) (f : ι → polynomial R) (hs : ∀ (i : ι), i ∈ s → monic (f i)) : monic (finset.prod s fun (i : ι) => f i) :=
  finset.prod_induction (fun (x : ι) => f x) monic monic_mul monic_one hs

theorem is_unit_C {R : Type u} [comm_semiring R] {x : R} : is_unit (coe_fn C x) ↔ is_unit x := sorry

theorem eq_one_of_is_unit_of_monic {R : Type u} [comm_semiring R] {p : polynomial R} (hm : monic p) (hpu : is_unit p) : p = 1 := sorry

theorem monic.next_coeff_prod {R : Type u} {ι : Type y} [comm_semiring R] (s : finset ι) (f : ι → polynomial R) (h : ∀ (i : ι), i ∈ s → monic (f i)) : next_coeff (finset.prod s fun (i : ι) => f i) = finset.sum s fun (i : ι) => next_coeff (f i) := sorry

theorem monic_X_sub_C {R : Type u} [ring R] (x : R) : monic (X - coe_fn C x) := sorry

theorem monic_X_pow_sub {R : Type u} [ring R] {p : polynomial R} {n : ℕ} (H : degree p ≤ ↑n) : monic (X ^ (n + 1) - p) := sorry

/-- `X ^ n - a` is monic. -/
theorem monic_X_pow_sub_C {R : Type u} [ring R] (a : R) {n : ℕ} (h : n ≠ 0) : monic (X ^ n - coe_fn C a) := sorry

theorem monic_sub_of_left {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} (hp : monic p) (hpq : degree q < degree p) : monic (p - q) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (monic (p - q))) (sub_eq_add_neg p q)))
    (monic_add_of_left hp (eq.mpr (id (Eq._oldrec (Eq.refl (degree (-q) < degree p)) (degree_neg q))) hpq))

theorem monic_sub_of_right {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} (hq : leading_coeff q = -1) (hpq : degree p < degree q) : monic (p - q) := sorry

theorem leading_coeff_of_injective {R : Type u} {S : Type v} [ring R] [semiring S] {f : R →+* S} (hf : function.injective ⇑f) (p : polynomial R) : leading_coeff (map f p) = coe_fn f (leading_coeff p) := sorry

theorem monic_of_injective {R : Type u} {S : Type v} [ring R] [semiring S] {f : R →+* S} (hf : function.injective ⇑f) {p : polynomial R} (hp : monic (map f p)) : monic p := sorry

@[simp] theorem not_monic_zero {R : Type u} [semiring R] [nontrivial R] : ¬monic 0 := sorry

theorem ne_zero_of_monic {R : Type u} [semiring R] [nontrivial R] {p : polynomial R} (h : monic p) : p ≠ 0 :=
  fun (h₁ : p = 0) => not_monic_zero (h₁ ▸ h)


/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow, Kenny Lau
-/
import algebra.ring.equiv
import algebra.ring.opposite

/-!
# Ring involutions

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines a ring involution as a structure extending `R ≃+* Rᵐᵒᵖ`,
with the additional fact `f.involution : (f (f x).unop).unop = x`.

## Notations

We provide a coercion to a function `R → Rᵐᵒᵖ`.

## References

* <https://en.wikipedia.org/wiki/Involution_(mathematics)#Ring_theory>

## Tags

Ring involution
-/

variables (R : Type*)

set_option old_structure_cmd true

/-- A ring involution -/
structure ring_invo [semiring R] extends R ≃+* Rᵐᵒᵖ :=
(involution' : ∀ x, (to_fun (to_fun x).unop).unop = x)

/-- The equivalence of rings underlying a ring involution. -/
add_decl_doc ring_invo.to_ring_equiv

/-- `ring_invo_class F R S` states that `F` is a type of ring involutions.
You should extend this class when you extend `ring_invo`. -/
class ring_invo_class (F : Type*) (R : out_param Type*) [semiring R]
  extends ring_equiv_class F R Rᵐᵒᵖ :=
(involution : ∀ (f : F) (x), (f (f x).unop).unop = x)

namespace ring_invo
variables {R} [semiring R]

instance (R : Type*) [semiring R] : ring_invo_class (ring_invo R) R :=
{ coe := to_fun,
  inv :=  inv_fun,
  coe_injective' := λ e f h₁ h₂, by { cases e, cases f, congr' },
  map_add := map_add',
  map_mul := map_mul',
  left_inv := left_inv,
  right_inv := right_inv,
  involution := involution' }

/-- Construct a ring involution from a ring homomorphism. -/
def mk' (f : R →+* Rᵐᵒᵖ) (involution : ∀ r, (f (f r).unop).unop = r) :
  ring_invo R :=
{ inv_fun := λ r, (f r.unop).unop,
  left_inv := λ r, involution r,
  right_inv := λ r, mul_opposite.unop_injective $ involution _,
  involution' := involution,
  .. f }

/-- Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. -/
instance : has_coe_to_fun (ring_invo R) (λ _, R → Rᵐᵒᵖ) := ⟨λ f, f.to_ring_equiv.to_fun⟩

@[simp]
lemma to_fun_eq_coe (f : ring_invo R) : f.to_fun = f := rfl

@[simp]
lemma involution (f : ring_invo R) (x : R) : (f (f x).unop).unop = x :=
f.involution' x

instance has_coe_to_ring_equiv : has_coe (ring_invo R) (R ≃+* Rᵐᵒᵖ) :=
⟨ring_invo.to_ring_equiv⟩

@[norm_cast] lemma coe_ring_equiv (f : ring_invo R) (a : R) :
  (f : R ≃+* Rᵐᵒᵖ) a = f a := rfl

@[simp] lemma map_eq_zero_iff (f : ring_invo R) {x : R} : f x = 0 ↔ x = 0 :=
f.to_ring_equiv.map_eq_zero_iff

end ring_invo

open ring_invo

section comm_ring
variables [comm_ring R]

/-- The identity function of a `comm_ring` is a ring involution. -/
protected def ring_invo.id : ring_invo R :=
{ involution' := λ r, rfl,
  ..(ring_equiv.to_opposite R) }

instance : inhabited (ring_invo R) := ⟨ring_invo.id _⟩

end comm_ring


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.category_theory.limits.shapes.kernels
import Mathlib.category_theory.limits.shapes.normal_mono
import Mathlib.category_theory.preadditive.default
import Mathlib.PostPort

universes v u l

namespace Mathlib

/-!
# Every non_preadditive_abelian category is preadditive

In mathlib, we define an abelian category as a preadditive category with a zero object,
kernels and cokernels, products and coproducts and in which every monomorphism and epimorphis is
normal.

While virtually every interesting abelian category has a natural preadditive structure (which is why
it is included in the definition), preadditivity is not actually needed: Every category that has
all of the other properties appearing in the definition of an abelian category admits a preadditive
structure. This is the construction we carry out in this file.

The proof proceeds in roughly five steps:
1. Prove some results (for example that all equalizers exist) that would be trivial if we already
   had the preadditive structure but are a bit of work without it.
2. Develop images and coimages to show that every monomorphism is the kernel of its cokernel.

The results of the first two steps are also useful for the "normal" development of abelian
categories, and will be used there.

3. For every object `A`, define a "subtraction" morphism `σ : A ⨯ A ⟶ A` and use it to define
   subtraction on morphisms as `f - g := prod.lift f g ≫ σ`.
4. Prove a small number of identities about this subtraction from the definition of `σ`.
5. From these identities, prove a large number of other identities that imply that defining
   `f + g := f - (0 - g)` indeed gives an abelian group structure on morphisms such that composition
   is bilinear.

The construction is non-trivial and it is quite remarkable that this abelian group structure can
be constructed purely from the existence of a few limits and colimits. What's even more impressive
is that all additive structures on a category are in some sense isomorphic, so for abelian
categories with a natural preadditive structure, this construction manages to "almost" reconstruct
this natural structure. However, we have not formalized this isomorphism.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]

-/

namespace category_theory

/-- We call a category `non_preadditive_abelian` if it has a zero object, kernels, cokernels, binary
    products and coproducts, and every monomorphism and every epimorphism is normal. -/
class non_preadditive_abelian (C : Type u) [category C]
where
  has_zero_object : limits.has_zero_object C
  has_zero_morphisms : limits.has_zero_morphisms C
  has_kernels : limits.has_kernels C
  has_cokernels : limits.has_cokernels C
  has_finite_products : limits.has_finite_products C
  has_finite_coproducts : limits.has_finite_coproducts C
  normal_mono : {X Y : C} → (f : X ⟶ Y) → [_inst_2 : mono f] → normal_mono f
  normal_epi : {X Y : C} → (f : X ⟶ Y) → [_inst_2 : epi f] → normal_epi f

end category_theory

namespace category_theory.non_preadditive_abelian

/-- In a `non_preadditive_abelian` category, every epimorphism is strong. -/
theorem strong_epi_of_epi {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) [epi f] : strong_epi f :=
  category_theory.strong_epi_of_regular_epi f

/-- In a `non_preadditive_abelian` category, a monomorphism which is also an epimorphism is an
    isomorphism. -/
def is_iso_of_mono_of_epi {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) [mono f] [epi f] : is_iso f :=
  is_iso_of_mono_of_strong_epi f

/-- The pullback of two monomorphisms exists. -/
theorem pullback_of_mono {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} {Z : C} (a : X ⟶ Z) (b : Y ⟶ Z) [mono a] [mono b] : limits.has_limit (limits.cospan a b) := sorry

/-- The pushout of two epimorphisms exists. -/
theorem pushout_of_epi {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} {Z : C} (a : X ⟶ Y) (b : X ⟶ Z) [epi a] [epi b] : limits.has_colimit (limits.span a b) := sorry

/-- The pullback of `(𝟙 X, f)` and `(𝟙 X, g)` -/
/-- The equalizer of `f` and `g` exists. -/
theorem has_limit_parallel_pair {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) : limits.has_limit (limits.parallel_pair f g) := sorry

/-- The pushout of `(𝟙 Y, f)` and `(𝟙 Y, g)`. -/
/-- The coequalizer of `f` and `g` exists. -/
theorem has_colimit_parallel_pair {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) : limits.has_colimit (limits.parallel_pair f g) := sorry

/-- A `non_preadditive_abelian` category has all equalizers. -/
protected instance has_equalizers {C : Type u} [category C] [non_preadditive_abelian C] : limits.has_equalizers C :=
  limits.has_equalizers_of_has_limit_parallel_pair C

/-- A `non_preadditive_abelian` category has all coequalizers. -/
protected instance has_coequalizers {C : Type u} [category C] [non_preadditive_abelian C] : limits.has_coequalizers C :=
  limits.has_coequalizers_of_has_colimit_parallel_pair C

/-- If a zero morphism is a kernel of `f`, then `f` is a monomorphism. -/
theorem mono_of_zero_kernel {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (Z : C) (l : limits.is_limit
  (limits.kernel_fork.of_ι 0
    ((fun (this : 0 ≫ f = 0) => this)
      (eq.mpr
        (id
          (Eq.trans
            ((fun (a a_1 : Z ⟶ Y) (e_1 : a = a_1) (ᾰ ᾰ_1 : Z ⟶ Y) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
              (0 ≫ f) 0 limits.zero_comp 0 0 (Eq.refl 0))
            (propext (eq_self_iff_true 0))))
        trivial)))) : mono f := sorry

/-- If a zero morphism is a cokernel of `f`, then `f` is an epimorphism. -/
theorem epi_of_zero_cokernel {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (Z : C) (l : limits.is_colimit
  (limits.cokernel_cofork.of_π 0
    ((fun (this : f ≫ 0 = 0) => this)
      (eq.mpr
        (id
          (Eq.trans
            ((fun (a a_1 : X ⟶ Z) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ Z) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
              (f ≫ 0) 0 limits.comp_zero 0 0 (Eq.refl 0))
            (propext (eq_self_iff_true 0))))
        trivial)))) : epi f := sorry

/-- If `g ≫ f = 0` implies `g = 0` for all `g`, then `0 : 0 ⟶ X` is a kernel of `f`. -/
def zero_kernel_of_cancel_zero {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (hf : ∀ (Z : C) (g : Z ⟶ X), g ≫ f = 0 → g = 0) : limits.is_limit (limits.kernel_fork.of_ι 0 (zero_kernel_of_cancel_zero._proof_1 f)) :=
  limits.fork.is_limit.mk (limits.kernel_fork.of_ι 0 sorry) (fun (s : limits.fork f 0) => 0) sorry sorry

/-- If `f ≫ g = 0` implies `g = 0` for all `g`, then `0 : Y ⟶ 0` is a cokernel of `f`. -/
def zero_cokernel_of_zero_cancel {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (hf : ∀ (Z : C) (g : Y ⟶ Z), f ≫ g = 0 → g = 0) : limits.is_colimit (limits.cokernel_cofork.of_π 0 (zero_cokernel_of_zero_cancel._proof_1 f)) :=
  limits.cofork.is_colimit.mk (limits.cokernel_cofork.of_π 0 sorry) (fun (s : limits.cofork f 0) => 0) sorry sorry

/-- If `g ≫ f = 0` implies `g = 0` for all `g`, then `f` is a monomorphism. -/
theorem mono_of_cancel_zero {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (hf : ∀ (Z : C) (g : Z ⟶ X), g ≫ f = 0 → g = 0) : mono f :=
  mono_of_zero_kernel f 0 (zero_kernel_of_cancel_zero f hf)

/-- If `f ≫ g = 0` implies `g = 0` for all `g`, then `g` is a monomorphism. -/
theorem epi_of_zero_cancel {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) (hf : ∀ (Z : C) (g : Y ⟶ Z), f ≫ g = 0 → g = 0) : epi f :=
  epi_of_zero_cokernel f 0 (zero_cokernel_of_zero_cancel f hf)

/-- The kernel of the cokernel of `f` is called the image of `f`. -/
protected def image {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : C :=
  limits.kernel (limits.cokernel.π f)

/-- The inclusion of the image into the codomain. -/
protected def image.ι {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : non_preadditive_abelian.image f ⟶ Q :=
  limits.kernel.ι (limits.cokernel.π f)

/-- There is a canonical epimorphism `p : P ⟶ image f` for every `f`. -/
protected def factor_thru_image {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : P ⟶ non_preadditive_abelian.image f :=
  limits.kernel.lift (limits.cokernel.π f) f sorry

/-- `f` factors through its image via the canonical morphism `p`. -/
@[simp] theorem image.fac_assoc {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) {X' : C} (f' : Q ⟶ X') : non_preadditive_abelian.factor_thru_image f ≫ image.ι f ≫ f' = f ≫ f' := sorry

/-- The map `p : P ⟶ image f` is an epimorphism -/
protected instance factor_thru_image.category_theory.epi {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : epi (non_preadditive_abelian.factor_thru_image f) := sorry

-- It will suffice to consider some g : I ⟶ R such that p ≫ g = 0 and show that g = 0.

protected instance mono_factor_thru_image {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) [mono f] : mono (non_preadditive_abelian.factor_thru_image f) :=
  mono_of_mono_fac (image.fac f)

protected instance is_iso_factor_thru_image {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) [mono f] : is_iso (non_preadditive_abelian.factor_thru_image f) :=
  is_iso_of_mono_of_epi (non_preadditive_abelian.factor_thru_image f)

/-- The cokernel of the kernel of `f` is called the coimage of `f`. -/
protected def coimage {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : C :=
  limits.cokernel (limits.kernel.ι f)

/-- The projection onto the coimage. -/
protected def coimage.π {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : P ⟶ non_preadditive_abelian.coimage f :=
  limits.cokernel.π (limits.kernel.ι f)

/-- There is a canonical monomorphism `i : coimage f ⟶ Q`. -/
protected def factor_thru_coimage {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : non_preadditive_abelian.coimage f ⟶ Q :=
  limits.cokernel.desc (limits.kernel.ι f) f sorry

/-- `f` factors through its coimage via the canonical morphism `p`. -/
protected theorem coimage.fac {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : coimage.π f ≫ non_preadditive_abelian.factor_thru_coimage f = f :=
  limits.cokernel.π_desc (limits.kernel.ι f) f (factor_thru_coimage._proof_1 f)

/-- The canonical morphism `i : coimage f ⟶ Q` is a monomorphism -/
protected instance factor_thru_coimage.category_theory.mono {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) : mono (non_preadditive_abelian.factor_thru_coimage f) := sorry

protected instance epi_factor_thru_coimage {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) [epi f] : epi (non_preadditive_abelian.factor_thru_coimage f) :=
  epi_of_epi_fac (coimage.fac f)

protected instance is_iso_factor_thru_coimage {C : Type u} [category C] [non_preadditive_abelian C] {P : C} {Q : C} (f : P ⟶ Q) [epi f] : is_iso (non_preadditive_abelian.factor_thru_coimage f) :=
  is_iso_of_mono_of_epi (non_preadditive_abelian.factor_thru_coimage f)

/-- In a `non_preadditive_abelian` category, an epi is the cokernel of its kernel. More precisely:
    If `f` is an epimorphism and `s` is some limit kernel cone on `f`, then `f` is a cokernel
    of `fork.ι s`. -/
def epi_is_cokernel_of_kernel {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} {f : X ⟶ Y} [epi f] (s : limits.fork f 0) (h : limits.is_limit s) : limits.is_colimit (limits.cokernel_cofork.of_π f (epi_is_cokernel_of_kernel._proof_1 s)) :=
  limits.is_cokernel.cokernel_iso (limits.fork.ι s) f
    (limits.cokernel.of_iso_comp
      (nat_trans.app (limits.cone.π (limits.limit.cone (limits.parallel_pair f 0))) limits.walking_parallel_pair.zero)
      (limits.fork.ι s) (limits.is_limit.cone_point_unique_up_to_iso (limits.limit.is_limit (limits.parallel_pair f 0)) h)
      sorry)
    (as_iso (non_preadditive_abelian.factor_thru_coimage f)) sorry

/-- In a `non_preadditive_abelian` category, a mono is the kernel of its cokernel. More precisely:
    If `f` is a monomorphism and `s` is some colimit cokernel cocone on `f`, then `f` is a kernel
    of `cofork.π s`. -/
def mono_is_kernel_of_cokernel {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} {f : X ⟶ Y} [mono f] (s : limits.cofork f 0) (h : limits.is_colimit s) : limits.is_limit (limits.kernel_fork.of_ι f (mono_is_kernel_of_cokernel._proof_1 s)) :=
  limits.is_kernel.iso_kernel (limits.cofork.π s) f
    (limits.kernel.of_comp_iso
      (nat_trans.app (limits.cocone.ι (limits.colimit.cocone (limits.parallel_pair f 0)))
        limits.walking_parallel_pair.one)
      (limits.cofork.π s)
      (limits.is_colimit.cocone_point_unique_up_to_iso h (limits.colimit.is_colimit (limits.parallel_pair f 0))) sorry)
    (as_iso (non_preadditive_abelian.factor_thru_image f)) sorry

/-- The composite `A ⟶ A ⨯ A ⟶ cokernel (Δ A)`, where the first map is `(𝟙 A, 0)` and the second map
    is the canonical projection into the cokernel. -/
def r {C : Type u} [category C] [non_preadditive_abelian C] (A : C) : A ⟶ limits.cokernel (limits.diag A) :=
  limits.prod.lift 𝟙 0 ≫ limits.cokernel.π (limits.diag A)

protected instance mono_Δ {C : Type u} [category C] [non_preadditive_abelian C] {A : C} : mono (limits.diag A) :=
  mono_of_mono_fac (limits.prod.lift_fst 𝟙 𝟙)

protected instance mono_r {C : Type u} [category C] [non_preadditive_abelian C] {A : C} : mono (r A) := sorry

protected instance epi_r {C : Type u} [category C] [non_preadditive_abelian C] {A : C} : epi (r A) := sorry

protected instance is_iso_r {C : Type u} [category C] [non_preadditive_abelian C] {A : C} : is_iso (r A) :=
  is_iso_of_mono_of_epi (r A)

/-- The composite `A ⨯ A ⟶ cokernel (diag A) ⟶ A` given by the natural projection into the cokernel
    followed by the inverse of `r`. In the category of modules, using the normal kernels and
    cokernels, this map is equal to the map `(a, b) ↦ a - b`, hence the name `σ` for
    "subtraction". -/
def σ {C : Type u} [category C] [non_preadditive_abelian C] {A : C} : A ⨯ A ⟶ A :=
  limits.cokernel.π (limits.diag A) ≫ inv (r A)

@[simp] theorem diag_σ {C : Type u} [category C] [non_preadditive_abelian C] {X : C} : limits.diag X ≫ σ = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (limits.diag X ≫ σ = 0)) (limits.cokernel.condition_assoc (limits.diag X) (inv (r X)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 ≫ inv (r X) = 0)) limits.zero_comp)) (Eq.refl 0))

@[simp] theorem lift_σ_assoc {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {X' : C} (f' : X ⟶ X') : limits.prod.lift 𝟙 0 ≫ limits.cokernel.π (limits.diag X) ≫ inv (r X) ≫ f' = f' := sorry

theorem lift_map {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) : limits.prod.lift 𝟙 0 ≫ limits.prod.map f f = f ≫ limits.prod.lift 𝟙 0 := sorry

/-- σ is a cokernel of Δ X. -/
def is_colimit_σ {C : Type u} [category C] [non_preadditive_abelian C] {X : C} : limits.is_colimit (limits.cokernel_cofork.of_π σ diag_σ) :=
  limits.cokernel.cokernel_iso (limits.diag X) σ (iso.symm (as_iso (r X))) sorry

/-- This is the key identity satisfied by `σ`. -/
theorem σ_comp {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (f : X ⟶ Y) : σ ≫ f = limits.prod.map f f ≫ σ := sorry

/- We write `f - g` for `prod.lift f g ≫ σ`. -/

/-- Subtraction of morphisms in a `non_preadditive_abelian` category. -/
def has_sub {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} : Sub (X ⟶ Y) :=
  { sub := fun (f g : X ⟶ Y) => limits.prod.lift f g ≫ σ }

/- We write `-f` for `0 - f`. -/

/-- Negation of morphisms in a `non_preadditive_abelian` category. -/
def has_neg {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} : Neg (X ⟶ Y) :=
  { neg := fun (f : X ⟶ Y) => 0 - f }

/- We write `f + g` for `f - (-g)`. -/

/-- Addition of morphisms in a `non_preadditive_abelian` category. -/
def has_add {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} : Add (X ⟶ Y) :=
  { add := fun (f g : X ⟶ Y) => f - -g }

theorem sub_def {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) : a - b = limits.prod.lift a b ≫ σ :=
  rfl

theorem add_def {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) : a + b = a - -b :=
  rfl

theorem neg_def {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) : -a = 0 - a :=
  rfl

theorem sub_zero {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) : a - 0 = a := sorry

theorem sub_self {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) : a - a = 0 := sorry

theorem lift_sub_lift {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) (c : X ⟶ Y) (d : X ⟶ Y) : limits.prod.lift a b - limits.prod.lift c d = limits.prod.lift (a - c) (b - d) := sorry

theorem sub_sub_sub {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) (c : X ⟶ Y) (d : X ⟶ Y) : a - c - (b - d) = a - b - (c - d) := sorry

theorem neg_sub {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) : -a - b = -b - a := sorry

theorem neg_neg {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) : --a = a := sorry

theorem add_comm {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) : a + b = b + a := sorry

theorem add_neg {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) : a + -b = a - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + -b = a - b)) (add_def a (-b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - --b = a - b)) (neg_neg b))) (Eq.refl (a - b)))

theorem add_neg_self {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) : a + -a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + -a = 0)) (add_neg a a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - a = 0)) (sub_self a))) (Eq.refl 0))

theorem neg_add_self {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) : -a + a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a + a = 0)) (add_comm (-a) a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -a = 0)) (add_neg_self a))) (Eq.refl 0))

theorem neg_sub' {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) : -(a - b) = -a + b := sorry

theorem neg_add {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) : -(a + b) = -a - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-(a + b) = -a - b)) (add_def a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-(a - -b) = -a - b)) (neg_sub' a (-b))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (-a + -b = -a - b)) (add_neg (-a) b))) (Eq.refl (-a - b))))

theorem sub_add {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) (c : X ⟶ Y) : a - b + c = a - (b - c) := sorry

theorem add_assoc {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) (b : X ⟶ Y) (c : X ⟶ Y) : a + b + c = a + (b + c) := sorry

theorem add_zero {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} (a : X ⟶ Y) : a + 0 = a := sorry

theorem comp_sub {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (h : Y ⟶ Z) : f ≫ (g - h) = f ≫ g - f ≫ h := sorry

theorem sub_comp {C : Type u} [category C] [non_preadditive_abelian C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Y) (h : Y ⟶ Z) : (f - g) ≫ h = f ≫ h - g ≫ h := sorry

theorem comp_add {C : Type u} [category C] [non_preadditive_abelian C] (X : C) (Y : C) (Z : C) (f : X ⟶ Y) (g : Y ⟶ Z) (h : Y ⟶ Z) : f ≫ (g + h) = f ≫ g + f ≫ h := sorry

theorem add_comp {C : Type u} [category C] [non_preadditive_abelian C] (X : C) (Y : C) (Z : C) (f : X ⟶ Y) (g : X ⟶ Y) (h : Y ⟶ Z) : (f + g) ≫ h = f ≫ h + g ≫ h := sorry

/-- Every `non_preadditive_abelian` category is preadditive. -/
def preadditive {C : Type u} [category C] [non_preadditive_abelian C] : preadditive C :=
  preadditive.mk