/-
Copyright (c) 2020 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Rémy Degenne.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.ess_sup
import Mathlib.measure_theory.l1_space
import Mathlib.analysis.mean_inequalities
import Mathlib.PostPort

universes u_1 u_3 u_2 u_4

namespace Mathlib

/-!
# ℒp space and Lp space

This file describes properties of almost everywhere measurable functions with finite seminorm,
denoted by `snorm f p μ` and defined for `p:ennreal` as `0` if `p=0`, `(∫ ∥f a∥^p ∂μ) ^ (1/p)` for
`0 < p < ∞` and `ess_sup ∥f∥ μ` for `p=∞`.

The Prop-valued `mem_ℒp f p μ` states that a function `f : α → E` has finite seminorm.
The space `Lp α E p μ` is the subtype of elements of `α →ₘ[μ] E` (see ae_eq_fun) such that
`snorm f p μ` is finite. For `1 ≤ p`, `snorm` defines a norm and Lp is a metric space.

TODO: prove that Lp is complete.

## Main definitions

* `snorm' f p μ` : `(∫ ∥f a∥^p ∂μ) ^ (1/p)` for `f : α → F` and `p : ℝ`, where `α` is a  measurable
  space and `F` is a normed group.
* `snorm_ess_sup f μ` : seminorm in `ℒ∞`, equal to the essential supremum `ess_sup ∥f∥ μ`.
* `snorm f p μ` : for `p : ennreal`, seminorm in `ℒp`, equal to `0` for `p=0`, to `snorm' f p μ`
  for `0 < p < ∞` and to `snorm_ess_sup f μ` for `p = ∞`.

* `mem_ℒp f p μ` : property that the function `f` is almost everywhere measurable and has finite
  p-seminorm for measure `μ` (`snorm f p μ < ∞`)
* `Lp E p μ` : elements of `α →ₘ[μ] E` (see ae_eq_fun) such that `snorm f p μ` is finite. Defined
  as an `add_subgroup` of `α →ₘ[μ] E`.

-/

namespace measure_theory

/-- `(∫ ∥f a∥^p ∂μ) ^ (1/p)`, which is a seminorm on the space of measurable functions for which
this quantity is finite -/
def snorm' {α : Type u_1} {F : Type u_3} [measurable_space α] [normed_group F] (f : α → F) (p : ℝ)
    (μ : measure α) : ennreal :=
  (lintegral μ fun (a : α) => ↑(nnnorm (f a)) ^ p) ^ (1 / p)

/-- seminorm for `ℒ∞`, equal to the essential supremum of `∥f∥`. -/
def snorm_ess_sup {α : Type u_1} {F : Type u_3} [measurable_space α] [normed_group F] (f : α → F)
    (μ : measure α) : ennreal :=
  ess_sup (fun (x : α) => ↑(nnnorm (f x))) μ

/-- `ℒp` seminorm, equal to `0` for `p=0`, to `(∫ ∥f a∥^p ∂μ) ^ (1/p)` for `0 < p < ∞` and to
`ess_sup ∥f∥ μ` for `p = ∞`. -/
def snorm {α : Type u_1} {F : Type u_3} [measurable_space α] [normed_group F] (f : α → F)
    (q : ennreal) (μ : measure α) : ennreal :=
  ite (q = 0) 0 (ite (q = ⊤) (snorm_ess_sup f μ) (snorm' f (ennreal.to_real q) μ))

theorem snorm_eq_snorm' {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {q : ennreal} (hq_ne_zero : q ≠ 0) (hq_ne_top : q ≠ ⊤) {f : α → F} :
    snorm f q μ = snorm' f (ennreal.to_real q) μ :=
  sorry

@[simp] theorem snorm_exponent_top {α : Type u_1} {F : Type u_3} [measurable_space α]
    {μ : measure α} [normed_group F] {f : α → F} : snorm f ⊤ μ = snorm_ess_sup f μ :=
  sorry

/-- The property that `f:α→E` is ae_measurable and `(∫ ∥f a∥^p ∂μ)^(1/p)` is finite -/
def mem_ℒp {α : Type u_1} {E : Type u_2} [measurable_space α] [measurable_space E] [normed_group E]
    (f : α → E) (p : ennreal) (μ : measure α) :=
  ae_measurable f ∧ snorm f p μ < ⊤

theorem lintegral_rpow_nnnorm_eq_rpow_snorm' {α : Type u_1} {F : Type u_3} [measurable_space α]
    {μ : measure α} [normed_group F] {p : ℝ} {f : α → F} (hp0_lt : 0 < p) :
    (lintegral μ fun (a : α) => ↑(nnnorm (f a)) ^ p) = snorm' f p μ ^ p :=
  sorry

theorem mem_ℒp_one_iff_integrable {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {f : α → E} : mem_ℒp f 1 μ ↔ integrable f :=
  sorry

theorem mem_ℒp.snorm_lt_top {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} {f : α → E} (hfp : mem_ℒp f q μ) :
    snorm f q μ < ⊤ :=
  and.right hfp

theorem mem_ℒp.snorm_ne_top {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} {f : α → E} (hfp : mem_ℒp f q μ) :
    snorm f q μ ≠ ⊤ :=
  ne_of_lt (and.right hfp)

theorem lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top {α : Type u_1} {F : Type u_3}
    [measurable_space α] {μ : measure α} [normed_group F] {p : ℝ} {f : α → F} (hp0_lt : 0 < p)
    (hfp : snorm' f p μ < ⊤) : (lintegral μ fun (a : α) => ↑(nnnorm (f a)) ^ p) < ⊤ :=
  sorry

@[simp] theorem snorm'_exponent_zero {α : Type u_1} {F : Type u_3} [measurable_space α]
    {μ : measure α} [normed_group F] {f : α → F} : snorm' f 0 μ = 1 :=
  sorry

@[simp] theorem snorm_exponent_zero {α : Type u_1} {F : Type u_3} [measurable_space α]
    {μ : measure α} [normed_group F] {f : α → F} : snorm f 0 μ = 0 :=
  sorry

theorem mem_ℒp_zero_iff_ae_measurable {α : Type u_1} {E : Type u_2} [measurable_space α]
    {μ : measure α} [measurable_space E] [normed_group E] {f : α → E} :
    mem_ℒp f 0 μ ↔ ae_measurable f :=
  sorry

@[simp] theorem snorm'_zero {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} (hp0_lt : 0 < p) : snorm' 0 p μ = 0 :=
  sorry

@[simp] theorem snorm'_zero' {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} (hp0_ne : p ≠ 0) (hμ : μ ≠ 0) : snorm' 0 p μ = 0 :=
  sorry

@[simp] theorem snorm_ess_sup_zero {α : Type u_1} {F : Type u_3} [measurable_space α]
    {μ : measure α} [normed_group F] : snorm_ess_sup 0 μ = 0 :=
  sorry

@[simp] theorem snorm_zero {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {q : ennreal} : snorm 0 q μ = 0 :=
  sorry

theorem zero_mem_ℒp {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} : mem_ℒp 0 q μ :=
  { left := measurable.ae_measurable measurable_zero,
    right := eq.mpr (id (Eq._oldrec (Eq.refl (snorm 0 q μ < ⊤)) snorm_zero)) ennreal.coe_lt_top }

theorem snorm'_measure_zero_of_pos {α : Type u_1} {F : Type u_3} [measurable_space α]
    [normed_group F] {p : ℝ} {f : α → F} (hp_pos : 0 < p) : snorm' f p 0 = 0 :=
  sorry

theorem snorm'_measure_zero_of_exponent_zero {α : Type u_1} {F : Type u_3} [measurable_space α]
    [normed_group F] {f : α → F} : snorm' f 0 0 = 1 :=
  sorry

theorem snorm'_measure_zero_of_neg {α : Type u_1} {F : Type u_3} [measurable_space α]
    [normed_group F] {p : ℝ} {f : α → F} (hp_neg : p < 0) : snorm' f p 0 = ⊤ :=
  sorry

@[simp] theorem snorm_ess_sup_measure_zero {α : Type u_1} {F : Type u_3} [measurable_space α]
    [normed_group F] {f : α → F} : snorm_ess_sup f 0 = 0 :=
  sorry

@[simp] theorem snorm_measure_zero {α : Type u_1} {F : Type u_3} [measurable_space α]
    [normed_group F] {q : ennreal} {f : α → F} : snorm f q 0 = 0 :=
  sorry

theorem snorm'_const {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} (c : F) (hp_pos : 0 < p) :
    snorm' (fun (x : α) => c) p μ = ↑(nnnorm c) * coe_fn μ set.univ ^ (1 / p) :=
  sorry

theorem snorm'_const' {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} [finite_measure μ] (c : F) (hc_ne_zero : c ≠ 0) (hp_ne_zero : p ≠ 0) :
    snorm' (fun (x : α) => c) p μ = ↑(nnnorm c) * coe_fn μ set.univ ^ (1 / p) :=
  sorry

theorem snorm_ess_sup_const {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] (c : F) (hμ : μ ≠ 0) : snorm_ess_sup (fun (x : α) => c) μ = ↑(nnnorm c) :=
  sorry

theorem snorm'_const_of_probability_measure {α : Type u_1} {F : Type u_3} [measurable_space α]
    {μ : measure α} [normed_group F] {p : ℝ} (c : F) (hp_pos : 0 < p) [probability_measure μ] :
    snorm' (fun (x : α) => c) p μ = ↑(nnnorm c) :=
  sorry

theorem snorm_const {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {q : ennreal} (c : F) (h0 : q ≠ 0) (hμ : μ ≠ 0) :
    snorm (fun (x : α) => c) q μ = ↑(nnnorm c) * coe_fn μ set.univ ^ (1 / ennreal.to_real q) :=
  sorry

theorem snorm_const' {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {q : ennreal} (c : F) (h0 : q ≠ 0) (h_top : q ≠ ⊤) :
    snorm (fun (x : α) => c) q μ = ↑(nnnorm c) * coe_fn μ set.univ ^ (1 / ennreal.to_real q) :=
  sorry

theorem mem_ℒp_const {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} (c : E) [finite_measure μ] :
    mem_ℒp (fun (a : α) => c) q μ :=
  sorry

theorem snorm'_congr_ae {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} {f : α → F} {g : α → F}
    (hfg : filter.eventually_eq (measure.ae μ) f g) : snorm' f p μ = snorm' g p μ :=
  sorry

theorem snorm_ess_sup_congr_ae {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {f : α → F} {g : α → F} (hfg : filter.eventually_eq (measure.ae μ) f g) :
    snorm_ess_sup f μ = snorm_ess_sup g μ :=
  sorry

theorem snorm_congr_ae {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {q : ennreal} {f : α → F} {g : α → F}
    (hfg : filter.eventually_eq (measure.ae μ) f g) : snorm f q μ = snorm g q μ :=
  sorry

theorem mem_ℒp.ae_eq {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} {f : α → E} {g : α → E}
    (hfg : filter.eventually_eq (measure.ae μ) f g) (hf_Lp : mem_ℒp f q μ) : mem_ℒp g q μ :=
  sorry

theorem mem_ℒp_congr_ae {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} {f : α → E} {g : α → E}
    (hfg : filter.eventually_eq (measure.ae μ) f g) : mem_ℒp f q μ ↔ mem_ℒp g q μ :=
  { mp := fun (h : mem_ℒp f q μ) => mem_ℒp.ae_eq hfg h,
    mpr := fun (h : mem_ℒp g q μ) => mem_ℒp.ae_eq (filter.eventually_eq.symm hfg) h }

theorem snorm'_eq_zero_of_ae_zero {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} {f : α → F} (hp0_lt : 0 < p)
    (hf_zero : filter.eventually_eq (measure.ae μ) f 0) : snorm' f p μ = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (snorm' f p μ = 0)) (snorm'_congr_ae hf_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (snorm' 0 p μ = 0)) (snorm'_zero hp0_lt))) (Eq.refl 0))

theorem snorm'_eq_zero_of_ae_zero' {α : Type u_1} {F : Type u_3} [measurable_space α]
    {μ : measure α} [normed_group F] {p : ℝ} (hp0_ne : p ≠ 0) (hμ : μ ≠ 0) {f : α → F}
    (hf_zero : filter.eventually_eq (measure.ae μ) f 0) : snorm' f p μ = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (snorm' f p μ = 0)) (snorm'_congr_ae hf_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (snorm' 0 p μ = 0)) (snorm'_zero' hp0_ne hμ))) (Eq.refl 0))

