-- import StatementAutoformalisation.Interface
import StatementAutoformalisation.Config.Default
-- import StatementAutoformalisation.Config.Custom
-- import StatementAutoformalisation.Config.Informalisation
-- import StatementAutoformalisation.Config.SuggestName
-- import Mathbin.All

/-!
The code actions implemented so far can be tested here.

- To test autoformalisation, click anywhere on the comment below and
  select the code action to translate it to Lean code.
- To test informalisation, click anywhere on the `example` below (EXCEPT
  the end) and attempt to generate a natural language description.
- To test name suggestions, select the *type* of the `example` below
  (everything between `example` and `:=`, including the first `:`) and
  attempt to generate a name for the declaration.
-/

/- Every prime number is either `2` or odd. -/

example : ∀ n : Nat, ∃ m : Nat, m > n ∧ m % 2 = 1  := sorry

def req : Prompt.Request := ⟨Default.PromptParams, "There are infinitely many odd numbers."⟩

#eval do
  let decls ← Prompt.promptDecls req
  return buildPrompt DeclarationWithDocstring.toMessage decls req.stmt


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.sites.pretopology
import Mathlib.category_theory.limits.shapes.types
import Mathlib.category_theory.full_subcategory
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Sheaves of types on a Grothendieck topology

Defines the notion of a sheaf of types (usually called a sheaf of sets by mathematicians)
on a category equipped with a Grothendieck topology, as well as a range of equivalent
conditions useful in different situations.

First define what it means for a presheaf `P : Cᵒᵖ ⥤ Type v` to be a sheaf *for* a particular
presieve `R` on `X`:
* A *family of elements* `x` for `P` at `R` is an element `x_f` of `P Y` for every `f : Y ⟶ X` in
  `R`. See `family_of_elements`.
* The family `x` is *compatible* if, for any `f₁ : Y₁ ⟶ X` and `f₂ : Y₂ ⟶ X` both in `R`,
  and any `g₁ : Z ⟶ Y₁` and `g₂ : Z ⟶ Y₂` such that `g₁ ≫ f₁ = g₂ ≫ f₂`, the restriction of
  `x_f₁` along `g₁` agrees with the restriction of `x_f₂` along `g₂`.
  See `family_of_elements.compatible`.
* An *amalgamation* `t` for the family is an element of `P X` such that for every `f : Y ⟶ X` in
  `R`, the restriction of `t` on `f` is `x_f`.
  See `family_of_elements.is_amalgamation`.
We then say `P` is *separated* for `R` if every compatible family has at most one amalgamation,
and it is a *sheaf* for `R` if every compatible family has a unique amalgamation.
See `is_separated_for` and `is_sheaf_for`.

In the special case where `R` is a sieve, the compatibility condition can be simplified:
* The family `x` is *compatible* if, for any `f : Y ⟶ X` in `R` and `g : Z ⟶ Y`, the restriction of
  `x_f` along `g` agrees with `x_(g ≫ f)` (which is well defined since `g ≫ f` is in `R`).
See `family_of_elements.sieve_compatible` and `compatible_iff_sieve_compatible`.

In the special case where `C` has pullbacks, the compatibility condition can be simplified:
* The family `x` is *compatible* if, for any `f : Y ⟶ X` and `g : Z ⟶ X` both in `R`,
  the restriction of `x_f` along `π₁ : pullback f g ⟶ Y` agrees with the restriction of `x_g`
  along `π₂ : pullback f g ⟶ Z`.
See `family_of_elements.pullback_compatible` and `pullback_compatible_iff`.

Now given a Grothendieck topology `J`, `P` is a sheaf if it is a sheaf for every sieve in the
topology. See `is_sheaf`.

In the case where the topology is generated by a basis, it suffices to check `P` is a sheaf for
every sieve in the pretopology. See `is_sheaf_pretopology`.

We also provide equivalent conditions to satisfy alternate definitions given in the literature.

* Stacks: In `equalizer.presieve.sheaf_condition`, the sheaf condition at a presieve is shown to be
  equivalent to that of https://stacks.math.columbia.edu/tag/00VM (and combined with
  `is_sheaf_pretopology`, this shows the notions of `is_sheaf` are exactly equivalent.)

  The condition of https://stacks.math.columbia.edu/tag/00Z8 is virtually identical to the
  statement of `yoneda_condition_iff_sheaf_condition` (since the bijection described there carries
  the same information as the unique existence.)

* Maclane-Moerdijk [MM92]: Using `compatible_iff_sieve_compatible`, the definitions of `is_sheaf`
  are equivalent. There are also alternate definitions given:
  - Yoneda condition: Defined in `yoneda_sheaf_condition` and equivalence in
    `yoneda_condition_iff_sheaf_condition`.
  - Equalizer condition (Equation 3): Defined in the `equalizer.sieve` namespace, and equivalence
    in `equalizer.sieve.sheaf_condition`.
  - Matching family for presieves with pullback: `pullback_compatible_iff`.
  - Sheaf for a pretopology (Prop 1): `is_sheaf_pretopology` combined with the previous.
  - Sheaf for a pretopology as equalizer (Prop 1, bis): `equalizer.presieve.sheaf_condition`
    combined with the previous.

## Implementation

The sheaf condition is given as a proposition, rather than a subsingleton in `Type (max u v)`.
This doesn't seem to make a big difference, other than making a couple of definitions noncomputable,
but it means that equivalent conditions can be given as `↔` statements rather than `≃` statements,
which can be convenient.

## References

* [MM92]: *Sheaves in geometry and logic*, Saunders MacLane, and Ieke Moerdijk:
  Chapter III, Section 4.
* [Elephant]: *Sketches of an Elephant*, P. T. Johnstone: C2.1.
* https://stacks.math.columbia.edu/tag/00VL (sheaves on a pretopology or site)
* https://stacks.math.columbia.edu/tag/00ZB (sheaves on a topology)

-/

namespace category_theory

namespace presieve

/--
A family of elements for a presheaf `P` given a collection of arrows `R` with fixed codomain `X`
consists of an element of `P Y` for every `f : Y ⟶ X` in `R`.
A presheaf is a sheaf (resp, separated) if every *compatible* family of elements has exactly one
(resp, at most one) amalgamation.

This data is referred to as a `family` in [MM92], Chapter III, Section 4. It is also a concrete
version of the elements of the middle object in https://stacks.math.columbia.edu/tag/00VM which is
more useful for direct calculations. It is also used implicitly in Definition C2.1.2 in [Elephant].
-/
def family_of_elements {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) (R : presieve X) :=
  {Y : C} → (f : Y ⟶ X) → R f → functor.obj P (opposite.op Y)

protected instance family_of_elements.inhabited {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} : Inhabited (family_of_elements P ⊥) :=
  { default := fun (Y : C) (f : Y ⟶ X) => false.elim }

/--
A family of elements for a presheaf on the presieve `R₂` can be restricted to a smaller presieve
`R₁`.
-/
def family_of_elements.restrict {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R₁ : presieve X} {R₂ : presieve X} (h : R₁ ≤ R₂) : family_of_elements P R₂ → family_of_elements P R₁ :=
  fun (x : family_of_elements P R₂) (Y : C) (f : Y ⟶ X) (hf : R₁ f) => x f (h Y hf)

/--
A family of elements for the arrow set `R` is *compatible* if for any `f₁ : Y₁ ⟶ X` and
`f₂ : Y₂ ⟶ X` in `R`, and any `g₁ : Z ⟶ Y₁` and `g₂ : Z ⟶ Y₂`, if the square `g₁ ≫ f₁ = g₂ ≫ f₂`
commutes then the elements of `P Z` obtained by restricting the element of `P Y₁` along `g₁` and
restricting the element of `P Y₂` along `g₂` are the same.

In special cases, this condition can be simplified, see `pullback_compatible_iff` and
`compatible_iff_sieve_compatible`.

This is referred to as a "compatible family" in Definition C2.1.2 of [Elephant], and on nlab:
https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents
-/
def family_of_elements.compatible {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) :=
  ∀ {Y₁ Y₂ Z : C} (g₁ : Z ⟶ Y₁) (g₂ : Z ⟶ Y₂) {f₁ : Y₁ ⟶ X} {f₂ : Y₂ ⟶ X} (h₁ : R f₁) (h₂ : R f₂),
    g₁ ≫ f₁ = g₂ ≫ f₂ → functor.map P (has_hom.hom.op g₁) (x f₁ h₁) = functor.map P (has_hom.hom.op g₂) (x f₂ h₂)

/--
If the category `C` has pullbacks, this is an alternative condition for a family of elements to be
compatible: For any `f : Y ⟶ X` and `g : Z ⟶ X` in the presieve `R`, the restriction of the
given elements for `f` and `g` to the pullback agree.
This is equivalent to being compatible (provided `C` has pullbacks), shown in
`pullback_compatible_iff`.

This is the definition for a "matching" family given in [MM92], Chapter III, Section 4,
Equation (5). Viewing the type `family_of_elements` as the middle object of the fork in
https://stacks.math.columbia.edu/tag/00VM, this condition expresses that `pr₀* (x) = pr₁* (x)`,
using the notation defined there.
-/
def family_of_elements.pullback_compatible {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) [limits.has_pullbacks C] :=
  ∀ {Y₁ Y₂ : C} {f₁ : Y₁ ⟶ X} {f₂ : Y₂ ⟶ X} (h₁ : R f₁) (h₂ : R f₂),
    functor.map P (has_hom.hom.op limits.pullback.fst) (x f₁ h₁) =
      functor.map P (has_hom.hom.op limits.pullback.snd) (x f₂ h₂)

theorem pullback_compatible_iff {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) [limits.has_pullbacks C] : family_of_elements.compatible x ↔ family_of_elements.pullback_compatible x := sorry

/-- The restriction of a compatible family is compatible. -/
theorem family_of_elements.compatible.restrict {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R₁ : presieve X} {R₂ : presieve X} (h : R₁ ≤ R₂) {x : family_of_elements P R₂} : family_of_elements.compatible x → family_of_elements.compatible (family_of_elements.restrict h x) :=
  fun (q : family_of_elements.compatible x) (Y₁ Y₂ Z : C) (g₁ : Z ⟶ Y₁) (g₂ : Z ⟶ Y₂) (f₁ : Y₁ ⟶ X) (f₂ : Y₂ ⟶ X)
    (h₁ : R₁ f₁) (h₂ : R₁ f₂) (comm : g₁ ≫ f₁ = g₂ ≫ f₂) => q g₁ g₂ (h Y₁ h₁) (h Y₂ h₂) comm

/--
Extend a family of elements to the sieve generated by an arrow set.
This is the construction described as "easy" in Lemma C2.1.3 of [Elephant].
-/
def family_of_elements.sieve_extend {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) : family_of_elements P ⇑(sieve.generate R) :=
  fun (Z : C) (f : Z ⟶ X) (hf : coe_fn (sieve.generate R) Z f) =>
    functor.map P (has_hom.hom.op (classical.some sorry)) (x (classical.some sorry) sorry)

/-- The extension of a compatible family to the generated sieve is compatible. -/
theorem family_of_elements.compatible.sieve_extend {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) (hx : family_of_elements.compatible x) : family_of_elements.compatible (family_of_elements.sieve_extend x) := sorry

