/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import sum_eval.second_sum
import sum_eval.third_sum
import p_adic_L_function_def

/-!
# p-adic L-function
This file proves that the p-adic L-function takes special values at negative integers, in terms
of generalized Bernoulli numbers.

## Main definitions
 * `p_adic_L_function_eval_neg_int`
 * `bernoulli_measure_eval_char_fn`

## Implementation notes
 * `pri_dir_char_extend'` replaced with `dir_char_extend`
 * Try to avoid `teichmuller_character_mod_p_change_level`
 * `neg_pow'_to_hom` replaced with `mul_inv_pow_hom`
 * `neg_pow'` replaced with `mul_inv_pow`
 * `clopen_from_units` replaced with `clopen_from.units`

## References
Introduction to Cyclotomic Fields, Washington (Chapter 12, Section 2)

## Tags
p-adic, L-function, Bernoulli measure, Dirichlet character
-/

open_locale big_operators
local attribute [instance] zmod.topological_space

variables (p : ℕ) [fact (nat.prime p)] (d : ℕ) (R : Type*) [normed_comm_ring R] (m : ℕ)
(hd : d.gcd p = 1) (χ : dirichlet_character R (d*(p^m))) {c : ℕ} (hc : c.gcd p = 1)
(hc' : c.gcd d = 1) (na : ∀ (n : ℕ) (f : ℕ → R),
  ∥ ∑ (i : ℕ) in finset.range n, f i∥ ≤ ⨆ (i : zmod n), ∥f i.val∥)
(w : continuous_monoid_hom (units (zmod d) × units ℤ_[p]) R)
variables [fact (0 < d)] [complete_space R] [char_zero R]