theorem ae_eq_zero_of_snorm'_eq_zero {α : Type u_1} {E : Type u_2} [measurable_space α]
    {μ : measure α} [measurable_space E] [normed_group E] {p : ℝ} [opens_measurable_space E]
    {f : α → E} (hp0 : 0 ≤ p) (hf : ae_measurable f) (h : snorm' f p μ = 0) :
    filter.eventually_eq (measure.ae μ) f 0 :=
  sorry

theorem snorm'_eq_zero_iff {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {p : ℝ} [opens_measurable_space E] (hp0_lt : 0 < p)
    {f : α → E} (hf : ae_measurable f) :
    snorm' f p μ = 0 ↔ filter.eventually_eq (measure.ae μ) f 0 :=
  { mp := ae_eq_zero_of_snorm'_eq_zero (le_of_lt hp0_lt) hf,
    mpr := snorm'_eq_zero_of_ae_zero hp0_lt }

theorem coe_nnnorm_ae_le_snorm_ess_sup {α : Type u_1} {F : Type u_3} [measurable_space α]
    [normed_group F] (f : α → F) (μ : measure α) :
    filter.eventually (fun (x : α) => ↑(nnnorm (f x)) ≤ snorm_ess_sup f μ) (measure.ae μ) :=
  ennreal.ae_le_ess_sup fun (x : α) => ↑(nnnorm (f x))

theorem snorm_ess_sup_eq_zero_iff {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {f : α → F} :
    snorm_ess_sup f μ = 0 ↔ filter.eventually_eq (measure.ae μ) f 0 :=
  sorry

theorem snorm_eq_zero_iff {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} [opens_measurable_space E] {f : α → E}
    (hf : ae_measurable f) (h0 : q ≠ 0) :
    snorm f q μ = 0 ↔ filter.eventually_eq (measure.ae μ) f 0 :=
  sorry

@[simp] theorem snorm'_neg {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} {f : α → F} : snorm' (-f) p μ = snorm' f p μ :=
  sorry

@[simp] theorem snorm_neg {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {q : ennreal} {f : α → F} : snorm (-f) q μ = snorm f q μ :=
  sorry

theorem mem_ℒp.neg {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} [borel_space E] {f : α → E}
    (hf : mem_ℒp f q μ) : mem_ℒp (-f) q μ :=
  sorry

theorem snorm'_le_snorm'_mul_rpow_measure_univ {α : Type u_1} {E : Type u_2} [measurable_space α]
    {μ : measure α} [measurable_space E] [normed_group E] [borel_space E] {p : ℝ} {q : ℝ}
    (hp0_lt : 0 < p) (hpq : p ≤ q) {f : α → E} (hf : ae_measurable f) :
    snorm' f p μ ≤ snorm' f q μ * coe_fn μ set.univ ^ (1 / p - 1 / q) :=
  sorry

theorem snorm'_le_snorm_ess_sup_mul_rpow_measure_univ {α : Type u_1} {F : Type u_3}
    [measurable_space α] {μ : measure α} [normed_group F] {p : ℝ} (hp_pos : 0 < p) {f : α → F} :
    snorm' f p μ ≤ snorm_ess_sup f μ * coe_fn μ set.univ ^ (1 / p) :=
  sorry

theorem snorm'_le_snorm'_of_exponent_le {α : Type u_1} {E : Type u_2} [measurable_space α]
    [measurable_space E] [normed_group E] [borel_space E] {p : ℝ} {q : ℝ} (hp0_lt : 0 < p)
    (hpq : p ≤ q) (μ : measure α) [probability_measure μ] {f : α → E} (hf : ae_measurable f) :
    snorm' f p μ ≤ snorm' f q μ :=
  sorry

theorem snorm'_le_snorm_ess_sup {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} (hp_pos : 0 < p) {f : α → F} [probability_measure μ] :
    snorm' f p μ ≤ snorm_ess_sup f μ :=
  sorry

theorem snorm_le_snorm_of_exponent_le {α : Type u_1} {E : Type u_2} [measurable_space α]
    {μ : measure α} [measurable_space E] [normed_group E] [borel_space E] {p : ennreal}
    {q : ennreal} (hpq : p ≤ q) [probability_measure μ] {f : α → E} (hf : ae_measurable f) :
    snorm f p μ ≤ snorm f q μ :=
  sorry

theorem snorm'_lt_top_of_snorm'_lt_top_of_exponent_le {α : Type u_1} {E : Type u_2}
    [measurable_space α] {μ : measure α} [measurable_space E] [normed_group E] [borel_space E]
    {p : ℝ} {q : ℝ} [finite_measure μ] {f : α → E} (hf : ae_measurable f)
    (hfq_lt_top : snorm' f q μ < ⊤) (hp_nonneg : 0 ≤ p) (hpq : p ≤ q) : snorm' f p μ < ⊤ :=
  sorry

theorem mem_ℒp.mem_ℒp_of_exponent_le {α : Type u_1} {E : Type u_2} [measurable_space α]
    {μ : measure α} [measurable_space E] [normed_group E] [borel_space E] {p : ennreal}
    {q : ennreal} [finite_measure μ] {f : α → E} (hfq : mem_ℒp f q μ) (hpq : p ≤ q) :
    mem_ℒp f p μ :=
  sorry

theorem mem_ℒp.integrable {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} [borel_space E] (hq1 : 1 ≤ q) {f : α → E}
    [finite_measure μ] (hfq : mem_ℒp f q μ) : integrable f :=
  iff.mp mem_ℒp_one_iff_integrable (mem_ℒp.mem_ℒp_of_exponent_le hfq hq1)

theorem snorm'_add_le {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {p : ℝ} [borel_space E] {f : α → E} {g : α → E}
    (hf : ae_measurable f) (hg : ae_measurable g) (hp1 : 1 ≤ p) :
    snorm' (f + g) p μ ≤ snorm' f p μ + snorm' g p μ :=
  sorry

theorem snorm_ess_sup_add_le {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {f : α → F} {g : α → F} :
    snorm_ess_sup (f + g) μ ≤ snorm_ess_sup f μ + snorm_ess_sup g μ :=
  sorry

theorem snorm_add_le {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} [borel_space E] {f : α → E} {g : α → E}
    (hf : ae_measurable f) (hg : ae_measurable g) (hq1 : 1 ≤ q) :
    snorm (f + g) q μ ≤ snorm f q μ + snorm g q μ :=
  sorry

theorem snorm_add_lt_top_of_one_le {α : Type u_1} {E : Type u_2} [measurable_space α]
    {μ : measure α} [measurable_space E] [normed_group E] {q : ennreal} [borel_space E] {f : α → E}
    {g : α → E} (hf : mem_ℒp f q μ) (hg : mem_ℒp g q μ) (hq1 : 1 ≤ q) : snorm (f + g) q μ < ⊤ :=
  lt_of_le_of_lt (snorm_add_le (and.left hf) (and.left hg) hq1)
    (iff.mpr ennreal.add_lt_top { left := and.right hf, right := and.right hg })

theorem snorm'_add_lt_top_of_le_one {α : Type u_1} {E : Type u_2} [measurable_space α]
    {μ : measure α} [measurable_space E] [normed_group E] {p : ℝ} [borel_space E] {f : α → E}
    {g : α → E} (hf : ae_measurable f) (hg : ae_measurable g) (hf_snorm : snorm' f p μ < ⊤)
    (hg_snorm : snorm' g p μ < ⊤) (hp_pos : 0 < p) (hp1 : p ≤ 1) : snorm' (f + g) p μ < ⊤ :=
  sorry

theorem snorm_add_lt_top {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} [borel_space E] {f : α → E} {g : α → E}
    (hf : mem_ℒp f q μ) (hg : mem_ℒp g q μ) : snorm (f + g) q μ < ⊤ :=
  sorry

theorem mem_ℒp.add {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} [borel_space E]
    [topological_space.second_countable_topology E] {f : α → E} {g : α → E} (hf : mem_ℒp f q μ)
    (hg : mem_ℒp g q μ) : mem_ℒp (f + g) q μ :=
  { left := ae_measurable.add (and.left hf) (and.left hg), right := snorm_add_lt_top hf hg }

theorem mem_ℒp.sub {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} [borel_space E]
    [topological_space.second_countable_topology E] {f : α → E} {g : α → E} (hf : mem_ℒp f q μ)
    (hg : mem_ℒp g q μ) : mem_ℒp (f - g) q μ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (mem_ℒp (f - g) q μ)) (sub_eq_add_neg f g)))
    (mem_ℒp.add hf (mem_ℒp.neg hg))

theorem snorm'_const_smul {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {p : ℝ} {𝕜 : Type u_4} [normed_field 𝕜] [normed_space 𝕜 F] {f : α → F} (c : 𝕜)
    (hp0_lt : 0 < p) : snorm' (c • f) p μ = ↑(nnnorm c) * snorm' f p μ :=
  sorry

theorem snorm_ess_sup_const_smul {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {𝕜 : Type u_4} [normed_field 𝕜] [normed_space 𝕜 F] {f : α → F} (c : 𝕜) :
    snorm_ess_sup (c • f) μ = ↑(nnnorm c) * snorm_ess_sup f μ :=
  sorry

theorem snorm_const_smul {α : Type u_1} {F : Type u_3} [measurable_space α] {μ : measure α}
    [normed_group F] {q : ennreal} {𝕜 : Type u_4} [normed_field 𝕜] [normed_space 𝕜 F] {f : α → F}
    (c : 𝕜) : snorm (c • f) q μ = ↑(nnnorm c) * snorm f q μ :=
  sorry

theorem mem_ℒp.const_smul {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {q : ennreal} {𝕜 : Type u_4} [normed_field 𝕜]
    [normed_space 𝕜 E] [borel_space E] {f : α → E} (hf : mem_ℒp f q μ) (c : 𝕜) :
    mem_ℒp (c • f) q μ :=
  { left := ae_measurable.const_smul (and.left hf) c,
    right :=
      lt_of_le_of_lt (le_of_eq (snorm_const_smul c))
        (ennreal.mul_lt_top ennreal.coe_lt_top (and.right hf)) }

theorem snorm'_smul_le_mul_snorm' {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {p : ℝ} {𝕜 : Type u_4} [normed_field 𝕜] [normed_space 𝕜 E]
    [opens_measurable_space E] [measurable_space 𝕜] [opens_measurable_space 𝕜] {q : ℝ} {r : ℝ}
    {f : α → E} (hf : ae_measurable f) {φ : α → 𝕜} (hφ : ae_measurable φ) (hp0_lt : 0 < p)
    (hpq : p < q) (hpqr : 1 / p = 1 / q + 1 / r) :
    snorm' (φ • f) p μ ≤ snorm' φ q μ * snorm' f r μ :=
  sorry

/-! ### Lp space

The space of equivalence classes of measurable functions for which `snorm f p μ < ⊤`.
-/

@[simp] theorem snorm_ae_eq_fun {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {p : ennreal} {f : α → E} (hf : ae_measurable f) :
    snorm (⇑(ae_eq_fun.mk f hf)) p μ = snorm f p μ :=
  snorm_congr_ae (ae_eq_fun.coe_fn_mk f hf)

theorem mem_ℒp.snorm_mk_lt_top {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] {p : ennreal} {f : α → E} (hfp : mem_ℒp f p μ) :
    snorm (⇑(ae_eq_fun.mk f (and.left hfp))) p μ < ⊤ :=
  sorry

/-- Lp space -/
def Lp {α : Type u_1} (E : Type u_2) [measurable_space α] [measurable_space E] [normed_group E]
    [borel_space E] [topological_space.second_countable_topology E] (p : ennreal) (μ : measure α) :
    add_subgroup (ae_eq_fun α E μ) :=
  add_subgroup.mk (set_of fun (f : ae_eq_fun α E μ) => snorm (⇑f) p μ < ⊤) sorry sorry sorry

/-- make an element of Lp from a function verifying `mem_ℒp` -/
def mem_ℒp.to_Lp {α : Type u_1} {E : Type u_2} [measurable_space α] [measurable_space E]
    [normed_group E] [borel_space E] [topological_space.second_countable_topology E] (f : α → E)
    {p : ennreal} {μ : measure α} (h_mem_ℒp : mem_ℒp f p μ) : ↥(Lp E p μ) :=
  { val := ae_eq_fun.mk f sorry, property := mem_ℒp.snorm_mk_lt_top h_mem_ℒp }

theorem mem_ℒp.coe_fn_to_Lp {α : Type u_1} {E : Type u_2} [measurable_space α] [measurable_space E]
    [normed_group E] [borel_space E] [topological_space.second_countable_topology E] {μ : measure α}
    {p : ennreal} {f : α → E} (hf : mem_ℒp f p μ) :
    filter.eventually_eq (measure.ae μ) (⇑(mem_ℒp.to_Lp f hf)) f :=
  ae_eq_fun.coe_fn_mk f (mem_ℒp.to_Lp._proof_1 f hf)

namespace Lp

theorem mem_Lp_iff_snorm_lt_top {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {f : ae_eq_fun α E μ} :
    f ∈ Lp E p μ ↔ snorm (⇑f) p μ < ⊤ :=
  iff.refl (f ∈ Lp E p μ)

theorem antimono {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] [finite_measure μ] {p : ennreal} {q : ennreal}
    (hpq : p ≤ q) : Lp E q μ ≤ Lp E p μ :=
  fun (f : ae_eq_fun α E μ) (hf : f ∈ Lp E q μ) =>
    and.right (mem_ℒp.mem_ℒp_of_exponent_le { left := ae_eq_fun.ae_measurable f, right := hf } hpq)

theorem coe_fn_mk {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {f : ae_eq_fun α E μ}
    (hf : snorm (⇑f) p μ < ⊤) :
    filter.eventually_eq (measure.ae μ) ⇑{ val := f, property := hf } ⇑f :=
  sorry

theorem snorm_lt_top {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} (f : ↥(Lp E p μ)) :
    snorm (⇑f) p μ < ⊤ :=
  subtype.prop f

theorem snorm_ne_top {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} (f : ↥(Lp E p μ)) :
    snorm (⇑f) p μ ≠ ⊤ :=
  has_lt.lt.ne (snorm_lt_top f)

theorem measurable {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} (f : ↥(Lp E p μ)) :
    measurable ⇑f :=
  ae_eq_fun.measurable (subtype.val f)

theorem ae_measurable {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} (f : ↥(Lp E p μ)) :
    ae_measurable ⇑f :=
  ae_eq_fun.ae_measurable (subtype.val f)

theorem mem_ℒp {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} (f : ↥(Lp E p μ)) :
    mem_ℒp (⇑f) p μ :=
  { left := ae_measurable f, right := subtype.prop f }

theorem coe_fn_zero {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} :
    filter.eventually_eq (measure.ae μ) (⇑0) 0 :=
  ae_eq_fun.coe_fn_zero

theorem coe_fn_neg {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {f : ↥(Lp E p μ)} :
    filter.eventually_eq (measure.ae μ) (⇑(-f)) (-⇑f) :=
  ae_eq_fun.coe_fn_neg ↑f

theorem coe_fn_add {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {f : ↥(Lp E p μ)}
    {g : ↥(Lp E p μ)} : filter.eventually_eq (measure.ae μ) (⇑(f + g)) (⇑f + ⇑g) :=
  ae_eq_fun.coe_fn_add (subtype.val f) (subtype.val g)

theorem coe_fn_sub {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {f : ↥(Lp E p μ)}
    {g : ↥(Lp E p μ)} : filter.eventually_eq (measure.ae μ) (⇑(f - g)) (⇑f - ⇑g) :=
  ae_eq_fun.coe_fn_sub ↑f ↑g

theorem mem_Lp_const {E : Type u_2} [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} (α : Type u_1)
    [measurable_space α] (μ : measure α) (c : E) [finite_measure μ] :
    ae_eq_fun.const α c ∈ Lp E p μ :=
  mem_ℒp.snorm_mk_lt_top (mem_ℒp_const c)

protected instance has_norm {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} : has_norm ↥(Lp E p μ) :=
  has_norm.mk fun (f : ↥(Lp E p μ)) => ennreal.to_real (snorm (⇑f) p μ)

theorem norm_def {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} (f : ↥(Lp E p μ)) :
    norm f = ennreal.to_real (snorm (⇑f) p μ) :=
  rfl

@[simp] theorem norm_zero {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} : norm 0 = 0 :=
  sorry

theorem norm_eq_zero_iff {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {f : ↥(Lp E p μ)} (hp : 0 < p) :
    norm f = 0 ↔ f = 0 :=
  sorry

@[simp] theorem norm_neg {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {f : ↥(Lp E p μ)} :
    norm (-f) = norm f :=
  sorry

protected instance normed_group {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} [hp : fact (1 ≤ p)] :
    normed_group ↥(Lp E p μ) :=
  normed_group.of_core ↥(Lp E p μ) sorry

theorem mem_Lp_const_smul {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {𝕜 : Type u_4} [normed_field 𝕜]
    [normed_space 𝕜 E] (c : 𝕜) (f : ↥(Lp E p μ)) : c • ↑f ∈ Lp E p μ :=
  sorry

protected instance has_scalar {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {𝕜 : Type u_4} [normed_field 𝕜]
    [normed_space 𝕜 E] : has_scalar 𝕜 ↥(Lp E p μ) :=
  has_scalar.mk
    fun (c : 𝕜) (f : ↥(Lp E p μ)) => { val := c • ↑f, property := mem_Lp_const_smul c f }

theorem coe_fn_smul {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {𝕜 : Type u_4} [normed_field 𝕜]
    [normed_space 𝕜 E] {f : ↥(Lp E p μ)} {c : 𝕜} :
    filter.eventually_eq (measure.ae μ) (⇑(c • f)) (c • ⇑f) :=
  ae_eq_fun.coe_fn_smul c ↑f

protected instance semimodule {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {𝕜 : Type u_4} [normed_field 𝕜]
    [normed_space 𝕜 E] : semimodule 𝕜 ↥(Lp E p μ) :=
  semimodule.mk sorry sorry

theorem norm_const_smul {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {𝕜 : Type u_4} [normed_field 𝕜]
    [normed_space 𝕜 E] (c : 𝕜) (f : ↥(Lp E p μ)) : norm (c • f) = norm c * norm f :=
  sorry

protected instance normed_space {α : Type u_1} {E : Type u_2} [measurable_space α] {μ : measure α}
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {p : ennreal} {𝕜 : Type u_4} [normed_field 𝕜]
    [normed_space 𝕜 E] [fact (1 ≤ p)] : normed_space 𝕜 ↥(Lp E p μ) :=
  normed_space.mk sorry

end Mathlib


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

! This file was ported from Lean 3 source module category_theory.limits.preserves.shapes.zero
! leanprover-community/mathlib commit bbe25d4d92565a5fd773e52e041a90387eee3c93
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Preserves.Shapes.Terminal
import Mathlib.CategoryTheory.Limits.Shapes.ZeroMorphisms

/-!
# Preservation of zero objects and zero morphisms

We define the class `PreservesZeroMorphisms` and show basic properties.

## Main results

We provide the following results:
* Left adjoints and right adjoints preserve zero morphisms;
* full functors preserve zero morphisms;
* if both categories involved have a zero object, then a functor preserves zero morphisms if and
  only if it preserves the zero object;
* functors which preserve initial or terminal objects preserve zero morphisms.

-/

universe v₁ v₂ u₁ u₂

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory.Functor

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D]

section ZeroMorphisms

variable [HasZeroMorphisms C] [HasZeroMorphisms D]

/-- A functor preserves zero morphisms if it sends zero morphisms to zero morphisms. -/
class PreservesZeroMorphisms (F : C ⥤ D) : Prop where
  /-- For any pair objects `F (0: X ⟶  Y) = (0 : F X ⟶  F Y)` -/
  map_zero : ∀ X Y : C, F.map (0 : X ⟶ Y) = 0 := by aesop
#align category_theory.functor.preserves_zero_morphisms CategoryTheory.Functor.PreservesZeroMorphisms

@[simp]
protected theorem map_zero (F : C ⥤ D) [PreservesZeroMorphisms F] (X Y : C) :
    F.map (0 : X ⟶ Y) = 0 :=
  PreservesZeroMorphisms.map_zero _ _
#align category_theory.functor.map_zero CategoryTheory.Functor.map_zero

theorem zero_of_map_zero (F : C ⥤ D) [PreservesZeroMorphisms F] [Faithful F] {X Y : C} (f : X ⟶ Y)
    (h : F.map f = 0) : f = 0 :=
  F.map_injective <| h.trans <| Eq.symm <| F.map_zero _ _
#align category_theory.functor.zero_of_map_zero CategoryTheory.Functor.zero_of_map_zero

theorem map_eq_zero_iff (F : C ⥤ D) [PreservesZeroMorphisms F] [Faithful F] {X Y : C} {f : X ⟶ Y} :
    F.map f = 0 ↔ f = 0 :=
  ⟨F.zero_of_map_zero _, by
    rintro rfl
    exact F.map_zero _ _⟩
#align category_theory.functor.map_eq_zero_iff CategoryTheory.Functor.map_eq_zero_iff

instance (priority := 100) preservesZeroMorphisms_of_isLeftAdjoint (F : C ⥤ D) [IsLeftAdjoint F] :
    PreservesZeroMorphisms F where
  map_zero X Y := by
    let adj := Adjunction.ofLeftAdjoint F
    dsimp
    calc
      F.map (0 : X ⟶ Y) = F.map 0 ≫ F.map (adj.unit.app Y) ≫ adj.counit.app (F.obj Y) := ?_
      _ = F.map 0 ≫ F.map ((rightAdjoint F).map (0 : F.obj X ⟶ _)) ≫ adj.counit.app (F.obj Y) := ?_
      _ = 0 := ?_
    · rw [Adjunction.left_triangle_components]
      exact (Category.comp_id _).symm
    · simp only [← Category.assoc, ← F.map_comp, zero_comp]
    · simp only [Adjunction.counit_naturality, comp_zero]
#align category_theory.functor.preserves_zero_morphisms_of_is_left_adjoint CategoryTheory.Functor.preservesZeroMorphisms_of_isLeftAdjoint

instance (priority := 100) preservesZeroMorphisms_of_isRightAdjoint (G : C ⥤ D) [IsRightAdjoint G] :
    PreservesZeroMorphisms G where
  map_zero X Y := by
    let adj := Adjunction.ofRightAdjoint G
    calc
      G.map (0 : X ⟶ Y) = adj.unit.app (G.obj X) ≫ G.map (adj.counit.app X) ≫ G.map 0 := ?_
      _ = adj.unit.app (G.obj X) ≫ G.map ((leftAdjoint G).map (0 : _ ⟶ G.obj X)) ≫ G.map 0 := ?_
      _ = 0 := ?_
    · rw [Adjunction.right_triangle_components_assoc]; simp only [id_obj,Category.id_comp]
    · simp only [← G.map_comp, comp_zero]
    · simp only [Adjunction.unit_naturality_assoc, zero_comp]
#align category_theory.functor.preserves_zero_morphisms_of_is_right_adjoint CategoryTheory.Functor.preservesZeroMorphisms_of_isRightAdjoint

instance (priority := 100) preservesZeroMorphisms_of_full (F : C ⥤ D) [Full F] :
    PreservesZeroMorphisms F where
  map_zero X Y :=
    calc
      F.map (0 : X ⟶ Y) = F.map (0 ≫ F.preimage (0 : F.obj Y ⟶ F.obj Y)) := by rw [zero_comp]
      _ = 0 := by rw [F.map_comp, F.image_preimage, comp_zero]
#align category_theory.functor.preserves_zero_morphisms_of_full CategoryTheory.Functor.preservesZeroMorphisms_of_full

end ZeroMorphisms

section ZeroObject

variable [HasZeroObject C] [HasZeroObject D]

open ZeroObject

variable [HasZeroMorphisms C] [HasZeroMorphisms D] (F : C ⥤ D)

/-- A functor that preserves zero morphisms also preserves the zero object. -/
@[simps]
def mapZeroObject [PreservesZeroMorphisms F] : F.obj 0 ≅ 0 where
  hom := 0
  inv := 0
  hom_inv_id := by rw [← F.map_id, id_zero, F.map_zero, zero_comp]
  inv_hom_id := by rw [id_zero, comp_zero]
#align category_theory.functor.map_zero_object CategoryTheory.Functor.mapZeroObject

variable {F}

theorem preservesZeroMorphisms_of_map_zero_object (i : F.obj 0 ≅ 0) : PreservesZeroMorphisms F where
  map_zero X Y :=
    calc
      F.map (0 : X ⟶ Y) = F.map (0 : X ⟶ 0) ≫ F.map 0 := by rw [← Functor.map_comp, comp_zero]
      _ = F.map 0 ≫ (i.hom ≫ i.inv) ≫ F.map 0 := by rw [Iso.hom_inv_id, Category.id_comp]
      _ = 0 := by simp only [zero_of_to_zero i.hom, zero_comp, comp_zero]
#align category_theory.functor.preserves_zero_morphisms_of_map_zero_object CategoryTheory.Functor.preservesZeroMorphisms_of_map_zero_object

instance (priority := 100) preservesZeroMorphisms_of_preserves_initial_object
    [PreservesColimit (Functor.empty.{0} C) F] : PreservesZeroMorphisms F :=
  preservesZeroMorphisms_of_map_zero_object <|
    F.mapIso HasZeroObject.zeroIsoInitial ≪≫
      PreservesInitial.iso F ≪≫ HasZeroObject.zeroIsoInitial.symm
#align category_theory.functor.preserves_zero_morphisms_of_preserves_initial_object CategoryTheory.Functor.preservesZeroMorphisms_of_preserves_initial_object

instance (priority := 100) preservesZeroMorphisms_of_preserves_terminal_object
    [PreservesLimit (Functor.empty.{0} C) F] : PreservesZeroMorphisms F :=
  preservesZeroMorphisms_of_map_zero_object <|
    F.mapIso HasZeroObject.zeroIsoTerminal ≪≫
      PreservesTerminal.iso F ≪≫ HasZeroObject.zeroIsoTerminal.symm
#align category_theory.functor.preserves_zero_morphisms_of_preserves_terminal_object CategoryTheory.Functor.preservesZeroMorphisms_of_preserves_terminal_object

variable (F)

/-- Preserving zero morphisms implies preserving terminal objects. -/
def preservesTerminalObjectOfPreservesZeroMorphisms [PreservesZeroMorphisms F] :
    PreservesLimit (Functor.empty C) F :=
  preservesTerminalOfIso F <|
    F.mapIso HasZeroObject.zeroIsoTerminal.symm ≪≫ mapZeroObject F ≪≫ HasZeroObject.zeroIsoTerminal
#align category_theory.functor.preserves_terminal_object_of_preserves_zero_morphisms CategoryTheory.Functor.preservesTerminalObjectOfPreservesZeroMorphisms

/-- Preserving zero morphisms implies preserving terminal objects. -/
def preservesInitialObjectOfPreservesZeroMorphisms [PreservesZeroMorphisms F] :
    PreservesColimit (Functor.empty C) F :=
  preservesInitialOfIso F <|
    HasZeroObject.zeroIsoInitial.symm ≪≫
      (mapZeroObject F).symm ≪≫ (F.mapIso HasZeroObject.zeroIsoInitial.symm).symm
#align category_theory.functor.preserves_initial_object_of_preserves_zero_morphisms CategoryTheory.Functor.preservesInitialObjectOfPreservesZeroMorphisms

end ZeroObject

end CategoryTheory.Functor


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.kernel_pair

/-!
# Reflexive coequalizers

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

We define reflexive pairs as a pair of morphisms which have a common section. We say a category has
reflexive coequalizers if it has coequalizers of all reflexive pairs.
Reflexive coequalizers often enjoy nicer properties than general coequalizers, and feature heavily
in some versions of the monadicity theorem.

We also give some examples of reflexive pairs: for an adjunction `F ⊣ G` with counit `ε`, the pair
`(FGε_B, ε_FGB)` is reflexive. If a pair `f,g` is a kernel pair for some morphism, then it is
reflexive.

# TODO
* If `C` has binary coproducts and reflexive coequalizers, then it has all coequalizers.
* If `T` is a monad on cocomplete category `C`, then `algebra T` is cocomplete iff it has reflexive
  coequalizers.
* If `C` is locally cartesian closed and has reflexive coequalizers, then it has images: in fact
  regular epi (and hence strong epi) images.
-/

namespace category_theory

universes v v₂ u u₂

variables {C : Type u} [category.{v} C]
variables {D : Type u₂} [category.{v₂} D]
variables {A B : C} {f g : A ⟶ B}

/--
The pair `f g : A ⟶ B` is reflexive if there is a morphism `B ⟶ A` which is a section for both.
-/
class is_reflexive_pair (f g : A ⟶ B) : Prop :=
(common_section [] : ∃ (s : B ⟶ A), s ≫ f = 𝟙 B ∧ s ≫ g = 𝟙 B)

/--
The pair `f g : A ⟶ B` is coreflexive if there is a morphism `B ⟶ A` which is a retraction for both.
-/
class is_coreflexive_pair (f g : A ⟶ B) : Prop :=
(common_retraction [] : ∃ (s : B ⟶ A), f ≫ s = 𝟙 A ∧ g ≫ s = 𝟙 A)

lemma is_reflexive_pair.mk' (s : B ⟶ A) (sf : s ≫ f = 𝟙 B) (sg : s ≫ g = 𝟙 B) :
  is_reflexive_pair f g :=
⟨⟨s, sf, sg⟩⟩

lemma is_coreflexive_pair.mk' (s : B ⟶ A) (fs : f ≫ s = 𝟙 A) (gs : g ≫ s = 𝟙 A) :
  is_coreflexive_pair f g :=
⟨⟨s, fs, gs⟩⟩

/-- Get the common section for a reflexive pair. -/
noncomputable def common_section (f g : A ⟶ B) [is_reflexive_pair f g] : B ⟶ A :=
(is_reflexive_pair.common_section f g).some

@[simp, reassoc]
lemma section_comp_left (f g : A ⟶ B) [is_reflexive_pair f g] :
  common_section f g ≫ f = 𝟙 B :=
(is_reflexive_pair.common_section f g).some_spec.1

@[simp, reassoc]
lemma section_comp_right (f g : A ⟶ B) [is_reflexive_pair f g] :
  common_section f g ≫ g = 𝟙 B :=
(is_reflexive_pair.common_section f g).some_spec.2

/-- Get the common retraction for a coreflexive pair. -/
noncomputable def common_retraction (f g : A ⟶ B) [is_coreflexive_pair f g] :
  B ⟶ A :=
(is_coreflexive_pair.common_retraction f g).some

@[simp, reassoc]
lemma left_comp_retraction (f g : A ⟶ B) [is_coreflexive_pair f g] :
  f ≫ common_retraction f g = 𝟙 A :=
(is_coreflexive_pair.common_retraction f g).some_spec.1

@[simp, reassoc]
lemma right_comp_retraction (f g : A ⟶ B) [is_coreflexive_pair f g] :
  g ≫ common_retraction f g = 𝟙 A :=
(is_coreflexive_pair.common_retraction f g).some_spec.2

/-- If `f,g` is a kernel pair for some morphism `q`, then it is reflexive. -/
lemma is_kernel_pair.is_reflexive_pair {R : C} {f g : R ⟶ A} {q : A ⟶ B}
  (h : is_kernel_pair q f g) :
  is_reflexive_pair f g :=
is_reflexive_pair.mk' _ (h.lift' _ _ rfl).2.1 (h.lift' _ _ _).2.2

/-- If `f,g` is reflexive, then `g,f` is reflexive. -/
-- This shouldn't be an instance as it would instantly loop.
lemma is_reflexive_pair.swap [is_reflexive_pair f g] :
  is_reflexive_pair g f :=
is_reflexive_pair.mk' _ (section_comp_right f g) (section_comp_left f g)

/-- If `f,g` is coreflexive, then `g,f` is coreflexive. -/
-- This shouldn't be an instance as it would instantly loop.
lemma is_coreflexive_pair.swap [is_coreflexive_pair f g] :
  is_coreflexive_pair g f :=
is_coreflexive_pair.mk' _ (right_comp_retraction f g) (left_comp_retraction f g)

variables {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G)

/-- For an adjunction `F ⊣ G` with counit `ε`, the pair `(FGε_B, ε_FGB)` is reflexive. -/
instance (B : D) :
  is_reflexive_pair (F.map (G.map (adj.counit.app B))) (adj.counit.app (F.obj (G.obj B))) :=
is_reflexive_pair.mk'
  (F.map (adj.unit.app (G.obj B)))
  (by { rw [← F.map_comp, adj.right_triangle_components], apply F.map_id })
  adj.left_triangle_components

namespace limits

variables (C)

/-- `C` has reflexive coequalizers if it has coequalizers for every reflexive pair. -/
class has_reflexive_coequalizers : Prop :=
(has_coeq : ∀ ⦃A B : C⦄ (f g : A ⟶ B) [is_reflexive_pair f g], has_coequalizer f g)

/-- `C` has coreflexive equalizers if it has equalizers for every coreflexive pair. -/
class has_coreflexive_equalizers : Prop :=
(has_eq : ∀ ⦃A B : C⦄ (f g : A ⟶ B) [is_coreflexive_pair f g], has_equalizer f g)

attribute [instance, priority 1] has_reflexive_coequalizers.has_coeq
attribute [instance, priority 1] has_coreflexive_equalizers.has_eq

lemma has_coequalizer_of_common_section [has_reflexive_coequalizers C]
  {A B : C} {f g : A ⟶ B} (r : B ⟶ A)
  (rf : r ≫ f = 𝟙 _) (rg : r ≫ g = 𝟙 _) :
  has_coequalizer f g :=
begin
  letI := is_reflexive_pair.mk' r rf rg,
  apply_instance
end

lemma has_equalizer_of_common_retraction [has_coreflexive_equalizers C]
  {A B : C} {f g : A ⟶ B} (r : B ⟶ A)
  (fr : f ≫ r = 𝟙 _) (gr : g ≫ r = 𝟙 _) :
  has_equalizer f g :=
begin
  letI := is_coreflexive_pair.mk' r fr gr,
  apply_instance
end

/-- If `C` has coequalizers, then it has reflexive coequalizers. -/
@[priority 100]
instance has_reflexive_coequalizers_of_has_coequalizers [has_coequalizers C] :
  has_reflexive_coequalizers C :=
{ has_coeq := λ A B f g i, by apply_instance }

/-- If `C` has equalizers, then it has coreflexive equalizers. -/
@[priority 100]
instance has_coreflexive_equalizers_of_has_equalizers [has_equalizers C] :
  has_coreflexive_equalizers C :=
{ has_eq := λ A B f g i, by apply_instance }

end limits

open limits

end category_theory


import Geo.Background.Real
import Geo.Background.List
import Geo.Background.Vec
import Geo.Background.Set
import Geo.Background.Tuple
import Geo.Geo.Analytic

/-
Currently, we do not require NDGs in the constructions.
We will experiment with requiring them only for the theorems about the constructions,
and perhaps auto-generating them from the theorem statements.

So far I have found the `HasOn` typeclass to be convenient because of all the helper functions,
but so far the other typeclasses have mostly just preempted the ⟨⟩ notation without much benefit.
-/

namespace Geo

class HasOn (α : Type) := (on : Point → α → Prop)
def on {α : Type} [HasOn α] : Point → α → Prop := HasOn.on

class HasInOrderOn (α : Type) := (inOrderOn: List Point → α → Prop)
def inOrderOn {α : Type} [HasInOrderOn α] : List Point → α → Prop := HasInOrderOn.inOrderOn

section
variables {α β : Type} [HasOn α] [HasOn β]

def allOn (ps : List Point) (x : α) : Prop := ps.allP (flip on x)

def intersectAt (x : α) (y : β) : Set Point := λ p => on p x ∧ on p y
def intersectAt₂ (x : α) (y : β) (p₁ p₂ : Point) : Prop :=
intersectAt x y p₁ ∧ intersectAt x y p₂ ∧ p₁ ≠ p₂
def intersect (x : α) (y : β) : Prop := Exists (intersectAt x y)

def allIntersectAt (xs : List α) : Set Point := λ p => xs.allP (on p)
def allIntersect (xs : List α) : Prop := Exists (allIntersectAt xs)

def allIntersectAt₂ (xs : List α) (ys : List β) : Set Point :=
λ p => xs.allP (on p) ∧ ys.allP (on p)
def allIntersect₂ (xs : List α) (ys : List β) : Prop :=
Exists (allIntersectAt₂ xs ys)

def intersectAtMany (x : α) (y : β) (ps : List Point) : Prop :=
ps.allP (λ p => intersectAt x y p)

def tangentAt (x : α) (y : β) : Set Point := unique (intersectAt x y)
def tangent (x : α) (y : β) : Prop := Exists (tangentAt x y)

end

class HasInside (α : Type) := (inside : Point → α → Prop)
def inside {α : Type} [HasInside α] : Point → α → Prop := HasInside.inside

class HasReflect (α β : Type) : Type := (reflect : α → β → α)
def reflect {α β : Type} [HasReflect α β] : α → β → α := HasReflect.reflect

class HasUnsignedArea (α : Type) : Type := (uarea : α → ℝ≥)
def uarea {α : Type} [HasUnsignedArea α] : α → ℝ≥ := HasUnsignedArea.uarea

class HasSignedArea (α : Type) : Type := (sarea : α → ℝ)
def sarea {α : Type} [HasSignedArea α] : α → ℝ  := HasSignedArea.sarea

class HasLength (α : Type) := (ulen : α → ℝ≥)
def ulen {α : Type} [HasLength α] : α → ℝ≥ := HasLength.ulen

structure Line : Type := (p₁ p₂ : Point)

namespace Line

def same (l₁ l₂ : Line) : Prop := WIP

def wf : Line → Prop
| ⟨a, b⟩ => a ≠ b

protected def on (p : Point) : Line → Prop
| ⟨a, b⟩ => a ≠ b ∧ Analytic.coll p a b -- TODO: bundle NDGs like this?
instance : HasOn Line := ⟨Line.on⟩

protected def inOrderOn (ps : List Point) : Line → Prop := WIP
instance : HasInOrderOn Line := ⟨Line.inOrderOn⟩

noncomputable def reflectPL (p : Point) (l : Line) : Point := WIP -- ARITH
noncomputable def reflectLL (l₁ l₂ : Line) : Line := WIP -- ARITH
noncomputable instance ReflectPL : HasReflect Point Line := ⟨reflectPL⟩
noncomputable instance ReflectLL : HasReflect Line Line := ⟨reflectLL⟩

noncomputable def buildPara (p : Point) (l : Line) : Line := WIP -- build a line passing through p parallel to l

end Line

noncomputable def coll : Point → Point → Point → Prop := Analytic.coll
noncomputable def foot (p : Point) (l : Line) : Point := WIP -- ARITH
noncomputable def perpTo (p q : Point) : Point := WIP -- ARITH

def para (l₁ l₂ : Line) : Prop :=
l₁.wf ∧ l₂.wf ∧ Analytic.para l₁.p₁ l₁.p₂ l₂.p₁ l₂.p₂

def perp (l₁ l₂ : Line) : Prop :=
l₁.wf ∧ l₂.wf ∧ Analytic.perp l₁.p₁ l₁.p₂ l₂.p₁ l₂.p₂

structure Seg : Type := (src dst : Point)

namespace Seg

protected def on (p : Point) (l : Seg) : Prop := WIP -- (on line & btw, including endpoints)
instance : HasOn Seg := ⟨Seg.on⟩

def strictlyBtw (p₁ p₂ p₃ : Point) : Prop :=
on p₁ (Seg.mk p₂ p₃) ∧ p₁ ≠ p₂ ∧ p₁ ≠ p₃

protected def inOrderOn (ps : List Point) : Seg → Prop := WIP
instance : HasInOrderOn Seg := ⟨Seg.inOrderOn⟩

protected noncomputable def ulen (l : Seg) : ℝ≥ :=
⟨Analytic.dist l.src l.dst, Analytic.distGe0 _ _⟩

noncomputable instance : HasLength Seg := ⟨Seg.ulen⟩

protected noncomputable def midp (l : Seg) : Point := Analytic.midp l.src l.dst
protected def isMidpoint (p : Point) (l : Seg) : Prop := p = l.midp

def cong (l₁ l₂ : Seg) : Prop := ulen l₁ = ulen l₂

end Seg

noncomputable def perpBis (l : Seg) : Line := ⟨Seg.midp l, perpTo (Seg.midp l) l.dst⟩
def isPerpBis (l : Line) (s : Seg) : Prop := Line.same l (perpBis s)

structure Ray : Type := (src dst : Point)

namespace Ray

-- `Ray.buildBeyond x beyond` builds the ray `Ray.mk beyond (reflect x beyond)`
noncomputable def buildBeyond (x beyond : Point) : Ray := WIP

protected def on (p : Point) (l : Ray) : Prop := WIP
instance : HasOn Ray := ⟨Ray.on⟩

protected def inOrderOn (ps : List Point) : Ray → Prop := WIP
instance : HasInOrderOn Ray := ⟨Ray.inOrderOn⟩

def toLine (l : Ray) : Line := ⟨l.src, l.dst⟩
instance : HasCoe Ray Line := ⟨toLine⟩

end Ray

structure Circle : Type := (origin : Point) (radius : ℝ₊)

namespace Circle

protected def on (p : Point) (Γ : Circle) : Prop :=
Γ.radius = ⟨Analytic.dist p Γ.origin, Analytic.distGe0 _ _⟩

instance : HasOn Circle := ⟨Circle.on⟩

protected def inOrderOn (ps : List Point) : Circle → Prop := WIP
instance : HasInOrderOn Circle := ⟨Circle.inOrderOn⟩

protected def inside (p : Point) (Γ : Circle) : Prop :=
Γ.radius > ⟨Analytic.dist p Γ.origin, Analytic.distGe0 _ _⟩

instance : HasInside Circle := ⟨Circle.inside⟩

noncomputable def diameter (Γ : Circle) : ℝ₊ := Γ.radius * 2
def isDiameter (p₁ p₂ : Point) (Γ : Circle) : Prop :=
on p₁ Γ ∧ on p₂ Γ ∧ Seg.isMidpoint (Γ.origin) ⟨p₁, p₂⟩

protected noncomputable def uarea (Γ : Circle) : ℝ≥ :=
π * Γ.radius^2

noncomputable instance : HasUnsignedArea Circle := ⟨Circle.uarea⟩

noncomputable def lineTangentAtP (Γ : Circle) (p : Point) : Line := WIP

protected noncomputable def buildOP (origin p : Point) : Circle := WIP
protected noncomputable def buildPPP (p₁ p₂ p₃ : Point) : Circle := WIP
protected noncomputable def buildDiam (p₁ p₂ : Point) : Circle :=
Circle.buildOP (Seg.midp ⟨p₁, p₂⟩) p₁

def isOrigin (p : Point) (Γ : Circle) : Prop := p = Γ.origin

end Circle

noncomputable def cycl (ps : List Point) : Prop :=
Exists (λ (Γ : Circle) => allOn ps Γ)

structure Arc (Γ : Circle) : Type := (src dst avoid : Point)

namespace Arc

variable {Γ : Circle}

protected def on (p : Point) (arc : Arc Γ) : Prop := WIP -- ARITH
instance: HasOn (Arc Γ) := ⟨Arc.on⟩

protected noncomputable def ulen (arc : Arc Γ) : ℝ≥ := WIP -- ARITH
noncomputable instance : HasLength (Arc Γ) := ⟨Arc.ulen⟩

noncomputable def buildMinor (Γ : Circle) : Point → Point → Arc Γ := WIP
noncomputable def buildMajor (Γ : Circle) : Point → Point → Arc Γ := WIP

protected noncomputable def midp (a : Arc Γ) : Point := WIP
protected def isMidpoint (p : Point) (a : Arc Γ) : Prop := p = a.midp

end Arc

def isChord (Γ : Circle) (l : Seg) : Prop := on l.src Γ ∧ on l.dst Γ

open Triple (cmap any all)

def Angle : Type := Triple Point

noncomputable def uangle : Angle → ℝ2π := WIP
noncomputable def dangle : Angle → ℝπ  := WIP

namespace Angle

noncomputable def bisector : Angle → Line := WIP
def isBisector (l : Line) (ang : Angle) : Prop := WIP

def isRight : Angle → Prop := WIP

end Angle

def Triangle : Type := Triple Point

namespace Triangle

protected def mk (A B C : Point) : Triangle := ⟨A, B, C⟩

protected noncomputable def buildLLL (ls : Triple Line) : Triangle := WIP

protected def on : Point → Triangle → Prop := WIP

instance : HasOn Triangle := ⟨Triangle.on⟩

protected def inside : Point → Triangle → Prop := WIP
instance : HasInside Triangle := ⟨Triangle.inside⟩

protected noncomputable def uarea : Triangle → ℝ₊ := WIP
noncomputable instance : HasUnsignedArea Triangle := ⟨Triangle.uarea⟩

protected noncomputable def sarea : Triangle → ℝ := WIP
noncomputable instance : HasSignedArea Triangle := ⟨Triangle.sarea⟩

def sides : Triangle → Triple Seg
| ⟨A, B, C⟩ => ⟨⟨B, C⟩, ⟨C, A⟩, ⟨A, B⟩⟩

def vertices : Triangle → Triple Point
| ⟨A, B, C⟩ => ⟨A, B, C⟩

noncomputable def sideLengths (tri : Triangle) : Triple ℝ≥ :=
ulen <$> sides tri

def esides : Triangle → Triple Line
| ⟨A, B, C⟩ => ⟨⟨B, C⟩, ⟨C, A⟩, ⟨A, B⟩⟩

-- RK: note that tri.cycles returns angles in the following order [B, C, A]
noncomputable def angles (tri : Triangle) : Triple Angle :=
match tri.cycles with ⟨B, C, A⟩ => ⟨A, B, C⟩

def isRight (tri : Triangle) : Prop :=
Triple.any Angle.isRight tri.angles

noncomputable def uangles (tri : Triangle) : Triple ℝ2π :=
uangle <$> tri.angles

noncomputable def dangles (tri : Triangle) : Triple ℝπ  :=
dangle <$> tri.angles

noncomputable def altitudes : Triangle → Triple Seg :=
cmap $ λ tri => ⟨tri.A, foot tri.A ⟨tri.B, tri.C⟩⟩

noncomputable def medians : Triangle → Triple Seg :=
cmap $ λ tri => ⟨tri.A, Seg.midp ⟨tri.B, tri.C⟩⟩

noncomputable def circumcenter  : Triangle → Point := WIP
noncomputable def incenter      : Triangle → Point := WIP
noncomputable def orthocenter   : Triangle → Point := WIP
noncomputable def centroid      : Triangle → Point := WIP
noncomputable def excenters     : Triangle → Triple Point := WIP

def isIncenter (p : Point) (tri : Triangle) : Prop := p = tri.incenter

protected noncomputable def circumcircle  : Triangle → Circle := WIP
-- ryankrue: excircles.A ought to be the excircle across from X in a triangle ⟨X, Y, Z⟩
noncomputable def excircles     : Triangle → Triple Circle := WIP
noncomputable def incircle      : Triangle → Circle := WIP

/-
See the following link for formula in Trilinear coordinates:

en.wikipedia.org/wiki/Incircle_and_excircles_of_a_triangle#Gergonne_triangle_and_point

IMO 2000 P6 requires this. There are notes there for more general ways to accomplish this.

Chen also has an easy way to get this.
-/
-- Points ordered as ⟨Ta, Tb, Tc⟩
noncomputable def gergonneTriangle : Triangle → Triangle := WIP

noncomputable def circumradius   : Triangle → ℝ₊ := WIP
noncomputable def inradius       : Triangle → ℝ₊ := WIP
noncomputable def exradii        : Triangle → Triple ℝ₊ := WIP

noncomputable def pedalTriangle  : Triangle → Point → Triangle := WIP

noncomputable def orthicTriangle (tri : Triangle) : Triangle :=
pedalTriangle tri tri.orthocenter

noncomputable def medialTriangle (tri : Triangle) : Triangle :=
pedalTriangle tri tri.circumcenter

noncomputable def ceviansThrough (tri : Triangle) (p : Point) : Triple Line := WIP

-- Awkward
def cevian (tri : Triangle) (l : Seg) : Prop :=
any (λ (tri : Triangle) => tri.A = l.src ∧ on l.dst tri.esides.A) tri.cycles

def acute (tri : Triangle)       : Prop := WIP
def scalene (tri : Triangle)     : Prop := WIP
def isosceles (tri : Triangle)   : Prop := WIP
def equilateral (tri : Triangle) : Prop := WIP

end Triangle

open Quadruple (cmap any all)

abbrev Quadrilateral : Type := Quadruple Point

namespace Quadrilateral

protected def mk (A B C D : Point) : Quadrilateral := ⟨A, B, C, D⟩

protected def on : Point → Quadrilateral → Prop := WIP

instance : HasOn Quadrilateral := ⟨Quadrilateral.on⟩

protected def inside : Point → Quadrilateral → Prop := WIP
instance : HasInside Quadrilateral := ⟨Quadrilateral.inside⟩

protected noncomputable def uarea : Quadrilateral → ℝ₊ := WIP
noncomputable instance : HasUnsignedArea Quadrilateral := ⟨Quadrilateral.uarea⟩

protected noncomputable def sarea : Quadrilateral → ℝ := WIP
noncomputable instance : HasSignedArea Quadrilateral := ⟨Quadrilateral.sarea⟩

def sides : Quadrilateral → Quadruple Seg
| ⟨A, B, C, D⟩ => ⟨⟨A, B⟩, ⟨B, C⟩, ⟨C, D⟩, ⟨D, A⟩⟩

noncomputable def sideLengths (quad : Quadrilateral) : Quadruple ℝ≥ :=
ulen <$> sides quad

def esides : Quadrilateral → Quadruple Line
| ⟨A, B, C, D⟩ => ⟨⟨A, B⟩, ⟨B, C⟩, ⟨C, D⟩, ⟨D, A⟩⟩

noncomputable def angles : Quadrilateral → Quadruple Angle
| ⟨A, B, C, D⟩ => ⟨⟨D, A, B⟩, ⟨A, B, C⟩, ⟨B, C, D⟩, ⟨C, D, A⟩⟩

noncomputable def uangles (quad : Quadrilateral) : Quadruple ℝ2π :=
uangle <$> quad.angles

noncomputable def dangles (quad : Quadrilateral) : Quadruple ℝπ  :=
dangle <$> quad.angles

-- could either be that there exists a circle with all points on it,
-- or could define a circle with three of the points and ensure that the other two are on it
-- (this way we don't have an existential)
def cyclic   : Quadrilateral → Prop
| ⟨A, B, C, D⟩ => on D (Circle.buildPPP A B C)
def convex   : Quadrilateral → Prop := WIP
def regular  : Quadrilateral → Prop := WIP
def harmonic : Quadrilateral → Prop := WIP

def parallelogram (quad : Quadrilateral) : Prop :=
convex quad ∧ para quad.esides.A quad.esides.C ∧ para quad.esides.B quad.esides.D

def trapezoid (quad : Quadrilateral) : Prop :=
convex quad ∧ (para quad.esides.A quad.esides.C ∨ para quad.esides.B quad.esides.D)

protected noncomputable def circumcircle (quad : Quadrilateral) (cyclicPf : cyclic quad) : Circle :=
Circle.buildPPP quad.A quad.B quad.C

end Quadrilateral

open Triangle Quadrilateral

/-
Triangle and Quadrilateral could be made Polygons.
For now, we keep it this way for convienence,
and only use Polygon for n ≥ 5.
-/
structure Polygon (n : Nat) : Type := (ps : Vec Point n)

namespace Polygon

variables {n : Nat}

noncomputable def buildPs (ps : List Point) : Polygon (ps.length) := WIP

def vertices (pgon : Polygon n) : Vec Point n := pgon.ps

noncomputable def sides (pgon : Polygon n)  : Vec Seg n := WIP
noncomputable def sideLengths (pgon : Polygon n)  : Vec ℝ≥ n := WIP
def equalSides (pgon : Polygon n) : Prop := pgon.sideLengths.allEq
noncomputable def esides (pgon : Polygon n) : Vec Line n := WIP
noncomputable def angles (pgon : Polygon n) : Vec Angle n := WIP

def convex : Polygon n → Prop := WIP
def regular : Polygon n → Prop := WIP

-- TODO: Vec.zip (pgon.sides.take half) (pgon.sides.drop half)
noncomputable def oppoSides {n} (pgon : Polygon n) (pgonEven : n % 2 = 0)
: Vec (Seg × Seg) (n / 2) := WIP

end Polygon

/- UNCOMMENT for >2 types intersecting
namespace WithInst

def ListWithInst (ϕ : ∀ (α : Type), Type) : Type 1 := List (Sigma (λ γ => ϕ γ × γ))
def allIntersectAt₂ (xs : ListWithInst HasOn) : Set Point :=
λ p => xs.allP (λ ⟨α, ⟨inst, x⟩⟩ => on p x)
def allIntersect₂ (xs : ListWithInst HasOn) : Prop := Exists (allIntersectAt₂ xs)

def intersectElem {α : Type} [inst : HasOn α] (x : α) : Sigma (λ γ => HasOn γ × γ) := ⟨α, ⟨inst, x⟩⟩
--def examplePolymorphicSpec (a b c : Point) : Prop :=
allIntersect₂ [intersectElem $ Seg.mk a b, intersectElem $ Line.mk a c]

end WithInst
-/

end Geo


/-
Copyright (c) 2022 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import measure_theory.integral.periodic
import data.zmod.quotient

/-!
# Measure-theoretic results about the additive circle

The file is a place to collect measure-theoretic results about the additive circle.

## Main definitions:

 * `add_circle.closed_ball_ae_eq_ball`: open and closed balls in the additive circle are almost
   equal
 * `add_circle.is_add_fundamental_domain_of_ae_ball`: a ball is a fundamental domain for rational
   angle rotation in the additive circle

-/

open set function filter measure_theory measure_theory.measure metric
open_locale measure_theory pointwise big_operators topology ennreal

namespace add_circle

variables {T : ℝ} [hT : fact (0 < T)]
include hT

lemma closed_ball_ae_eq_ball {x : add_circle T} {ε : ℝ} :
  closed_ball x ε =ᵐ[volume] ball x ε :=
begin
  cases le_or_lt ε 0 with hε hε,
  { rw [ball_eq_empty.mpr hε, ae_eq_empty, volume_closed_ball,
      min_eq_right (by linarith [hT.out] : 2 * ε ≤ T), ennreal.of_real_eq_zero],
    exact mul_nonpos_of_nonneg_of_nonpos zero_le_two hε, },
  { suffices : volume (closed_ball x ε) ≤ volume (ball x ε),
    { exact (ae_eq_of_subset_of_measure_ge ball_subset_closed_ball this measurable_set_ball
        (measure_ne_top _ _)).symm, },
    have : tendsto (λ δ, volume (closed_ball x δ)) (𝓝[<] ε) (𝓝 $ volume (closed_ball x ε)),
    { simp_rw volume_closed_ball,
      refine ennreal.tendsto_of_real (tendsto.min tendsto_const_nhds $ tendsto.const_mul _ _),
      convert (@monotone_id ℝ _).tendsto_nhds_within_Iio ε,
      simp, },
    refine le_of_tendsto this (mem_nhds_within_Iio_iff_exists_Ioo_subset.mpr ⟨0, hε, λ r hr, _⟩),
    exact measure_mono (closed_ball_subset_ball hr.2), },
end

/-- Let `G` be the subgroup of `add_circle T` generated by a point `u` of finite order `n : ℕ`. Then
any set `I` that is almost equal to a ball of radius `T / 2n` is a fundamental domain for the action
of `G` on `add_circle T` by left addition. -/
lemma is_add_fundamental_domain_of_ae_ball (I : set $ add_circle T)
  (u x : add_circle T) (hu : is_of_fin_add_order u)
  (hI : I =ᵐ[volume] ball x (T / (2 * add_order_of u))) :
  is_add_fundamental_domain (add_subgroup.zmultiples u) I :=
begin
  set G := add_subgroup.zmultiples u,
  set n := add_order_of u,
  set B := ball x (T / (2 * n)),
  have hn : 1 ≤ (n : ℝ), { norm_cast, linarith [add_order_of_pos' hu], },
  refine is_add_fundamental_domain.mk_of_measure_univ_le _ _ _ _,
  { -- `null_measurable_set I volume`
    exact (measurable_set_ball.null_measurable_set.congr hI.symm), },
  { -- `∀ (g : G), g ≠ 0 → ae_disjoint volume (g +ᵥ I) I`
    rintros ⟨g, hg⟩ hg',
    replace hg' : g ≠ 0, by simpa only [ne.def, add_subgroup.mk_eq_zero_iff] using hg',
    change ae_disjoint volume (g +ᵥ I) I,
    refine ae_disjoint.congr (disjoint.ae_disjoint _)
      ((quasi_measure_preserving_add_left volume (-g)).vadd_ae_eq_of_ae_eq g hI) hI,
    have hBg : g +ᵥ B = ball (g + x) (T / (2 * n)),
    { rw [add_comm g x, ← singleton_add_ball _ x g, add_ball, thickening_singleton], },
    rw hBg,
    apply ball_disjoint_ball,
    rw [dist_eq_norm, add_sub_cancel, div_mul_eq_div_div, ← add_div, ← add_div, add_self_div_two,
      div_le_iff' (by positivity : 0 < (n : ℝ)), ← nsmul_eq_mul],
    refine (le_add_order_smul_norm_of_is_of_fin_add_order (hu.of_mem_zmultiples hg) hg').trans
      (nsmul_le_nsmul (norm_nonneg g) _),
    exact nat.le_of_dvd (add_order_of_pos_iff.mpr hu) (add_order_of_dvd_of_mem_zmultiples hg), },
  { -- `∀ (g : G), quasi_measure_preserving (has_vadd.vadd g) volume volume`
    exact (λ g, quasi_measure_preserving_add_left volume g), },
  { -- `volume univ ≤ ∑' (g : G), volume (g +ᵥ I)`
    replace hI : I =ᵐ[volume] closed_ball x (T / (2 * ↑n)) :=
      hI.trans closed_ball_ae_eq_ball.symm,
    haveI : fintype G := @fintype.of_finite _ hu.finite_zmultiples,
    have hG_card : (finset.univ : finset G).card = n,
    { show _ = add_order_of u, rw [add_order_eq_card_zmultiples', nat.card_eq_fintype_card], refl },
    simp_rw [measure_vadd],
    rw [add_circle.measure_univ, tsum_fintype, finset.sum_const, measure_congr hI,
      volume_closed_ball, ← ennreal.of_real_nsmul, mul_div, mul_div_mul_comm,
      div_self (@two_ne_zero ℝ _ _ _ _), one_mul, min_eq_right (div_le_self hT.out.le hn), hG_card,
      nsmul_eq_mul, mul_div_cancel' T (lt_of_lt_of_le zero_lt_one hn).ne.symm],
    exact le_refl _, },
end

lemma volume_of_add_preimage_eq (s I : set $ add_circle T) (u x : add_circle T)
  (hu : is_of_fin_add_order u) (hs : (u +ᵥ s : set $ add_circle T) =ᵐ[volume] s)
  (hI : I =ᵐ[volume] ball x (T / (2 * add_order_of u))) :
  volume s = add_order_of u • volume (s ∩ I) :=
begin
  let G := add_subgroup.zmultiples u,
  haveI : fintype G := @fintype.of_finite _ hu.finite_zmultiples,
  have hsG : ∀ (g : G), (g +ᵥ s : set $ add_circle T) =ᵐ[volume] s,
  { rintros ⟨y, hy⟩, exact (vadd_ae_eq_self_of_mem_zmultiples hs hy : _), },
  rw [(is_add_fundamental_domain_of_ae_ball I u x hu hI).measure_eq_card_smul_of_vadd_ae_eq_self
    s hsG, add_order_eq_card_zmultiples' u, nat.card_eq_fintype_card],
end

end add_circle


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.functor_category
import Mathlib.category_theory.isomorphism
import Mathlib.PostPort

universes u₁ u₂ v₁ v₂ u₃ v₃

namespace Mathlib

/-!
# Natural isomorphisms

For the most part, natural isomorphisms are just another sort of isomorphism.

We provide some special support for extracting components:
* if `α : F ≅ G`, then `a.app X : F.obj X ≅ G.obj X`,
and building natural isomorphisms from components:
*
```
nat_iso.of_components
  (app : ∀ X : C, F.obj X ≅ G.obj X)
  (naturality : ∀ {X Y : C} (f : X ⟶ Y), F.map f ≫ (app Y).hom = (app X).hom ≫ G.map f) :
F ≅ G
```
only needing to check naturality in one direction.

## Implementation

Note that `nat_iso` is a namespace without a corresponding definition;
we put some declarations that are specifically about natural isomorphisms in the `iso`
namespace so that they are available using dot notation.
-/

-- declare the `v`'s first; see `category_theory.category` for an explanation

namespace category_theory

namespace iso

/-- The application of a natural isomorphism to an object. We put this definition in a different
namespace, so that we can use `α.app` -/
@[simp] theorem app_hom {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} (α : F ≅ G) (X : C) : hom (app α X) = nat_trans.app (hom α) X :=
  Eq.refl (hom (app α X))

@[simp] theorem hom_inv_id_app_assoc {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) (X : C) {X' : D} (f' : functor.obj F X ⟶ X') :
    nat_trans.app (hom α) X ≫ nat_trans.app (inv α) X ≫ f' = f' :=
  sorry

@[simp] theorem inv_hom_id_app_assoc {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) (X : C) {X' : D} (f' : functor.obj G X ⟶ X') :
    nat_trans.app (inv α) X ≫ nat_trans.app (hom α) X ≫ f' = f' :=
  sorry

end iso

namespace nat_iso

@[simp] theorem trans_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} {H : C ⥤ D} (α : F ≅ G) (β : G ≅ H) (X : C) :
    iso.app (α ≪≫ β) X = iso.app α X ≪≫ iso.app β X :=
  rfl

theorem app_hom {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D}
    (α : F ≅ G) (X : C) : iso.hom (iso.app α X) = nat_trans.app (iso.hom α) X :=
  rfl

theorem app_inv {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D}
    (α : F ≅ G) (X : C) : iso.inv (iso.app α X) = nat_trans.app (iso.inv α) X :=
  rfl

protected instance hom_app_is_iso {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} (α : F ≅ G) (X : C) : is_iso (nat_trans.app (iso.hom α) X) :=
  is_iso.mk (nat_trans.app (iso.inv α) X)

protected instance inv_app_is_iso {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} (α : F ≅ G) (X : C) : is_iso (nat_trans.app (iso.inv α) X) :=
  is_iso.mk (nat_trans.app (iso.hom α) X)

/-!
Unfortunately we need a separate set of cancellation lemmas for components of natural isomorphisms,
because the `simp` normal form is `α.hom.app X`, rather than `α.app.hom X`.

(With the later, the morphism would be visibly part of an isomorphism, so general lemmas about
isomorphisms would apply.)

In the future, we should consider a redesign that changes this simp norm form,
but for now it breaks too many proofs.
-/

@[simp] theorem cancel_nat_iso_hom_left {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) {X : C} {Z : D} (g : functor.obj G X ⟶ Z)
    (g' : functor.obj G X ⟶ Z) :
    nat_trans.app (iso.hom α) X ≫ g = nat_trans.app (iso.hom α) X ≫ g' ↔ g = g' :=
  sorry

@[simp] theorem cancel_nat_iso_inv_left {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) {X : C} {Z : D} (g : functor.obj F X ⟶ Z)
    (g' : functor.obj F X ⟶ Z) :
    nat_trans.app (iso.inv α) X ≫ g = nat_trans.app (iso.inv α) X ≫ g' ↔ g = g' :=
  sorry

@[simp] theorem cancel_nat_iso_hom_right {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) {X : D} {Y : C} (f : X ⟶ functor.obj F Y)
    (f' : X ⟶ functor.obj F Y) :
    f ≫ nat_trans.app (iso.hom α) Y = f' ≫ nat_trans.app (iso.hom α) Y ↔ f = f' :=
  sorry

@[simp] theorem cancel_nat_iso_inv_right {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) {X : D} {Y : C} (f : X ⟶ functor.obj G Y)
    (f' : X ⟶ functor.obj G Y) :
    f ≫ nat_trans.app (iso.inv α) Y = f' ≫ nat_trans.app (iso.inv α) Y ↔ f = f' :=
  sorry

@[simp] theorem cancel_nat_iso_hom_right_assoc {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) {W : D} {X : D} {X' : D} {Y : C} (f : W ⟶ X)
    (g : X ⟶ functor.obj F Y) (f' : W ⟶ X') (g' : X' ⟶ functor.obj F Y) :
    f ≫ g ≫ nat_trans.app (iso.hom α) Y = f' ≫ g' ≫ nat_trans.app (iso.hom α) Y ↔ f ≫ g = f' ≫ g' :=
  sorry

@[simp] theorem cancel_nat_iso_inv_right_assoc {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ≅ G) {W : D} {X : D} {X' : D} {Y : C} (f : W ⟶ X)
    (g : X ⟶ functor.obj G Y) (f' : W ⟶ X') (g' : X' ⟶ functor.obj G Y) :
    f ≫ g ≫ nat_trans.app (iso.inv α) Y = f' ≫ g' ≫ nat_trans.app (iso.inv α) Y ↔ f ≫ g = f' ≫ g' :=
  sorry

theorem naturality_1 {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D}
    {X : C} {Y : C} (α : F ≅ G) (f : X ⟶ Y) :
    nat_trans.app (iso.inv α) X ≫ functor.map F f ≫ nat_trans.app (iso.hom α) Y = functor.map G f :=
  sorry

theorem naturality_2 {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D}
    {X : C} {Y : C} (α : F ≅ G) (f : X ⟶ Y) :
    nat_trans.app (iso.hom α) X ≫ functor.map G f ≫ nat_trans.app (iso.inv α) Y = functor.map F f :=
  sorry

/--
A natural transformation is an isomorphism if all its components are isomorphisms.
-/
-- Making this an instance would cause a typeclass inference loop with `is_iso_app_of_is_iso`.

def is_iso_of_is_iso_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} (α : F ⟶ G) [(X : C) → is_iso (nat_trans.app α X)] : is_iso α :=
  is_iso.mk (nat_trans.mk fun (X : C) => inv (nat_trans.app α X))

/--
The components of a natural isomorphism are isomorphisms.
-/
protected instance is_iso_app_of_is_iso {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (α : F ⟶ G) [is_iso α] (X : C) : is_iso (nat_trans.app α X) :=
  is_iso.mk (nat_trans.app (inv α) X)

/--
Construct a natural isomorphism between functors by giving object level isomorphisms,
and checking naturality only in the forward direction.
-/
def of_components {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D}
    (app : (X : C) → functor.obj F X ≅ functor.obj G X)
    (naturality :
      ∀ {X Y : C} (f : X ⟶ Y),
        functor.map F f ≫ iso.hom (app Y) = iso.hom (app X) ≫ functor.map G f) :
    F ≅ G :=
  iso.mk (nat_trans.mk fun (X : C) => iso.hom (app X))
    (inv (nat_trans.mk fun (X : C) => iso.hom (app X)))

@[simp] theorem of_components.app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} (app' : (X : C) → functor.obj F X ≅ functor.obj G X)
    (naturality :
      ∀ {X Y : C} (f : X ⟶ Y),
        functor.map F f ≫ iso.hom (app' Y) = iso.hom (app' X) ≫ functor.map G f)
    (X : C) : iso.app (of_components app' naturality) X = app' X :=
  iso.ext (Eq.refl (iso.hom (iso.app (of_components app' naturality) X)))

@[simp] theorem of_components.hom_app {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (app : (X : C) → functor.obj F X ≅ functor.obj G X)
    (naturality :
      ∀ {X Y : C} (f : X ⟶ Y),
        functor.map F f ≫ iso.hom (app Y) = iso.hom (app X) ≫ functor.map G f)
    (X : C) : nat_trans.app (iso.hom (of_components app naturality)) X = iso.hom (app X) :=
  rfl

@[simp] theorem of_components.inv_app {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : C ⥤ D} (app : (X : C) → functor.obj F X ≅ functor.obj G X)
    (naturality :
      ∀ {X Y : C} (f : X ⟶ Y),
        functor.map F f ≫ iso.hom (app Y) = iso.hom (app X) ≫ functor.map G f)
    (X : C) : nat_trans.app (iso.inv (of_components app naturality)) X = iso.inv (app X) :=
  rfl

/-- Horizontal composition of natural isomorphisms. -/
def hcomp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E]
    {F : C ⥤ D} {G : C ⥤ D} {H : D ⥤ E} {I : D ⥤ E} (α : F ≅ G) (β : H ≅ I) : F ⋙ H ≅ G ⋙ I :=
  iso.mk (iso.hom α ◫ iso.hom β) (iso.inv α ◫ iso.inv β)

end Mathlib


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.group.ext
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Hom.Group

/-!
# Extensionality lemmas for monoid and group structures

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

In this file we prove extensionality lemmas for `monoid` and higher algebraic structures with one
binary operation. Extensionality lemmas for structures that are lower in the hierarchy can be found
in `algebra.group.defs`.

## Implementation details

To get equality of `npow` etc, we define a monoid homomorphism between two monoid structures on the
same type, then apply lemmas like `monoid_hom.map_div`, `monoid_hom.map_pow` etc.

## Tags
monoid, group, extensionality
-/

universe u

/- warning: monoid.ext -> Monoid.ext is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {{m₁ : Monoid.{u1} M}} {{m₂ : Monoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Monoid.mul.{u1} M m₁) (Monoid.mul.{u1} M m₂)) -> (Eq.{succ u1} (Monoid.{u1} M) m₁ m₂)
but is expected to have type
  forall {M : Type.{u1}} {{m₁ : Monoid.{u1} M}} {{m₂ : Monoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (Monoid.toSemigroup.{u1} M m₁))) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (Monoid.toSemigroup.{u1} M m₂)))) -> (Eq.{succ u1} (Monoid.{u1} M) m₁ m₂)
Case conversion may be inaccurate. Consider using '#align monoid.ext Monoid.extₓ'. -/
@[ext, to_additive]
theorem Monoid.ext {M : Type u} ⦃m₁ m₂ : Monoid M⦄ (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
  by
  have h₁ : (@Monoid.toMulOneClass _ m₁).one = (@Monoid.toMulOneClass _ m₂).one :=
    congr_arg (@MulOneClass.one M) (MulOneClass.ext h_mul)
  set f : @MonoidHom M M (@Monoid.toMulOneClass _ m₁) (@Monoid.toMulOneClass _ m₂) :=
    { toFun := id
      map_one' := h₁
      map_mul' := fun x y => congr_fun (congr_fun h_mul x) y }
  have hpow : m₁.npow = m₂.npow := by
    ext (n x)
    exact @MonoidHom.map_pow M M m₁ m₂ f x n
  cases m₁
  cases m₂
  congr <;> assumption
#align monoid.ext Monoid.ext
#align add_monoid.ext AddMonoid.ext

#print CommMonoid.toMonoid_injective /-
@[to_additive]
theorem CommMonoid.toMonoid_injective {M : Type u} : Function.Injective (@CommMonoid.toMonoid M) :=
  by
  rintro ⟨⟩ ⟨⟩ h
  congr <;> injection h
#align comm_monoid.to_monoid_injective CommMonoid.toMonoid_injective
#align add_comm_monoid.to_add_monoid_injective AddCommMonoid.toAddMonoid_injective
-/

/- warning: comm_monoid.ext -> CommMonoid.ext is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {{m₁ : CommMonoid.{u1} M}} {{m₂ : CommMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (CommMonoid.mul.{u1} M m₁) (CommMonoid.mul.{u1} M m₂)) -> (Eq.{succ u1} (CommMonoid.{u1} M) m₁ m₂)
but is expected to have type
  forall {M : Type.{u1}} {{m₁ : CommMonoid.{u1} M}} {{m₂ : CommMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (Monoid.toSemigroup.{u1} M (CommMonoid.toMonoid.{u1} M m₁)))) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (Monoid.toSemigroup.{u1} M (CommMonoid.toMonoid.{u1} M m₂))))) -> (Eq.{succ u1} (CommMonoid.{u1} M) m₁ m₂)
Case conversion may be inaccurate. Consider using '#align comm_monoid.ext CommMonoid.extₓ'. -/
@[ext, to_additive]
theorem CommMonoid.ext {M : Type _} ⦃m₁ m₂ : CommMonoid M⦄ (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
  CommMonoid.toMonoid_injective <| Monoid.ext h_mul
#align comm_monoid.ext CommMonoid.ext
#align add_comm_monoid.ext AddCommMonoid.ext

#print LeftCancelMonoid.toMonoid_injective /-
@[to_additive]
theorem LeftCancelMonoid.toMonoid_injective {M : Type u} :
    Function.Injective (@LeftCancelMonoid.toMonoid M) :=
  by
  rintro ⟨⟩ ⟨⟩ h
  congr <;> injection h
#align left_cancel_monoid.to_monoid_injective LeftCancelMonoid.toMonoid_injective
#align add_left_cancel_monoid.to_add_monoid_injective AddLeftCancelMonoid.toAddMonoid_injective
-/

/- warning: left_cancel_monoid.ext -> LeftCancelMonoid.ext is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {{m₁ : LeftCancelMonoid.{u1} M}} {{m₂ : LeftCancelMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (LeftCancelMonoid.mul.{u1} M m₁) (LeftCancelMonoid.mul.{u1} M m₂)) -> (Eq.{succ u1} (LeftCancelMonoid.{u1} M) m₁ m₂)
but is expected to have type
  forall {M : Type.{u1}} {{m₁ : LeftCancelMonoid.{u1} M}} {{m₂ : LeftCancelMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (LeftCancelSemigroup.toSemigroup.{u1} M (LeftCancelMonoid.toLeftCancelSemigroup.{u1} M m₁)))) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (LeftCancelSemigroup.toSemigroup.{u1} M (LeftCancelMonoid.toLeftCancelSemigroup.{u1} M m₂))))) -> (Eq.{succ u1} (LeftCancelMonoid.{u1} M) m₁ m₂)
Case conversion may be inaccurate. Consider using '#align left_cancel_monoid.ext LeftCancelMonoid.extₓ'. -/
@[ext, to_additive]
theorem LeftCancelMonoid.ext {M : Type u} ⦃m₁ m₂ : LeftCancelMonoid M⦄ (h_mul : m₁.mul = m₂.mul) :
    m₁ = m₂ :=
  LeftCancelMonoid.toMonoid_injective <| Monoid.ext h_mul
#align left_cancel_monoid.ext LeftCancelMonoid.ext
#align add_left_cancel_monoid.ext AddLeftCancelMonoid.ext

#print RightCancelMonoid.toMonoid_injective /-
@[to_additive]
theorem RightCancelMonoid.toMonoid_injective {M : Type u} :
    Function.Injective (@RightCancelMonoid.toMonoid M) :=
  by
  rintro ⟨⟩ ⟨⟩ h
  congr <;> injection h
#align right_cancel_monoid.to_monoid_injective RightCancelMonoid.toMonoid_injective
#align add_right_cancel_monoid.to_add_monoid_injective AddRightCancelMonoid.toAddMonoid_injective
-/

/- warning: right_cancel_monoid.ext -> RightCancelMonoid.ext is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {{m₁ : RightCancelMonoid.{u1} M}} {{m₂ : RightCancelMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (RightCancelMonoid.mul.{u1} M m₁) (RightCancelMonoid.mul.{u1} M m₂)) -> (Eq.{succ u1} (RightCancelMonoid.{u1} M) m₁ m₂)
but is expected to have type
  forall {M : Type.{u1}} {{m₁ : RightCancelMonoid.{u1} M}} {{m₂ : RightCancelMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (RightCancelSemigroup.toSemigroup.{u1} M (RightCancelMonoid.toRightCancelSemigroup.{u1} M m₁)))) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (RightCancelSemigroup.toSemigroup.{u1} M (RightCancelMonoid.toRightCancelSemigroup.{u1} M m₂))))) -> (Eq.{succ u1} (RightCancelMonoid.{u1} M) m₁ m₂)
Case conversion may be inaccurate. Consider using '#align right_cancel_monoid.ext RightCancelMonoid.extₓ'. -/
@[ext, to_additive]
theorem RightCancelMonoid.ext {M : Type u} ⦃m₁ m₂ : RightCancelMonoid M⦄ (h_mul : m₁.mul = m₂.mul) :
    m₁ = m₂ :=
  RightCancelMonoid.toMonoid_injective <| Monoid.ext h_mul
#align right_cancel_monoid.ext RightCancelMonoid.ext
#align add_right_cancel_monoid.ext AddRightCancelMonoid.ext

#print CancelMonoid.toLeftCancelMonoid_injective /-
@[to_additive]
theorem CancelMonoid.toLeftCancelMonoid_injective {M : Type u} :
    Function.Injective (@CancelMonoid.toLeftCancelMonoid M) :=
  by
  rintro ⟨⟩ ⟨⟩ h
  congr <;> injection h
#align cancel_monoid.to_left_cancel_monoid_injective CancelMonoid.toLeftCancelMonoid_injective
#align add_cancel_monoid.to_left_cancel_add_monoid_injective AddCancelMonoid.toAddLeftCancelMonoid_injective
-/

/- warning: cancel_monoid.ext -> CancelMonoid.ext is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {{m₁ : CancelMonoid.{u1} M}} {{m₂ : CancelMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (CancelMonoid.mul.{u1} M m₁) (CancelMonoid.mul.{u1} M m₂)) -> (Eq.{succ u1} (CancelMonoid.{u1} M) m₁ m₂)
but is expected to have type
  forall {M : Type.{u1}} {{m₁ : CancelMonoid.{u1} M}} {{m₂ : CancelMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (LeftCancelSemigroup.toSemigroup.{u1} M (LeftCancelMonoid.toLeftCancelSemigroup.{u1} M (CancelMonoid.toLeftCancelMonoid.{u1} M m₁))))) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (LeftCancelSemigroup.toSemigroup.{u1} M (LeftCancelMonoid.toLeftCancelSemigroup.{u1} M (CancelMonoid.toLeftCancelMonoid.{u1} M m₂)))))) -> (Eq.{succ u1} (CancelMonoid.{u1} M) m₁ m₂)
Case conversion may be inaccurate. Consider using '#align cancel_monoid.ext CancelMonoid.extₓ'. -/
@[ext, to_additive]
theorem CancelMonoid.ext {M : Type _} ⦃m₁ m₂ : CancelMonoid M⦄ (h_mul : m₁.mul = m₂.mul) :
    m₁ = m₂ :=
  CancelMonoid.toLeftCancelMonoid_injective <| LeftCancelMonoid.ext h_mul
#align cancel_monoid.ext CancelMonoid.ext
#align add_cancel_monoid.ext AddCancelMonoid.ext

#print CancelCommMonoid.toCommMonoid_injective /-
@[to_additive]
theorem CancelCommMonoid.toCommMonoid_injective {M : Type u} :
    Function.Injective (@CancelCommMonoid.toCommMonoid M) :=
  by
  rintro ⟨⟩ ⟨⟩ h
  congr <;> injection h
#align cancel_comm_monoid.to_comm_monoid_injective CancelCommMonoid.toCommMonoid_injective
#align add_cancel_comm_monoid.to_add_comm_monoid_injective AddCancelCommMonoid.toAddCommMonoid_injective
-/

/- warning: cancel_comm_monoid.ext -> CancelCommMonoid.ext is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {{m₁ : CancelCommMonoid.{u1} M}} {{m₂ : CancelCommMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (CancelCommMonoid.mul.{u1} M m₁) (CancelCommMonoid.mul.{u1} M m₂)) -> (Eq.{succ u1} (CancelCommMonoid.{u1} M) m₁ m₂)
but is expected to have type
  forall {M : Type.{u1}} {{m₁ : CancelCommMonoid.{u1} M}} {{m₂ : CancelCommMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (LeftCancelSemigroup.toSemigroup.{u1} M (LeftCancelMonoid.toLeftCancelSemigroup.{u1} M (CancelCommMonoid.toLeftCancelMonoid.{u1} M m₁))))) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (LeftCancelSemigroup.toSemigroup.{u1} M (LeftCancelMonoid.toLeftCancelSemigroup.{u1} M (CancelCommMonoid.toLeftCancelMonoid.{u1} M m₂)))))) -> (Eq.{succ u1} (CancelCommMonoid.{u1} M) m₁ m₂)
Case conversion may be inaccurate. Consider using '#align cancel_comm_monoid.ext CancelCommMonoid.extₓ'. -/
@[ext, to_additive]
theorem CancelCommMonoid.ext {M : Type _} ⦃m₁ m₂ : CancelCommMonoid M⦄ (h_mul : m₁.mul = m₂.mul) :
    m₁ = m₂ :=
  CancelCommMonoid.toCommMonoid_injective <| CommMonoid.ext h_mul
#align cancel_comm_monoid.ext CancelCommMonoid.ext
#align add_cancel_comm_monoid.ext AddCancelCommMonoid.ext

/- warning: div_inv_monoid.ext -> DivInvMonoid.ext is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {{m₁ : DivInvMonoid.{u1} M}} {{m₂ : DivInvMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (DivInvMonoid.mul.{u1} M m₁) (DivInvMonoid.mul.{u1} M m₂)) -> (Eq.{succ u1} (M -> M) (DivInvMonoid.inv.{u1} M m₁) (DivInvMonoid.inv.{u1} M m₂)) -> (Eq.{succ u1} (DivInvMonoid.{u1} M) m₁ m₂)
but is expected to have type
  forall {M : Type.{u1}} {{m₁ : DivInvMonoid.{u1} M}} {{m₂ : DivInvMonoid.{u1} M}}, (Eq.{succ u1} (M -> M -> M) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (Monoid.toSemigroup.{u1} M (DivInvMonoid.toMonoid.{u1} M m₁)))) (Mul.mul.{u1} M (Semigroup.toMul.{u1} M (Monoid.toSemigroup.{u1} M (DivInvMonoid.toMonoid.{u1} M m₂))))) -> (Eq.{succ u1} (M -> M) (Inv.inv.{u1} M (DivInvMonoid.toInv.{u1} M m₁)) (Inv.inv.{u1} M (DivInvMonoid.toInv.{u1} M m₂))) -> (Eq.{succ u1} (DivInvMonoid.{u1} M) m₁ m₂)
Case conversion may be inaccurate. Consider using '#align div_inv_monoid.ext DivInvMonoid.extₓ'. -/
@[ext, to_additive]
theorem DivInvMonoid.ext {M : Type _} ⦃m₁ m₂ : DivInvMonoid M⦄ (h_mul : m₁.mul = m₂.mul)
    (h_inv : m₁.inv = m₂.inv) : m₁ = m₂ :=
  by
  have h₁ : (@DivInvMonoid.toMonoid _ m₁).one = (@DivInvMonoid.toMonoid _ m₂).one :=
    congr_arg (@Monoid.one M) (Monoid.ext h_mul)
  set f : @MonoidHom M M (by letI := m₁ <;> infer_instance) (by letI := m₂ <;> infer_instance) :=
    { toFun := id
      map_one' := h₁
      map_mul' := fun x y => congr_fun (congr_fun h_mul x) y }
  have hpow : (@DivInvMonoid.toMonoid _ m₁).npow = (@DivInvMonoid.toMonoid _ m₂).npow :=
    congr_arg (@Monoid.npow M) (Monoid.ext h_mul)
  have hzpow : m₁.zpow = m₂.zpow := by
    ext (m x)
    exact @MonoidHom.map_zpow' M M m₁ m₂ f (congr_fun h_inv) x m
  have hdiv : m₁.div = m₂.div := by
    ext (a b)
    exact @map_div' M M _ m₁ m₂ _ f (congr_fun h_inv) a b
  cases m₁
  cases m₂
  congr
  exacts[h_mul, h₁, hpow, h_inv, hdiv, hzpow]
#align div_inv_monoid.ext DivInvMonoid.ext
#align sub_neg_monoid.ext SubNegMonoid.ext

/- warning: group.ext -> Group.ext is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} {{g₁ : Group.{u1} G}} {{g₂ : Group.{u1} G}}, (Eq.{succ u1} (G -> G -> G) (Group.mul.{u1} G g₁) (Group.mul.{u1} G g₂)) -> (Eq.{succ u1} (Group.{u1} G) g₁ g₂)
but is expected to have type
  forall {G : Type.{u1}} {{g₁ : Group.{u1} G}} {{g₂ : Group.{u1} G}}, (Eq.{succ u1} (G -> G -> G) (Mul.mul.{u1} G (Semigroup.toMul.{u1} G (Monoid.toSemigroup.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G g₁))))) (Mul.mul.{u1} G (Semigroup.toMul.{u1} G (Monoid.toSemigroup.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G g₂)))))) -> (Eq.{succ u1} (Group.{u1} G) g₁ g₂)
Case conversion may be inaccurate. Consider using '#align group.ext Group.extₓ'. -/
@[ext, to_additive]
theorem Group.ext {G : Type _} ⦃g₁ g₂ : Group G⦄ (h_mul : g₁.mul = g₂.mul) : g₁ = g₂ :=
  by
  set f :=
    @MonoidHom.mk' G G (by letI := g₁ <;> infer_instance) g₂ id fun a b =>
      congr_fun (congr_fun h_mul a) b
  exact
    Group.toDivInvMonoid_injective
      (DivInvMonoid.ext h_mul
        (funext <| @MonoidHom.map_inv G G g₁ (@Group.toDivisionMonoid _ g₂) f))
#align group.ext Group.ext
#align add_group.ext AddGroup.ext

/- warning: comm_group.ext -> CommGroup.ext is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} {{g₁ : CommGroup.{u1} G}} {{g₂ : CommGroup.{u1} G}}, (Eq.{succ u1} (G -> G -> G) (CommGroup.mul.{u1} G g₁) (CommGroup.mul.{u1} G g₂)) -> (Eq.{succ u1} (CommGroup.{u1} G) g₁ g₂)
but is expected to have type
  forall {G : Type.{u1}} {{g₁ : CommGroup.{u1} G}} {{g₂ : CommGroup.{u1} G}}, (Eq.{succ u1} (G -> G -> G) (Mul.mul.{u1} G (Semigroup.toMul.{u1} G (Monoid.toSemigroup.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G (CommGroup.toGroup.{u1} G g₁)))))) (Mul.mul.{u1} G (Semigroup.toMul.{u1} G (Monoid.toSemigroup.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G (CommGroup.toGroup.{u1} G g₂))))))) -> (Eq.{succ u1} (CommGroup.{u1} G) g₁ g₂)
Case conversion may be inaccurate. Consider using '#align comm_group.ext CommGroup.extₓ'. -/
@[ext, to_additive]
theorem CommGroup.ext {G : Type _} ⦃g₁ g₂ : CommGroup G⦄ (h_mul : g₁.mul = g₂.mul) : g₁ = g₂ :=
  CommGroup.toGroup_injective <| Group.ext h_mul
#align comm_group.ext CommGroup.ext
#align add_comm_group.ext AddCommGroup.ext


import for_mathlib.short_exact
import for_mathlib.derived.defs

noncomputable theory

open category_theory category_theory.limits

variables {A : Type*} [category A] [abelian A] [enough_projectives A]
variables {X Y Z : cochain_complex A ℤ} (f : X ⟶ Y) (g : Y ⟶ Z)

-- this files exists to save these lemmas from a file that will probably get nuked

-- move me
lemma biprod.lift_desc_comm {X₁ X₂ Y₁ Y₂ : A}
  (f₁₁ : X₁ ⟶ Y₁) (f₁₂ : X₁ ⟶ Y₂) (f₂₁ : X₂ ⟶ Y₁) (f₂₂ : X₂ ⟶ Y₂) :
  biprod.lift (biprod.desc f₁₁ f₂₁) (biprod.desc f₁₂ f₂₂) =
  biprod.desc (biprod.lift f₁₁ f₁₂) (biprod.lift f₂₁ f₂₂) :=
by ext; simp only [category.assoc,
  biprod.lift_fst, biprod.lift_snd, biprod.inl_desc, biprod.inr_desc]

-- move me
lemma biprod.comp_lift {W X Y Z : A} (f : W ⟶ X) (g : X ⟶ Y) (h : X ⟶ Z) :
  f ≫ biprod.lift g h = biprod.lift (f ≫ g) (f ≫ h) :=
by ext; simp only [category.assoc, biprod.lift_fst, biprod.lift_snd]

-- move me
@[reassoc]
lemma comp_factor_thru_image_eq_zero {X Y Z : A} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) :
  f ≫ factor_thru_image g = 0 :=
by rw [← cancel_mono (limits.image.ι g), category.assoc, limits.image.fac, w, zero_comp]