/-- The extension of a family agrees with the original family. -/
theorem extend_agrees {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {Y : C} {R : presieve X} {x : family_of_elements P R} (t : family_of_elements.compatible x) {f : Y ⟶ X} (hf : R f) : family_of_elements.sieve_extend x f
    (Exists.intro Y (Exists.intro 𝟙 (Exists.intro f { left := hf, right := category.id_comp f }))) =
  x f hf := sorry

/-- The restriction of an extension is the original. -/
@[simp] theorem restrict_extend {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} {x : family_of_elements P R} (t : family_of_elements.compatible x) : family_of_elements.restrict (sieve.le_generate R) (family_of_elements.sieve_extend x) = x :=
  funext fun (Y : C) => funext fun (f : Y ⟶ X) => funext fun (hf : R f) => extend_agrees t hf

/--
If the arrow set for a family of elements is actually a sieve (i.e. it is downward closed) then the
consistency condition can be simplified.
This is an equivalent condition, see `compatible_iff_sieve_compatible`.

This is the notion of "matching" given for families on sieves given in [MM92], Chapter III,
Section 4, Equation 1, and nlab: https://ncatlab.org/nlab/show/matching+family.
See also the discussion before Lemma C2.1.4 of [Elephant].
-/
def family_of_elements.sieve_compatible {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} (x : family_of_elements P ⇑S) :=
  ∀ {Y Z : C} (f : Y ⟶ X) (g : Z ⟶ Y) (hf : coe_fn S Y f),
    x (g ≫ f) (sieve.downward_closed S hf g) = functor.map P (has_hom.hom.op g) (x f hf)

theorem compatible_iff_sieve_compatible {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} (x : family_of_elements P ⇑S) : family_of_elements.compatible x ↔ family_of_elements.sieve_compatible x := sorry

theorem family_of_elements.compatible.to_sieve_compatible {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} {x : family_of_elements P ⇑S} (t : family_of_elements.compatible x) : family_of_elements.sieve_compatible x :=
  iff.mp (compatible_iff_sieve_compatible x) t

/--
Two compatible families on the sieve generated by a presieve `R` are equal if and only if they are
equal when restricted to `R`.
-/
theorem restrict_inj {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} {x₁ : family_of_elements P ⇑(sieve.generate R)} {x₂ : family_of_elements P ⇑(sieve.generate R)} (t₁ : family_of_elements.compatible x₁) (t₂ : family_of_elements.compatible x₂) : family_of_elements.restrict (sieve.le_generate R) x₁ = family_of_elements.restrict (sieve.le_generate R) x₂ → x₁ = x₂ := sorry

/--
Given a family of elements `x` for the sieve `S` generated by a presieve `R`, if `x` is restricted
to `R` and then extended back up to `S`, the resulting extension equals `x`.
-/
@[simp] theorem extend_restrict {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} {x : family_of_elements P ⇑(sieve.generate R)} (t : family_of_elements.compatible x) : family_of_elements.sieve_extend (family_of_elements.restrict (sieve.le_generate R) x) = x := sorry

/--
The given element `t` of `P.obj (op X)` is an *amalgamation* for the family of elements `x` if every
restriction `P.map f.op t = x_f` for every arrow `f` in the presieve `R`.

This is the definition given in  https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents,
and https://ncatlab.org/nlab/show/matching+family, as well as [MM92], Chapter III, Section 4,
equation (2).
-/
def family_of_elements.is_amalgamation {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) (t : functor.obj P (opposite.op X)) :=
  ∀ {Y : C} (f : Y ⟶ X) (h : R f), functor.map P (has_hom.hom.op f) t = x f h

theorem is_compatible_of_exists_amalgamation {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) (h : ∃ (t : functor.obj P (opposite.op X)), family_of_elements.is_amalgamation x t) : family_of_elements.compatible x := sorry

theorem is_amalgamation_restrict {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R₁ : presieve X} {R₂ : presieve X} (h : R₁ ≤ R₂) (x : family_of_elements P R₂) (t : functor.obj P (opposite.op X)) (ht : family_of_elements.is_amalgamation x t) : family_of_elements.is_amalgamation (family_of_elements.restrict h x) t :=
  fun (Y : C) (f : Y ⟶ X) (hf : R₁ f) => ht f (h Y hf)

theorem is_amalgamation_sieve_extend {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (x : family_of_elements P R) (t : functor.obj P (opposite.op X)) (ht : family_of_elements.is_amalgamation x t) : family_of_elements.is_amalgamation (family_of_elements.sieve_extend x) t := sorry

/-- A presheaf is separated for a presieve if there is at most one amalgamation. -/
def is_separated_for {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) (R : presieve X) :=
  ∀ (x : family_of_elements P R) (t₁ t₂ : functor.obj P (opposite.op X)),
    family_of_elements.is_amalgamation x t₁ → family_of_elements.is_amalgamation x t₂ → t₁ = t₂

theorem is_separated_for.ext {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (hR : is_separated_for P R) {t₁ : functor.obj P (opposite.op X)} {t₂ : functor.obj P (opposite.op X)} (h : ∀ {Y : C} {f : Y ⟶ X}, R f → functor.map P (has_hom.hom.op f) t₁ = functor.map P (has_hom.hom.op f) t₂) : t₁ = t₂ :=
  hR (fun (Y : C) (f : Y ⟶ X) (hf : R f) => functor.map P (has_hom.hom.op f) t₂) t₁ t₂
    (fun (Y : C) (f : Y ⟶ X) (hf : R f) => h hf) fun (Y : C) (f : Y ⟶ X) (hf : R f) => rfl

theorem is_separated_for_iff_generate {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} : is_separated_for P R ↔ is_separated_for P ⇑(sieve.generate R) := sorry

theorem is_separated_for_top {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) : is_separated_for P ⊤ := sorry

/--
We define `P` to be a sheaf for the presieve `R` if every compatible family has a unique
amalgamation.

This is the definition of a sheaf for the given presieve given in C2.1.2 of [Elephant], and
https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents. Using `compatible_iff_sieve_compatible`,
this is equivalent to the definition of a sheaf in [MM92], Chapter III, Section 4.
-/
def is_sheaf_for {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) (R : presieve X) :=
  ∀ (x : family_of_elements P R),
    family_of_elements.compatible x →
      exists_unique fun (t : functor.obj P (opposite.op X)) => family_of_elements.is_amalgamation x t

/--
This is an equivalent condition to be a sheaf, which is useful for the abstraction to local
operators on elementary toposes. However this definition is defined only for sieves, not presieves.
The equivalence between this and `is_sheaf_for` is given in `yoneda_condition_iff_sheaf_condition`.
This version is also useful to establish that being a sheaf is preserved under isomorphism of
presheaves.

See the discussion before Equation (3) of [MM92], Chapter III, Section 4. See also C2.1.4 of
[Elephant]. This is also a direct reformulation of https://stacks.math.columbia.edu/tag/00Z8.
-/
def yoneda_sheaf_condition {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) (S : sieve X) :=
  ∀ (f : sieve.functor S ⟶ P), exists_unique fun (g : functor.obj yoneda X ⟶ P) => sieve.functor_inclusion S ≫ g = f

/--
(Implementation). This is a (primarily internal) equivalence between natural transformations
and compatible families.

Cf the discussion after Lemma 7.47.10 in https://stacks.math.columbia.edu/tag/00YW. See also
the proof of C2.1.4 of [Elephant], and the discussion in [MM92], Chapter III, Section 4.
-/
def nat_trans_equiv_compatible_family {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} : (sieve.functor S ⟶ P) ≃ Subtype fun (x : family_of_elements P ⇑S) => family_of_elements.compatible x :=
  equiv.mk
    (fun (α : sieve.functor S ⟶ P) =>
      { val :=
          fun (Y : C) (f : Y ⟶ X) (hf : coe_fn S Y f) => nat_trans.app α (opposite.op Y) { val := f, property := hf },
        property := sorry })
    (fun (t : Subtype fun (x : family_of_elements P ⇑S) => family_of_elements.compatible x) =>
      nat_trans.mk
        fun (Y : Cᵒᵖ) (f : functor.obj (sieve.functor S) Y) => subtype.val t (opposite.unop Y) (subtype.val f) sorry)
    sorry sorry

/-- (Implementation). A lemma useful to prove `yoneda_condition_iff_sheaf_condition`. -/
theorem extension_iff_amalgamation {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} (x : sieve.functor S ⟶ P) (g : functor.obj yoneda X ⟶ P) : sieve.functor_inclusion S ≫ g = x ↔
  family_of_elements.is_amalgamation (subtype.val (coe_fn nat_trans_equiv_compatible_family x)) (coe_fn yoneda_equiv g) := sorry

/--
The yoneda version of the sheaf condition is equivalent to the sheaf condition.

C2.1.4 of [Elephant].
-/
theorem is_sheaf_for_iff_yoneda_sheaf_condition {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} : is_sheaf_for P ⇑S ↔ yoneda_sheaf_condition P S := sorry

/--
If `P` is a sheaf for the sieve `S` on `X`, a natural transformation from `S` (viewed as a functor)
to `P` can be (uniquely) extended to all of `yoneda.obj X`.

      f
   S  →  P
   ↓  ↗
   yX

-/
def is_sheaf_for.extend {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} (h : is_sheaf_for P ⇑S) (f : sieve.functor S ⟶ P) : functor.obj yoneda X ⟶ P :=
  classical.some sorry

/--
Show that the extension of `f : S.functor ⟶ P` to all of `yoneda.obj X` is in fact an extension, ie
that the triangle below commutes, provided `P` is a sheaf for `S`

      f
   S  →  P
   ↓  ↗
   yX

-/
@[simp] theorem is_sheaf_for.functor_inclusion_comp_extend {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} (h : is_sheaf_for P ⇑S) (f : sieve.functor S ⟶ P) : sieve.functor_inclusion S ≫ is_sheaf_for.extend h f = f :=
  classical.some_spec (exists_unique.exists (iff.mp is_sheaf_for_iff_yoneda_sheaf_condition h f))

/-- The extension of `f` to `yoneda.obj X` is unique. -/
theorem is_sheaf_for.unique_extend {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} (h : is_sheaf_for P ⇑S) {f : sieve.functor S ⟶ P} (t : functor.obj yoneda X ⟶ P) (ht : sieve.functor_inclusion S ≫ t = f) : t = is_sheaf_for.extend h f :=
  exists_unique.unique (iff.mp is_sheaf_for_iff_yoneda_sheaf_condition h f) ht
    (is_sheaf_for.functor_inclusion_comp_extend h f)

/--
If `P` is a sheaf for the sieve `S` on `X`, then if two natural transformations from `yoneda.obj X`
to `P` agree when restricted to the subfunctor given by `S`, they are equal.
-/
theorem is_sheaf_for.hom_ext {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {S : sieve X} (h : is_sheaf_for P ⇑S) (t₁ : functor.obj yoneda X ⟶ P) (t₂ : functor.obj yoneda X ⟶ P) (ht : sieve.functor_inclusion S ≫ t₁ = sieve.functor_inclusion S ≫ t₂) : t₁ = t₂ :=
  Eq.trans (is_sheaf_for.unique_extend h t₁ ht) (Eq.symm (is_sheaf_for.unique_extend h t₂ rfl))

/-- `P` is a sheaf for `R` iff it is separated for `R` and there exists an amalgamation. -/
theorem is_separated_for_and_exists_is_amalgamation_iff_sheaf_for {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} : (is_separated_for P R ∧
    ∀ (x : family_of_elements P R),
      family_of_elements.compatible x → ∃ (t : functor.obj P (opposite.op X)), family_of_elements.is_amalgamation x t) ↔
  is_sheaf_for P R := sorry

/--
If `P` is separated for `R` and every family has an amalgamation, then `P` is a sheaf for `R`.
-/
theorem is_separated_for.is_sheaf_for {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (t : is_separated_for P R) : (∀ (x : family_of_elements P R),
    family_of_elements.compatible x → ∃ (t : functor.obj P (opposite.op X)), family_of_elements.is_amalgamation x t) →
  is_sheaf_for P R := sorry

/-- If `P` is a sheaf for `R`, it is separated for `R`. -/
theorem is_sheaf_for.is_separated_for {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} : is_sheaf_for P R → is_separated_for P R :=
  fun (q : is_sheaf_for P R) => and.left (iff.mpr is_separated_for_and_exists_is_amalgamation_iff_sheaf_for q)

/-- Get the amalgamation of the given compatible family, provided we have a sheaf. -/
def is_sheaf_for.amalgamate {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (t : is_sheaf_for P R) (x : family_of_elements P R) (hx : family_of_elements.compatible x) : functor.obj P (opposite.op X) :=
  classical.some sorry

theorem is_sheaf_for.is_amalgamation {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} (t : is_sheaf_for P R) {x : family_of_elements P R} (hx : family_of_elements.compatible x) : family_of_elements.is_amalgamation x (is_sheaf_for.amalgamate t x hx) :=
  classical.some_spec (exists_unique.exists (t x hx))

@[simp] theorem is_sheaf_for.valid_glue {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {Y : C} {R : presieve X} (t : is_sheaf_for P R) {x : family_of_elements P R} (hx : family_of_elements.compatible x) (f : Y ⟶ X) (Hf : R f) : functor.map P (has_hom.hom.op f) (is_sheaf_for.amalgamate t x hx) = x f Hf :=
  is_sheaf_for.is_amalgamation t hx f Hf

/-- C2.1.3 in [Elephant] -/
theorem is_sheaf_for_iff_generate {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} (R : presieve X) : is_sheaf_for P R ↔ is_sheaf_for P ⇑(sieve.generate R) := sorry

/--
Every presheaf is a sheaf for the family {𝟙 X}.

[Elephant] C2.1.5(i)
-/
theorem is_sheaf_for_singleton_iso {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) : is_sheaf_for P (singleton 𝟙) := sorry

/--
Every presheaf is a sheaf for the maximal sieve.

[Elephant] C2.1.5(ii)
-/
theorem is_sheaf_for_top_sieve {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) : is_sheaf_for P ⇑⊤ := sorry

/--
If `P` is a sheaf for `S`, and it is iso to `P'`, then `P'` is a sheaf for `S`. This shows that
"being a sheaf for a presieve" is a mathematical or hygenic property.
-/
theorem is_sheaf_for_iso {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} {X : C} {R : presieve X} {P' : Cᵒᵖ ⥤ Type v} (i : P ≅ P') : is_sheaf_for P R → is_sheaf_for P' R := sorry

/--
If a presieve `R` on `X` has a subsieve `S` such that:

* `P` is a sheaf for `S`.
* For every `f` in `R`, `P` is separated for the pullback of `S` along `f`,

then `P` is a sheaf for `R`.

This is closely related to [Elephant] C2.1.6(i).
-/
theorem is_sheaf_for_subsieve_aux {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) {S : sieve X} {R : presieve X} (h : ⇑S ≤ R) (hS : is_sheaf_for P ⇑S) (trans : ∀ {Y : C} {f : Y ⟶ X}, R f → is_separated_for P ⇑(sieve.pullback f S)) : is_sheaf_for P R := sorry

/--
If `P` is a sheaf for every pullback of the sieve `S`, then `P` is a sheaf for any presieve which
contains `S`.
This is closely related to [Elephant] C2.1.6.
-/
theorem is_sheaf_for_subsieve {C : Type u} [category C] {X : C} (P : Cᵒᵖ ⥤ Type v) {S : sieve X} {R : presieve X} (h : ⇑S ≤ R) (trans : ∀ {Y : C} (f : Y ⟶ X), is_sheaf_for P ⇑(sieve.pullback f S)) : is_sheaf_for P R := sorry

/-- A presheaf is separated for a topology if it is separated for every sieve in the topology. -/
def is_separated {C : Type u} [category C] (J : grothendieck_topology C) (P : Cᵒᵖ ⥤ Type v) :=
  ∀ {X : C} (S : sieve X), S ∈ coe_fn J X → is_separated_for P ⇑S

/--
A presheaf is a sheaf for a topology if it is a sheaf for every sieve in the topology.

If the given topology is given by a pretopology, `is_sheaf_for_pretopology` shows it suffices to
check the sheaf condition at presieves in the pretopology.
-/
def is_sheaf {C : Type u} [category C] (J : grothendieck_topology C) (P : Cᵒᵖ ⥤ Type v) :=
  ∀ {X : C} (S : sieve X), S ∈ coe_fn J X → is_sheaf_for P ⇑S

theorem is_sheaf.is_sheaf_for {C : Type u} [category C] {X : C} (J : grothendieck_topology C) {P : Cᵒᵖ ⥤ Type v} (hp : is_sheaf J P) (R : presieve X) (hr : sieve.generate R ∈ coe_fn J X) : is_sheaf_for P R :=
  iff.mpr (is_sheaf_for_iff_generate R) (hp (sieve.generate R) hr)

theorem is_sheaf_of_le {C : Type u} [category C] (P : Cᵒᵖ ⥤ Type v) {J₁ : grothendieck_topology C} {J₂ : grothendieck_topology C} : J₁ ≤ J₂ → is_sheaf J₂ P → is_sheaf J₁ P :=
  fun (h : J₁ ≤ J₂) (t : is_sheaf J₂ P) (X : C) (S : sieve X) (hS : S ∈ coe_fn J₁ X) => t S (h X hS)

theorem is_separated_of_is_sheaf {C : Type u} [category C] (J : grothendieck_topology C) (P : Cᵒᵖ ⥤ Type v) (h : is_sheaf J P) : is_separated J P :=
  fun (X : C) (S : sieve X) (hS : S ∈ coe_fn J X) => is_sheaf_for.is_separated_for (h S hS)

/-- The property of being a sheaf is preserved by isomorphism. -/
theorem is_sheaf_iso {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} (J : grothendieck_topology C) {P' : Cᵒᵖ ⥤ Type v} (i : P ≅ P') (h : is_sheaf J P) : is_sheaf J P' :=
  fun (X : C) (S : sieve X) (hS : S ∈ coe_fn J X) => is_sheaf_for_iso i (h S hS)

theorem is_sheaf_of_yoneda {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} (J : grothendieck_topology C) (h : ∀ {X : C} (S : sieve X), S ∈ coe_fn J X → yoneda_sheaf_condition P S) : is_sheaf J P :=
  fun (X : C) (S : sieve X) (hS : S ∈ coe_fn J X) => iff.mpr is_sheaf_for_iff_yoneda_sheaf_condition (h S hS)

/--
For a topology generated by a basis, it suffices to check the sheaf condition on the basis
presieves only.
-/
theorem is_sheaf_pretopology {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} [limits.has_pullbacks C] (K : pretopology C) : is_sheaf (pretopology.to_grothendieck C K) P ↔ ∀ {X : C} (R : presieve X), R ∈ coe_fn K X → is_sheaf_for P R := sorry

/-- Any presheaf is a sheaf for the bottom (trivial) grothendieck topology. -/
theorem is_sheaf_bot {C : Type u} [category C] {P : Cᵒᵖ ⥤ Type v} : is_sheaf ⊥ P := sorry

end presieve

namespace equalizer

/--
The middle object of the fork diagram given in Equation (3) of [MM92], as well as the fork diagram
of https://stacks.math.columbia.edu/tag/00VM.
-/
def first_obj {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) :=
  ∏ fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) => functor.obj P (opposite.op (sigma.fst f))

/-- Show that `first_obj` is isomorphic to `family_of_elements`. -/
def first_obj_eq_family {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) : first_obj P R ≅ presieve.family_of_elements P R :=
  iso.mk
    (fun (t : first_obj P R) (Y : C) (f : Y ⟶ X) (hf : R f) =>
      limits.pi.π
        (fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) => functor.obj P (opposite.op (sigma.fst f)))
        (sigma.mk Y { val := f, property := hf }) t)
    (limits.pi.lift
      fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) (x : presieve.family_of_elements P R) =>
        x (subtype.val (sigma.snd f)) sorry)

protected instance first_obj.inhabited {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} : Inhabited (first_obj P ⊥) :=
  equiv.inhabited (iso.to_equiv (first_obj_eq_family P ⊥))

/--
The left morphism of the fork diagram given in Equation (3) of [MM92], as well as the fork diagram
of https://stacks.math.columbia.edu/tag/00VM.
-/
def fork_map {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) : functor.obj P (opposite.op X) ⟶ first_obj P R :=
  limits.pi.lift
    fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) =>
      functor.map P (has_hom.hom.op (subtype.val (sigma.snd f)))

/-!
This section establishes the equivalence between the sheaf condition of Equation (3) [MM92] and
the definition of `is_sheaf_for`.
-/

namespace sieve

/--
The rightmost object of the fork diagram of Equation (3) [MM92], which contains the data used
to check a family is compatible.
-/
def second_obj {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (S : sieve X) :=
  ∏
    fun
      (f :
      sigma fun (Y : C) => sigma fun (Z : C) => sigma fun (g : Z ⟶ Y) => Subtype fun (f' : Y ⟶ X) => coe_fn S Y f') =>
      functor.obj P (opposite.op (sigma.fst (sigma.snd f)))

/-- The map `p` of Equations (3,4) [MM92]. -/
def first_map {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (S : sieve X) : first_obj P ⇑S ⟶ second_obj P S :=
  limits.pi.lift
    fun
      (fg :
      sigma fun (Y : C) => sigma fun (Z : C) => sigma fun (g : Z ⟶ Y) => Subtype fun (f' : Y ⟶ X) => coe_fn S Y f') =>
      limits.pi.π
        (fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => coe_fn S Y f) =>
          functor.obj P (opposite.op (sigma.fst f)))
        (sigma.mk (sigma.fst (sigma.snd fg))
          { val := sigma.fst (sigma.snd (sigma.snd fg)) ≫ subtype.val (sigma.snd (sigma.snd (sigma.snd fg))),
            property := sorry })

protected instance second_obj.inhabited {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} : Inhabited (second_obj P ⊥) :=
  { default := first_map P ⊥ Inhabited.default }

/-- The map `a` of Equations (3,4) [MM92]. -/
def second_map {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (S : sieve X) : first_obj P ⇑S ⟶ second_obj P S :=
  limits.pi.lift
    fun
      (fg :
      sigma fun (Y : C) => sigma fun (Z : C) => sigma fun (g : Z ⟶ Y) => Subtype fun (f' : Y ⟶ X) => coe_fn S Y f') =>
      limits.pi.π
          (fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => coe_fn S Y f) =>
            functor.obj P (opposite.op (sigma.fst f)))
          (sigma.mk (sigma.fst fg) (sigma.snd (sigma.snd (sigma.snd fg)))) ≫
        functor.map P (has_hom.hom.op (sigma.fst (sigma.snd (sigma.snd fg))))

theorem w {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (S : sieve X) : fork_map P ⇑S ≫ first_map P S = fork_map P ⇑S ≫ second_map P S := sorry

/--
The family of elements given by `x : first_obj P S` is compatible iff `first_map` and `second_map`
map it to the same point.
-/
theorem compatible_iff {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (S : sieve X) (x : first_obj P ⇑S) : presieve.family_of_elements.compatible (iso.hom (first_obj_eq_family P ⇑S) x) ↔ first_map P S x = second_map P S x := sorry

/-- `P` is a sheaf for `S`, iff the fork given by `w` is an equalizer. -/
theorem equalizer_sheaf_condition {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (S : sieve X) : presieve.is_sheaf_for P ⇑S ↔ Nonempty (limits.is_limit (limits.fork.of_ι (fork_map P ⇑S) (w P S))) := sorry

end sieve

/-!
This section establishes the equivalence between the sheaf condition of
https://stacks.math.columbia.edu/tag/00VM and the definition of `is_sheaf_for`.
-/

namespace presieve

/--
The rightmost object of the fork diagram of https://stacks.math.columbia.edu/tag/00VM, which
contains the data used to check a family of elements for a presieve is compatible.
-/
def second_obj {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) [limits.has_pullbacks C] :=
  ∏
    fun
      (fg :
      (sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) × sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) =>
      functor.obj P
        (opposite.op (limits.pullback (subtype.val (sigma.snd (prod.fst fg))) (subtype.val (sigma.snd (prod.snd fg)))))

/-- The map `pr₀*` of https://stacks.math.columbia.edu/tag/00VL. -/
def first_map {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) [limits.has_pullbacks C] : first_obj P R ⟶ second_obj P R :=
  limits.pi.lift
    fun
      (fg :
      (sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) × sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) =>
      limits.pi.π
          (fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) => functor.obj P (opposite.op (sigma.fst f)))
          (prod.fst fg) ≫
        functor.map P (has_hom.hom.op limits.pullback.fst)

protected instance second_obj.inhabited {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} [limits.has_pullbacks C] : Inhabited (second_obj P ⊥) :=
  { default := first_map P ⊥ Inhabited.default }

/-- The map `pr₁*` of https://stacks.math.columbia.edu/tag/00VL. -/
def second_map {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) [limits.has_pullbacks C] : first_obj P R ⟶ second_obj P R :=
  limits.pi.lift
    fun
      (fg :
      (sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) × sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) =>
      limits.pi.π
          (fun (f : sigma fun (Y : C) => Subtype fun (f : Y ⟶ X) => R f) => functor.obj P (opposite.op (sigma.fst f)))
          (prod.snd fg) ≫
        functor.map P (has_hom.hom.op limits.pullback.snd)

theorem w {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) [limits.has_pullbacks C] : fork_map P R ≫ first_map P R = fork_map P R ≫ second_map P R := sorry

/--
The family of elements given by `x : first_obj P S` is compatible iff `first_map` and `second_map`
map it to the same point.
-/
theorem compatible_iff {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) [limits.has_pullbacks C] (x : first_obj P R) : presieve.family_of_elements.compatible (iso.hom (first_obj_eq_family P R) x) ↔ first_map P R x = second_map P R x := sorry

/--
`P` is a sheaf for `R`, iff the fork given by `w` is an equalizer.
See https://stacks.math.columbia.edu/tag/00VM.
-/
theorem sheaf_condition {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) [limits.has_pullbacks C] : presieve.is_sheaf_for P R ↔ Nonempty (limits.is_limit (limits.fork.of_ι (fork_map P R) (w P R))) := sorry

end presieve

end equalizer

/-- The category of sheaves on a grothendieck topology. -/
def SheafOfTypes {C : Type u} [category C] (J : grothendieck_topology C) :=
  Subtype fun (P : Cᵒᵖ ⥤ Type v) => presieve.is_sheaf J P

/-- The inclusion functor from sheaves to presheaves. -/
@[simp] theorem SheafOfTypes_to_presheaf_obj {C : Type u} [category C] (J : grothendieck_topology C) (c : Subtype fun (X : Cᵒᵖ ⥤ Type v) => presieve.is_sheaf J X) : functor.obj (SheafOfTypes_to_presheaf J) c = ↑c :=
  Eq.refl ↑c

/--
The category of sheaves on the bottom (trivial) grothendieck topology is equivalent to the category
of presheaves.
-/
@[simp] theorem SheafOfTypes_bot_equiv_functor {C : Type u} [category C] : equivalence.functor SheafOfTypes_bot_equiv = SheafOfTypes_to_presheaf ⊥ :=
  Eq.refl (equivalence.functor SheafOfTypes_bot_equiv)

protected instance SheafOfTypes.inhabited {C : Type u} [category C] : Inhabited (SheafOfTypes ⊥) :=
  { default := functor.obj (equivalence.inverse SheafOfTypes_bot_equiv) (functor.obj (functor.const (Cᵒᵖ)) PUnit) }


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Algdata.Init.Logic

section Order

universe u

variable {α : Type u}

/-
  Indivisual axioms
-/
class Irreflective (r : α → α → Prop) : Prop where
  irrefl : ∀ a, ¬ r a a

class Asymmetry (r : α → α → Prop) : Prop where
  asymm : ∀ a b, r a b → ¬ r b a

instance instIrreflectiveAsymmetry (r : α → α → Prop) [Asymmetry r] : Irreflective r where
  irrefl _ haa := absurd haa (Asymmetry.asymm _ _ haa)

instance instAsymmetryIrreflectiveTrans (r : α → α → Prop) [Trans r r r] [Irreflective r] : Asymmetry r where
  asymm _ _ hab hba := Irreflective.irrefl _ (trans hab hba)

@[inline, reducible]
def Incomp (r : α → α → Prop) (a b : α) : Prop :=
  ¬ r a b ∧ ¬ r b a

protected
theorem Incomp.symm {r : α → α → Prop} {a b : α} : Incomp r a b → Incomp r b a :=
  And.comm.mp

class IncompStable (r : α → α → Prop) : Prop where
  stable_left : ∀ a b c, Incomp r a b → r b c → r a c
  stable_right : ∀ a b c, r a b → Incomp r b c → r a c

instance instTransIncomp (r : α → α → Prop) [Trans r r r] [IncompStable r] : Trans (Incomp r) (Incomp r) (Incomp r) where
  trans {a b c} hab hbc := by
    apply And.intro
    . intro hac
      have := IncompStable.stable_right _ _ _ hac hbc.symm
      exact absurd this hab.left
    . intro hca
      have := IncompStable.stable_right _ _ _ hca hab
      exact absurd this hbc.right

class Trichotomous (r : α → α → Prop) : Prop where
  trichot : ∀ a b, a = b ∨ r a b ∨ r b a

@[reducible]
theorem trichotomous (r : α → α → Prop) [Trichotomous r] : ∀ a b, a = b ∨ r a b ∨ r b a :=
  Trichotomous.trichot (r:=r)

theorem Trichotomous.eq_of_incomp {r : α → α → Prop} [Trichotomous r] {a b : α} : Incomp r a b → a = b :=
  λ hincomp => (trichot a b).elim id (Or.rec (flip absurd hincomp.left) (flip absurd hincomp.right))

instance instIncompStableTrichotomous (r : α → α → Prop) [Trichotomous r] : IncompStable r where
  stable_left _ _ _ hab hbc := (Trichotomous.eq_of_incomp hab) ▸ hbc
  stable_right _ _ _ hab hbc := (Trichotomous.eq_of_incomp hbc) ▸ hab

@[elab_as_elim]
theorem trichotCases {motive : α → α → Prop} (r : α → α → Prop) [Trichotomous r] (of_rfl : ∀ a, motive a a) (of_rel : ∀ a b, r a b → motive a b) (of_opp : ∀ a b, r b a → motive a b) : ∀ (a b : α), motive a b :=
  λ a b =>
    match Trichotomous.trichot (r:=r) a b with
    | Or.inl h => h ▸ of_rfl a
    | Or.inr (Or.inl h) => of_rel a b h
    | Or.inr (Or.inr h) => of_opp a b h

@[elab_as_elim, reducible]
theorem trichotCasesOn {motive : α → α → Prop} (r : α → α → Prop) [Trichotomous r] (a b: α) (of_rfl : ∀ a, motive a a) (of_rel : ∀ a b, r a b → motive a b) (of_opp : ∀ a b, r b a → motive a b) : motive a b :=
  trichotCases r of_rfl of_rel of_opp a b

@[elab_as_elim, inline, reducible]
def decTrichotCases {motive : α → α → Sort _} (r : α → α → Prop) [Trichotomous r] [DecidableRel r] (of_rfl : ∀ a, motive a a) (of_rel : ∀ a b, r a b → motive a b) (of_opp : ∀ a b, r b a → motive a b) : (a b : α) → motive a b :=
  λ a b => dite (r a b) (of_rel _ _) (λ hab => dite (r b a) (of_opp _ _) (λ hba => Trichotomous.eq_of_incomp ⟨hab,hba⟩ ▸ of_rfl a))

@[elab_as_elim, inline, reducible]
def decTrichotCasesOn {motive : α → α → Sort _} (r : α → α → Prop) [Trichotomous r] [DecidableRel r] (a b : α) (of_rfl : ∀ a, motive a a) (of_rel : ∀ a b, r a b → motive a b) (of_opp : ∀ a b, r b a → motive a b) : motive a b :=
  decTrichotCases r of_rfl of_rel of_opp a b

/-
  Strict orders
-/
class StrictOrder (r : α  → α → Prop) extends Trans r r r, Irreflective r

attribute [instance] StrictOrder.mk

class StrictLinearOrder (r : α → α → Prop) extends StrictOrder r, Trichotomous r

attribute [instance] StrictLinearOrder.mk

/-
  Constructions
-/
-- opposite order
instance (r : α → α → Prop) [Trans r r r] : Trans (flip r) (flip r) (flip r) where
  trans := flip (trans (r:=r))

instance (r : α → α → Prop) [Irreflective r] : Irreflective (flip r) where
  irrefl := Irreflective.irrefl (r:=r)

instance (r : α → α → Prop) [Asymmetry r] : Asymmetry (flip r) where
  asymm a b := Asymmetry.asymm b a

instance (r : α → α → Prop) [IncompStable r] : IncompStable (flip r) where
  stable_left _ _ _ hab hbc := IncompStable.stable_right (r:=r) _ _ _ hbc hab
  stable_right _ _ _ hab hbc := IncompStable.stable_left (r:=r) _ _ _ hbc hab

instance (r : α → α → Prop) [Trichotomous r] : Trichotomous (flip r) where
  trichot a b := Or.map Eq.symm id $ Trichotomous.trichot (r:=r) b a

instance (r : α → α → Prop) [DecidableRel r] : DecidableRel (flip r) :=
  λ a b => inferInstanceAs (Decidable (r b a))

-- inverse image of relation
-- `InvImage` defined in `Init.Core` in Lean4
instance {β : Type _} (r : α → α → Prop) [Trans r r r] (f : β → α) : Trans (InvImage r f) (InvImage r f) (InvImage r f) where
  trans hab hbc := trans (r:=r) hab hbc

instance {β : Type _} (r : α → α → Prop) [Irreflective r] (f : β → α) : Irreflective (InvImage r f) where
  irrefl a := Irreflective.irrefl (f a)

instance {β : Type _} (r : α → α → Prop) [Asymmetry r] (f : β → α) : Asymmetry (InvImage r f) where
  asymm a b := Asymmetry.asymm (f a) (f b)

instance {β : Type _} (r : α → α → Prop) [IncompStable r] (f : β → α) : IncompStable (InvImage r f) where
  stable_left a b c := IncompStable.stable_left (f a) (f b) (f c)
  stable_right a b c := IncompStable.stable_right (f a) (f b) (f c)

instance {β : Type _} (r : α → α → Prop) [DecidableRel r] (f : β → α) : DecidableRel (InvImage r f) :=
  λ a b => dite (r (f a) (f b)) isTrue isFalse

def mkInstTrichotomousInvImage {β : Type _} (r : α → α → Prop) [Trichotomous r] (f : β → α) (f_inj : ∀ b₁ b₂, f b₁ = f b₂ → b₁ = b₂) : Trichotomous (InvImage r f) where
  trichot b₁ b₂ :=
    Or.map (f_inj b₁ b₂) id $ Trichotomous.trichot (f b₁) (f b₂)

--- Lexicographical combination of two relations
@[inline, reducible]
def Lexcomb (r s : α → α → Prop) (a b : α) : Prop :=
  r a b ∨ (Incomp r a b ∧ s a b)

instance (r s : α → α → Prop) [DecidableRel r] [DecidableRel s] : DecidableRel (Lexcomb r s) :=
  λ _ _ => inferInstance

instance (r s : α → α → Prop) [Trans r r r] [IncompStable r] [Trans s s s] : Trans (Lexcomb r s) (Lexcomb r s) (Lexcomb r s) where
  trans
  | Or.inl hrab, Or.inl hrbc => Or.inl (trans hrab hrbc)
  | Or.inl hrab, Or.inr hsbc => Or.inl (IncompStable.stable_right _ _ _ hrab hsbc.left)
  | Or.inr hsab, Or.inl hrbc => Or.inl (IncompStable.stable_left _ _ _ hsab.left hrbc)
  | Or.inr hsab, Or.inr hsbc => Or.inr ⟨trans hsab.left hsbc.left, trans hsab.right hsbc.right⟩

instance (r s : α → α → Prop) [Irreflective r] [Irreflective s] : Irreflective (Lexcomb r s) where
  irrefl a
  | Or.inl hraa => absurd hraa (Irreflective.irrefl (r:=r) a)
  | Or.inr hsaa => absurd hsaa.right (Irreflective.irrefl (r:=s) a)

instance (r s : α → α → Prop) [Asymmetry r] [Asymmetry s] : Asymmetry (Lexcomb r s) where
  asymm _ _
  | Or.inl hrab, Or.inl hrba => Asymmetry.asymm _ _ hrab hrba
  | Or.inl hrab, Or.inr hsba => absurd hrab hsba.left.right
  | Or.inr hsab, Or.inl hrba => absurd hrba hsab.left.right
  | Or.inr hsab, Or.inr hsba => Asymmetry.asymm _ _ hsab.right hsba.right

@[simp]
theorem Incomp_Lexcomb_iff {r s : α → α → Prop} {a b : α}: Incomp (Lexcomb r s) a b ↔ Incomp r a b ∧ Incomp s a b where
  mp h := by
    dsimp [Incomp] at h
    have hab := not_or_iff_and_not.mp h.left
    have hba := not_or_iff_and_not.mp h.right
    have : Incomp r a b := ⟨hab.left, hba.left⟩
    have hsab : ¬ s a b :=
      λ h => absurd ⟨this, h⟩ hab.right
    have hsba : ¬ s b a :=
      λ h => absurd ⟨this.symm, h⟩ hba.right
    exact ⟨this, ⟨hsab, hsba⟩⟩
  mpr h := by
    unfold Incomp
    dsimp [Lexcomb]
    apply And.intro <;> apply not_or_iff_and_not.mpr
    case left =>
      exact ⟨h.left.left, h.right.left ∘ And.right⟩
    case right =>
      exact ⟨h.left.right, h.right.right ∘ And.right⟩

instance (r s : α → α → Prop) [Trans r r r] [IncompStable r] [IncompStable s] : IncompStable (Lexcomb r s) where
  stable_left a b c := by
    intro hab hbc
    have := Incomp_Lexcomb_iff.mp hab
    cases hbc with
    | inl hrbc => exact Or.inl (IncompStable.stable_left _ _ _ this.left hrbc)
    | inr hsbc =>
      apply Or.inr; apply And.intro
      . exact trans this.left hsbc.left
      . exact IncompStable.stable_left _ _ _ this.right hsbc.right
  stable_right a b c := by
    intro hab hbc
    have := Incomp_Lexcomb_iff.mp hbc
    cases hab with
    | inl hrab => exact Or.inl (IncompStable.stable_right _ _ _ hrab this.left)
    | inr hsab =>
      apply Or.inr; apply And.intro
      . exact trans hsab.left this.left
      . exact IncompStable.stable_right _ _ _ hsab.right this.right

instance (r s : α → α → Prop) [DecidableRel r] [Trichotomous s] : Trichotomous (Lexcomb r s) where
  trichot a b :=
    if hab : r a b then
      Or.inr $ Or.inl $ Or.inl hab
    else if hba : r b a then
      Or.inr $ Or.inr $ Or.inl hba
    else
      trichotCasesOn s a b
        (λ _ _ => Or.inl rfl)
        (λ _ _ hsab hrab => Or.inr $ Or.inl $ Or.inr ⟨hrab,hsab⟩)
        (λ _ _ hsba hrab => Or.inr $ Or.inr $ Or.inr ⟨⟨hrab.right,hrab.left⟩, hsba⟩)
        (And.intro hab hba)

/-
  Instances on some buit-in types
-/
instance instStrictLinearOrderNatLT : StrictLinearOrder Nat.lt where
  trans := Nat.lt_trans
  irrefl := Nat.lt_irrefl
  trichot a b :=
    match Nat.lt_or_ge a b with
    | Or.inl h =>  Or.inr (Or.inl h)
    | Or.inr h =>
      match Nat.eq_or_lt_of_le h with
      | Or.inl h => Or.inl h.symm
      | Or.inr h => Or.inr (Or.inr h)

instance instStrictLinearOrderNatGT : StrictLinearOrder (α:=Nat) GT.gt where
  trans := flip Nat.lt_trans
  irrefl := Nat.lt_irrefl
  trichot a b :=
    match Trichotomous.trichot (r:=Nat.lt) b a with
    | Or.inl h => Or.inl h.symm
    | Or.inr h => Or.inr h

end Order


import positive_nat.lemmas

namespace positive_nat namespace natural

def div.total : natural → natural → natural
| a b :=
if h : a > b then
have sub a b h < a := sub_lt_of_lt h,
div.total (sub a b h) b + 1 else 1
using_well_founded lib.wf_tacs

lemma div_wf {a b : natural} (h : b < a) : sub a b h < a := begin
  exact sub_lt_self
end

def div.impl : Π (a b : natural), (b ∣ a) → natural
| a b hd := if h : b < a then
have hh : _ := div_wf h,
div.impl (sub a b h) b (sub_dvd_of_dvd hd)  + 1 else 1
using_well_founded lib.wf_tacs

def div (a b : natural) (h : b ∣ a . autoparam) := div.impl a b h

def div_def {a b : natural} {h} : div a b h = if hh : b < a then div (sub a b hh) b (sub_dvd_of_dvd h) + 1 else 1 :=
begin
  conv in (div a b h) { rw div, rw div.impl.equations._eqn_1 },
  split_ifs,
  { rw div },
  { refl }
end

lemma div_eq_div_total {a b : natural} {h} : div a b = div.total a b :=
begin
  induction a using positive_nat.natural.strong_induction with a ih,
  delta div, rw div.impl.equations._eqn_1,
  rw div.total.equations._eqn_1,
  split_ifs with hh,
  { congr, apply ih, apply sub_lt_self },
  { refl }
end

lemma eq_of_div_eq_one {a b : natural} {h₁} (h₂ : div a b h₁ = 1) : a = b :=
begin
  rw div_def at h₂,
  split_ifs at h₂ with h₃,
  { exfalso, exact succ_ne_one h₂ },
  { cases h₁ with x h₁,
    subst a,
    cases ge_of_not_lt h₃,
    { assumption },
    { exfalso, exact not_mul_lt h } }
end

@[simp]
lemma div_self {a : natural} (h : a ∣ a): div a a h = 1 := begin
  rw div_def,
  split_ifs with h₂,
  { exfalso, exact not_lt_of_eq h₂ },
  { refl }
end

def div_step {a b} {h₁ h₂} : div (a + b) b h₁ = div a b h₂ + 1 :=
begin
  conv { to_lhs, rw div_def },
  split_ifs,
  { conv in (sub _ _ _) { rw sub_step } },
  { exfalso,
    apply h,
    use a,
    ac_refl }
end

lemma div_one {a : natural} {h} : div a 1 = a :=
begin
  induction a with a ih,
  { refl },
  { rw div_step, rw ih }
end

lemma sub_div {a b : natural} {h₁ h₂ h₃ h₄} : div (sub a b h₁) b h₂ = sub (div a b h₃) 1 h₄ :=
begin
  by_cases h: a > b,
  { cases h with y h,
    rw add_comm at h,
    subst a,
    conv in (sub _ b _) { rw sub_step },
    conv in (div _ b _) { rw div_step },
    conv in (sub _ _ _) { rw sub_step } },
  { exfalso, exact h h₁ }
end

@[simp]
lemma div_mul {a b : natural} {h} : (div a b h) * b = a :=
begin
  cases h with k h,
  revert a b,
  induction k with k ih,
  { intros, subst a,
    repeat { conv in (b * 1) { rw mul_one } },
    rw div_self,
    rw one_mul },
  { intros,
    specialize @ih (sub a b) b,
    have h₂ := h,
    rw [mul_succ, add_comm] at h₂,
    specialize ih (eq_sub_of_add_eq h₂.symm).symm,
    replace ih := congr_arg (+ b) ih,
    simp at ih,
    conv { to_rhs, rw [← ih, add_comm, ← succ_mul] },
    congr,
    conv { to_rhs, rw ← div_step },
    congr,
    simp }
end

end natural end positive_nat


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.tensor_product
import Mathlib.linear_algebra.direct_sum_module
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

namespace tensor_product

/-- The linear equivalence `(⨁ i₁, M₁ i₁) ⊗ (⨁ i₂, M₂ i₂) ≃ (⨁ i₁, ⨁ i₂, M₁ i₁ ⊗ M₂ i₂)`, i.e.
"tensor product distributes over direct sum". -/
def direct_sum (R : Type u_1) [comm_ring R] (ι₁ : Type u_2) (ι₂ : Type u_3) [DecidableEq ι₁] [DecidableEq ι₂] (M₁ : ι₁ → Type u_4) (M₂ : ι₂ → Type u_5) [(i₁ : ι₁) → add_comm_group (M₁ i₁)] [(i₂ : ι₂) → add_comm_group (M₂ i₂)] [(i₁ : ι₁) → module R (M₁ i₁)] [(i₂ : ι₂) → module R (M₂ i₂)] : linear_equiv R (tensor_product R (direct_sum ι₁ fun (i₁ : ι₁) => M₁ i₁) (direct_sum ι₂ fun (i₂ : ι₂) => M₂ i₂))
  (direct_sum (ι₁ × ι₂) fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))) :=
  linear_equiv.of_linear
    (lift
      (direct_sum.to_module R ι₁
        (linear_map R (direct_sum ι₂ fun (i₂ : ι₂) => M₂ i₂)
          (direct_sum (ι₁ × ι₂) fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))))
        fun (i₁ : ι₁) =>
          linear_map.flip
            (direct_sum.to_module R ι₂
              (linear_map R (M₁ i₁)
                (direct_sum (ι₁ × ι₂) fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))))
              fun (i₂ : ι₂) =>
                linear_map.flip
                  (curry
                    (direct_sum.lof R (ι₁ × ι₂)
                      (fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))) (i₁, i₂))))))
    (direct_sum.to_module R (ι₁ × ι₂)
      (tensor_product R (direct_sum ι₁ fun (i₁ : ι₁) => M₁ i₁) (direct_sum ι₂ fun (i₂ : ι₂) => M₂ i₂))
      fun (i : ι₁ × ι₂) => map (direct_sum.lof R ι₁ M₁ (prod.fst i)) (direct_sum.lof R ι₂ M₂ (prod.snd i)))
    sorry sorry

@[simp] theorem direct_sum_lof_tmul_lof (R : Type u_1) [comm_ring R] (ι₁ : Type u_2) (ι₂ : Type u_3) [DecidableEq ι₁] [DecidableEq ι₂] (M₁ : ι₁ → Type u_4) (M₂ : ι₂ → Type u_5) [(i₁ : ι₁) → add_comm_group (M₁ i₁)] [(i₂ : ι₂) → add_comm_group (M₂ i₂)] [(i₁ : ι₁) → module R (M₁ i₁)] [(i₂ : ι₂) → module R (M₂ i₂)] (i₁ : ι₁) (m₁ : M₁ i₁) (i₂ : ι₂) (m₂ : M₂ i₂) : coe_fn (direct_sum R ι₁ ι₂ M₁ M₂)
    (tmul R (coe_fn (direct_sum.lof R ι₁ M₁ i₁) m₁) (coe_fn (direct_sum.lof R ι₂ M₂ i₂) m₂)) =
  coe_fn
    (direct_sum.lof R (ι₁ × ι₂) (fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))) (i₁, i₂))
    (tmul R m₁ m₂) := sorry