lemma trying [algebra ℚ R] [normed_algebra ℚ_[p] R] [norm_one_class R] (f : C((zmod d)ˣ × ℤ_[p]ˣ, R))
  (i : ℕ → locally_constant ((zmod d)ˣ × ℤ_[p]ˣ) R)
  (hf : filter.tendsto (λ j : ℕ, (i j : C((zmod d)ˣ × ℤ_[p]ˣ, R))) (filter.at_top) (nhds f)) :
  filter.tendsto (λ j : ℕ, (bernoulli_measure R hc hc' hd na).1 (i j)) (filter.at_top)
  (nhds (measure.integral (bernoulli_measure R hc hc' hd na) f)) :=
begin
  convert filter.tendsto.comp (continuous.tendsto (continuous_linear_map.continuous (measure.integral
     (bernoulli_measure R hc hc' hd na) )) f) hf,
  ext,
  simp,
  rw integral_loc_const_eval, simp,
end

open ind_fn eventually_constant_seq zmod clopen_from
lemma bernoulli_measure_eval_char_fn [normed_algebra ℚ_[p] R] [algebra ℚ R] [norm_one_class R] (n : ℕ) (hn : 1 < n)
  (a : (zmod d)ˣ × (zmod (p^n))ˣ) :
  (bernoulli_measure R hc hc' hd na).val (_root_.char_fn R
  (clopen_from.is_clopen_units a)) =
  (algebra_map ℚ_[p] R (bernoulli_distribution p d c n ((zmod.chinese_remainder (nat.coprime.pow_right n hd)).inv_fun
  ((a.1 : zmod d), (a.2 : zmod (p^n))))) ) :=
begin
  delta bernoulli_measure, simp only [linear_map.coe_mk, ring_equiv.inv_fun_eq_symm],
  --delta bernoulli_distribution, simp only [linear_map.coe_mk],
  rw sequence_limit_eq _ n _,
  { --delta g, simp only [algebra.id.smul_eq_mul],
    convert finset.sum_eq_single_of_mem _ _ (λ b memb hb, _),
    swap 2, { refine ((zmod.chinese_remainder (nat.coprime.pow_right n hd)).inv_fun
      ((a.1 : zmod d), (a.2 : zmod (p^n)))), },
    { conv_lhs { rw ← one_mul ((algebra_map ℚ_[p] R)
        (bernoulli_distribution p d c n (((zmod.chinese_remainder _).symm) (↑(a.fst), ↑(a.snd))))), },
      congr,
      rw loc_const_ind_fn, simp only [ring_equiv.inv_fun_eq_symm, locally_constant.coe_mk],
      --rw ind_fn_def, simp only, rw dif_pos _,
      rw map_ind_fn_eq_fn,
      { symmetry, rw ← char_fn_one, rw set.mem_prod,
        simp only [prod.fst_zmod_cast, prod.snd_zmod_cast, set.mem_singleton_iff,
          ring_hom.to_monoid_hom_eq_coe, set.mem_preimage],
        rw units.ext_iff, rw units.ext_iff,
        rw is_unit.unit_spec, rw units.coe_map, rw is_unit.unit_spec,
        rw ← ring_equiv.inv_fun_eq_symm,
        rw proj_fst'', rw ring_hom.coe_monoid_hom (@padic_int.to_zmod_pow p _ n),
        rw proj_snd'', simp only [eq_self_iff_true, and_self], },
      { rw ← ring_equiv.inv_fun_eq_symm,
        simp only [prod.fst_zmod_cast, prod.snd_zmod_cast],
        split,
        { rw proj_fst'', apply units.is_unit, },
        { apply padic_int.is_unit_to_zmod_pow_of_is_unit p hn,
          rw proj_snd'', apply units.is_unit, }, }, },
    { delta zmod', apply finset.mem_univ, },
    { --rw loc_const_ind_fn.loc_const_ind_fn_def, rw map_ind_fn_eq_zero,
      --rw smul_eq_zero, left,
      --rw mul_eq_zero_of_left _,
      rw helper_18 p d R hd hn a,
      rw (char_fn_zero R _ _).1 _, rw zero_smul,
      rw mem_clopen_from, intro h, apply hb,
      rw units.chinese_remainder_symm_apply_snd at h,
      rw units.chinese_remainder_symm_apply_fst at h,
      rw h.2, rw ← h.1,
      rw ring_equiv.eq_inv_fun_iff, rw ← ring_equiv.coe_to_equiv,
      change (zmod.chinese_remainder (nat.coprime.pow_right n hd)).to_equiv b = _,
      rw prod.ext_iff, rw inv_fst', rw inv_snd',
      simp only [prod.fst_zmod_cast, eq_self_iff_true, prod.snd_zmod_cast, true_and],
      conv_rhs { rw ← zmod.int_cast_cast, }, rw ring_hom.map_int_cast,
      rw zmod.int_cast_cast, }, },
  { convert seq_lim_from_loc_const_char_fn R
      ((units.chinese_remainder (nat.coprime.pow_right n hd)).symm a : zmod (d * p^n)) hc hc' hd,
    apply helper_18 p d R hd hn a, },
end

open continuous_map zmod dirichlet_character

variables [normed_algebra ℚ_[p] R] [fact (0 < m)]

variable [fact (0 < d)]

variable (c)

variables (hc) (hc')

@[simp, to_additive] lemma locally_constant.coe_prod {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → locally_constant α β) :
  ⇑(∏ i in s, f i) = (∏ i in s, (f i : α → β)) :=
map_prod (locally_constant.coe_fn_monoid_hom : locally_constant α β →* _) f s

-- remove prod_apply
@[to_additive]
lemma locally_constant.prod_apply' {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → locally_constant α β) (a : α) :
  (∏ i in s, f i) a = (∏ i in s, f i a) :=
by simp

lemma monoid_hom.pow_apply {X Y : Type*} [monoid X] [comm_monoid Y] (f : X →* Y) (n : ℕ) (x : X) :
  (f^n) x = (f x)^n := rfl

lemma ring_hom.comp_to_monoid_hom {α β γ : Type*} [non_assoc_semiring α] [non_assoc_semiring β] [non_assoc_semiring γ]
  (f : α →+* β) (g : β →+* γ) : (g.comp f).to_monoid_hom = g.to_monoid_hom.comp f.to_monoid_hom :=
by { ext, simp, }

lemma monoid_hom.snd_apply {X Y : Type*} [mul_one_class X] [mul_one_class Y] (x : X) (y : Y) :
  monoid_hom.snd X Y (x, y) = y := rfl

lemma helper_254 [algebra ℚ R] [norm_one_class R] (n : ℕ) (hn : n ≠ 0) :
  (algebra_map ℚ R) (1 / ↑n) * (1 - ↑(χ (zmod.unit_of_coprime c
  (nat.coprime_mul_iff_right.2 ⟨hc', nat.coprime.pow_right m hc⟩))) * (mul_inv_pow p d R n)
  (zmod.unit_of_coprime c hc', (is_unit.unit (padic_int.nat_is_unit_of_not_dvd ((fact.out (nat.prime p)).coprime_iff_not_dvd.mp (nat.coprime.symm hc)))
  --(is_unit_iff_not_dvd _ _ ((fact.out (nat.prime p)).coprime_iff_not_dvd.mp (nat.coprime.symm hc)))
  ))) *
  (1 - (asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ n)))
  ↑p * ↑p ^ (n - 1)) * general_bernoulli_number
  (χ.mul (teichmuller_character_mod_p' p R ^ n)) n =
  (1 - (asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ n))) ↑p *
  ↑p ^ (n - 1)) * general_bernoulli_number (χ.mul (teichmuller_character_mod_p' p R ^ n)) n -
  ((algebra_map ℚ R) ((↑n - 1) / ↑n) + (algebra_map ℚ R) (1 / ↑n) * (asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ n))) ↑c *
  ↑c ^ n) * ((1 - (asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ n))) ↑p *
  ↑p ^ (n - 1)) * general_bernoulli_number (χ.mul (teichmuller_character_mod_p' p R ^ n)) n) + 0 :=
begin
  have h2 : nat.coprime c (d * p^m) := nat.coprime_mul_iff_right.2 ⟨hc', nat.coprime.pow_right _ hc⟩,
  have h1 : is_unit (c : zmod (d * p^m)) :=
    is_unit_of_is_coprime_dvd dvd_rfl h2,
--((fact.out (nat.prime p)).coprime_iff_not_dvd.mp (nat.coprime.symm hc)),
  rw add_zero, rw ← one_sub_mul, rw mul_assoc, congr, rw ← sub_sub, rw sub_div, rw div_self _,  --rw ← sub_mul, apply congr_arg2 _ _ rfl, rw sub_div, rw div_self _,
  --simp,

  rw ring_hom.map_sub, rw ring_hom.map_one, rw sub_sub_cancel (1 : R), rw mul_assoc,
  rw ← mul_one_sub, congr' 2,
--  rw teichmuller_character_mod_p_change_level_def,
  rw mul_eval_of_coprime, rw mul_assoc, congr,
  { rw asso_dirichlet_character_eq_char' _ h1, congr,
    rw units.ext_iff, rw is_unit.unit_spec, rw zmod.coe_unit_of_coprime, },
  { delta mul_inv_pow,
    change (mul_inv_pow_hom p d R n).to_fun _ = _,
    delta mul_inv_pow_hom,
    simp only,
    rw asso_dirichlet_character_eq_char' _ (is_unit_of_is_coprime_dvd dvd_rfl hc), rw mul_pow, rw monoid_hom.comp_mul,
    rw monoid_hom.comp_mul, rw monoid_hom.comp_mul, rw monoid_hom.to_fun_eq_coe, rw mul_comm,
    rw monoid_hom.mul_apply,
    delta teichmuller_character_mod_p',
    simp_rw monoid_hom.comp_apply, simp_rw monoid_hom.pow_apply,
    simp_rw units.coe_hom_apply, simp_rw units.coe_pow, simp_rw monoid_hom.map_pow, --rw ←monoid_hom.to_fun_eq_coe,
    simp_rw monoid_hom.comp_apply,
    rw ←monoid_hom.comp_inv, rw monoid_hom.comp_apply, rw units.coe_map,
    rw ring_hom.comp_to_monoid_hom, rw monoid_hom.comp_apply, rw monoid_hom.snd_apply,
    rw is_unit.unit_spec,
    congr,
    { rw units.ext_iff, rw units.coe_map, rw is_unit.unit_spec, rw is_unit.unit_spec,
      rw ring_hom.to_monoid_hom_eq_coe, rw ring_hom.coe_monoid_hom, rw map_nat_cast, },
    { rw ring_hom.to_monoid_hom_eq_coe, rw ring_hom.coe_monoid_hom,
      rw ring_hom.to_monoid_hom_eq_coe, rw ring_hom.coe_monoid_hom, rw map_nat_cast,
      rw map_nat_cast, }, },
  { apply nat.coprime.mul_right h2 hc, },
  { norm_cast, apply hn, },
end

lemma helpful_much {α β : Type*} [nonempty β] [semilattice_sup β] [topological_space α]
  [t2_space α] {a b : α} {f : filter β} [f.ne_bot] {g : β → α}
  (h1 : filter.tendsto g filter.at_top (nhds a))
  (h2 : filter.tendsto g filter.at_top (nhds b)) : a = b :=
begin
  haveI : (@filter.at_top β _).ne_bot,
  { apply filter.at_top_ne_bot, },
  have h3 := @filter.tendsto.lim_eq _ _ _ _ _ _ infer_instance _ h2,
  have h4 := @filter.tendsto.lim_eq _ _ _ _ _ _ infer_instance _ h1,
  rw ← h3, rw ← h4,
end

lemma helper_269 (n : ℕ) (y : (zmod (d * p^n))ˣ) :
  (zmod.chinese_remainder (nat.coprime.pow_right n hd)).inv_fun
  (↑(((units.chinese_remainder (nat.coprime.pow_right n hd)) y).fst),
  ↑(((units.chinese_remainder (nat.coprime.pow_right n hd)) y).snd)) = (y : zmod (d * p^n)) :=
begin
  delta units.chinese_remainder, delta mul_equiv.prod_units, delta units.map_equiv,
  simp,
end

lemma helper_idk' (n : ℕ) : (change_level (dvd_lcm_left (d * p^m) p) χ *
  change_level (dvd_lcm_right _ _) ((teichmuller_character_mod_p' p R) ^n)).conductor ∣ d * p^m :=
(dvd_trans (conductor.dvd_lev _) (by { rw helper_4 m, }))

lemma exists_pow_of_dvd_mul_pow (hd : d.coprime p) (hχ : d ∣ χ.conductor) (n : ℕ) : ∃ k : ℕ,
  (change_level (dvd_lcm_left (d * p^m) p) χ * change_level (dvd_lcm_right _ _) (teichmuller_character_mod_p' p R ^ n)).conductor = d * p^k :=
begin
  obtain ⟨y, hy⟩ := dvd_mul_of_dvd_conductor p d R m χ n hd hχ,
  have := helper_idk' p d R m χ n, --dvd_trans (conductor_dvd (χ.mul (teichmuller_character_mod_p' p R ^ n))) (conductor_dvd _),
  rw (is_primitive_def _).1 (is_primitive.mul _ _) at hy,
  simp_rw [hy] at this,
  have dvd' := nat.dvd_of_mul_dvd_mul_left (fact.out _) this,
  obtain ⟨k, h1, h2⟩ := (nat.dvd_prime_pow (fact.out _)).1 dvd',
  use k,
  rw [hy, h2],
end

/-noncomputable abbreviation k (n : ℕ) (hχ : d ∣ χ.conductor) : ℕ := classical.some
  (exists_pow_of_dvd_mul_pow p d R m χ hd hχ n)

abbreviation ψ (n : ℕ) (hχ : d ∣ χ.conductor) : dirichlet_character R (d * p^(k p d R m hd χ n hχ)) :=
-- gives a timeout-/

/-theorem cont_paLf'' [fact (0 < m)] : _root_.continuous
((units.coe_hom R).comp (dirichlet_char_extend p d R m hd ((χ
--.mul
--((teichmuller_character_mod_p' p R)^n)).change_level (helper_idk p d R m χ n
))) * w.to_monoid_hom) :=
continuous.mul (units.continuous_coe.comp (dirichlet_char_extend.continuous m hd _))
  w.continuous_to_fun

noncomputable def p_adic_L_function'' [normed_algebra ℚ_[p] R] [nontrivial R] [complete_space R]
  [norm_one_class R] [fact (0 < d)] [fact (0 < m)] (hχ : d ∣ χ.conductor) : R :=
(@measure.integral _ _ _ _ _ _ _ _ (bernoulli_measure' R hc hc' hd na)
⟨(units.coe_hom R).comp (dirichlet_char_extend p d R m hd
((χ.mul ((teichmuller_character_mod_p' p R))).change_level (helper_idk p d R m χ))) *
w.to_monoid_hom, cont_paLf'' p d R m hd _ w⟩) -- cont_paLf' m hd χ w -/

open filter

-- `pls_help` changed to `rev_prod_hom`
noncomputable abbreviation rev_prod_hom (y : ℕ) : (zmod d)ˣ × ℤ_[p]ˣ →* (zmod (d * p^y))ˣ :=
monoid_hom.comp (units.map (zmod.chinese_remainder (nat.coprime.pow_right y hd)).symm.to_monoid_hom)
(monoid_hom.comp (mul_equiv.to_monoid_hom mul_equiv.prod_units.symm) ((monoid_hom.prod_map (monoid_hom.id (zmod d)ˣ)
(units.map (@padic_int.to_zmod_pow p _ y).to_monoid_hom))))
-- dot notation does not work for mul_equiv.to_monoid_hom?

lemma is_loc_const_rev_prod_hom (y : ℕ) : is_locally_constant (rev_prod_hom p d hd y) :=
begin
  delta rev_prod_hom,
  apply is_locally_constant.comp_continuous,
  { convert is_locally_constant.of_discrete _, apply_instance, },
  { simp only [ring_hom.to_monoid_hom_eq_coe, monoid_hom.coe_comp, mul_equiv.coe_to_monoid_hom,
      monoid_hom.coe_prod_map, function.comp_app, _root_.prod_map, monoid_hom.id_apply],
    refine continuous.comp continuous_of_discrete_topology
      (continuous_fst.prod_mk (continuous.comp (padic_int.continuous_units _) continuous_snd)), },
end

lemma zmod.cast_cast {n : ℕ} [fact (0 < n)] (l m : ℕ) (a : zmod n) (h1 : l ∣ m) :
  ((a : zmod m) : zmod l) = (a : zmod l) :=
begin
  rw ← zmod.nat_cast_val a, rw zmod.cast_nat_cast h1,
  { rw zmod.nat_cast_val, },
  { refine zmod.char_p _, },
end

lemma ring_equiv.coe_to_monoid_hom {R S : Type*} [non_assoc_semiring R]
  [non_assoc_semiring S] (e : R ≃+* S) : ⇑e.to_monoid_hom = e :=
by { ext, change e.to_ring_hom.to_monoid_hom x  = _, rw ring_hom.to_monoid_hom_eq_coe,
  rw ring_hom.coe_monoid_hom, rw ring_equiv.to_ring_hom_eq_coe, rw ring_equiv.coe_to_ring_hom, }

lemma ring_equiv.eq_symm_apply {R S : Type*} [non_assoc_semiring R]
  [non_assoc_semiring S] (e : R ≃+* S) (x : S) (y : R) : y = e.symm x ↔ e y = x :=
by { refine ⟨λ h, _, λ h, _⟩, { rw h, simp, }, { rw ← h, simp, }, }

lemma zmod.coe_proj {x : ℕ} (hx : m < x) (a : (zmod d)ˣ × ℤ_[p]ˣ) :
  ↑(((zmod.chinese_remainder (nat.coprime.pow_right x hd)).symm.to_monoid_hom)
  (↑(a.fst), (padic_int.to_zmod_pow x) ↑(a.snd))) =
  ((zmod.chinese_remainder (nat.coprime.pow_right m hd)).symm.to_monoid_hom)
  (↑(a.fst), (padic_int.to_zmod_pow m) ↑(a.snd)) :=
begin
  --haveI : fact (0 < d * p ^ x), { apply imp p d x, },
  rw ring_equiv.coe_to_monoid_hom (zmod.chinese_remainder (nat.coprime.pow_right x hd)).symm,
  rw ring_equiv.coe_to_monoid_hom (zmod.chinese_remainder (nat.coprime.pow_right m hd)).symm,
  rw ring_equiv.eq_symm_apply, apply prod.ext,
  { rw ← ring_equiv.coe_to_equiv, rw ← ring_equiv.to_equiv_eq_coe,
    rw inv_fst' _ (nat.coprime.pow_right _ hd),
    rw zmod.cast_cast _ _ _ (dvd_mul_right d _),
    simp_rw proj_fst'',
    change (zmod.cast_hom (dvd_mul_right d (p^x)) (zmod d))
      ((zmod.chinese_remainder (nat.coprime.pow_right _ hd)).symm
      (↑(a.fst), (padic_int.to_zmod_pow x) ↑(a.snd))) = _,
    rw proj_fst' (nat.coprime.pow_right x hd) (↑(a.fst)) _,
    apply_instance, },
  { rw ← ring_equiv.coe_to_equiv, rw ← ring_equiv.to_equiv_eq_coe,
    rw inv_snd' _ (nat.coprime.pow_right _ hd),
    rw zmod.cast_cast _ _ _ (dvd_mul_left _ d),
    have h2 : p^m ∣ p^x, apply pow_dvd_pow p (le_of_lt hx),
    rw ← zmod.cast_cast _ _ _ h2,
   -- rw ← ring_equiv.inv_fun_eq_symm,
    change _ = (padic_int.to_zmod_pow m) ↑(a.snd),
    rw ← padic_int.cast_to_zmod_pow m x (le_of_lt hx) _,
    apply congr_arg,
    change (zmod.cast_hom (dvd_mul_left (p^x) d) (zmod (p^x)))
      ((zmod.chinese_remainder (nat.coprime.pow_right _ hd)).symm
      (↑(a.fst), (padic_int.to_zmod_pow x) ↑(a.snd))) = _,
    simp_rw proj_snd' (nat.coprime.pow_right x hd) (↑(a.fst)) _,
    apply_instance,
    apply_instance, },
end

lemma helper_281 {x : ℕ} (hx : m < x) (a : (zmod d)ˣ × ℤ_[p]ˣ) :
  (((rev_prod_hom p d hd x) a) : zmod (d * p^m)) = ↑((rev_prod_hom p d hd m) a) :=
begin
  change ((units.map (zmod.cast_hom (mul_dvd_mul_left d (pow_dvd_pow p (le_of_lt hx)))
    (zmod (d * p^m))).to_monoid_hom) (rev_prod_hom p d hd x a) : zmod (d * p^m)) = _,
  rw units.coe_map,
  delta rev_prod_hom, simp_rw monoid_hom.comp_apply,
  rw units.coe_map, rw units.coe_map,
  simp only [ring_hom.to_monoid_hom_eq_coe, monoid_hom.coe_prod_map, _root_.prod_map, monoid_hom.id_apply,
    mul_equiv.coe_to_monoid_hom, ring_hom.coe_monoid_hom, zmod.cast_hom_apply],
  delta mul_equiv.prod_units, simp,
  rw zmod.coe_proj p d m hd hx a,
end

lemma units_chinese_remainder_comp_rev_prod_hom (x : ℕ) (a : (zmod d)ˣ × ℤ_[p]ˣ) :
  (units.chinese_remainder (nat.coprime.pow_right x hd)) ((rev_prod_hom p d hd x) a) =
  (a.fst, units.map (@padic_int.to_zmod_pow p _ x).to_monoid_hom a.snd) :=
begin
  delta rev_prod_hom, rw monoid_hom.comp_apply, convert mul_equiv.apply_symm_apply _ _,
end
.
lemma units_chinese_remainder_comp_rev_prod_hom_fst (x : ℕ) (a : (zmod d)ˣ × ℤ_[p]ˣ) :
  ((units.chinese_remainder (nat.coprime.pow_right x hd)) ((rev_prod_hom p d hd x) a)).fst =
  a.fst := by { rw units_chinese_remainder_comp_rev_prod_hom p d hd x a, }

lemma units_chinese_remainder_comp_rev_prod_hom_snd (x : ℕ) (a : (zmod d)ˣ × ℤ_[p]ˣ) :
  ((units.chinese_remainder (nat.coprime.pow_right x hd)) ((rev_prod_hom p d hd x) a)).snd =
  units.map (@padic_int.to_zmod_pow p _ x).to_monoid_hom a.snd :=
by { rw units_chinese_remainder_comp_rev_prod_hom p d hd x a, }

lemma helper_256 (n : ℕ) (hn : 1 < n) : (λ y : ℕ, ((∑ (a : (zmod (d * p ^ y))ˣ),
  ((asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ n))) ↑a *
  ↑((a : zmod (d * p^y)).val) ^ (n - 1)) • _root_.char_fn R (clopen_from.is_clopen_units
  ((units.chinese_remainder (nat.coprime.pow_right y hd)) a)) : locally_constant ((zmod d)ˣ × ℤ_[p]ˣ) R) : C((zmod d)ˣ × ℤ_[p]ˣ, R))) =ᶠ[at_top]
  (λ y : ℕ, (⟨λ x, (change_level (helper_change_level_conductor m χ) (χ.mul (teichmuller_character_mod_p' p R))
  ((rev_prod_hom p d hd m) x) : R),
  is_locally_constant.continuous begin apply is_locally_constant.comp _ _, apply is_locally_constant.comp _ _, apply is_loc_const_rev_prod_hom, end⟩) *
  (((⟨λ x, ↑(rev_prod_hom p d hd y x : zmod (d * p^y)) ^ (n - 1), is_locally_constant.continuous begin apply is_locally_constant.comp₂,
      { apply is_locally_constant.comp _ _, apply is_locally_constant.comp _ _, apply is_loc_const_rev_prod_hom, },
      { apply is_locally_constant.const, }, end⟩ ) *
  ⟨λ x, (change_level (dvd_mul_of_dvd_right (dvd_pow dvd_rfl (nat.ne_zero_of_lt' 0)) d) ((teichmuller_character_mod_p' p R) ^ (n - 1)) ((rev_prod_hom p d hd m) x) : R),
  is_locally_constant.continuous begin
    apply is_locally_constant.comp _ _, apply is_locally_constant.comp _ _, apply is_loc_const_rev_prod_hom, end⟩ ))) :=
begin
  rw eventually_eq_iff_exists_mem,
  set s : set ℕ := {x : ℕ | m < x} with hs,
  refine ⟨s, _, _⟩,
  { rw mem_at_top_sets, refine ⟨m.succ, λ b hb, _⟩,
    change m < b, apply nat.succ_le_iff.1 hb, },
  { rw set.eq_on, rintros x hx, ext, simp only, rw coe_mul, rw coe_mul, rw pi.mul_apply,
    rw pi.mul_apply, rw locally_constant.coe_continuous_map, --rw locally_constant.coe_sum,
    rw locally_constant.sum_apply',
    simp_rw locally_constant.smul_apply,
    have h1 : is_unit ((rev_prod_hom p d hd x a) : zmod (d * p^m)),
    { apply coe_map_of_dvd, apply mul_dvd_mul_left d (pow_dvd_pow p (le_of_lt hx)), },
    rw finset.sum_eq_single_of_mem (rev_prod_hom p d hd x a),
    { rw (char_fn_one R _ _).1, rw smul_eq_mul, rw mul_one,
      conv_rhs { rw mul_comm, rw mul_assoc, rw mul_comm, },
      rw zmod.nat_cast_val, congr, rw ← to_fun_eq_coe, rw ← to_fun_eq_coe, simp only,
      rw ← units.coe_mul,
      { rw asso_dirichlet_character_eq_char' _ _,
        swap 2, { -- change name of lemma
          apply coe_map_of_dvd (dvd_trans (helper_idk' p d R m χ n) (mul_dvd_mul_left d
            (pow_dvd_pow p (le_of_lt hx)))) _, },
        apply congr_arg, rw ← monoid_hom.mul_apply, rw units.ext_iff,
        rw ←asso_dirichlet_character_eq_char', rw coe_coe,
        rw ←zmod.cast_cast _ _ (↑((rev_prod_hom p d hd x) a)) (helper_idk' p d R m χ n),
        rw ←coe_coe,
        rw helper_281 p d m hd hx, rw ←coe_coe,
        rw ←asso_dirichlet_character_eq_char,
        rw ←change_level.asso_dirichlet_character_eq (χ.mul (teichmuller_character_mod_p' p R ^ n))
          (helper_idk' p d R m χ n) _,
        apply congr _ rfl,
        { -- rw ←asso_dirichlet_character_eq_iff,
          rw mul_def, rw mul_def, rw ←eq_asso_primitive_character_change_level,
          rw ←eq_asso_primitive_character_change_level,
          any_goals { rw helper_4, },
          simp_rw [monoid_hom.map_mul, ←change_level.dvd],
          conv_rhs { rw mul_comm _ (change_level _ χ * _), rw mul_assoc, rw monoid_hom.map_pow, }, --_ (χ.mul teichmuller_character_mod_p' p R), },
          rw ← pow_succ, rw nat.sub_add_cancel (le_of_lt hn), rw monoid_hom.map_pow, },
        { apply_instance, }, },
      { rw set.mem_prod,
        simp only [prod.fst_zmod_cast, prod.snd_zmod_cast, set.mem_singleton_iff,
          ring_hom.to_monoid_hom_eq_coe, set.mem_preimage],
        rw units.ext_iff, rw units.ext_iff,
        rw units_chinese_remainder_comp_rev_prod_hom,
        simp only [eq_self_iff_true, ring_hom.to_monoid_hom_eq_coe, and_self], }, },
    { apply finset.mem_univ, },
    { intros b h' hb, clear h',
      rw (char_fn_zero R _ _).1 _,
      { rw smul_zero, },
      { intro h,
        rw set.mem_prod at h, rw set.mem_preimage at h, rw set.mem_singleton_iff at h,
        rw set.mem_singleton_iff at h, cases h with h2 h3,
        conv_lhs at h2 { rw ← units_chinese_remainder_comp_rev_prod_hom_fst p d hd x a, },
        conv_lhs at h3 { rw ← units_chinese_remainder_comp_rev_prod_hom_snd p d hd x a, },
        apply hb,
        apply mul_equiv.injective (units.chinese_remainder (nat.coprime.pow_right x hd)),
        symmetry,
        apply prod.ext h2 h3, }, }, },
end

lemma helper_271 (n : ℕ) : continuous
(λ x : (zmod d)ˣ × ℤ_[p]ˣ, ((algebra_map ℚ_[p] R) (padic_int.coe.ring_hom (x.snd : ℤ_[p])))) :=
begin continuity, { rw algebra.algebra_map_eq_smul_one',
    exact continuous_id'.smul continuous_const, }, { exact units.continuous_coe, }, end

lemma helper_272 (a : (zmod d)ˣ × ℤ_[p]ˣ) :
  ↑(((zmod.chinese_remainder (nat.coprime.pow_right m hd)).symm.to_monoid_hom)
  (↑(a.fst), (padic_int.to_zmod_pow m) ↑(a.snd))) = (@padic_int.to_zmod_pow p _ m) ↑(a.snd) :=
begin
  have := proj_snd' (nat.coprime.pow_right _ hd) (a.fst : zmod d) ((padic_int.to_zmod_pow m) ↑(a.snd)),
  conv_rhs { rw ← this, },
  simp only [ring_equiv.inv_fun_eq_symm, zmod.cast_hom_apply],
  congr,
end

--the underlying def for to_zmod and to_zmod_pow are different, this causes an issue, dont want to
--  use equi between p and p^1 ; maybe ring_hom.ext_zmod can be extended to ring_hom.padic_ext?
lemma padic_int.to_zmod_pow_cast_to_zmod (n : ℕ) (hn : n ≠ 0) (x : ℤ_[p]) :
  (padic_int.to_zmod_pow n x : zmod p) = padic_int.to_zmod x :=
begin
  apply padic_int.dense_range_int_cast.induction_on x,
  { refine is_closed_eq _ _,
    { continuity, apply padic_int.continuous_to_zmod_pow, },
    { apply padic_int.continuous_to_zmod, }, },
  { intro a,
    change (zmod.cast_hom (dvd_pow_self p hn) (zmod p)).comp (padic_int.to_zmod_pow n)
      (a : ℤ_[p]) = padic_int.to_zmod (a : ℤ_[p]),
    rw ring_hom.map_int_cast, rw ring_hom.map_int_cast, },
end

lemma helper_258 (n : ℕ) :
  continuous_monoid_hom.to_continuous_map (mul_inv_pow p d R (n - 1)) =
  ((⟨λ x, ((algebra_map ℚ_[p] R) (padic_int.coe.ring_hom (x.snd : ℤ_[p]))),
  helper_271 p d R n⟩ : C((zmod d)ˣ × ℤ_[p]ˣ, R))^ (n - 1) *
  (⟨λ x, (change_level (dvd_mul_of_dvd_right (dvd_pow dvd_rfl (nat.ne_zero_of_lt' 0)) d)
  ((teichmuller_character_mod_p' p R)^(n - 1)) ((rev_prod_hom p d hd m) x) : R),
  begin
    apply is_locally_constant.comp _ _, apply is_locally_constant.comp _ _,
    apply is_loc_const_rev_prod_hom, end⟩ : locally_constant ((zmod d)ˣ × ℤ_[p]ˣ) R)) :=
begin
  ext,
  change mul_inv_pow_hom p d R (n - 1) a = _,
  delta mul_inv_pow_hom, rw mul_pow, simp_rw monoid_hom.comp_mul,
  rw coe_mul, rw pi.mul_apply, rw monoid_hom.mul_apply,
  apply congr_arg2 _ _ _,
  { change _ = ((algebra_map ℚ_[p] R) (padic_int.coe.ring_hom ↑(a.snd)))^(n - 1),
    rw ← ring_hom.map_pow, rw ← ring_hom.map_pow, rw ← units.coe_pow, refl, },
  { change _ = ↑(change_level (dvd_mul_of_dvd_right (dvd_pow dvd_rfl (nat.ne_zero_of_lt' 0)) d)
      ((teichmuller_character_mod_p' p R) ^ (n - 1)) ((rev_prod_hom p d hd m) a)),
    delta teichmuller_character_mod_p',
    --rw dirichlet_character.pow_apply,
    simp_rw monoid_hom.comp_apply,
    change ((algebra_map ℚ_[p] R).to_monoid_hom) ((padic_int.coe.ring_hom.to_monoid_hom)
     ((units.coe_hom ℤ_[p]) (((monoid_hom.comp (teichmuller_character_mod_p p)⁻¹
     (units.map padic_int.to_zmod.to_monoid_hom)) (a.snd)^(n - 1))))) = _,
    rw monoid_hom.map_pow, rw monoid_hom.map_pow, rw monoid_hom.map_pow,
    rw monoid_hom.map_pow, rw dirichlet_character.pow_apply, rw units.coe_pow,
    apply congr_arg2 _ _ rfl, --rw teichmuller_character_mod_p_change_level_def,
    rw units.coe_hom_apply, rw dirichlet_character.change_level_def,
    conv_rhs { rw monoid_hom.comp_apply, rw monoid_hom.inv_apply, rw monoid_hom.comp_apply, },
    rw ← monoid_hom.map_inv, rw units.coe_map, rw ← monoid_hom.comp_apply,
    rw ← ring_hom.comp_to_monoid_hom, apply congr_arg, rw ← units.ext_iff,
    rw monoid_hom.comp_apply, rw monoid_hom.inv_apply, apply congr_arg, apply congr_arg,
    rw units.ext_iff, rw units.coe_map, rw units.coe_map, rw units.coe_map,
    delta mul_equiv.prod_units, simp,
    have mnz : m ≠ 0, { apply ne_of_gt (fact.out _), apply_instance, apply_instance, },
    rw ← zmod.cast_cast _ _ _ (dvd_pow_self p mnz),
    rw helper_272 p d m hd a,
    rw padic_int.to_zmod_pow_cast_to_zmod p _ mnz _,
    { apply_instance, }, },
end
-- make change_level a monoid_hom?

lemma helper_259 (n : ℕ) : filter.tendsto (λ (x : ℕ), ((⟨λ (x : (zmod d)ˣ × ℤ_[p]ˣ),
  ↑(change_level (helper_change_level_conductor m χ) (χ.mul (teichmuller_character_mod_p' p R)) ((rev_prod_hom p d hd m) x)),
  begin apply is_locally_constant.comp _ _, apply is_locally_constant.comp _ _, apply is_loc_const_rev_prod_hom, end⟩ : locally_constant ((zmod d)ˣ × ℤ_[p]ˣ) R) : C((zmod d)ˣ × ℤ_[p]ˣ, R))) filter.at_top
  (nhds ⟨((units.coe_hom R).comp (dirichlet_char_extend p d R m hd
  (change_level (helper_change_level_conductor m χ) (χ.mul (teichmuller_character_mod_p' p R))))),
  units.continuous_coe.comp (dirichlet_char_extend.continuous p d R m hd _)⟩) :=
begin
-- for later : try to use this instead : convert tendsto_const_nhds,
  rw metric.tendsto_at_top, intros ε hε,
  refine ⟨1, λ y hy, _⟩, rw dist_eq_norm,
  rw norm_eq_supr_norm, rw coe_sub, simp_rw pi.sub_apply, simp_rw ← to_fun_eq_coe,
  simp_rw monoid_hom.comp_apply, simp_rw units.coe_hom_apply,
  have calc1  :  ε/2 < ε, by linarith,
  apply lt_of_le_of_lt  _ calc1,
  apply cSup_le (set.range_nonempty _) (λ b hb, _),
  { apply_instance, },
  cases hb with y hy,
  rw ← hy,
  simp only, clear hy,
  convert le_of_lt (half_pos hε), rw norm_eq_zero,
  rw ← locally_constant.to_continuous_map_eq_coe,
  delta locally_constant.to_continuous_map, simp_rw ← locally_constant.to_fun_eq_coe,
  rw sub_eq_zero,
end

lemma helper_263 : continuous (λ (x : (zmod d)ˣ × ℤ_[p]ˣ), (algebra_map ℚ_[p] R) (padic_int.coe.ring_hom ↑(x.snd))) :=
by { continuity, { rw algebra.algebra_map_eq_smul_one',
    exact continuous_id'.smul continuous_const, }, { exact units.continuous_coe, }, }

open padic_int
lemma helper_268 (x : ℤ_[p]) (n : ℕ) :
  (@padic_int.to_zmod_pow p _ n x : ℤ_[p]) = (padic_int.appr x n : ℤ_[p]) :=
begin
  haveI : fact (0 < p^n) := fact_iff.2 (pow_pos (nat.prime.pos (fact.out _)) _),
  rw ← zmod.nat_cast_val, congr,
  change (x.appr n : zmod (p^n)).val = _,
  rw zmod.val_cast_of_lt, apply padic_int.appr_lt,
end

lemma helper_267 (n x : ℕ) : @padic_int.to_zmod_pow p _ n (x : ℤ_[p]) = (x : zmod (p^n)) := by { simp, }

lemma helper_261 [norm_one_class R] : filter.tendsto (λ (x : ℕ),
  (⟨λ (z : (zmod d)ˣ × ℤ_[p]ˣ), ↑((@padic_int.to_zmod_pow p _ x) ↑(z.snd)),
  continuous.comp continuous_bot (continuous.comp (padic_int.continuous_to_zmod_pow x)
  (continuous.comp units.continuous_coe continuous_snd))⟩ : C((zmod d)ˣ × ℤ_[p]ˣ, R)))
  filter.at_top (nhds ⟨λ (x : (zmod d)ˣ × ℤ_[p]ˣ), (algebra_map ℚ_[p] R)
  (padic_int.coe.ring_hom ↑(x.snd)), helper_263 p d R⟩) :=
begin
  rw metric.tendsto_at_top, intros ε hε,
  refine ⟨classical.some (padic_int.exists_pow_neg_lt p (half_pos hε)), λ n hn, _⟩, rw dist_eq_norm,
  rw norm_eq_supr_norm,
  simp only [continuous_map.coe_sub, coe_mk, pi.sub_apply],
  have calc1  :  ε/2 < ε, by linarith,
  apply lt_of_le_of_lt  _ calc1,
  apply cSup_le (set.range_nonempty _) (λ b hb, _),
  { apply_instance, },
  cases hb with y hy,
  rw ← hy,
  simp only, clear hy,
  haveI : fact (0 < p^n) := fact_iff.2 (pow_pos (nat.prime.pos (fact.out _)) _),
  have : (algebra_map ℚ_[p] R) (padic_int.coe.ring_hom ↑((@padic_int.to_zmod_pow p _ n) ↑(y.snd))) =
    ((@padic_int.to_zmod_pow p _ n) (y.snd : ℤ_[p]) : R),
  { change ((algebra_map ℚ_[p] R).comp (@padic_int.coe.ring_hom p _))
      (↑((padic_int.to_zmod_pow n) ↑(y.snd))) = _,
    rw ← zmod.nat_cast_val,
    rw map_nat_cast,
    rw zmod.nat_cast_val, },
  rw ← this,
  simp_rw ← ring_hom.map_sub,
  rw norm_algebra_map',
  rw padic_int.coe.ring_hom, simp only [ring_hom.coe_mk],
  rw padic_int.padic_norm_e_of_padic_int,
  have finally := dist_appr_spec (y.snd : ℤ_[p]) n,
  rw dist_eq_norm at finally,
  rw norm_sub_rev,
  have final := classical.some_spec (padic_int.exists_pow_neg_lt p (half_pos hε)),
  apply le_of_lt, apply lt_of_le_of_lt _ final,
  rw helper_268 p _ n, apply le_trans finally _,
  apply zpow_le_of_le,
  { norm_cast, apply le_of_lt (nat.prime.one_lt (fact.out _)), apply_instance, },
  { apply neg_le_neg, norm_cast, apply hn, },
end

lemma helper_262 [norm_one_class R] : filter.tendsto (λ (x : ℕ), dist (⟨λ (z : (zmod d)ˣ × ℤ_[p]ˣ),
  ↑((@padic_int.to_zmod_pow p _ x) ↑(z.snd)), continuous.comp continuous_bot (continuous.comp (padic_int.continuous_to_zmod_pow x)
  (continuous.comp units.continuous_coe continuous_snd))⟩ : C((zmod d)ˣ × ℤ_[p]ˣ, R)) (⟨λ (y : (zmod d)ˣ × ℤ_[p]ˣ),
  ↑((rev_prod_hom p d hd x) y), continuous.comp continuous_of_discrete_topology
  (is_locally_constant.continuous (is_loc_const_rev_prod_hom p d hd _))⟩)) filter.at_top (nhds 0) :=
begin
-- use norm_le!
  rw metric.tendsto_at_top, intros ε hε,
  refine ⟨classical.some (padic_int.exists_pow_neg_lt p (half_pos hε)), λ n hn, _⟩,
  rw dist_zero_right, rw dist_eq_norm, rw norm_norm,
  rw norm_eq_supr_norm,
  simp only [continuous_map.coe_sub, coe_mk, pi.sub_apply],
  have calc1  :  ε/2 < ε, by linarith,
  apply lt_of_le_of_lt  _ calc1,
  apply cSup_le (set.range_nonempty _) (λ b hb, _),
  { apply_instance, },
  cases hb with y hy,
  rw ← hy,
  simp only, clear hy,
  rw norm_sub_rev,
  delta rev_prod_hom,
  change ∥(((units.map (zmod.chinese_remainder (nat.coprime.pow_right n hd)).symm.to_monoid_hom)
  ((mul_equiv.prod_units.symm)
     (((monoid_hom.id (zmod d)ˣ).prod_map (units.map (@padic_int.to_zmod_pow p _ n).to_monoid_hom)) y)) : zmod (d * p^n)) : R) - _∥ ≤ ε/2,
  rw units.coe_map,
  change ∥(↑(((zmod.chinese_remainder (nat.coprime.pow_right n hd)).symm)
    ↑((mul_equiv.prod_units.symm) (y.1, (units.map (@padic_int.to_zmod_pow p _ n).to_monoid_hom) y.2)))) - _∥ ≤ ε/2,
  simp_rw ← mul_equiv.inv_fun_eq_symm, delta mul_equiv.prod_units, simp only,
  simp_rw units.coe_mk, simp_rw units.coe_map,
  change ∥↑(((zmod.chinese_remainder (nat.coprime.pow_right n hd)).inv_fun)
    (↑(y.fst), ((padic_int.to_zmod_pow n)) ↑(y.snd))) - _∥ ≤ ε/2,
  have := proj_snd ((y.fst : zmod d), (y.snd : ℤ_[p])) (nat.coprime.pow_right n hd),
  change ↑((zmod.chinese_remainder _).inv_fun (↑(y.fst), (padic_int.to_zmod_pow n) (↑(y.snd)))) =
    (padic_int.to_zmod_pow n) (↑(y.snd)) at this,
  haveI : fact (0 < p^n) := fact_iff.2 (pow_pos (nat.prime.pos (fact.out _)) _),
  conv { congr, congr, congr, rw ← zmod.nat_cast_val,
    rw ← map_nat_cast ((algebra_map ℚ_[p] R).comp (padic_int.coe.ring_hom)), skip,
    rw ← this, rw ← zmod.nat_cast_val, rw ← zmod.nat_cast_val,
    rw ← map_nat_cast ((algebra_map ℚ_[p] R).comp (padic_int.coe.ring_hom)), rw zmod.nat_cast_val, },
-- this entire pricess should be a separate lemma
  rw ← ring_hom.map_sub, rw ring_hom.comp_apply,
  rw norm_algebra_map',
  rw padic_int.coe.ring_hom, simp only [ring_hom.coe_mk],
  rw padic_int.padic_norm_e_of_padic_int, rw ← helper_267, rw helper_268, rw ← dist_eq_norm,
  apply le_trans (dist_appr_spec _ _) _,
  have final := classical.some_spec (padic_int.exists_pow_neg_lt p (half_pos hε)),
  apply le_of_lt, apply lt_of_le_of_lt _ final,
  apply zpow_le_of_le,
  { norm_cast, apply le_of_lt (nat.prime.one_lt (fact.out _)), apply_instance, },
  { apply neg_le_neg, norm_cast, apply hn, },
end

lemma helper_260 [norm_one_class R] (n : ℕ) : filter.tendsto (λ (x : ℕ), ↑(⟨λ (y : (zmod d)ˣ × ℤ_[p]ˣ),
  ((rev_prod_hom p d hd x) y : R) ^ (n - 1), begin apply is_locally_constant.comp₂,
      { apply is_locally_constant.comp _ _, apply is_loc_const_rev_prod_hom, },
      { apply is_locally_constant.const, }, end⟩ : locally_constant ((zmod d)ˣ × ℤ_[p]ˣ) R)) filter.at_top
  (nhds ((⟨λ (x : (zmod d)ˣ × ℤ_[p]ˣ), (algebra_map ℚ_[p] R)
  (padic_int.coe.ring_hom ↑(x.snd)), begin continuity, { rw algebra.algebra_map_eq_smul_one',
    exact continuous_id'.smul continuous_const, }, { exact units.continuous_coe, }, end⟩ : C((zmod d)ˣ × ℤ_[p]ˣ, R))^(n - 1))) :=
begin
  change filter.tendsto (λ x : ℕ, (⟨λ y, ((rev_prod_hom p d hd x) y : R), begin continuity,
  { simp only, apply continuous_of_discrete_topology, },
  { apply is_locally_constant.continuous (is_loc_const_rev_prod_hom p d hd x), }, end⟩ : C((zmod d)ˣ × ℤ_[p]ˣ, R))^(n - 1))
    filter.at_top _,
  apply filter.tendsto.pow _ (n - 1),
  { apply_instance, },
  { apply filter.tendsto.congr_dist,
    swap 3, { refine λ x, ⟨λ z, padic_int.to_zmod_pow x (z.snd : ℤ_[p]), continuous.comp
      continuous_bot (continuous.comp (padic_int.continuous_to_zmod_pow x)
      (continuous.comp units.continuous_coe continuous_snd))⟩, },
    apply helper_261,
    apply helper_262, },
end

theorem p_adic_L_function_eval_neg_int [algebra ℚ R] [norm_one_class R] [no_zero_divisors R]
  [is_scalar_tower ℚ ℚ_[p] R]
  (n : ℕ) (hn : 1 < n) (hχ : χ.is_even) (hp : 2 < p)
  (na : ∀ (n : ℕ) (f : ℕ → R), ∥ ∑ (i : ℕ) in finset.range n, f i∥ ≤ ⨆ (i : zmod n), ∥f i.val∥)
  (hp : 2 < p) (hχ : χ.is_even) (hχ1 : d ∣ χ.conductor)
  --(hχ2 : p ∣ (χ.mul (((teichmuller_character_mod_p' p R)^n))).conductor)
  (na' : ∀ (n : ℕ) (f : (zmod n)ˣ → R), ∥∑ i : (zmod n)ˣ, f i∥ ≤ ⨆ (i : (zmod n)ˣ), ∥f i∥)
  (na : ∀ (n : ℕ) (f : ℕ → R), ∥∑ i in finset.range n, f i∥ ≤ ⨆ (i : zmod n), ∥f i.val∥) :
  (p_adic_L_function m hd χ c hc hc' na (mul_inv_pow p d R (n - 1))) = (algebra_map ℚ R) (1 / n : ℚ) *
   (1 - (χ (zmod.unit_of_coprime c (nat.coprime_mul_iff_right.2 ⟨hc', nat.coprime.pow_right m hc⟩))
   * (mul_inv_pow p d R n (zmod.unit_of_coprime c hc', is_unit.unit (padic_int.nat_is_unit_of_not_dvd
   ((fact.out (nat.prime p)).coprime_iff_not_dvd.mp (nat.coprime.symm hc))
     )) ))) * (1 - ((asso_dirichlet_character (dirichlet_character.mul χ
     ((teichmuller_character_mod_p' p R)^n))) p * p^(n - 1)) ) *
   (general_bernoulli_number (dirichlet_character.mul χ
     ((teichmuller_character_mod_p' p R)^n)) n) :=
begin
  delta p_adic_L_function,
  have h1 := filter.tendsto.add (filter.tendsto.sub (U p d R m χ hd n hn hχ hχ1 hp na)
    (V p d R m χ c hd hc' hc hp hχ hχ1 na' na n hn))
    (W p d R m χ c hd hp na' na n hn hχ),
  conv at h1 { congr, skip, skip, rw ← helper_254 p d R m χ c hc hc' n (ne_zero_of_lt hn), },
  symmetry, apply helpful_much h1, clear h1,
  swap 3, { apply filter.at_top_ne_bot, },
  convert (tendsto_congr' _).2 (trying p d R hd hc hc' na _
    (λ j : ℕ, ∑ (a : (zmod (d * p^j))ˣ), (((asso_dirichlet_character (χ.mul ((teichmuller_character_mod_p' p R)^n)) a : R) *
    ((((a : zmod (d * p^j))).val)^(n - 1) : R))) • (_root_.char_fn R (clopen_from.is_clopen_units
     ((units.chinese_remainder (nat.coprime.pow_right j hd)) a)))) _),
  { rw eventually_eq_iff_exists_mem,
    set s : set ℕ := {x : ℕ | 1 < x} with hs,
    refine ⟨s, _, _⟩,
    { rw mem_at_top_sets, refine ⟨nat.succ 1, λ b hb, _⟩,
      change 1 < b, apply nat.succ_le_iff.1 hb, },
    rw set.eq_on, rintros x hx, simp only,
    delta U_def, delta V_def, rw linear_map.map_sum, simp_rw linear_map.map_smul,
    convert finset.sum_congr rfl _,
    swap 3, { intros z hz, rw bernoulli_measure_eval_char_fn, apply hx, },
    rw bernoulli_distribution, simp only,
    simp_rw [helper_269, ring_hom.map_add, ring_hom.map_sub, zmod.nat_cast_val, smul_add, smul_sub],
    rw finset.sum_add_distrib, rw finset.sum_sub_distrib,
    simp_rw is_scalar_tower.algebra_map_apply ℚ ℚ_[p] R,
    congr, },
  { rw tendsto_congr' (helper_256 p d R m hd χ n hn),
    change tendsto _ at_top (nhds ((⟨((units.coe_hom R).comp (dirichlet_char_extend p d R m hd
      (change_level (helper_change_level_conductor m χ) (χ.mul (teichmuller_character_mod_p' p R))))),
      units.continuous_coe.comp _⟩ : C((zmod d)ˣ × ℤ_[p]ˣ, R)) *
      ⟨((mul_inv_pow p d R (n - 1)).to_monoid_hom), ((mul_inv_pow p d R (n - 1))).continuous_to_fun⟩)),
    apply filter.tendsto.mul _ _,
    { exact semi_normed_ring_top_monoid, },
    { apply helper_259 p d R m hd χ n, },
    { change filter.tendsto _ filter.at_top (nhds (mul_inv_pow p d R (n - 1)).to_continuous_map),
      rw helper_258 p d R m hd n,
      apply filter.tendsto.mul,
      { apply helper_260, },
      { apply tendsto_const_nhds, }, }, },
end


/- Lemmas for simplify terms involving zero-length vectors. -/
import data.vector
universe variables u

namespace vector

variable {α : Type u}
variable {n : ℕ}

local infix `++`:65 := vector.append

theorem length_zero_vector_is_nil (x : vector α 0) : x = nil :=
begin
  apply vector.eq,
  cases x with v p,
  cases v,
  simp,
  contradiction
end

-- Simplify 0-length vector equality to true.
@[simp]
theorem zero_vec_always_eq (x y : vector α 0) : x = y ↔ true :=
begin
  simp [length_zero_vector_is_nil x, length_zero_vector_is_nil y],
end

@[simp]
theorem to_list_empty (x : vector α 0) : to_list x = list.nil :=
begin
  simp [length_zero_vector_is_nil x],
end

end vector


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import category_theory.epi_mono
import category_theory.limits.has_limits

/-!
# Equalizers and coequalizers

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

This file defines (co)equalizers as special cases of (co)limits.

An equalizer is the categorical generalization of the subobject {a ∈ A | f(a) = g(a)} known
from abelian groups or modules. It is a limit cone over the diagram formed by `f` and `g`.

A coequalizer is the dual concept.

## Main definitions

* `walking_parallel_pair` is the indexing category used for (co)equalizer_diagrams
* `parallel_pair` is a functor from `walking_parallel_pair` to our category `C`.
* a `fork` is a cone over a parallel pair.
  * there is really only one interesting morphism in a fork: the arrow from the vertex of the fork
    to the domain of f and g. It is called `fork.ι`.
* an `equalizer` is now just a `limit (parallel_pair f g)`

Each of these has a dual.

## Main statements

* `equalizer.ι_mono` states that every equalizer map is a monomorphism
* `is_iso_limit_cone_parallel_pair_of_self` states that the identity on the domain of `f` is an
  equalizer of `f` and `f`.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.

## References

* [F. Borceux, *Handbook of Categorical Algebra 1*][borceux-vol1]
-/

noncomputable theory

open category_theory opposite

namespace category_theory.limits

local attribute [tidy] tactic.case_bash

universes v v₂ u u₂

/-- The type of objects for the diagram indexing a (co)equalizer. -/
@[derive decidable_eq, derive inhabited] inductive walking_parallel_pair : Type
| zero | one

open walking_parallel_pair

/-- The type family of morphisms for the diagram indexing a (co)equalizer. -/
@[derive decidable_eq] inductive walking_parallel_pair_hom :
  walking_parallel_pair → walking_parallel_pair → Type
| left : walking_parallel_pair_hom zero one
| right : walking_parallel_pair_hom zero one
| id : Π X : walking_parallel_pair, walking_parallel_pair_hom X X

/-- Satisfying the inhabited linter -/
instance : inhabited (walking_parallel_pair_hom zero one) :=
{ default := walking_parallel_pair_hom.left }

open walking_parallel_pair_hom

/-- Composition of morphisms in the indexing diagram for (co)equalizers. -/
def walking_parallel_pair_hom.comp :
  Π (X Y Z : walking_parallel_pair)
    (f : walking_parallel_pair_hom X Y) (g : walking_parallel_pair_hom Y Z),
    walking_parallel_pair_hom X Z
  | _ _ _ (id _) h := h
  | _ _ _ left   (id one) := left
  | _ _ _ right  (id one) := right
.

instance walking_parallel_pair_hom_category : small_category walking_parallel_pair :=
{ hom  := walking_parallel_pair_hom,
  id   := walking_parallel_pair_hom.id,
  comp := walking_parallel_pair_hom.comp }

@[simp]
lemma walking_parallel_pair_hom_id (X : walking_parallel_pair) :
  walking_parallel_pair_hom.id X = 𝟙 X :=
rfl

/--
The functor `walking_parallel_pair ⥤ walking_parallel_pairᵒᵖ` sending left to left and right to
right.
-/
def walking_parallel_pair_op : walking_parallel_pair ⥤ walking_parallel_pairᵒᵖ :=
{ obj := (λ x, op $ by { cases x, exacts [one, zero] }),
  map := λ i j f, by { cases f; apply quiver.hom.op, exacts [left, right,
    walking_parallel_pair_hom.id _] },
  map_comp' := by { rintros (_|_) (_|_) (_|_) (_|_|_) (_|_|_); refl } }

@[simp] lemma walking_parallel_pair_op_zero :
  walking_parallel_pair_op.obj zero = op one := rfl
@[simp] lemma walking_parallel_pair_op_one :
  walking_parallel_pair_op.obj one = op zero := rfl
@[simp] lemma walking_parallel_pair_op_left :
  walking_parallel_pair_op.map left = @quiver.hom.op _ _ zero one left := rfl
@[simp] lemma walking_parallel_pair_op_right :
  walking_parallel_pair_op.map right = @quiver.hom.op _ _ zero one right := rfl

/--
The equivalence `walking_parallel_pair ⥤ walking_parallel_pairᵒᵖ` sending left to left and right to
right.
-/
@[simps functor inverse]
def walking_parallel_pair_op_equiv : walking_parallel_pair ≌ walking_parallel_pairᵒᵖ :=
{ functor := walking_parallel_pair_op,
  inverse := walking_parallel_pair_op.left_op,
  unit_iso := nat_iso.of_components (λ j, eq_to_iso (by { cases j; refl }))
    (by { rintros (_|_) (_|_) (_|_|_); refl }),
  counit_iso := nat_iso.of_components (λ j, eq_to_iso
    (by { induction j using opposite.rec, cases j; refl }))
    (λ i j f, by { induction i using opposite.rec, induction j using opposite.rec,
      let g := f.unop, have : f = g.op := rfl, clear_value g, subst this,
      rcases i with (_|_); rcases j with (_|_); rcases g with (_|_|_); refl }) }

@[simp] lemma walking_parallel_pair_op_equiv_unit_iso_zero :
  walking_parallel_pair_op_equiv.unit_iso.app zero = iso.refl zero := rfl
@[simp] lemma walking_parallel_pair_op_equiv_unit_iso_one :
  walking_parallel_pair_op_equiv.unit_iso.app one = iso.refl one := rfl
@[simp] lemma walking_parallel_pair_op_equiv_counit_iso_zero :
  walking_parallel_pair_op_equiv.counit_iso.app (op zero) = iso.refl (op zero) := rfl
@[simp] lemma walking_parallel_pair_op_equiv_counit_iso_one :
  walking_parallel_pair_op_equiv.counit_iso.app (op one) = iso.refl (op one) := rfl

variables {C : Type u} [category.{v} C]
variables {X Y : C}

/-- `parallel_pair f g` is the diagram in `C` consisting of the two morphisms `f` and `g` with
    common domain and codomain. -/
def parallel_pair (f g : X ⟶ Y) : walking_parallel_pair ⥤ C :=
{ obj := λ x, match x with
  | zero := X
  | one := Y
  end,
  map := λ x y h, match x, y, h with
  | _, _, (id _) := 𝟙 _
  | _, _, left := f
  | _, _, right := g
  end,
  -- `tidy` can cope with this, but it's too slow:
  map_comp' := begin rintros (⟨⟩|⟨⟩) (⟨⟩|⟨⟩) (⟨⟩|⟨⟩) ⟨⟩⟨⟩; { unfold_aux, simp; refl }, end, }.

@[simp] lemma parallel_pair_obj_zero (f g : X ⟶ Y) : (parallel_pair f g).obj zero = X := rfl
@[simp] lemma parallel_pair_obj_one (f g : X ⟶ Y) : (parallel_pair f g).obj one = Y := rfl

@[simp] lemma parallel_pair_map_left (f g : X ⟶ Y) : (parallel_pair f g).map left = f := rfl
@[simp] lemma parallel_pair_map_right (f g : X ⟶ Y) : (parallel_pair f g).map right = g := rfl

@[simp] lemma parallel_pair_functor_obj
  {F : walking_parallel_pair ⥤ C} (j : walking_parallel_pair) :
  (parallel_pair (F.map left) (F.map right)).obj j = F.obj j :=
begin
  cases j; refl
end

/-- Every functor indexing a (co)equalizer is naturally isomorphic (actually, equal) to a
    `parallel_pair` -/
@[simps]
def diagram_iso_parallel_pair (F : walking_parallel_pair ⥤ C) :
  F ≅ parallel_pair (F.map left) (F.map right) :=
nat_iso.of_components (λ j, eq_to_iso $ by cases j; tidy) $ by tidy

/-- Construct a morphism between parallel pairs. -/
def parallel_pair_hom {X' Y' : C} (f g : X ⟶ Y) (f' g' : X' ⟶ Y') (p : X ⟶ X') (q : Y ⟶ Y')
  (wf : f ≫ q = p ≫ f') (wg : g ≫ q = p ≫ g') : parallel_pair f g ⟶ parallel_pair f' g' :=
{ app := λ j, match j with
  | zero := p
  | one := q
  end,
  naturality' := begin
    rintros (⟨⟩|⟨⟩) (⟨⟩|⟨⟩) ⟨⟩; { unfold_aux, simp [wf, wg], },
  end }

@[simp] lemma parallel_pair_hom_app_zero
  {X' Y' : C} (f g : X ⟶ Y) (f' g' : X' ⟶ Y') (p : X ⟶ X') (q : Y ⟶ Y')
  (wf : f ≫ q = p ≫ f') (wg : g ≫ q = p ≫ g') :
  (parallel_pair_hom f g f' g' p q wf wg).app zero = p := rfl

@[simp] lemma parallel_pair_hom_app_one
  {X' Y' : C} (f g : X ⟶ Y) (f' g' : X' ⟶ Y') (p : X ⟶ X') (q : Y ⟶ Y')
  (wf : f ≫ q = p ≫ f') (wg : g ≫ q = p ≫ g') :
  (parallel_pair_hom f g f' g' p q wf wg).app one = q := rfl

/-- Construct a natural isomorphism between functors out of the walking parallel pair from
its components. -/
@[simps]
def parallel_pair.ext {F G : walking_parallel_pair ⥤ C}
  (zero : F.obj zero ≅ G.obj zero) (one : F.obj one ≅ G.obj one)
  (left : F.map left ≫ one.hom = zero.hom ≫ G.map left)
  (right : F.map right ≫ one.hom = zero.hom ≫ G.map right) : F ≅ G :=
nat_iso.of_components
  (by { rintro ⟨j⟩, exacts [zero, one] })
  (by { rintro ⟨j₁⟩ ⟨j₂⟩ ⟨f⟩; simp [left, right], })

/-- Construct a natural isomorphism between `parallel_pair f g` and `parallel_pair f' g'` given
equalities `f = f'` and `g = g'`. -/
@[simps]
def parallel_pair.eq_of_hom_eq {f g f' g' : X ⟶ Y} (hf : f = f') (hg : g = g') :
  parallel_pair f g ≅ parallel_pair f' g' :=
parallel_pair.ext (iso.refl _) (iso.refl _) (by simp [hf]) (by simp [hg])

/-- A fork on `f` and `g` is just a `cone (parallel_pair f g)`. -/
abbreviation fork (f g : X ⟶ Y) := cone (parallel_pair f g)

/-- A cofork on `f` and `g` is just a `cocone (parallel_pair f g)`. -/
abbreviation cofork (f g : X ⟶ Y) := cocone (parallel_pair f g)

variables {f g : X ⟶ Y}

/-- A fork `t` on the parallel pair `f g : X ⟶ Y` consists of two morphisms `t.π.app zero : t.X ⟶ X`
    and `t.π.app one : t.X ⟶ Y`. Of these, only the first one is interesting, and we give it the
    shorter name `fork.ι t`. -/
def fork.ι (t : fork f g) := t.π.app zero

@[simp] lemma fork.app_zero_eq_ι (t : fork f g) : t.π.app zero = t.ι := rfl

/-- A cofork `t` on the parallel_pair `f g : X ⟶ Y` consists of two morphisms
    `t.ι.app zero : X ⟶ t.X` and `t.ι.app one : Y ⟶ t.X`. Of these, only the second one is
    interesting, and we give it the shorter name `cofork.π t`. -/
def cofork.π (t : cofork f g) := t.ι.app one

@[simp] lemma cofork.app_one_eq_π (t : cofork f g) : t.ι.app one = t.π := rfl

@[simp] lemma fork.app_one_eq_ι_comp_left (s : fork f g) : s.π.app one = s.ι ≫ f :=
by rw [←s.app_zero_eq_ι, ←s.w left, parallel_pair_map_left]

@[reassoc] lemma fork.app_one_eq_ι_comp_right (s : fork f g) : s.π.app one = s.ι ≫ g :=
by rw [←s.app_zero_eq_ι, ←s.w right, parallel_pair_map_right]

@[simp] lemma cofork.app_zero_eq_comp_π_left (s : cofork f g) : s.ι.app zero = f ≫ s.π :=
by rw [←s.app_one_eq_π, ←s.w left, parallel_pair_map_left]

@[reassoc] lemma cofork.app_zero_eq_comp_π_right (s : cofork f g) : s.ι.app zero = g ≫ s.π :=
by rw [←s.app_one_eq_π, ←s.w right, parallel_pair_map_right]

/-- A fork on `f g : X ⟶ Y` is determined by the morphism `ι : P ⟶ X` satisfying `ι ≫ f = ι ≫ g`.
-/
@[simps]
def fork.of_ι {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) : fork f g :=
{ X := P,
  π :=
  { app := λ X, begin cases X, exact ι, exact ι ≫ f, end,
    naturality' := λ X Y f,
    begin
      cases X; cases Y; cases f; dsimp; simp,
      { dsimp, simp, }, -- See note [dsimp, simp].
      { exact w },
      { dsimp, simp, },
    end } }

/-- A cofork on `f g : X ⟶ Y` is determined by the morphism `π : Y ⟶ P` satisfying
    `f ≫ π = g ≫ π`. -/
@[simps]
def cofork.of_π {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) : cofork f g :=
{ X := P,
  ι :=
  { app := λ X, walking_parallel_pair.cases_on X (f ≫ π) π,
    naturality' := λ i j f, by { cases f; dsimp; simp [w] } } } -- See note [dsimp, simp]

@[simp] lemma fork.ι_of_ι {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) :
  (fork.of_ι ι w).ι = ι := rfl
@[simp] lemma cofork.π_of_π {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) :
  (cofork.of_π π w).π = π := rfl

@[simp, reassoc]
lemma fork.condition (t : fork f g) : t.ι ≫ f = t.ι ≫ g :=
by rw [←t.app_one_eq_ι_comp_left, ←t.app_one_eq_ι_comp_right]

@[simp, reassoc]
lemma cofork.condition (t : cofork f g) : f ≫ t.π = g ≫ t.π :=
by rw [←t.app_zero_eq_comp_π_left, ←t.app_zero_eq_comp_π_right]

/-- To check whether two maps are equalized by both maps of a fork, it suffices to check it for the
    first map -/
lemma fork.equalizer_ext (s : fork f g) {W : C} {k l : W ⟶ s.X} (h : k ≫ s.ι = l ≫ s.ι) :
  ∀ (j : walking_parallel_pair), k ≫ s.π.app j = l ≫ s.π.app j
| zero := h
| one := by rw [s.app_one_eq_ι_comp_left, reassoc_of h]

/-- To check whether two maps are coequalized by both maps of a cofork, it suffices to check it for
    the second map -/

lemma fork.is_limit.hom_ext {s : fork f g} (hs : is_limit s) {W : C} {k l : W ⟶ s.X}
  (h : k ≫ fork.ι s = l ≫ fork.ι s) : k = l :=
hs.hom_ext $ fork.equalizer_ext _ h

lemma cofork.is_colimit.hom_ext {s : cofork f g} (hs : is_colimit s) {W : C} {k l : s.X ⟶ W}
  (h : cofork.π s ≫ k = cofork.π s ≫ l) : k = l :=
hs.hom_ext $ cofork.coequalizer_ext _ h

@[simp, reassoc] lemma fork.is_limit.lift_ι {s t : fork f g} (hs : is_limit s) :
  hs.lift t ≫ s.ι = t.ι :=
hs.fac _ _

@[simp, reassoc] lemma cofork.is_colimit.π_desc {s t : cofork f g} (hs : is_colimit s) :
  s.π ≫ hs.desc t = t.π :=
hs.fac _ _

/-- If `s` is a limit fork over `f` and `g`, then a morphism `k : W ⟶ X` satisfying
    `k ≫ f = k ≫ g` induces a morphism `l : W ⟶ s.X` such that `l ≫ fork.ι s = k`. -/
def fork.is_limit.lift' {s : fork f g} (hs : is_limit s) {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
  {l : W ⟶ s.X // l ≫ fork.ι s = k} :=
⟨hs.lift $ fork.of_ι _ h, hs.fac _ _⟩

/-- If `s` is a colimit cofork over `f` and `g`, then a morphism `k : Y ⟶ W` satisfying
    `f ≫ k = g ≫ k` induces a morphism `l : s.X ⟶ W` such that `cofork.π s ≫ l = k`. -/
def cofork.is_colimit.desc' {s : cofork f g} (hs : is_colimit s) {W : C} (k : Y ⟶ W)
  (h : f ≫ k = g ≫ k) : {l : s.X ⟶ W // cofork.π s ≫ l = k} :=
⟨hs.desc $ cofork.of_π _ h, hs.fac _ _⟩

lemma fork.is_limit.exists_unique {s : fork f g} (hs : is_limit s) {W : C} (k : W ⟶ X)
  (h : k ≫ f = k ≫ g) : ∃! (l : W ⟶ s.X), l ≫ fork.ι s = k :=
⟨hs.lift $ fork.of_ι _ h, hs.fac _ _, λ m hm, fork.is_limit.hom_ext hs $
  hm.symm ▸ (hs.fac (fork.of_ι _ h) walking_parallel_pair.zero).symm⟩

lemma cofork.is_colimit.exists_unique {s : cofork f g} (hs : is_colimit s) {W : C} (k : Y ⟶ W)
  (h : f ≫ k = g ≫ k) : ∃! (d : s.X ⟶ W), cofork.π s ≫ d = k :=
⟨hs.desc $ cofork.of_π _ h, hs.fac _ _, λ m hm, cofork.is_colimit.hom_ext hs $
  hm.symm ▸ (hs.fac (cofork.of_π _ h) walking_parallel_pair.one).symm⟩

/-- This is a slightly more convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
@[simps lift]
def fork.is_limit.mk (t : fork f g)
  (lift : Π (s : fork f g), s.X ⟶ t.X)
  (fac : ∀ (s : fork f g), lift s ≫ fork.ι t = fork.ι s)
  (uniq : ∀ (s : fork f g) (m : s.X ⟶ t.X) (w : m ≫ t.ι = s.ι), m = lift s) :
  is_limit t :=
{ lift := lift,
  fac' := λ s j, walking_parallel_pair.cases_on j (fac s) $
    by erw [←s.w left, ←t.w left, ←category.assoc, fac]; refl,
  uniq' := λ s m j, by tidy }

/-- This is another convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def fork.is_limit.mk' {X Y : C} {f g : X ⟶ Y} (t : fork f g)
  (create : Π (s : fork f g), {l // l ≫ t.ι = s.ι ∧ ∀ {m}, m ≫ t.ι = s.ι → m = l}) :
is_limit t :=
fork.is_limit.mk t
  (λ s, (create s).1)
  (λ s, (create s).2.1)
  (λ s m w, (create s).2.2 w)

/-- This is a slightly more convenient method to verify that a cofork is a colimit cocone. It
    only asks for a proof of facts that carry any mathematical content -/
def cofork.is_colimit.mk (t : cofork f g)
  (desc : Π (s : cofork f g), t.X ⟶ s.X)
  (fac : ∀ (s : cofork f g), cofork.π t ≫ desc s = cofork.π s)
  (uniq : ∀ (s : cofork f g) (m : t.X ⟶ s.X) (w : t.π ≫ m = s.π), m = desc s) :
  is_colimit t :=
{ desc := desc,
  fac' := λ s j, walking_parallel_pair.cases_on j
    (by erw [←s.w left, ←t.w left, category.assoc, fac]; refl) (fac s),
  uniq' := by tidy }

/-- This is another convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def cofork.is_colimit.mk' {X Y : C} {f g : X ⟶ Y} (t : cofork f g)
  (create : Π (s : cofork f g), {l : t.X ⟶ s.X // t.π ≫ l = s.π ∧ ∀ {m}, t.π ≫ m = s.π → m = l}) :
is_colimit t :=
cofork.is_colimit.mk t
  (λ s, (create s).1)
  (λ s, (create s).2.1)
  (λ s m w, (create s).2.2 w)

/-- Noncomputably make a limit cone from the existence of unique factorizations. -/
def fork.is_limit.of_exists_unique {t : fork f g}
  (hs : ∀ (s : fork f g), ∃! l : s.X ⟶ t.X, l ≫ fork.ι t = fork.ι s) : is_limit t :=
by { choose d hd hd' using hs, exact fork.is_limit.mk _ d hd (λ s m hm, hd' _ _ hm) }

/-- Noncomputably make a colimit cocone from the existence of unique factorizations. -/
def cofork.is_colimit.of_exists_unique {t : cofork f g}
  (hs : ∀ (s : cofork f g), ∃! d : t.X ⟶ s.X, cofork.π t ≫ d = cofork.π s) : is_colimit t :=
by { choose d hd hd' using hs, exact cofork.is_colimit.mk _ d hd (λ s m hm, hd' _ _ hm) }

/--
Given a limit cone for the pair `f g : X ⟶ Y`, for any `Z`, morphisms from `Z` to its point are in
bijection with morphisms `h : Z ⟶ X` such that `h ≫ f = h ≫ g`.
Further, this bijection is natural in `Z`: see `fork.is_limit.hom_iso_natural`.
This is a special case of `is_limit.hom_iso'`, often useful to construct adjunctions.
-/
@[simps]
def fork.is_limit.hom_iso {X Y : C} {f g : X ⟶ Y} {t : fork f g} (ht : is_limit t) (Z : C) :
  (Z ⟶ t.X) ≃ {h : Z ⟶ X // h ≫ f = h ≫ g} :=
{ to_fun := λ k, ⟨k ≫ t.ι, by simp only [category.assoc, t.condition]⟩,
  inv_fun := λ h, (fork.is_limit.lift' ht _ h.prop).1,
  left_inv := λ k, fork.is_limit.hom_ext ht (fork.is_limit.lift' _ _ _).prop,
  right_inv := λ h, subtype.ext (fork.is_limit.lift' ht _ _).prop }

/-- The bijection of `fork.is_limit.hom_iso` is natural in `Z`. -/
lemma fork.is_limit.hom_iso_natural {X Y : C} {f g : X ⟶ Y} {t : fork f g} (ht : is_limit t)
  {Z Z' : C} (q : Z' ⟶ Z) (k : Z ⟶ t.X) :
  (fork.is_limit.hom_iso ht _ (q ≫ k) : Z' ⟶ X) = q ≫ (fork.is_limit.hom_iso ht _ k : Z ⟶ X) :=
category.assoc _ _ _

/--
Given a colimit cocone for the pair `f g : X ⟶ Y`, for any `Z`, morphisms from the cocone point
to `Z` are in bijection with morphisms `h : Y ⟶ Z` such that `f ≫ h = g ≫ h`.
Further, this bijection is natural in `Z`: see `cofork.is_colimit.hom_iso_natural`.
This is a special case of `is_colimit.hom_iso'`, often useful to construct adjunctions.
-/
@[simps]
def cofork.is_colimit.hom_iso {X Y : C} {f g : X ⟶ Y} {t : cofork f g} (ht : is_colimit t) (Z : C) :
  (t.X ⟶ Z) ≃ {h : Y ⟶ Z // f ≫ h = g ≫ h} :=
{ to_fun := λ k, ⟨t.π ≫ k, by simp only [←category.assoc, t.condition]⟩,
  inv_fun := λ h, (cofork.is_colimit.desc' ht _ h.prop).1,
  left_inv := λ k, cofork.is_colimit.hom_ext ht (cofork.is_colimit.desc' _ _ _).prop,
  right_inv := λ h, subtype.ext (cofork.is_colimit.desc' ht _ _).prop }

/-- The bijection of `cofork.is_colimit.hom_iso` is natural in `Z`. -/
lemma cofork.is_colimit.hom_iso_natural {X Y : C} {f g : X ⟶ Y} {t : cofork f g} {Z Z' : C}
  (q : Z ⟶ Z') (ht : is_colimit t) (k : t.X ⟶ Z) :
    (cofork.is_colimit.hom_iso ht _ (k ≫ q) : Y ⟶ Z') =
    (cofork.is_colimit.hom_iso ht _ k : Y ⟶ Z) ≫ q :=
(category.assoc _ _ _).symm

/-- This is a helper construction that can be useful when verifying that a category has all
    equalizers. Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)`, and a fork on `F.map left` and `F.map right`,
    we get a cone on `F`.

    If you're thinking about using this, have a look at `has_equalizers_of_has_limit_parallel_pair`,
    which you may find to be an easier way of achieving your goal. -/
def cone.of_fork
  {F : walking_parallel_pair ⥤ C} (t : fork (F.map left) (F.map right)) : cone F :=
{ X := t.X,
  π :=
  { app := λ X, t.π.app X ≫ eq_to_hom (by tidy),
    naturality' := λ j j' g, by { cases j; cases j'; cases g; dsimp; simp } } }

/-- This is a helper construction that can be useful when verifying that a category has all
    coequalizers. Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)`, and a cofork on `F.map left` and `F.map right`,
    we get a cocone on `F`.

    If you're thinking about using this, have a look at
    `has_coequalizers_of_has_colimit_parallel_pair`, which you may find to be an easier way of
    achieving your goal. -/
def cocone.of_cofork
  {F : walking_parallel_pair ⥤ C} (t : cofork (F.map left) (F.map right)) : cocone F :=
{ X := t.X,
  ι :=
  { app := λ X, eq_to_hom (by tidy) ≫ t.ι.app X,
    naturality' := λ j j' g, by { cases j; cases j'; cases g; dsimp; simp } } }

@[simp] lemma cone.of_fork_π
  {F : walking_parallel_pair ⥤ C} (t : fork (F.map left) (F.map right)) (j) :
  (cone.of_fork t).π.app j = t.π.app j ≫ eq_to_hom (by tidy) := rfl

@[simp] lemma cocone.of_cofork_ι
  {F : walking_parallel_pair ⥤ C} (t : cofork (F.map left) (F.map right)) (j) :
  (cocone.of_cofork t).ι.app j = eq_to_hom (by tidy) ≫ t.ι.app j := rfl

/-- Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)` and a cone on `F`, we get a fork on
    `F.map left` and `F.map right`. -/
def fork.of_cone
  {F : walking_parallel_pair ⥤ C} (t : cone F) : fork (F.map left) (F.map right) :=
{ X := t.X,
  π := { app := λ X, t.π.app X ≫ eq_to_hom (by tidy) } }

/-- Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)` and a cocone on `F`, we get a cofork on
    `F.map left` and `F.map right`. -/
def cofork.of_cocone
  {F : walking_parallel_pair ⥤ C} (t : cocone F) : cofork (F.map left) (F.map right) :=
{ X := t.X,
  ι := { app := λ X, eq_to_hom (by tidy) ≫ t.ι.app X } }

@[simp] lemma fork.of_cone_π {F : walking_parallel_pair ⥤ C} (t : cone F) (j) :
  (fork.of_cone t).π.app j = t.π.app j ≫ eq_to_hom (by tidy) := rfl
@[simp] lemma cofork.of_cocone_ι {F : walking_parallel_pair ⥤ C} (t : cocone F) (j) :
  (cofork.of_cocone t).ι.app j = eq_to_hom (by tidy) ≫ t.ι.app j := rfl

@[simp] lemma fork.ι_postcompose {f' g' : X ⟶ Y} {α : parallel_pair f g ⟶ parallel_pair f' g'}
  {c : fork f g} : fork.ι ((cones.postcompose α).obj c) = c.ι ≫ α.app _ := rfl

@[simp] lemma cofork.π_precompose {f' g' : X ⟶ Y} {α : parallel_pair f g ⟶ parallel_pair f' g'}
  {c : cofork f' g'} : cofork.π ((cocones.precompose α).obj c) = α.app _ ≫ c.π := rfl

/--
Helper function for constructing morphisms between equalizer forks.
-/
@[simps]
def fork.mk_hom {s t : fork f g} (k : s.X ⟶ t.X) (w : k ≫ t.ι = s.ι) : s ⟶ t :=
{ hom := k,
  w' :=
  begin
    rintro ⟨_|_⟩,
    { exact w },
    { simp only [fork.app_one_eq_ι_comp_left, reassoc_of w] },
  end }

/--
To construct an isomorphism between forks,
it suffices to give an isomorphism between the cone points
and check that it commutes with the `ι` morphisms.
-/
@[simps]
def fork.ext {s t : fork f g} (i : s.X ≅ t.X) (w : i.hom ≫ t.ι = s.ι) : s ≅ t :=
{ hom := fork.mk_hom i.hom w,
  inv := fork.mk_hom i.inv (by rw [← w, iso.inv_hom_id_assoc]) }

/-- Every fork is isomorphic to one of the form `fork.of_ι _ _`. -/
def fork.iso_fork_of_ι (c : fork f g) : c ≅ fork.of_ι c.ι c.condition :=
fork.ext (by simp only [fork.of_ι_X, functor.const_obj_obj]) (by simp)

/--
Helper function for constructing morphisms between coequalizer coforks.
-/
@[simps]
def cofork.mk_hom {s t : cofork f g} (k : s.X ⟶ t.X) (w : s.π ≫ k = t.π) : s ⟶ t :=
{ hom := k,
  w' :=
  begin
    rintro ⟨_|_⟩,
    { simp [cofork.app_zero_eq_comp_π_left, w] },
    { exact w }
  end }

@[simp, reassoc] lemma fork.hom_comp_ι {s t : fork f g} (f : s ⟶ t) : f.hom ≫ t.ι = s.ι :=
by tidy

@[simp, reassoc] lemma fork.π_comp_hom {s t : cofork f g} (f : s ⟶ t) : s.π ≫ f.hom = t.π :=
by tidy

/--
To construct an isomorphism between coforks,
it suffices to give an isomorphism between the cocone points
and check that it commutes with the `π` morphisms.
-/
@[simps]
def cofork.ext {s t : cofork f g} (i : s.X ≅ t.X) (w : s.π ≫ i.hom = t.π) : s ≅ t :=
{ hom := cofork.mk_hom i.hom w,
  inv := cofork.mk_hom i.inv (by rw [iso.comp_inv_eq, w]) }

/-- Every cofork is isomorphic to one of the form `cofork.of_π _ _`. -/
def cofork.iso_cofork_of_π (c : cofork f g) : c ≅ cofork.of_π c.π c.condition :=
cofork.ext (by simp only [cofork.of_π_X, functor.const_obj_obj]) (by dsimp; simp)

variables (f g)

section
/--
`has_equalizer f g` represents a particular choice of limiting cone
for the parallel pair of morphisms `f` and `g`.
-/
abbreviation has_equalizer := has_limit (parallel_pair f g)

variables [has_equalizer f g]

/-- If an equalizer of `f` and `g` exists, we can access an arbitrary choice of such by
    saying `equalizer f g`. -/
abbreviation equalizer : C := limit (parallel_pair f g)

/-- If an equalizer of `f` and `g` exists, we can access the inclusion
    `equalizer f g ⟶ X` by saying `equalizer.ι f g`. -/
abbreviation equalizer.ι : equalizer f g ⟶ X :=
limit.π (parallel_pair f g) zero

/--
An equalizer cone for a parallel pair `f` and `g`.
-/
abbreviation equalizer.fork : fork f g := limit.cone (parallel_pair f g)

@[simp] lemma equalizer.fork_ι :
  (equalizer.fork f g).ι = equalizer.ι f g := rfl

@[simp] lemma equalizer.fork_π_app_zero :
  (equalizer.fork f g).π.app zero = equalizer.ι f g := rfl

@[reassoc] lemma equalizer.condition : equalizer.ι f g ≫ f = equalizer.ι f g ≫ g :=
fork.condition $ limit.cone $ parallel_pair f g

/-- The equalizer built from `equalizer.ι f g` is limiting. -/
def equalizer_is_equalizer : is_limit (fork.of_ι (equalizer.ι f g) (equalizer.condition f g)) :=
is_limit.of_iso_limit (limit.is_limit _) (fork.ext (iso.refl _) (by tidy))

variables {f g}

/-- A morphism `k : W ⟶ X` satisfying `k ≫ f = k ≫ g` factors through the equalizer of `f` and `g`
    via `equalizer.lift : W ⟶ equalizer f g`. -/
abbreviation equalizer.lift {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) : W ⟶ equalizer f g :=
limit.lift (parallel_pair f g) (fork.of_ι k h)

@[simp, reassoc]
lemma equalizer.lift_ι {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
  equalizer.lift k h ≫ equalizer.ι f g = k :=
limit.lift_π _ _

/-- A morphism `k : W ⟶ X` satisfying `k ≫ f = k ≫ g` induces a morphism `l : W ⟶ equalizer f g`
    satisfying `l ≫ equalizer.ι f g = k`. -/
def equalizer.lift' {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
  {l : W ⟶ equalizer f g // l ≫ equalizer.ι f g = k} :=
⟨equalizer.lift k h, equalizer.lift_ι _ _⟩

/-- Two maps into an equalizer are equal if they are are equal when composed with the equalizer
    map. -/
@[ext] lemma equalizer.hom_ext {W : C} {k l : W ⟶ equalizer f g}
  (h : k ≫ equalizer.ι f g = l ≫ equalizer.ι f g) : k = l :=
fork.is_limit.hom_ext (limit.is_limit _) h

lemma equalizer.exists_unique {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
  ∃! (l : W ⟶ equalizer f g), l ≫ equalizer.ι f g = k :=
fork.is_limit.exists_unique (limit.is_limit _) _ h

/-- An equalizer morphism is a monomorphism -/
instance equalizer.ι_mono : mono (equalizer.ι f g) :=
{ right_cancellation := λ Z h k w, equalizer.hom_ext w }

end

section
variables {f g}
/-- The equalizer morphism in any limit cone is a monomorphism. -/
lemma mono_of_is_limit_fork {c : fork f g} (i : is_limit c) : mono (fork.ι c) :=
{ right_cancellation := λ Z h k w, fork.is_limit.hom_ext i w }

end

section
variables {f g}

/-- The identity determines a cone on the equalizer diagram of `f` and `g` if `f = g`. -/
def id_fork (h : f = g) : fork f g :=
fork.of_ι (𝟙 X) $ h ▸ rfl

/-- The identity on `X` is an equalizer of `(f, g)`, if `f = g`. -/
def is_limit_id_fork (h : f = g) : is_limit (id_fork h) :=
fork.is_limit.mk _
  (λ s, fork.ι s)
  (λ s, category.comp_id _)
  (λ s m h, by { convert h, exact (category.comp_id _).symm })

/-- Every equalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
lemma is_iso_limit_cone_parallel_pair_of_eq (h₀ : f = g) {c : fork f g}
  (h : is_limit c) : is_iso c.ι :=
is_iso.of_iso $ is_limit.cone_point_unique_up_to_iso h $ is_limit_id_fork h₀

/-- The equalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
lemma equalizer.ι_of_eq [has_equalizer f g] (h : f = g) : is_iso (equalizer.ι f g) :=
is_iso_limit_cone_parallel_pair_of_eq h $ limit.is_limit _

/-- Every equalizer of `(f, f)` is an isomorphism. -/
lemma is_iso_limit_cone_parallel_pair_of_self {c : fork f f} (h : is_limit c) : is_iso c.ι :=
is_iso_limit_cone_parallel_pair_of_eq rfl h

/-- An equalizer that is an epimorphism is an isomorphism. -/
lemma is_iso_limit_cone_parallel_pair_of_epi {c : fork f g}
  (h : is_limit c) [epi (c.ι)] : is_iso c.ι :=
is_iso_limit_cone_parallel_pair_of_eq ((cancel_epi _).1 (fork.condition c)) h

/-- Two morphisms are equal if there is a fork whose inclusion is epi. -/
lemma eq_of_epi_fork_ι (t : fork f g) [epi (fork.ι t)] : f = g :=
(cancel_epi (fork.ι t)).1 $ fork.condition t

/-- If the equalizer of two morphisms is an epimorphism, then the two morphisms are equal. -/
lemma eq_of_epi_equalizer [has_equalizer f g] [epi (equalizer.ι f g)] : f = g :=
(cancel_epi (equalizer.ι f g)).1 $ equalizer.condition _ _

end

instance has_equalizer_of_self : has_equalizer f f :=
has_limit.mk
{ cone := id_fork rfl,
  is_limit := is_limit_id_fork rfl }

/-- The equalizer inclusion for `(f, f)` is an isomorphism. -/
instance equalizer.ι_of_self : is_iso (equalizer.ι f f) :=
equalizer.ι_of_eq rfl

/-- The equalizer of a morphism with itself is isomorphic to the source. -/
def equalizer.iso_source_of_self : equalizer f f ≅ X :=
as_iso (equalizer.ι f f)

@[simp] lemma equalizer.iso_source_of_self_hom :
  (equalizer.iso_source_of_self f).hom = equalizer.ι f f :=
rfl

@[simp] lemma equalizer.iso_source_of_self_inv :
  (equalizer.iso_source_of_self f).inv = equalizer.lift (𝟙 X) (by simp) :=
by { ext, simp [equalizer.iso_source_of_self], }

section
/--
`has_coequalizer f g` represents a particular choice of colimiting cocone
for the parallel pair of morphisms `f` and `g`.
-/
abbreviation has_coequalizer := has_colimit (parallel_pair f g)

variables [has_coequalizer f g]

/-- If a coequalizer of `f` and `g` exists, we can access an arbitrary choice of such by
    saying `coequalizer f g`. -/
abbreviation coequalizer : C := colimit (parallel_pair f g)

/--  If a coequalizer of `f` and `g` exists, we can access the corresponding projection by
    saying `coequalizer.π f g`. -/
abbreviation coequalizer.π : Y ⟶ coequalizer f g :=
colimit.ι (parallel_pair f g) one

/--
An arbitrary choice of coequalizer cocone for a parallel pair `f` and `g`.
-/
abbreviation coequalizer.cofork : cofork f g := colimit.cocone (parallel_pair f g)

@[simp] lemma coequalizer.cofork_π :
  (coequalizer.cofork f g).π = coequalizer.π f g := rfl

@[simp] lemma coequalizer.cofork_ι_app_one :
  (coequalizer.cofork f g).ι.app one = coequalizer.π f g := rfl

@[reassoc] lemma coequalizer.condition : f ≫ coequalizer.π f g = g ≫ coequalizer.π f g :=
cofork.condition $ colimit.cocone $ parallel_pair f g

/-- The cofork built from `coequalizer.π f g` is colimiting. -/
def coequalizer_is_coequalizer :
  is_colimit (cofork.of_π (coequalizer.π f g) (coequalizer.condition f g)) :=
is_colimit.of_iso_colimit (colimit.is_colimit _) (cofork.ext (iso.refl _) (by tidy))

variables {f g}

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = g ≫ k` factors through the coequalizer of `f`
    and `g` via `coequalizer.desc : coequalizer f g ⟶ W`. -/
abbreviation coequalizer.desc {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) : coequalizer f g ⟶ W :=
colimit.desc (parallel_pair f g) (cofork.of_π k h)

@[simp, reassoc]
lemma coequalizer.π_desc {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) :
  coequalizer.π f g ≫ coequalizer.desc k h = k :=
colimit.ι_desc _ _

lemma coequalizer.π_colim_map_desc {X' Y' Z : C} (f' g' : X' ⟶ Y') [has_coequalizer f' g']
  (p : X ⟶ X') (q : Y ⟶ Y') (wf : f ≫ q = p ≫ f') (wg : g ≫ q = p ≫ g')
  (h : Y' ⟶ Z) (wh : f' ≫ h = g' ≫ h) :
  coequalizer.π f g ≫ colim_map (parallel_pair_hom f g f' g' p q wf wg) ≫ coequalizer.desc h wh =
  q ≫ h :=
by rw [ι_colim_map_assoc, parallel_pair_hom_app_one, coequalizer.π_desc]

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = g ≫ k` induces a morphism
    `l : coequalizer f g ⟶ W` satisfying `coequalizer.π ≫ g = l`. -/
def coequalizer.desc' {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) :
  {l : coequalizer f g ⟶ W // coequalizer.π f g ≫ l = k} :=
⟨coequalizer.desc k h, coequalizer.π_desc _ _⟩

/-- Two maps from a coequalizer are equal if they are equal when composed with the coequalizer
    map -/
@[ext] lemma coequalizer.hom_ext {W : C} {k l : coequalizer f g ⟶ W}
  (h : coequalizer.π f g ≫ k = coequalizer.π f g ≫ l) : k = l :=
cofork.is_colimit.hom_ext (colimit.is_colimit _) h

lemma coequalizer.exists_unique {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) :
  ∃! (d : coequalizer f g ⟶ W), coequalizer.π f g ≫ d = k :=
cofork.is_colimit.exists_unique (colimit.is_colimit _) _ h

/-- A coequalizer morphism is an epimorphism -/
instance coequalizer.π_epi : epi (coequalizer.π f g) :=
{ left_cancellation := λ Z h k w, coequalizer.hom_ext w }

end

section
variables {f g}

/-- The coequalizer morphism in any colimit cocone is an epimorphism. -/
lemma epi_of_is_colimit_cofork {c : cofork f g} (i : is_colimit c) : epi c.π :=
{ left_cancellation := λ Z h k w, cofork.is_colimit.hom_ext i w }

end

section
variables {f g}

/-- The identity determines a cocone on the coequalizer diagram of `f` and `g`, if `f = g`. -/
def id_cofork (h : f = g) : cofork f g :=
cofork.of_π (𝟙 Y) $ h ▸ rfl

/-- The identity on `Y` is a coequalizer of `(f, g)`, where `f = g`.  -/
def is_colimit_id_cofork (h : f = g) : is_colimit (id_cofork h) :=
cofork.is_colimit.mk _
  (λ s, cofork.π s)
  (λ s, category.id_comp _)
  (λ s m h, by { convert h, exact (category.id_comp _).symm })

/-- Every coequalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
lemma is_iso_colimit_cocone_parallel_pair_of_eq (h₀ : f = g) {c : cofork f g}  (h : is_colimit c) :
  is_iso c.π :=
is_iso.of_iso $ is_colimit.cocone_point_unique_up_to_iso (is_colimit_id_cofork h₀) h

/-- The coequalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
lemma coequalizer.π_of_eq [has_coequalizer f g] (h : f = g) : is_iso (coequalizer.π f g) :=
is_iso_colimit_cocone_parallel_pair_of_eq h $ colimit.is_colimit _

/-- Every coequalizer of `(f, f)` is an isomorphism. -/
lemma is_iso_colimit_cocone_parallel_pair_of_self {c : cofork f f} (h : is_colimit c) :
  is_iso c.π :=
is_iso_colimit_cocone_parallel_pair_of_eq rfl h

/-- A coequalizer that is a monomorphism is an isomorphism. -/
lemma is_iso_limit_cocone_parallel_pair_of_epi {c : cofork f g}
  (h : is_colimit c) [mono c.π] : is_iso c.π :=
is_iso_colimit_cocone_parallel_pair_of_eq ((cancel_mono _).1 (cofork.condition c)) h

/-- Two morphisms are equal if there is a cofork whose projection is mono. -/
lemma eq_of_mono_cofork_π (t : cofork f g) [mono (cofork.π t)] : f = g :=
(cancel_mono (cofork.π t)).1 $ cofork.condition t

/-- If the coequalizer of two morphisms is a monomorphism, then the two morphisms are equal. -/
lemma eq_of_mono_coequalizer [has_coequalizer f g] [mono (coequalizer.π f g)] : f = g :=
(cancel_mono (coequalizer.π f g)).1 $ coequalizer.condition _ _

end

instance has_coequalizer_of_self : has_coequalizer f f :=
has_colimit.mk
{ cocone := id_cofork rfl,
  is_colimit := is_colimit_id_cofork rfl }

/-- The coequalizer projection for `(f, f)` is an isomorphism. -/
instance coequalizer.π_of_self : is_iso (coequalizer.π f f) :=
coequalizer.π_of_eq rfl

/-- The coequalizer of a morphism with itself is isomorphic to the target. -/
def coequalizer.iso_target_of_self : coequalizer f f ≅ Y :=
(as_iso (coequalizer.π f f)).symm

@[simp] lemma coequalizer.iso_target_of_self_hom :
  (coequalizer.iso_target_of_self f).hom = coequalizer.desc (𝟙 Y) (by simp) :=
by { ext, simp [coequalizer.iso_target_of_self], }

@[simp] lemma coequalizer.iso_target_of_self_inv :
  (coequalizer.iso_target_of_self f).inv = coequalizer.π f f :=
rfl

section comparison

variables {D : Type u₂} [category.{v₂} D] (G : C ⥤ D)

/--
The comparison morphism for the equalizer of `f,g`.
This is an isomorphism iff `G` preserves the equalizer of `f,g`; see
`category_theory/limits/preserves/shapes/equalizers.lean`
-/
def equalizer_comparison [has_equalizer f g] [has_equalizer (G.map f) (G.map g)] :
  G.obj (equalizer f g) ⟶ equalizer (G.map f) (G.map g) :=
equalizer.lift (G.map (equalizer.ι _ _)) (by simp only [←G.map_comp, equalizer.condition])

@[simp, reassoc]
lemma equalizer_comparison_comp_π [has_equalizer f g] [has_equalizer (G.map f) (G.map g)] :
  equalizer_comparison f g G ≫ equalizer.ι (G.map f) (G.map g) = G.map (equalizer.ι f g) :=
equalizer.lift_ι _ _

@[simp, reassoc]
lemma map_lift_equalizer_comparison [has_equalizer f g] [has_equalizer (G.map f) (G.map g)]
  {Z : C} {h : Z ⟶ X} (w : h ≫ f = h ≫ g) :
    G.map (equalizer.lift h w) ≫ equalizer_comparison f g G =
      equalizer.lift (G.map h) (by simp only [←G.map_comp, w]) :=
by { ext, simp [← G.map_comp] }

/-- The comparison morphism for the coequalizer of `f,g`. -/
def coequalizer_comparison [has_coequalizer f g] [has_coequalizer (G.map f) (G.map g)] :
  coequalizer (G.map f) (G.map g) ⟶ G.obj (coequalizer f g) :=
coequalizer.desc (G.map (coequalizer.π _ _)) (by simp only [←G.map_comp, coequalizer.condition])

@[simp, reassoc]
lemma ι_comp_coequalizer_comparison [has_coequalizer f g] [has_coequalizer (G.map f) (G.map g)] :
  coequalizer.π _ _ ≫ coequalizer_comparison f g G = G.map (coequalizer.π _ _) :=
coequalizer.π_desc _ _

@[simp, reassoc]
lemma coequalizer_comparison_map_desc [has_coequalizer f g] [has_coequalizer (G.map f) (G.map g)]
  {Z : C} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h) :
  coequalizer_comparison f g G ≫ G.map (coequalizer.desc h w) =
    coequalizer.desc (G.map h) (by simp only [←G.map_comp, w]) :=
by { ext, simp [← G.map_comp] }

end comparison

variables (C)

/-- `has_equalizers` represents a choice of equalizer for every pair of morphisms -/
abbreviation has_equalizers := has_limits_of_shape walking_parallel_pair C

/-- `has_coequalizers` represents a choice of coequalizer for every pair of morphisms -/
abbreviation has_coequalizers := has_colimits_of_shape walking_parallel_pair C

/-- If `C` has all limits of diagrams `parallel_pair f g`, then it has all equalizers -/
lemma has_equalizers_of_has_limit_parallel_pair
  [Π {X Y : C} {f g : X ⟶ Y}, has_limit (parallel_pair f g)] : has_equalizers C :=
{ has_limit := λ F, has_limit_of_iso (diagram_iso_parallel_pair F).symm }

/-- If `C` has all colimits of diagrams `parallel_pair f g`, then it has all coequalizers -/
lemma has_coequalizers_of_has_colimit_parallel_pair
  [Π {X Y : C} {f g : X ⟶ Y}, has_colimit (parallel_pair f g)] : has_coequalizers C :=
{ has_colimit := λ F, has_colimit_of_iso (diagram_iso_parallel_pair F) }

section
-- In this section we show that a split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.
variables {C} [is_split_mono f]

/--
A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.
Here we build the cone, and show in `is_split_mono_equalizes` that it is a limit cone.
-/
@[simps {rhs_md := semireducible}]
def cone_of_is_split_mono : fork (𝟙 Y) (retraction f ≫ f) :=
fork.of_ι f (by simp)

@[simp] lemma cone_of_is_split_mono_ι : (cone_of_is_split_mono f).ι = f := rfl

/--
A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.
-/
def is_split_mono_equalizes {X Y : C} (f : X ⟶ Y) [is_split_mono f] :
  is_limit (cone_of_is_split_mono f) :=
fork.is_limit.mk' _ $ λ s,
⟨s.ι ≫ retraction f,
 by { dsimp, rw [category.assoc, ←s.condition], apply category.comp_id },
 λ m hm, by simp [←hm]⟩

end

/-- We show that the converse to `is_split_mono_equalizes` is true:
Whenever `f` equalizes `(r ≫ f)` and `(𝟙 Y)`, then `r` is a retraction of `f`. -/
def split_mono_of_equalizer {X Y : C} {f : X ⟶ Y} {r : Y ⟶ X} (hr : f ≫ r ≫ f = f)
  (h : is_limit (fork.of_ι f (hr.trans (category.comp_id _).symm : f ≫ r ≫ f = f ≫ 𝟙 Y))) :
  split_mono f :=
{ retraction := r,
  id' := fork.is_limit.hom_ext h
    ((category.assoc _ _ _).trans $ hr.trans (category.id_comp _).symm) }

variables {C f g}

/-- The fork obtained by postcomposing an equalizer fork with a monomorphism is an equalizer. -/
def is_equalizer_comp_mono {c : fork f g} (i : is_limit c) {Z : C} (h : Y ⟶ Z) [hm : mono h] :
  is_limit (fork.of_ι c.ι (by simp [reassoc_of c.condition]) : fork (f ≫ h) (g ≫ h)) :=
fork.is_limit.mk' _ $ λ s,
  let s' : fork f g := fork.of_ι s.ι (by apply hm.right_cancellation; simp [s.condition]) in
  let l := fork.is_limit.lift' i s'.ι s'.condition in
  ⟨l.1, l.2, λ m hm, by apply fork.is_limit.hom_ext i; rw fork.ι_of_ι at hm; rw hm; exact l.2.symm⟩

variables (C f g)

@[instance]
lemma has_equalizer_comp_mono [has_equalizer f g] {Z : C} (h : Y ⟶ Z) [mono h] :
  has_equalizer (f ≫ h) (g ≫ h) :=
⟨⟨{ cone := _, is_limit := is_equalizer_comp_mono (limit.is_limit _) h }⟩⟩

/-- An equalizer of an idempotent morphism and the identity is split mono. -/
@[simps]
def split_mono_of_idempotent_of_is_limit_fork {X : C} {f : X ⟶ X} (hf : f ≫ f = f)
  {c : fork (𝟙 X) f} (i : is_limit c) : split_mono c.ι :=
{ retraction := i.lift (fork.of_ι f (by simp [hf])),
  id' :=
  begin
    letI := mono_of_is_limit_fork i,
    rw [←cancel_mono_id c.ι, category.assoc, fork.is_limit.lift_ι, fork.ι_of_ι, ←c.condition],
    exact category.comp_id c.ι
  end }

/-- The equalizer of an idempotent morphism and the identity is split mono. -/
def split_mono_of_idempotent_equalizer {X : C} {f : X ⟶ X} (hf : f ≫ f = f)
  [has_equalizer (𝟙 X) f] : split_mono (equalizer.ι (𝟙 X) f) :=
split_mono_of_idempotent_of_is_limit_fork _ hf (limit.is_limit _)

section
-- In this section we show that a split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.
variables {C} [is_split_epi f]

/--
A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.
Here we build the cocone, and show in `is_split_epi_coequalizes` that it is a colimit cocone.
-/
@[simps {rhs_md := semireducible}]
def cocone_of_is_split_epi : cofork (𝟙 X) (f ≫ section_ f) :=
cofork.of_π f (by simp)

@[simp] lemma cocone_of_is_split_epi_π : (cocone_of_is_split_epi f).π = f := rfl

/--
A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.
-/
def is_split_epi_coequalizes {X Y : C} (f : X ⟶ Y) [is_split_epi f] :
  is_colimit (cocone_of_is_split_epi f) :=
cofork.is_colimit.mk' _ $ λ s,
⟨section_ f ≫ s.π,
 by { dsimp, rw [← category.assoc, ← s.condition, category.id_comp] },
 λ m hm, by simp [← hm]⟩

end

/-- We show that the converse to `is_split_epi_equalizes` is true:
Whenever `f` coequalizes `(f ≫ s)` and `(𝟙 X)`, then `s` is a section of `f`. -/
def split_epi_of_coequalizer {X Y : C} {f : X ⟶ Y} {s : Y ⟶ X} (hs : f ≫ s ≫ f = f)
  (h : is_colimit (cofork.of_π f ((category.assoc _ _ _).trans $
    hs.trans (category.id_comp f).symm : (f ≫ s) ≫ f = 𝟙 X ≫ f))) :
  split_epi f :=
{ section_ := s,
  id' := cofork.is_colimit.hom_ext h (hs.trans (category.comp_id _).symm) }

variables {C f g}

/-- The cofork obtained by precomposing a coequalizer cofork with an epimorphism is
a coequalizer. -/
def is_coequalizer_epi_comp {c : cofork f g} (i : is_colimit c) {W : C} (h : W ⟶ X) [hm : epi h] :
  is_colimit (cofork.of_π c.π (by simp) : cofork (h ≫ f) (h ≫ g)) :=
cofork.is_colimit.mk' _ $ λ s,
  let s' : cofork f g := cofork.of_π s.π
    (by apply hm.left_cancellation; simp_rw [←category.assoc, s.condition]) in
  let l := cofork.is_colimit.desc' i s'.π s'.condition in
  ⟨l.1, l.2,
    λ m hm,by apply cofork.is_colimit.hom_ext i; rw cofork.π_of_π at hm; rw hm; exact l.2.symm⟩

lemma has_coequalizer_epi_comp [has_coequalizer f g] {W : C} (h : W ⟶ X) [hm : epi h] :
  has_coequalizer (h ≫ f) (h ≫ g) :=
⟨⟨{ cocone := _, is_colimit := is_coequalizer_epi_comp (colimit.is_colimit _) h }⟩⟩

variables (C f g)

/-- A coequalizer of an idempotent morphism and the identity is split epi. -/
@[simps]
def split_epi_of_idempotent_of_is_colimit_cofork {X : C} {f : X ⟶ X} (hf : f ≫ f = f)
  {c : cofork (𝟙 X) f} (i : is_colimit c) : split_epi c.π :=
{ section_ := i.desc (cofork.of_π f (by simp [hf])),
  id' :=
  begin
    letI := epi_of_is_colimit_cofork i,
    rw [← cancel_epi_id c.π, ← category.assoc, cofork.is_colimit.π_desc,
      cofork.π_of_π, ← c.condition],
    exact category.id_comp _,
  end }

/-- The coequalizer of an idempotent morphism and the identity is split epi. -/
def split_epi_of_idempotent_coequalizer {X : C} {f : X ⟶ X} (hf : f ≫ f = f)
  [has_coequalizer (𝟙 X) f] : split_epi (coequalizer.π (𝟙 X) f) :=
split_epi_of_idempotent_of_is_colimit_cofork _ hf (colimit.is_colimit _)

end category_theory.limits


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

/-
Miscellaneous.
-/

import tactic.localized

variables {α β γ : Type}

namespace omega

lemma fun_mono_2 {p : α → β → γ} {a1 a2 : α} {b1 b2 : β} :
  a1 = a2 → b1 = b2 → (p a1 b1 = p a2 b2) :=
λ h1 h2, by rw [h1, h2]

lemma pred_mono_2' {c : Prop → Prop → Prop} {a1 a2 b1 b2 : Prop} :
  (a1 ↔ a2) → (b1 ↔ b2) → (c a1 b1 ↔ c a2 b2) :=
λ h1 h2, by rw [h1, h2]

/-- Update variable assignment for a specific variable
    and leave everything else unchanged -/
def update (m : nat) (a : α) (v : nat → α) : nat → α
| n := if n = m then a else v n

localized "notation v ` ⟨` m ` ↦ ` a `⟩` := omega.update m a v" in omega

lemma update_eq (m : nat) (a : α) (v : nat → α) : (v ⟨m ↦ a⟩) m = a :=
by simp only [update, if_pos rfl]

lemma update_eq_of_ne {m : nat} {a : α} {v : nat → α} (k : nat) :
  k ≠ m → update m a v k = v k :=
by {intro h1, unfold update, rw if_neg h1}

/-- Assign a new value to the zeroth variable, and push all
    other assignments up by 1 -/
def update_zero (a : α) (v : nat → α) : nat → α
| 0     := a
| (k+1) := v k

open tactic

/-- Intro with a fresh name -/
meta def intro_fresh : tactic unit :=
do n ← mk_fresh_name,
   intro n,
   skip

/-- Revert an expr if it passes the given test -/
meta def revert_cond (t : expr → tactic unit) (x : expr) : tactic unit :=
(t x >> revert x >> skip) <|> skip

/-- Revert all exprs in the context that pass the given test -/
meta def revert_cond_all (t : expr → tactic unit) : tactic unit :=
do hs ← local_context, mmap (revert_cond t) hs, skip

/-- Try applying a tactic to each of the element in a list
    until success, and return the first successful result -/
meta def app_first {α β : Type} (t : α → tactic β) : list α → tactic β
| [] := failed
| (a :: as) := t a <|> app_first as

end omega