import tactic
import linear_algebra.tensor_algebra.basic

instance pi.linear_map_module (S R : Type) [semiring S] [semiring R] (ι : Type)
  (M : ι → Type) [Π (i : ι), add_comm_monoid (M i)]
  [Π (i : ι), module R (M i)]
  (N : Type)
  [add_comm_monoid N]
  [module R N]
  [module S N] [smul_comm_class R S N] : module S (Π i : ι, (M i →ₗ[R] N)) :=
@pi.module ι (λ i, (M i →ₗ[R] N)) S _ _ (λ i, linear_map.module)

variables (R : Type) [comm_ring R]

constant coproduct {ι : Type} (M : ι → Type) [Π i, add_comm_group (M i)]
  [Π i, module R (M i)] : Type

variables {R}

namespace coproduct

variables {ι : Type} {M : ι → Type} [Π i, add_comm_group (M i)] [Π i, module R (M i)]

@[instance] protected constant add_comm_group :
  add_comm_group (coproduct R M)

@[instance] protected constant module : module R (coproduct R M)

constant of (i : ι) : M i →ₗ[R] coproduct R M

variables {N : Type} [add_comm_group N] [module R N]

set_option class.instance_max_depth 1000

constant extend : (Π i : ι, (M i →ₗ[R] N)) →ₗ[R] (coproduct R M →ₗ[R] N)

@[simp] constant extend_comp_of (i : ι) (f : Π i, M i →ₗ[R] N) : (extend f).comp (of i) = f i

@[simp] lemma extend_of (i : ι) (f : Π i, M i →ₗ[R] N) (x : M i) :
  extend f (of i x) = f i x :=
by rw [← extend_comp_of i f]; refl

@[ext] constant hom_ext {f g : coproduct R M →ₗ[R] N}
  (h : ∀ i, f.comp (of i) = g.comp (of i)) :
  f = g

end coproduct

section pi

end pi

variables {M : Type} [add_comm_group M] [module R M]

def poly_mul (mul : M →ₗ[R] M →ₗ[R] M) :
  coproduct R (λ n : ℕ, M) →ₗ[R] coproduct R (λ n : ℕ, M) →ₗ[R] coproduct R (λ n : ℕ, M) :=
coproduct.extend (λ n, begin
  refine linear_map.lcomp R _ _ _,

end)


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

! This file was ported from Lean 3 source module analysis.convex.uniform
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.StrictConvexSpace

/-!
# Uniformly convex spaces

This file defines uniformly convex spaces, which are real normed vector spaces in which for all
strictly positive `ε`, there exists some strictly positive `δ` such that `ε ≤ ‖x - y‖` implies
`‖x + y‖ ≤ 2 - δ` for all `x` and `y` of norm at most than `1`. This means that the triangle
inequality is strict with a uniform bound, as opposed to strictly convex spaces where the triangle
inequality is strict but not necessarily uniformly (`‖x + y‖ < ‖x‖ + ‖y‖` for all `x` and `y` not in
the same ray).

## Main declarations

`uniform_convex_space E` means that `E` is a uniformly convex space.

## TODO

* Milman-Pettis
* Hanner's inequalities

## Tags

convex, uniformly convex
-/

open Set Metric

open Convex Pointwise

/-- A *uniformly convex space* is a real normed space where the triangle inequality is strict with a
uniform bound. Namely, over the `x` and `y` of norm `1`, `‖x + y‖` is uniformly bounded above
by a constant `< 2` when `‖x - y‖` is uniformly bounded below by a positive constant.

See also `uniform_convex_space.of_uniform_convex_closed_unit_ball`. -/
class UniformConvexSpace (E : Type _) [SeminormedAddCommGroup E] : Prop where
  uniform_convex :
    ∀ ⦃ε : ℝ⦄,
      0 < ε → ∃ δ, 0 < δ ∧ ∀ ⦃x : E⦄, ‖x‖ = 1 → ∀ ⦃y⦄, ‖y‖ = 1 → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 - δ
#align uniform_convex_space UniformConvexSpace

variable {E : Type _}

section SeminormedAddCommGroup

variable (E) [SeminormedAddCommGroup E] [UniformConvexSpace E] {ε : ℝ}

theorem exists_forall_sphere_dist_add_le_two_sub (hε : 0 < ε) :
    ∃ δ, 0 < δ ∧ ∀ ⦃x : E⦄, ‖x‖ = 1 → ∀ ⦃y⦄, ‖y‖ = 1 → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 - δ :=
  UniformConvexSpace.uniform_convex hε
#align exists_forall_sphere_dist_add_le_two_sub exists_forall_sphere_dist_add_le_two_sub

variable [NormedSpace ℝ E]

theorem exists_forall_closed_ball_dist_add_le_two_sub (hε : 0 < ε) :
    ∃ δ, 0 < δ ∧ ∀ ⦃x : E⦄, ‖x‖ ≤ 1 → ∀ ⦃y⦄, ‖y‖ ≤ 1 → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 - δ :=
  by
  have hε' : 0 < ε / 3 := div_pos hε zero_lt_three
  obtain ⟨δ, hδ, h⟩ := exists_forall_sphere_dist_add_le_two_sub E hε'
  set δ' := min (1 / 2) (min (ε / 3) <| δ / 3)
  refine' ⟨δ', lt_min one_half_pos <| lt_min hε' (div_pos hδ zero_lt_three), fun x hx y hy hxy => _⟩
  obtain hx' | hx' := le_or_lt ‖x‖ (1 - δ')
  · exact (norm_add_le_of_le hx' hy).trans (sub_add_eq_add_sub _ _ _).le
  obtain hy' | hy' := le_or_lt ‖y‖ (1 - δ')
  · exact (norm_add_le_of_le hx hy').trans (add_sub_assoc _ _ _).ge
  have hδ' : 0 < 1 - δ' := sub_pos_of_lt (min_lt_of_left_lt one_half_lt_one)
  have h₁ : ∀ z : E, 1 - δ' < ‖z‖ → ‖‖z‖⁻¹ • z‖ = 1 :=
    by
    rintro z hz
    rw [norm_smul_of_nonneg (inv_nonneg.2 <| norm_nonneg _), inv_mul_cancel (hδ'.trans hz).ne']
  have h₂ : ∀ z : E, ‖z‖ ≤ 1 → 1 - δ' ≤ ‖z‖ → ‖‖z‖⁻¹ • z - z‖ ≤ δ' :=
    by
    rintro z hz hδz
    nth_rw 3 [← one_smul ℝ z]
    rwa [← sub_smul, norm_smul_of_nonneg (sub_nonneg_of_le <| one_le_inv (hδ'.trans_le hδz) hz),
      sub_mul, inv_mul_cancel (hδ'.trans_le hδz).ne', one_mul, sub_le_comm]
  set x' := ‖x‖⁻¹ • x
  set y' := ‖y‖⁻¹ • y
  have hxy' : ε / 3 ≤ ‖x' - y'‖ :=
    calc
      ε / 3 = ε - (ε / 3 + ε / 3) := by ring
      _ ≤ ‖x - y‖ - (‖x' - x‖ + ‖y' - y‖) :=
        (sub_le_sub hxy
          (add_le_add ((h₂ _ hx hx'.le).trans <| min_le_of_right_le <| min_le_left _ _) <|
            (h₂ _ hy hy'.le).trans <| min_le_of_right_le <| min_le_left _ _))
      _ ≤ _ := by
        have : ∀ x' y', x - y = x' - y' + (x - x') + (y' - y) := fun _ _ => by abel
        rw [sub_le_iff_le_add, norm_sub_rev _ x, ← add_assoc, this]
        exact norm_add₃_le _ _ _

  calc
    ‖x + y‖ ≤ ‖x' + y'‖ + ‖x' - x‖ + ‖y' - y‖ :=
      by
      have : ∀ x' y', x + y = x' + y' + (x - x') + (y - y') := fun _ _ => by abel
      rw [norm_sub_rev, norm_sub_rev y', this]
      exact norm_add₃_le _ _ _
    _ ≤ 2 - δ + δ' + δ' :=
      (add_le_add_three (h (h₁ _ hx') (h₁ _ hy') hxy') (h₂ _ hx hx'.le) (h₂ _ hy hy'.le))
    _ ≤ 2 - δ' := by
      rw [← le_sub_iff_add_le, ← le_sub_iff_add_le, sub_sub, sub_sub]
      refine' sub_le_sub_left _ _
      ring_nf
      rw [← mul_div_cancel' δ three_ne_zero]
      exact mul_le_mul_of_nonneg_left (min_le_of_right_le <| min_le_right _ _) three_pos.le

#align exists_forall_closed_ball_dist_add_le_two_sub exists_forall_closed_ball_dist_add_le_two_sub

theorem exists_forall_closed_ball_dist_add_le_two_mul_sub (hε : 0 < ε) (r : ℝ) :
    ∃ δ, 0 < δ ∧ ∀ ⦃x : E⦄, ‖x‖ ≤ r → ∀ ⦃y⦄, ‖y‖ ≤ r → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 * r - δ :=
  by
  obtain hr | hr := le_or_lt r 0
  ·
    exact
      ⟨1, one_pos, fun x hx y hy h =>
        (hε.not_le <|
            h.trans <| (norm_sub_le _ _).trans <| add_nonpos (hx.trans hr) (hy.trans hr)).elim⟩
  obtain ⟨δ, hδ, h⟩ := exists_forall_closed_ball_dist_add_le_two_sub E (div_pos hε hr)
  refine' ⟨δ * r, mul_pos hδ hr, fun x hx y hy hxy => _⟩
  rw [← div_le_one hr, div_eq_inv_mul, ← norm_smul_of_nonneg (inv_nonneg.2 hr.le)] at hx hy <;>
    try infer_instance
  have := h hx hy
  simp_rw [← smul_add, ← smul_sub, norm_smul_of_nonneg (inv_nonneg.2 hr.le), ← div_eq_inv_mul,
    div_le_div_right hr, div_le_iff hr, sub_mul] at this
  exact this hxy
#align exists_forall_closed_ball_dist_add_le_two_mul_sub exists_forall_closed_ball_dist_add_le_two_mul_sub

end SeminormedAddCommGroup

variable [NormedAddCommGroup E] [NormedSpace ℝ E] [UniformConvexSpace E]

-- See note [lower instance priority]
instance (priority := 100) UniformConvexSpace.toStrictConvexSpace : StrictConvexSpace ℝ E :=
  StrictConvexSpace.ofNormAddNeTwo fun x y hx hy hxy =>
    let ⟨δ, hδ, h⟩ := exists_forall_closed_ball_dist_add_le_two_sub E (norm_sub_pos_iff.2 hxy)
    ((h hx.le hy.le le_rfl).trans_lt <| sub_lt_self _ hδ).Ne
#align uniform_convex_space.to_strict_convex_space UniformConvexSpace.toStrictConvexSpace


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import algebra.group.ext
import category_theory.simple
import category_theory.linear
import category_theory.endomorphism
import field_theory.is_alg_closed.basic

/-!
# Schur's lemma
We first prove the part of Schur's Lemma that holds in any preadditive category with kernels,
that any nonzero morphism between simple objects
is an isomorphism.

Second, we prove Schur's lemma for `𝕜`-linear categories with finite dimensional hom spaces,
over an algebraically closed field `𝕜`:
the hom space `X ⟶ Y` between simple objects `X` and `Y` is at most one dimensional,
and is 1-dimensional iff `X` and `Y` are isomorphic.

## Future work
It might be nice to provide a `division_ring` instance on `End X` when `X` is simple.
This is an easy consequence of the results here,
but may take some care setting up usable instances.
-/

namespace category_theory

open category_theory.limits

universes v u
variables {C : Type u} [category.{v} C]
variables [preadditive C]

/--
The part of **Schur's lemma** that holds in any preadditive category with kernels:
that a nonzero morphism between simple objects is an isomorphism.
-/
lemma is_iso_of_hom_simple [has_kernels C] {X Y : C} [simple X] [simple Y] {f : X ⟶ Y} (w : f ≠ 0) :
  is_iso f :=
begin
  haveI : mono f := preadditive.mono_of_kernel_zero (kernel_zero_of_nonzero_from_simple w),
  exact is_iso_of_mono_of_nonzero w
end

/--
As a corollary of Schur's lemma for preadditive categories,
any morphism between simple objects is (exclusively) either an isomorphism or zero.
-/
lemma is_iso_iff_nonzero [has_kernels C] {X Y : C} [simple.{v} X] [simple.{v} Y] (f : X ⟶ Y) :
  is_iso.{v} f ↔ f ≠ 0 :=
⟨λ I,
  begin
    introI h,
    apply id_nonzero X,
    simp only [←is_iso.hom_inv_id f, h, zero_comp],
  end,
  λ w, is_iso_of_hom_simple w⟩

open finite_dimensional

variables (𝕜 : Type*) [field 𝕜]

/--
Part of **Schur's lemma** for `𝕜`-linear categories:
the hom space between two non-isomorphic simple objects is 0-dimensional.
-/
lemma finrank_hom_simple_simple_eq_zero_of_not_iso
  [has_kernels C] [linear 𝕜 C] {X Y : C} [simple.{v} X] [simple.{v} Y]
  (h : (X ≅ Y) → false):
  finrank 𝕜 (X ⟶ Y) = 0 :=
begin
  haveI := subsingleton_of_forall_eq (0 : X ⟶ Y) (λ f, begin
    have p := not_congr (is_iso_iff_nonzero f),
    simp only [not_not, ne.def] at p,
    refine p.mp (λ _, by exactI h (as_iso f)),
  end),
  exact finrank_zero_of_subsingleton,
end

variables [is_alg_closed 𝕜] [linear 𝕜 C]

-- In the proof below we have some difficulty using `I : finite_dimensional 𝕜 (X ⟶ X)`
-- where we need a `finite_dimensional 𝕜 (End X)`.
-- These are definitionally equal, but without eta reduction Lean can't see this.
-- To get around this, we use `convert I`,
-- then check the various instances agree field-by-field,
-- using `ext` equipped with the following extra lemmas:
local attribute [ext] module distrib_mul_action mul_action has_scalar

/--
An auxiliary lemma for Schur's lemma.

If `X ⟶ X` is finite dimensional, and every nonzero endomorphism is invertible,
then `X ⟶ X` is 1-dimensional.
-/
-- We prove this with the explicit `is_iso_iff_nonzero` assumption,
-- rather than just `[simple X]`, as this form is useful for
-- Müger's formulation of semisimplicity.
lemma finrank_endomorphism_eq_one
  {X : C} (is_iso_iff_nonzero : ∀ f : X ⟶ X, is_iso f ↔ f ≠ 0)
  [I : finite_dimensional 𝕜 (X ⟶ X)] :
  finrank 𝕜 (X ⟶ X) = 1 :=
begin
  have id_nonzero := (is_iso_iff_nonzero (𝟙 X)).mp (by apply_instance),
  apply finrank_eq_one (𝟙 X),
  { exact id_nonzero, },
  { intro f,
    haveI : nontrivial (End X) := nontrivial_of_ne _ _ id_nonzero,
    obtain ⟨c, nu⟩ := @exists_spectrum_of_is_alg_closed_of_finite_dimensional 𝕜 _ _ (End X) _ _ _
      (by { convert I, ext, refl, ext, refl, }) (End.of f),
    use c,
    rw [is_unit_iff_is_iso, is_iso_iff_nonzero, ne.def, not_not, sub_eq_zero,
      algebra.algebra_map_eq_smul_one] at nu,
    exact nu.symm, },
end

variables [has_kernels C]

/--
**Schur's lemma** for endomorphisms in `𝕜`-linear categories.
-/
lemma finrank_endomorphism_simple_eq_one
  (X : C) [simple.{v} X] [I : finite_dimensional 𝕜 (X ⟶ X)] :
  finrank 𝕜 (X ⟶ X) = 1 :=
finrank_endomorphism_eq_one 𝕜 is_iso_iff_nonzero

lemma endomorphism_simple_eq_smul_id
  {X : C} [simple.{v} X] [I : finite_dimensional 𝕜 (X ⟶ X)] (f : X ⟶ X) :
  ∃ c : 𝕜, c • 𝟙 X = f :=
(finrank_eq_one_iff_of_nonzero' (𝟙 X) (id_nonzero X)).mp (finrank_endomorphism_simple_eq_one 𝕜 X) f

/--
**Schur's lemma** for `𝕜`-linear categories:
if hom spaces are finite dimensional, then the hom space between simples is at most 1-dimensional.

See `finrank_hom_simple_simple_eq_one_iff` and `finrank_hom_simple_simple_eq_zero_iff` below
for the refinements when we know whether or not the simples are isomorphic.
-/
-- We don't really need `[∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)]` here,
-- just at least one of `[finite_dimensional 𝕜 (X ⟶ X)]` or `[finite_dimensional 𝕜 (Y ⟶ Y)]`.
lemma finrank_hom_simple_simple_le_one
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) ≤ 1 :=
begin
  cases subsingleton_or_nontrivial (X ⟶ Y) with h,
  { resetI,
    convert zero_le_one,
    exact finrank_zero_of_subsingleton, },
  { obtain ⟨f, nz⟩ := (nontrivial_iff_exists_ne 0).mp h,
    haveI fi := (is_iso_iff_nonzero f).mpr nz,
    apply finrank_le_one f,
    intro g,
    obtain ⟨c, w⟩ := endomorphism_simple_eq_smul_id 𝕜 (g ≫ inv f),
    exact ⟨c, by simpa using w =≫ f⟩, },
end

lemma finrank_hom_simple_simple_eq_one_iff
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) = 1 ↔ nonempty (X ≅ Y) :=
begin
  fsplit,
  { intro h,
    rw finrank_eq_one_iff' at h,
    obtain ⟨f, nz, -⟩ := h,
    rw ←is_iso_iff_nonzero at nz,
    exactI ⟨as_iso f⟩, },
  { rintro ⟨f⟩,
    have le_one := finrank_hom_simple_simple_le_one 𝕜 X Y,
    have zero_lt : 0 < finrank 𝕜 (X ⟶ Y) :=
      finrank_pos_iff_exists_ne_zero.mpr ⟨f.hom, (is_iso_iff_nonzero f.hom).mp infer_instance⟩,
    linarith, }
end

lemma finrank_hom_simple_simple_eq_zero_iff
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) = 0 ↔ is_empty (X ≅ Y) :=
begin
  rw [← not_nonempty_iff, ← not_congr (finrank_hom_simple_simple_eq_one_iff 𝕜 X Y)],
  refine ⟨λ h, by { rw h, simp, }, λ h, _⟩,
  have := finrank_hom_simple_simple_le_one 𝕜 X Y,
  interval_cases finrank 𝕜 (X ⟶ Y) with h',
  { exact h', },
  { exact false.elim (h h'), },
end

end category_theory


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_iff_two_colorable (G : Type*) [graph G] : bipartite G ↔ two_colorable G :=
begin
  split,
  assume hbipartite : bipartite G,
  show two_colorable G, from by {
    use (λ v, v ∈ (bipartite.partition hbipartite).1),
    assume v w hvw : v -- w,
    have h1 : v ∈ (bipartite.partition hbipartite).1, from by {
      apply mem_of_mem_of_mem (bipartite.partition hbipartite).2,
      exact hvw,
    },
    have h2 : w ∈ (bipartite.partition hbipartite).2, from by {
      apply mem_of_mem_of_mem (bipartite.partition hbipartite).2,
      exact hvw,
    },
    show (λ v, v ∈ (bipartite.partition hbipartite).1) v = (λ v, v ∈ (bipartite.partition hbipartite).1) w, from by {
      rw h1, rw h2,
    },
  },
  assume htwocolorable : two_colorable G,
  show bipartite G, from by {
    use (λ v, (htwocolorable v) = tt),
    assume v w hvw : v -- w,
    have h1 : (htwocolorable v) = tt, from by {
      apply mem_of_mem_of_mem (htwocolorable w) hvw,
    },
    have h2 : (htwocolorable w) = ff, from by {
      apply mem_of_mem_of_mem (htwocolorable w) hvw,
    },
    show (λ v, (htwocolorable v) = tt) v = (λ v, (htwocolorable v) = tt) w, from by {
      rw h1, rw h2,
    },
  },
end

--OUTPUT 2
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : 2-colorable G ↔ bipartite G :=
begin
  split,
  assume h1 : 2-colorable G,
  have h2 : ∀ A B : set G, (∀ v : G, v ∈ A ∨ v ∈ B) → (∀ e : G, e ∈ E → (e.1 ∈ A ∧ e.2 ∈ B) ∨ (e.1 ∈ B ∧ e.2 ∈ A)), from by {
    assume (A B : set G) (hpart : ∀ v : G, v ∈ A ∨ v ∈ B),
    assume (e : G) (he : e ∈ E),
    have h3 : e.1 ∈ A ∨ e.1 ∈ B, from hpart e.1,
    have h4 : e.2 ∈ A ∨ e.2 ∈ B, from hpart e.2,
    have h5 : e.1 ≠ e.2, from by {
      assume h6 : e.1 = e.2,
      have h7 : e ∈ E, from by {
        have h8 : e.1 ∈ V, from by {
          have h9 : e.1 ∈ A ∨ e.1 ∈ B, from hpart e.1,
          cases h9 with h9a h9b,
          exact h9a,
          exact h9b,
        },
        have h10 : e.2 ∈ V, from by {
          have h11 : e.2 ∈ A ∨ e.2 ∈ B, from hpart e.2,
          cases h11 with h11a h11b,
          exact h11a,
          exact h11b,
        },
        show e ∈ E, from by {
          have h12 : (e.1,e.2) ∈ E, from by {
            have h13 : e.1 ∈ A ∨ e.1 ∈ B, from hpart e.1,
            have h14 : e.2 ∈ A ∨ e.2 ∈ B, from hpart e.2,
            cases h13 with h13a h13b,
            cases h14 with h14a h14b,
            have h15 : (e.1,e.2) ∈ E, from h1.to_graph.edge_iff.mp ⟨h13a,h14b⟩,
            exact h15,
            have h15 : (e.1,e.2) ∈ E, from h1.to_graph.edge_iff.mp ⟨h13b,h14a⟩,
            exact h15,
            have h15 : (e.1,e.2) ∈ E, from h1.to_graph.edge_iff.mp ⟨h13b,h14b⟩,
            exact h15,
          },
          have h16 : e = (e.1,e.2), from by {
            rw h6,
            rw h6,
          },
          rw h16,
          exact h12,
        },
      },
      have h7a : e ∉ E, from by {
        have h8 : e.1 = e.2, from h6,
        have h9 : e ∈ E, from by {
          have h10 : (e.1,e.2) ∈ E, from by {
            have h11 : e.1 ∈ V, from by {
              have h12 : e.1 ∈ A ∨ e.1 ∈ B, from hpart e.1,
              cases h12 with h12a h12b,
              exact h12a,
              exact h12b,
            },
            have h13 : e.2 ∈ V, from by {
              have h14 : e.2 ∈ A ∨ e.2 ∈ B, from hpart e.2,
              cases h14 with h14a h14b,
              exact h14a,
              exact h14b,
            },
            show (e.1,e.2) ∈ E, from by {
              have h15 : e.1 = e.2, from h8,
              rw h15,
              exact h1.to_graph.loop_iff.mp ⟨h11,h13⟩,
            },
          },
          have h10a : e = (e.1,e.2), from by {
            rw h8,
            rw h8,
          },
          rw h10a,
          exact h10,
        },
        show e ∉ E, from by {
          have h11 : e ∈ E, from h9,
          exact h1.to_graph.no_loops h11,
        },
      },
      exact h7a,
    },
    cases h3 with h3a h3b,
    cases h4 with h4a h4b,
    have h6 : (e.1,e.2) ∈ E, from by {
      have h7 : (e.1,e.2) ∈ E, from h1.to_graph.edge_iff.mp ⟨h3a,h4b⟩,
      exact h7,
    },
    have h7 : e = (e.1,e.2), from by {
      rw h5,
      rw h5,
    },
    rw h7,
    exact ⟨h3a,h4b⟩,
    have h6 : (e.1,e.2) ∈ E, from by {
      have h7 : (e.1,e.2) ∈ E, from h1.to_graph.edge_iff.mp ⟨h3b,h4a⟩,
      exact h7,
    },
    have h7 : e = (e.1,e.2), from by {
      rw h5,
      rw h5,
    },
    rw h7,
    exact ⟨h3b,h4a⟩,
    have h6 : (e.1,e.2) ∈ E, from by {
      have h7 : (e.1,e.2) ∈ E, from h1.to_graph.edge_iff.mp ⟨h3b,h4b⟩,
      exact h7,
    },
    have h7 : e = (e.1,e.2), from by {
      rw h5,
      rw h5,
    },
    rw h7,
    exact ⟨h3b,h4b⟩,
  },
  have h3 : ∀ A B : set G, (∀ v : G, v ∈ A ∨ v ∈ B) → (∀ e : G, e ∈ E → (e.1 ∈ A ∧ e.2 ∈ B)), from by {
    assume (A B : set G) (hpart : ∀ v : G, v ∈ A ∨ v ∈ B),
    assume (e : G) (he : e ∈ E),
    have h4 : (e.1 ∈ A ∧ e.2 ∈ B) ∨ (e.1 ∈ B ∧ e.2 ∈ A), from h2 A B hpart e he,
    cases h4 with h4a h4b,
    exact h4a,
    have h5 : e.1 ∈ A ∧ e.2 ∈ B, from by {
      have h6 : e.1 ∈ B ∧ e.2 ∈ A, from h4b,
      have h7 : e.1 ∈ A ∧ e.2 ∈ B, from by {
        have h8 : e.1 ∈ B, from h6.left,
        have h9 : e.2 ∈ A, from h6.right,
        have h10 : e.1 ∈ A ∨ e.1 ∈ B, from hpart e.1,
        have h11 : e.2 ∈ A ∨ e.2 ∈ B, from hpart e.2,
        cases h10 with h10a h10b,
        cases h11 with h11a h11b,
        have h12 : e.1 ∈ A ∧ e
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem two_colorable_iff_bipartite {G : Type*} [fintype G] [decidable_eq G] [fintype (G × G)] :
  two_colorable G ↔ bipartite G :=
begin
  split,
  assume h,
  obtain ⟨f, hf⟩ : ∃ f : G → ℕ, ∀ a b : G, a ≠ b → f a ≠ f b, from h,
  use f,
  assume a b hab,
  have h1 : f a = 0 ∨ f a = 1, from by {
    have h2 : ∀ n : ℕ, n = 0 ∨ n = 1, from by {
      assume n : ℕ,
      cases n,
      left,
      refl,
      right,
      refl,
    },
    have h3 : f a = 0 ∨ f a = 1 ∨ f a = 2, from h2 (f a),
    cases h3,
    exact h3,
    cases h3,
    exact h3,
    cases h3,
    have h4 : f a = 0 ∨ f a = 1, from h2 (f a),
    exact h4,
  },
  have h2 : f b = 0 ∨ f b = 1, from by {
    have h3 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h4 : f a = 0, by {
      have h5 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h6 : f a = 0, by {
        have h7 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h8 : f a = 0, by {
          have h9 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h10 : f a = 0, by {
            have h11 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h12 : f a = 0, by {
              have h13 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h14 : f a = 0, by {
                have h15 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h16 : f a = 0, by {
                  have h17 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h18 : f a = 0, by {
                    have h19 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h20 : f a = 0, by {
                      have h21 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h22 : f a = 0, by {
                        have h23 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h24 : f a = 0, by {
                          have h25 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h26 : f a = 0, by {
                            have h27 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h28 : f a = 0, by {
                              have h29 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h30 : f a = 0, by {
                                have h31 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h32 : f a = 0, by {
                                  have h33 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h34 : f a = 0, by {
                                    have h35 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h36 : f a = 0, by {
                                      have h37 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h38 : f a = 0, by {
                                        have h39 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h40 : f a = 0, by {
                                          have h41 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h42 : f a = 0, by {
                                            have h43 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h44 : f a = 0, by {
                                              have h45 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h46 : f a = 0, by {
                                                have h47 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h48 : f a = 0, by {
                                                  have h49 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h50 : f a = 0, by {
                                                    have h51 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h52 : f a = 0, by {
                                                      have h53 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h54 : f a = 0, by {
                                                        have h55 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h56 : f a = 0, by {
                                                          have h57 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h58 : f a = 0, by {
                                                            have h59 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h60 : f a = 0, by {
                                                              have h61 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h62 : f a = 0, by {
                                                                have h63 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h64 : f a = 0, by {
                                                                  have h65 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h66 : f a = 0, by {
                                                                    have h67 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h68 : f a = 0, by {
                                                                      have h69 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h70 : f a = 0, by {
                                                                        have h71 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h72 : f a = 0, by {
                                                                          have h73 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h74 : f a = 0, by {
                                                                            have h75 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h76 : f a = 0, by {
                                                                              have h77 : f b = 0 ∨ f b = 1 ∨ f b = 2, from h1.elim (assume h78 : f a = 0, by {
                                                                                have h79 : f b = 0 ∨ f b = 1 ∨ f b = 2
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem bipartite_iff_two_colorable {G : Type*} [graph G] : bipartite G ↔ two_colorable G :=
begin
  split,
  assume hbipartite : bipartite G,
  show two_colorable G, from by {
    have h1 : ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2), from hbipartite,
    have h2 : ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅, from
      exists.elim h1 (assume V1 : set G,
      assume h1 : ∃ V2 : set G, V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2),
      exists.elim h1 (assume V2 : set G,
      assume h2 : V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2),
      have h3 : V1 ∩ V2 = ∅, from by {
        assume x : G,
        assume h4 : x ∈ V1 ∩ V2,
        have h5 : x ∈ V1, from h4.left,
        have h6 : x ∈ V2, from h4.right,
        have h7 : x ∈ V1 ∨ x ∈ V2, from or.inl h5,
        have h8 : x ∉ V1 ∨ x ∉ V2, from h2.right x,
        have h9 : x ∈ V1 ∧ x ∈ V2, from by {split,exact h7,exact h6},
        show false, from h8 h9,
      },
      show ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅, from by {
        use V1,
        use V2,
        split,
        exact h2.left,
        split,
        exact h2.right,
        exact h3,
      }
    )),
    have h3 : ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅ ∧ V1 ∪ V2 = G, from
      exists.elim h2 (assume V1 : set G,
      assume h1 : ∃ V2 : set G, V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅,
      exists.elim h1 (assume V2 : set G,
      assume h2 : V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅,
      have h3 : V1 ∪ V2 = G, from by {
        assume x : G,
        assume h4 : x ∈ G,
        have h5 : x ∈ V1 ∨ x ∈ V2, from by {
          assume h6 : x ∉ V1,
          assume h7 : x ∉ V2,
          have h8 : x ∈ V1 ∨ x ∈ V2 ∧ (x ∉ V1 ∨ x ∉ V2), from by {
            show x ∈ V1 ∨ x ∈ V2 ∧ (x ∉ V1 ∨ x ∉ V2), from or.inr ⟨h7,h6⟩,
          },
          have h9 : x ∈ V1 ∨ x ∈ V2, from h2.right x,
          show false, from h8 h9,
        },
        show x ∈ V1 ∪ V2, from h5,
      },
      show ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅ ∧ V1 ∪ V2 = G, from by {
        use V1,
        use V2,
        split,
        exact h2.left,
        split,
        exact h2.right.left,
        split,
        exact h2.right.right,
        exact h3,
      }
    )),
    have h4 : ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅ ∧ V1 ∪ V2 = G ∧ ∀ e : G, e ∈ V1 ∨ e ∉ V1, from
      exists.elim h3 (assume V1 : set G,
      assume h1 : ∃ V2 : set G, V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅ ∧ V1 ∪ V2 = G,
      exists.elim h1 (assume V2 : set G,
      assume h2 : V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅ ∧ V1 ∪ V2 = G,
      have h3 : ∀ e : G, e ∈ V1 ∨ e ∉ V1, from by {
        assume e : G,
        have h4 : e ∈ V1 ∨ e ∈ V2, from h2.right.left e,
        show e ∈ V1 ∨ e ∉ V1, from or.elim h4 (assume h5 : e ∈ V1, or.inl h5) (assume h5 : e ∈ V2, or.inr (mt (h2.right.right e).left h5)),
      },
      show ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1 ∩ V2 = ∅ ∧ V1 ∪ V2 = G ∧ ∀ e : G, e ∈ V1 ∨ e ∉ V1, from by {
        use V1,
        use V2,
        split,
        exact h2.left,
        split,
        exact h2.right.left,
        split,
        exact h2.right.right,
        split,
        exact h2.right.right.left,
        split,
        exact h2.right.right.right,
        exact h3,
      }
    )),
    have h5 : ∃ V1 V2 : set G, V1 ≠ ∅ ∧ V2 ≠ ∅ ∧ ∀ e : G, e ∈ V1 ∨ e ∈ V2 ∧ (e ∉ V1 ∨ e ∉ V2) ∧ V1
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem bipartite_iff_two_colorable (G : Type*) [graph G] : bipartite G ↔ two_colorable G :=
begin
  apply iff.intro,
  assume hbipartite : bipartite G,
  show two_colorable G, from
  begin
    use ⟨hbipartite.left, hbipartite.right⟩,
    assume (u v : G) (h : u.adjacent v),
    have h1 : u ∈ hbipartite.left ∨ u ∈ hbipartite.right, from hbipartite.partition u,
    have h2 : v ∈ hbipartite.left ∨ v ∈ hbipartite.right, from hbipartite.partition v,
    cases h1,
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm hbipartite.no_edge)).elim_right h},
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm hbipartite.no_edge)).elim_left h},
    cases h1,
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm hbipartite.no_edge)).elim_right h},
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm hbipartite.no_edge)).elim_left h},
  end,
  assume htwo_colorable : two_colorable G,
  show bipartite G, from
  begin
    use ⟨htwo_colorable.left, htwo_colorable.right⟩,
    assume (u v : G) (h : u.adjacent v),
    have h1 : u ∈ htwo_colorable.left ∨ u ∈ htwo_colorable.right, from htwo_colorable.partition u,
    have h2 : v ∈ htwo_colorable.left ∨ v ∈ htwo_colorable.right, from htwo_colorable.partition v,
    cases h1,
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm htwo_colorable.no_edge)).elim_right h},
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm htwo_colorable.no_edge)).elim_left h},
    cases h1,
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm htwo_colorable.no_edge)).elim_right h},
    cases h2,
    show u.color ≠ v.color, from by {rw h1, rw h2, exact (ne.symm (ne.symm htwo_colorable.no_edge)).elim_left h},
  end
end

--OUTPUT 6
theorem bipartite_iff_two_colorable (G : Type*) [fintype G] [decidable_eq G] [fintype (G × G)] [decidable_eq (G × G)] [fintype (G × G × G)] [decidable_eq (G × G × G)] [fintype (G × G × G × G)] [decidable_eq (G × G × G × G)] [fintype (G × G × G × G × G)] [decidable_eq (G × G × G × G × G)] [fintype (G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [decidable_eq (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G)] [fintype (G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G × G ×
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.degeneracies
! leanprover-community/mathlib commit ec1c7d810034d4202b0dd239112d1792be9f6fdc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.Decomposition
import Mathbin.Tactic.FinCases

/-!

# Behaviour of P_infty with respect to degeneracies

For any `X : simplicial_object C` where `C` is an abelian category,
the projector `P_infty : K[X] ⟶ K[X]` is supposed to be the projection
on the normalized subcomplex, parallel to the degenerate subcomplex, i.e.
the subcomplex generated by the images of all `X.σ i`.

In this file, we obtain `degeneracy_comp_P_infty` which states that
if `X : simplicial_object C` with `C` a preadditive category,
`θ : [n] ⟶ Δ'` is a non injective map in `simplex_category`, then
`X.map θ.op ≫ P_infty.f n = 0`. It follows from the more precise
statement vanishing statement `σ_comp_P_eq_zero` for the `P q`.

-/

open
  CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Preadditive Opposite

open Simplicial DoldKan

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C]

theorem HigherFacesVanish.comp_σ {Y : C} {X : SimplicialObject C} {n b q : ℕ} {φ : Y ⟶ X _[n + 1]}
    (v : HigherFacesVanish q φ) (hnbq : n + 1 = b + q) :
    HigherFacesVanish q
      (φ ≫
        X.σ ⟨b, by simpa only [hnbq, Nat.lt_succ_iff, le_add_iff_nonneg_right] using zero_le q⟩) :=
  fun j hj =>
  by
  rw [assoc, simplicial_object.δ_comp_σ_of_gt', Fin.pred_succ, v.comp_δ_eq_zero_assoc _ _ hj,
    zero_comp]
  · intro hj'
    simpa only [hj', hnbq, Fin.val_zero, zero_add, add_comm b, add_assoc, false_and_iff,
      add_le_iff_nonpos_right, le_zero_iff, add_eq_zero_iff, Nat.one_ne_zero] using hj
  · simp only [Fin.lt_iff_val_lt_val, Nat.lt_iff_add_one_le, Fin.succ_mk, Fin.val_mk, Fin.val_succ,
      add_le_add_iff_right]
    linarith
#align algebraic_topology.dold_kan.higher_faces_vanish.comp_σ AlgebraicTopology.DoldKan.HigherFacesVanish.comp_σ

theorem σ_comp_p_eq_zero (X : SimplicialObject C) {n q : ℕ} (i : Fin (n + 1)) (hi : n + 1 ≤ i + q) :
    X.σ i ≫ (p q).f (n + 1) = 0 :=
  by
  induction' q with q hq generalizing i hi
  · exfalso
    have h := Fin.is_lt i
    linarith
  · by_cases n + 1 ≤ (i : ℕ) + q
    · unfold P
      simp only [HomologicalComplex.comp_f, ← assoc]
      rw [hq i h, zero_comp]
    · have hi' : n = (i : ℕ) + q :=
        by
        cases' le_iff_exists_add.mp hi with j hj
        rw [← Nat.lt_succ_iff, Nat.succ_eq_add_one, add_assoc, hj, not_lt, add_le_iff_nonpos_right,
          nonpos_iff_eq_zero] at h
        rw [← add_left_inj 1, add_assoc, hj, self_eq_add_right, h]
      cases n
      · fin_cases i
        rw [show q = 0 by linarith]
        unfold P
        simp only [id_comp, HomologicalComplex.add_f_apply, comp_add, HomologicalComplex.id_f, Hσ,
          Homotopy.nullHomotopicMap'_f (c_mk 2 1 rfl) (c_mk 1 0 rfl),
          alternating_face_map_complex.obj_d_eq]
        erw [hσ'_eq' (zero_add 0).symm, hσ'_eq' (add_zero 1).symm, comp_id, Fin.sum_univ_two,
          Fin.sum_univ_succ, Fin.sum_univ_two]
        simp only [pow_zero, pow_one, pow_two, Fin.val_zero, Fin.val_one, Fin.val_two, one_zsmul,
          neg_zsmul, Fin.mk_zero, Fin.mk_one, Fin.val_succ, pow_add, one_mul, neg_mul, neg_neg,
          Fin.succ_zero_eq_one, Fin.succ_one_eq_two, comp_neg, neg_comp, add_comp, comp_add]
        erw [simplicial_object.δ_comp_σ_self, simplicial_object.δ_comp_σ_self_assoc,
          simplicial_object.δ_comp_σ_succ, comp_id,
          simplicial_object.δ_comp_σ_of_le X
            (show (0 : Fin 2) ≤ Fin.castSucc 0 by rw [Fin.castSucc_zero]),
          simplicial_object.δ_comp_σ_self_assoc, simplicial_object.δ_comp_σ_succ_assoc]
        abel
      · rw [← id_comp (X.σ i), ← (P_add_Q_f q n.succ : _ = 𝟙 (X.obj _)), add_comp, add_comp]
        have v : higher_faces_vanish q ((P q).f n.succ ≫ X.σ i) :=
          (higher_faces_vanish.of_P q n).comp_σ hi'
        unfold P
        erw [← assoc, v.comp_P_eq_self, HomologicalComplex.add_f_apply, preadditive.comp_add,
          comp_id, v.comp_Hσ_eq hi', assoc, simplicial_object.δ_comp_σ_succ'_assoc, Fin.eta,
          decomposition_Q n q, sum_comp, sum_comp, Finset.sum_eq_zero, add_zero, add_neg_eq_zero]
        swap
        · ext
          simp only [Fin.val_mk, Fin.val_succ]
        · intro j hj
          simp only [true_and_iff, Finset.mem_univ, Finset.mem_filter] at hj
          simp only [Nat.succ_eq_add_one] at hi'
          obtain ⟨k, hk⟩ := Nat.le.dest (nat.lt_succ_iff.mp (Fin.is_lt j))
          rw [add_comm] at hk
          have hi'' : i = Fin.castSucc ⟨i, by linarith⟩ :=
            by
            ext
            simp only [Fin.castSucc_mk, Fin.eta]
          have eq :=
            hq j.rev.succ
              (by
                simp only [← hk, Fin.rev_eq j hk.symm, Nat.succ_eq_add_one, Fin.succ_mk, Fin.val_mk]
                linarith)
          rw [HomologicalComplex.comp_f, assoc, assoc, assoc, hi'',
            simplicial_object.σ_comp_σ_assoc, reassoc_of Eq, zero_comp, comp_zero, comp_zero,
            comp_zero]
          simp only [Fin.rev_eq j hk.symm, Fin.le_iff_val_le_val, Fin.val_mk]
          linarith
#align algebraic_topology.dold_kan.σ_comp_P_eq_zero AlgebraicTopology.DoldKan.σ_comp_p_eq_zero

@[simp, reassoc.1]
theorem σ_comp_pInfty (X : SimplicialObject C) {n : ℕ} (i : Fin (n + 1)) :
    X.σ i ≫ pInfty.f (n + 1) = 0 :=
  by
  rw [P_infty_f, σ_comp_P_eq_zero X i]
  simp only [le_add_iff_nonneg_left, zero_le]
#align algebraic_topology.dold_kan.σ_comp_P_infty AlgebraicTopology.DoldKan.σ_comp_pInfty

@[reassoc.1]
theorem degeneracy_comp_pInfty (X : SimplicialObject C) (n : ℕ) {Δ' : SimplexCategory}
    (θ : [n] ⟶ Δ') (hθ : ¬Mono θ) : X.map θ.op ≫ pInfty.f n = 0 :=
  by
  rw [SimplexCategory.mono_iff_injective] at hθ
  cases n
  · exfalso
    apply hθ
    intro x y h
    fin_cases x
    fin_cases y
  · obtain ⟨i, α, h⟩ := SimplexCategory.eq_σ_comp_of_not_injective θ hθ
    rw [h, op_comp, X.map_comp, assoc, show X.map (SimplexCategory.σ i).op = X.σ i by rfl,
      σ_comp_P_infty, comp_zero]
#align algebraic_topology.dold_kan.degeneracy_comp_P_infty AlgebraicTopology.DoldKan.degeneracy_comp_pInfty

end DoldKan

end AlgebraicTopology


example (n : ℕ) : n + 1 = nat.succ n :=
begin
  show nat.succ n = nat.succ n,
  reflexivity,
end