/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.limits.shapes.wide_equalizers
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.HasLimits
import Mathbin.CategoryTheory.Limits.Shapes.Equalizers

/-!
# Wide equalizers and wide coequalizers

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

A wide equalizer for the family of morphisms `X ⟶ Y` indexed by `J` is the categorical
generalization of the subobject `{a ∈ A | ∀ j₁ j₂, f(j₁, a) = f(j₂, a)}`. Note that if `J` has
fewer than two morphisms this condition is trivial, so some lemmas and definitions assume `J` is
nonempty.

## Main definitions

* `walking_parallel_family` is the indexing category used for wide (co)equalizer diagrams
* `parallel_family` is a functor from `walking_parallel_family` to our category `C`.
* a `trident` is a cone over a parallel family.
  * there is really only one interesting morphism in a trident: the arrow from the vertex of the
    trident to the domain of f and g. It is called `trident.ι`.
* a `wide_equalizer` is now just a `limit (parallel_family f)`

Each of these has a dual.

## Main statements

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

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

## References

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

noncomputable section

namespace CategoryTheory.Limits

open CategoryTheory

universe w v u u₂

variable {J : Type w}

/-- The type of objects for the diagram indexing a wide (co)equalizer. -/
inductive WalkingParallelFamily (J : Type w) : Type w
  | zero : walking_parallel_family
  | one : walking_parallel_family
#align category_theory.limits.walking_parallel_family CategoryTheory.Limits.WalkingParallelFamily

open WalkingParallelFamily

instance : DecidableEq (WalkingParallelFamily J)
  | zero, zero => isTrue rfl
  | zero, one => isFalse fun t => WalkingParallelFamily.noConfusion t
  | one, zero => isFalse fun t => WalkingParallelFamily.noConfusion t
  | one, one => isTrue rfl

instance : Inhabited (WalkingParallelFamily J) :=
  ⟨zero⟩

/-- The type family of morphisms for the diagram indexing a wide (co)equalizer. -/
inductive WalkingParallelFamily.Hom (J : Type w) :
  WalkingParallelFamily J → WalkingParallelFamily J → Type w
  | id : ∀ X : WalkingParallelFamily.{w} J, walking_parallel_family.hom X X
  | line : ∀ j : J, walking_parallel_family.hom zero one
  deriving DecidableEq
#align category_theory.limits.walking_parallel_family.hom CategoryTheory.Limits.WalkingParallelFamily.Hom

/-- Satisfying the inhabited linter -/
instance (J : Type v) : Inhabited (WalkingParallelFamily.Hom J zero zero) where default := Hom.id _

open WalkingParallelFamily.Hom

/-- Composition of morphisms in the indexing diagram for wide (co)equalizers. -/
def WalkingParallelFamily.Hom.comp :
    ∀ (X Y Z : WalkingParallelFamily J) (f : WalkingParallelFamily.Hom J X Y)
      (g : WalkingParallelFamily.Hom J Y Z), WalkingParallelFamily.Hom J X Z
  | _, _, _, id _, h => h
  | _, _, _, line j, id one => line j
#align category_theory.limits.walking_parallel_family.hom.comp CategoryTheory.Limits.WalkingParallelFamily.Hom.comp

attribute [local tidy] tactic.case_bash

instance WalkingParallelFamily.category : SmallCategory (WalkingParallelFamily J)
    where
  Hom := WalkingParallelFamily.Hom J
  id := WalkingParallelFamily.Hom.id
  comp := WalkingParallelFamily.Hom.comp
#align category_theory.limits.walking_parallel_family.category CategoryTheory.Limits.WalkingParallelFamily.category

@[simp]
theorem WalkingParallelFamily.hom_id (X : WalkingParallelFamily J) :
    WalkingParallelFamily.Hom.id X = 𝟙 X :=
  rfl
#align category_theory.limits.walking_parallel_family.hom_id CategoryTheory.Limits.WalkingParallelFamily.hom_id

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

variable {X Y : C} (f : J → (X ⟶ Y))

/-- `parallel_family f` is the diagram in `C` consisting of the given family of morphisms, each with
common domain and codomain.
-/
def parallelFamily : WalkingParallelFamily J ⥤ C
    where
  obj x := WalkingParallelFamily.casesOn x X Y
  map x y h :=
    match x, y, h with
    | _, _, id _ => 𝟙 _
    | _, _, line j => f j
  map_comp' := by
    rintro _ _ _ ⟨⟩ ⟨⟩ <;>
      · unfold_aux
        simp <;> rfl
#align category_theory.limits.parallel_family CategoryTheory.Limits.parallelFamily

@[simp]
theorem parallelFamily_obj_zero : (parallelFamily f).obj zero = X :=
  rfl
#align category_theory.limits.parallel_family_obj_zero CategoryTheory.Limits.parallelFamily_obj_zero

@[simp]
theorem parallelFamily_obj_one : (parallelFamily f).obj one = Y :=
  rfl
#align category_theory.limits.parallel_family_obj_one CategoryTheory.Limits.parallelFamily_obj_one

@[simp]
theorem parallelFamily_map_left {j : J} : (parallelFamily f).map (line j) = f j :=
  rfl
#align category_theory.limits.parallel_family_map_left CategoryTheory.Limits.parallelFamily_map_left

/-- Every functor indexing a wide (co)equalizer is naturally isomorphic (actually, equal) to a
    `parallel_family` -/
@[simps]
def diagramIsoParallelFamily (F : WalkingParallelFamily J ⥤ C) :
    F ≅ parallelFamily fun j => F.map (line j) :=
  (NatIso.ofComponents fun j => eqToIso <| by cases j <;> tidy) <| by tidy
#align category_theory.limits.diagram_iso_parallel_family CategoryTheory.Limits.diagramIsoParallelFamily

/-- `walking_parallel_pair` as a category is equivalent to a special case of
`walking_parallel_family`.  -/
@[simps]
def walkingParallelFamilyEquivWalkingParallelPair :
    WalkingParallelFamily.{w} (ULift Bool) ≌ WalkingParallelPair
    where
  Functor :=
    parallelFamily fun p => cond p.down WalkingParallelPairHom.left WalkingParallelPairHom.right
  inverse := parallelPair (line (ULift.up true)) (line (ULift.up false))
  unitIso := NatIso.ofComponents (fun X => eqToIso (by cases X <;> rfl)) (by tidy)
  counitIso := NatIso.ofComponents (fun X => eqToIso (by cases X <;> rfl)) (by tidy)
#align category_theory.limits.walking_parallel_family_equiv_walking_parallel_pair CategoryTheory.Limits.walkingParallelFamilyEquivWalkingParallelPair

/-- A trident on `f` is just a `cone (parallel_family f)`. -/
abbrev Trident :=
  Cone (parallelFamily f)
#align category_theory.limits.trident CategoryTheory.Limits.Trident

/-- A cotrident on `f` and `g` is just a `cocone (parallel_family f)`. -/
abbrev Cotrident :=
  Cocone (parallelFamily f)
#align category_theory.limits.cotrident CategoryTheory.Limits.Cotrident

variable {f}

/-- A trident `t` on the parallel family `f : J → (X ⟶ Y)` consists of two morphisms
    `t.π.app zero : t.X ⟶ X` and `t.π.app one : t.X ⟶ Y`. Of these, only the first one is
    interesting, and we give it the shorter name `trident.ι t`. -/
abbrev Trident.ι (t : Trident f) :=
  t.π.app zero
#align category_theory.limits.trident.ι CategoryTheory.Limits.Trident.ι

/-- A cotrident `t` on the parallel family `f : J → (X ⟶ Y)` consists of two morphisms
    `t.ι.app zero : X ⟶ t.X` and `t.ι.app one : Y ⟶ t.X`. Of these, only the second one is
    interesting, and we give it the shorter name `cotrident.π t`. -/
abbrev Cotrident.π (t : Cotrident f) :=
  t.ι.app one
#align category_theory.limits.cotrident.π CategoryTheory.Limits.Cotrident.π

@[simp]
theorem Trident.ι_eq_app_zero (t : Trident f) : t.ι = t.π.app zero :=
  rfl
#align category_theory.limits.trident.ι_eq_app_zero CategoryTheory.Limits.Trident.ι_eq_app_zero

@[simp]
theorem Cotrident.π_eq_app_one (t : Cotrident f) : t.π = t.ι.app one :=
  rfl
#align category_theory.limits.cotrident.π_eq_app_one CategoryTheory.Limits.Cotrident.π_eq_app_one

@[simp, reassoc.1]
theorem Trident.app_zero (s : Trident f) (j : J) : s.π.app zero ≫ f j = s.π.app one := by
  rw [← s.w (line j), parallel_family_map_left]
#align category_theory.limits.trident.app_zero CategoryTheory.Limits.Trident.app_zero

@[simp, reassoc.1]
theorem Cotrident.app_one (s : Cotrident f) (j : J) : f j ≫ s.ι.app one = s.ι.app zero := by
  rw [← s.w (line j), parallel_family_map_left]
#align category_theory.limits.cotrident.app_one CategoryTheory.Limits.Cotrident.app_one

/-- A trident on `f : J → (X ⟶ Y)` is determined by the morphism `ι : P ⟶ X` satisfying
`∀ j₁ j₂, ι ≫ f j₁ = ι ≫ f j₂`.
-/
@[simps]
def Trident.ofι [Nonempty J] {P : C} (ι : P ⟶ X) (w : ∀ j₁ j₂, ι ≫ f j₁ = ι ≫ f j₂) : Trident f
    where
  pt := P
  π :=
    { app := fun X => WalkingParallelFamily.casesOn X ι (ι ≫ f (Classical.arbitrary J))
      naturality' := fun i j f => by
        dsimp
        cases' f with _ k
        · simp
        · simp [w (Classical.arbitrary J) k] }
#align category_theory.limits.trident.of_ι CategoryTheory.Limits.Trident.ofι

/-- A cotrident on `f : J → (X ⟶ Y)` is determined by the morphism `π : Y ⟶ P` satisfying
`∀ j₁ j₂, f j₁ ≫ π = f j₂ ≫ π`.
-/
@[simps]
def Cotrident.ofπ [Nonempty J] {P : C} (π : Y ⟶ P) (w : ∀ j₁ j₂, f j₁ ≫ π = f j₂ ≫ π) : Cotrident f
    where
  pt := P
  ι :=
    { app := fun X => WalkingParallelFamily.casesOn X (f (Classical.arbitrary J) ≫ π) π
      naturality' := fun i j f => by
        dsimp
        cases' f with _ k
        · simp
        · simp [w (Classical.arbitrary J) k] }
#align category_theory.limits.cotrident.of_π CategoryTheory.Limits.Cotrident.ofπ

-- See note [dsimp, simp]
theorem Trident.ι_ofι [Nonempty J] {P : C} (ι : P ⟶ X) (w : ∀ j₁ j₂, ι ≫ f j₁ = ι ≫ f j₂) :
    (Trident.ofι ι w).ι = ι :=
  rfl
#align category_theory.limits.trident.ι_of_ι CategoryTheory.Limits.Trident.ι_ofι

theorem Cotrident.π_ofπ [Nonempty J] {P : C} (π : Y ⟶ P) (w : ∀ j₁ j₂, f j₁ ≫ π = f j₂ ≫ π) :
    (Cotrident.ofπ π w).π = π :=
  rfl
#align category_theory.limits.cotrident.π_of_π CategoryTheory.Limits.Cotrident.π_ofπ

@[reassoc.1]
theorem Trident.condition (j₁ j₂ : J) (t : Trident f) : t.ι ≫ f j₁ = t.ι ≫ f j₂ := by
  rw [t.app_zero, t.app_zero]
#align category_theory.limits.trident.condition CategoryTheory.Limits.Trident.condition

@[reassoc.1]
theorem Cotrident.condition (j₁ j₂ : J) (t : Cotrident f) : f j₁ ≫ t.π = f j₂ ≫ t.π := by
  rw [t.app_one, t.app_one]
#align category_theory.limits.cotrident.condition CategoryTheory.Limits.Cotrident.condition

/-- To check whether two maps are equalized by both maps of a trident, it suffices to check it for
the first map -/
theorem Trident.equalizer_ext [Nonempty J] (s : Trident f) {W : C} {k l : W ⟶ s.pt}
    (h : k ≫ s.ι = l ≫ s.ι) : ∀ j : WalkingParallelFamily J, k ≫ s.π.app j = l ≫ s.π.app j
  | zero => h
  | one => by rw [← s.app_zero (Classical.arbitrary J), reassoc_of h]
#align category_theory.limits.trident.equalizer_ext CategoryTheory.Limits.Trident.equalizer_ext

/-- To check whether two maps are coequalized by both maps of a cotrident, it suffices to check it
for the second map -/
theorem Cotrident.coequalizer_ext [Nonempty J] (s : Cotrident f) {W : C} {k l : s.pt ⟶ W}
    (h : s.π ≫ k = s.π ≫ l) : ∀ j : WalkingParallelFamily J, s.ι.app j ≫ k = s.ι.app j ≫ l
  | zero => by rw [← s.app_one (Classical.arbitrary J), category.assoc, category.assoc, h]
  | one => h
#align category_theory.limits.cotrident.coequalizer_ext CategoryTheory.Limits.Cotrident.coequalizer_ext

theorem Trident.IsLimit.hom_ext [Nonempty J] {s : Trident f} (hs : IsLimit s) {W : C}
    {k l : W ⟶ s.pt} (h : k ≫ s.ι = l ≫ s.ι) : k = l :=
  hs.hom_ext <| Trident.equalizer_ext _ h
#align category_theory.limits.trident.is_limit.hom_ext CategoryTheory.Limits.Trident.IsLimit.hom_ext

theorem Cotrident.IsColimit.hom_ext [Nonempty J] {s : Cotrident f} (hs : IsColimit s) {W : C}
    {k l : s.pt ⟶ W} (h : s.π ≫ k = s.π ≫ l) : k = l :=
  hs.hom_ext <| Cotrident.coequalizer_ext _ h
#align category_theory.limits.cotrident.is_colimit.hom_ext CategoryTheory.Limits.Cotrident.IsColimit.hom_ext

/-- If `s` is a limit trident over `f`, then a morphism `k : W ⟶ X` satisfying
    `∀ j₁ j₂, k ≫ f j₁ = k ≫ f j₂` induces a morphism `l : W ⟶ s.X` such that
    `l ≫ trident.ι s = k`. -/
def Trident.IsLimit.lift' [Nonempty J] {s : Trident f} (hs : IsLimit s) {W : C} (k : W ⟶ X)
    (h : ∀ j₁ j₂, k ≫ f j₁ = k ≫ f j₂) : { l : W ⟶ s.pt // l ≫ Trident.ι s = k } :=
  ⟨hs.lift <| Trident.ofι _ h, hs.fac _ _⟩
#align category_theory.limits.trident.is_limit.lift' CategoryTheory.Limits.Trident.IsLimit.lift'

/-- If `s` is a colimit cotrident over `f`, then a morphism `k : Y ⟶ W` satisfying
    `∀ j₁ j₂, f j₁ ≫ k = f j₂ ≫ k` induces a morphism `l : s.X ⟶ W` such that
    `cotrident.π s ≫ l = k`. -/
def Cotrident.IsColimit.desc' [Nonempty J] {s : Cotrident f} (hs : IsColimit s) {W : C} (k : Y ⟶ W)
    (h : ∀ j₁ j₂, f j₁ ≫ k = f j₂ ≫ k) : { l : s.pt ⟶ W // Cotrident.π s ≫ l = k } :=
  ⟨hs.desc <| Cotrident.ofπ _ h, hs.fac _ _⟩
#align category_theory.limits.cotrident.is_colimit.desc' CategoryTheory.Limits.Cotrident.IsColimit.desc'

/-- This is a slightly more convenient method to verify that a trident is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def Trident.IsLimit.mk [Nonempty J] (t : Trident f) (lift : ∀ s : Trident f, s.pt ⟶ t.pt)
    (fac : ∀ s : Trident f, lift s ≫ t.ι = s.ι)
    (uniq :
      ∀ (s : Trident f) (m : s.pt ⟶ t.pt)
        (w : ∀ j : WalkingParallelFamily J, m ≫ t.π.app j = s.π.app j), m = lift s) :
    IsLimit t :=
  { lift
    fac := fun s j =>
      WalkingParallelFamily.casesOn j (fac s)
        (by rw [← t.w (line (Classical.arbitrary J)), reassoc_of fac, s.w])
    uniq := uniq }
#align category_theory.limits.trident.is_limit.mk CategoryTheory.Limits.Trident.IsLimit.mk

/-- This is another convenient method to verify that a trident is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def Trident.IsLimit.mk' [Nonempty J] (t : Trident f)
    (create : ∀ s : Trident f, { l // l ≫ t.ι = s.ι ∧ ∀ {m}, m ≫ t.ι = s.ι → m = l }) : IsLimit t :=
  Trident.IsLimit.mk t (fun s => (create s).1) (fun s => (create s).2.1) fun s m w =>
    (create s).2.2 (w zero)
#align category_theory.limits.trident.is_limit.mk' CategoryTheory.Limits.Trident.IsLimit.mk'

/-- This is a slightly more convenient method to verify that a cotrident is a colimit cocone. It
    only asks for a proof of facts that carry any mathematical content -/
def Cotrident.IsColimit.mk [Nonempty J] (t : Cotrident f) (desc : ∀ s : Cotrident f, t.pt ⟶ s.pt)
    (fac : ∀ s : Cotrident f, t.π ≫ desc s = s.π)
    (uniq :
      ∀ (s : Cotrident f) (m : t.pt ⟶ s.pt)
        (w : ∀ j : WalkingParallelFamily J, t.ι.app j ≫ m = s.ι.app j), m = desc s) :
    IsColimit t :=
  { desc
    fac := fun s j =>
      WalkingParallelFamily.casesOn j (by rw [← t.w_assoc (line (Classical.arbitrary J)), fac, s.w])
        (fac s)
    uniq := uniq }
#align category_theory.limits.cotrident.is_colimit.mk CategoryTheory.Limits.Cotrident.IsColimit.mk

/-- This is another convenient method to verify that a cotrident is a colimit cocone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def Cotrident.IsColimit.mk' [Nonempty J] (t : Cotrident f)
    (create :
      ∀ s : Cotrident f, { l : t.pt ⟶ s.pt // t.π ≫ l = s.π ∧ ∀ {m}, t.π ≫ m = s.π → m = l }) :
    IsColimit t :=
  Cotrident.IsColimit.mk t (fun s => (create s).1) (fun s => (create s).2.1) fun s m w =>
    (create s).2.2 (w one)
#align category_theory.limits.cotrident.is_colimit.mk' CategoryTheory.Limits.Cotrident.IsColimit.mk'

/--
Given a limit cone for the family `f : J → (X ⟶ Y)`, for any `Z`, morphisms from `Z` to its point
are in bijection with morphisms `h : Z ⟶ X` such that `∀ j₁ j₂, h ≫ f j₁ = h ≫ f j₂`.
Further, this bijection is natural in `Z`: see `trident.is_limit.hom_iso_natural`.
-/
@[simps]
def Trident.IsLimit.homIso [Nonempty J] {t : Trident f} (ht : IsLimit t) (Z : C) :
    (Z ⟶ t.pt) ≃ { h : Z ⟶ X // ∀ j₁ j₂, h ≫ f j₁ = h ≫ f j₂ }
    where
  toFun k := ⟨k ≫ t.ι, by simp⟩
  invFun h := (Trident.IsLimit.lift' ht _ h.Prop).1
  left_inv k := Trident.IsLimit.hom_ext ht (Trident.IsLimit.lift' _ _ _).Prop
  right_inv h := Subtype.ext (Trident.IsLimit.lift' ht _ _).Prop
#align category_theory.limits.trident.is_limit.hom_iso CategoryTheory.Limits.Trident.IsLimit.homIso

/-- The bijection of `trident.is_limit.hom_iso` is natural in `Z`. -/
theorem Trident.IsLimit.homIso_natural [Nonempty J] {t : Trident f} (ht : IsLimit t) {Z Z' : C}
    (q : Z' ⟶ Z) (k : Z ⟶ t.pt) :
    (Trident.IsLimit.homIso ht _ (q ≫ k) : Z' ⟶ X) = q ≫ (Trident.IsLimit.homIso ht _ k : Z ⟶ X) :=
  Category.assoc _ _ _
#align category_theory.limits.trident.is_limit.hom_iso_natural CategoryTheory.Limits.Trident.IsLimit.homIso_natural

/-- Given a colimit cocone for the family `f : J → (X ⟶ Y)`, for any `Z`, morphisms from the cocone
point to `Z` are in bijection with morphisms `h : Z ⟶ X` such that
`∀ j₁ j₂, f j₁ ≫ h = f j₂ ≫ h`.  Further, this bijection is natural in `Z`: see
`cotrident.is_colimit.hom_iso_natural`.
-/
@[simps]
def Cotrident.IsColimit.homIso [Nonempty J] {t : Cotrident f} (ht : IsColimit t) (Z : C) :
    (t.pt ⟶ Z) ≃ { h : Y ⟶ Z // ∀ j₁ j₂, f j₁ ≫ h = f j₂ ≫ h }
    where
  toFun k := ⟨t.π ≫ k, by simp⟩
  invFun h := (Cotrident.IsColimit.desc' ht _ h.Prop).1
  left_inv k := Cotrident.IsColimit.hom_ext ht (Cotrident.IsColimit.desc' _ _ _).Prop
  right_inv h := Subtype.ext (Cotrident.IsColimit.desc' ht _ _).Prop
#align category_theory.limits.cotrident.is_colimit.hom_iso CategoryTheory.Limits.Cotrident.IsColimit.homIso

/-- The bijection of `cotrident.is_colimit.hom_iso` is natural in `Z`. -/
theorem Cotrident.IsColimit.homIso_natural [Nonempty J] {t : Cotrident f} {Z Z' : C} (q : Z ⟶ Z')
    (ht : IsColimit t) (k : t.pt ⟶ Z) :
    (Cotrident.IsColimit.homIso ht _ (k ≫ q) : Y ⟶ Z') =
      (Cotrident.IsColimit.homIso ht _ k : Y ⟶ Z) ≫ q :=
  (Category.assoc _ _ _).symm
#align category_theory.limits.cotrident.is_colimit.hom_iso_natural CategoryTheory.Limits.Cotrident.IsColimit.homIso_natural

/-- This is a helper construction that can be useful when verifying that a category has certain wide
    equalizers. Given `F : walking_parallel_family ⥤ C`, which is really the same as
    `parallel_family (λ j, F.map (line j))`, and a trident on `λ j, F.map (line j)`, we get a cone
    on `F`.

    If you're thinking about using this, have a look at
    `has_wide_equalizers_of_has_limit_parallel_family`, which you may find to be an easier way of
    achieving your goal. -/
def Cone.ofTrident {F : WalkingParallelFamily J ⥤ C} (t : Trident fun j => F.map (line j)) : Cone F
    where
  pt := t.pt
  π :=
    { app := fun X => t.π.app X ≫ eqToHom (by tidy)
      naturality' := fun j j' g => by
        cases g <;>
          · dsimp
            simp }
#align category_theory.limits.cone.of_trident CategoryTheory.Limits.Cone.ofTrident

/-- This is a helper construction that can be useful when verifying that a category has all
    coequalizers. Given `F : walking_parallel_family ⥤ C`, which is really the same as
    `parallel_family (λ j, F.map (line j))`, and a cotrident on `λ j, F.map (line j)` we get a
    cocone on `F`.

    If you're thinking about using this, have a look at
    `has_wide_coequalizers_of_has_colimit_parallel_family`, which you may find to be an easier way
    of achieving your goal. -/
def Cocone.ofCotrident {F : WalkingParallelFamily J ⥤ C} (t : Cotrident fun j => F.map (line j)) :
    Cocone F where
  pt := t.pt
  ι :=
    { app := fun X => eqToHom (by tidy) ≫ t.ι.app X
      naturality' := fun j j' g => by cases g <;> dsimp <;> simp [cotrident.app_one t] }
#align category_theory.limits.cocone.of_cotrident CategoryTheory.Limits.Cocone.ofCotrident

@[simp]
theorem Cone.ofTrident_π {F : WalkingParallelFamily J ⥤ C} (t : Trident fun j => F.map (line j))
    (j) : (Cone.ofTrident t).π.app j = t.π.app j ≫ eqToHom (by tidy) :=
  rfl
#align category_theory.limits.cone.of_trident_π CategoryTheory.Limits.Cone.ofTrident_π

@[simp]
theorem Cocone.ofCotrident_ι {F : WalkingParallelFamily J ⥤ C}
    (t : Cotrident fun j => F.map (line j)) (j) :
    (Cocone.ofCotrident t).ι.app j = eqToHom (by tidy) ≫ t.ι.app j :=
  rfl
#align category_theory.limits.cocone.of_cotrident_ι CategoryTheory.Limits.Cocone.ofCotrident_ι

/-- Given `F : walking_parallel_family ⥤ C`, which is really the same as
    `parallel_family (λ j, F.map (line j))` and a cone on `F`, we get a trident on
    `λ j, F.map (line j)`. -/
def Trident.ofCone {F : WalkingParallelFamily J ⥤ C} (t : Cone F) : Trident fun j => F.map (line j)
    where
  pt := t.pt
  π := { app := fun X => t.π.app X ≫ eqToHom (by tidy) }
#align category_theory.limits.trident.of_cone CategoryTheory.Limits.Trident.ofCone

/-- Given `F : walking_parallel_family ⥤ C`, which is really the same as
    `parallel_family (F.map left) (F.map right)` and a cocone on `F`, we get a cotrident on
    `λ j, F.map (line j)`. -/
def Cotrident.ofCocone {F : WalkingParallelFamily J ⥤ C} (t : Cocone F) :
    Cotrident fun j => F.map (line j) where
  pt := t.pt
  ι := { app := fun X => eqToHom (by tidy) ≫ t.ι.app X }
#align category_theory.limits.cotrident.of_cocone CategoryTheory.Limits.Cotrident.ofCocone

@[simp]
theorem Trident.ofCone_π {F : WalkingParallelFamily J ⥤ C} (t : Cone F) (j) :
    (Trident.ofCone t).π.app j = t.π.app j ≫ eqToHom (by tidy) :=
  rfl
#align category_theory.limits.trident.of_cone_π CategoryTheory.Limits.Trident.ofCone_π

@[simp]
theorem Cotrident.ofCocone_ι {F : WalkingParallelFamily J ⥤ C} (t : Cocone F) (j) :
    (Cotrident.ofCocone t).ι.app j = eqToHom (by tidy) ≫ t.ι.app j :=
  rfl
#align category_theory.limits.cotrident.of_cocone_ι CategoryTheory.Limits.Cotrident.ofCocone_ι

/-- Helper function for constructing morphisms between wide equalizer tridents.
-/
@[simps]
def Trident.mkHom [Nonempty J] {s t : Trident f} (k : s.pt ⟶ t.pt) (w : k ≫ t.ι = s.ι) : s ⟶ t
    where
  Hom := k
  w' := by
    rintro ⟨_ | _⟩
    · exact w
    · simpa using w =≫ f (Classical.arbitrary J)
#align category_theory.limits.trident.mk_hom CategoryTheory.Limits.Trident.mkHom

/-- To construct an isomorphism between tridents,
it suffices to give an isomorphism between the cone points
and check that it commutes with the `ι` morphisms.
-/
@[simps]
def Trident.ext [Nonempty J] {s t : Trident f} (i : s.pt ≅ t.pt) (w : i.Hom ≫ t.ι = s.ι) : s ≅ t
    where
  Hom := Trident.mkHom i.Hom w
  inv := Trident.mkHom i.inv (by rw [← w, iso.inv_hom_id_assoc])
#align category_theory.limits.trident.ext CategoryTheory.Limits.Trident.ext

/-- Helper function for constructing morphisms between coequalizer cotridents.
-/
@[simps]
def Cotrident.mkHom [Nonempty J] {s t : Cotrident f} (k : s.pt ⟶ t.pt) (w : s.π ≫ k = t.π) : s ⟶ t
    where
  Hom := k
  w' := by
    rintro ⟨_ | _⟩
    · simpa using f (Classical.arbitrary J) ≫= w
    · exact w
#align category_theory.limits.cotrident.mk_hom CategoryTheory.Limits.Cotrident.mkHom

/-- To construct an isomorphism between cotridents,
it suffices to give an isomorphism between the cocone points
and check that it commutes with the `π` morphisms.
-/
def Cotrident.ext [Nonempty J] {s t : Cotrident f} (i : s.pt ≅ t.pt) (w : s.π ≫ i.Hom = t.π) : s ≅ t
    where
  Hom := Cotrident.mkHom i.Hom w
  inv := Cotrident.mkHom i.inv (by rw [iso.comp_inv_eq, w])
#align category_theory.limits.cotrident.ext CategoryTheory.Limits.Cotrident.ext

variable (f)

section

/--
`has_wide_equalizer f` represents a particular choice of limiting cone for the parallel family of
morphisms `f`.
-/
abbrev HasWideEqualizer :=
  HasLimit (parallelFamily f)
#align category_theory.limits.has_wide_equalizer CategoryTheory.Limits.HasWideEqualizer

variable [HasWideEqualizer f]

/-- If a wide equalizer of `f` exists, we can access an arbitrary choice of such by
    saying `wide_equalizer f`. -/
abbrev wideEqualizer : C :=
  limit (parallelFamily f)
#align category_theory.limits.wide_equalizer CategoryTheory.Limits.wideEqualizer

/-- If a wide equalizer of `f` exists, we can access the inclusion `wide_equalizer f ⟶ X` by
    saying `wide_equalizer.ι f`. -/
abbrev wideEqualizer.ι : wideEqualizer f ⟶ X :=
  limit.π (parallelFamily f) zero
#align category_theory.limits.wide_equalizer.ι CategoryTheory.Limits.wideEqualizer.ι

/-- A wide equalizer cone for a parallel family `f`.
-/
abbrev wideEqualizer.trident : Trident f :=
  limit.cone (parallelFamily f)
#align category_theory.limits.wide_equalizer.trident CategoryTheory.Limits.wideEqualizer.trident

@[simp]
theorem wideEqualizer.trident_ι : (wideEqualizer.trident f).ι = wideEqualizer.ι f :=
  rfl
#align category_theory.limits.wide_equalizer.trident_ι CategoryTheory.Limits.wideEqualizer.trident_ι

@[simp]
theorem wideEqualizer.trident_π_app_zero :
    (wideEqualizer.trident f).π.app zero = wideEqualizer.ι f :=
  rfl
#align category_theory.limits.wide_equalizer.trident_π_app_zero CategoryTheory.Limits.wideEqualizer.trident_π_app_zero

@[reassoc.1]
theorem wideEqualizer.condition (j₁ j₂ : J) : wideEqualizer.ι f ≫ f j₁ = wideEqualizer.ι f ≫ f j₂ :=
  Trident.condition j₁ j₂ <| limit.cone <| parallelFamily f
#align category_theory.limits.wide_equalizer.condition CategoryTheory.Limits.wideEqualizer.condition

/-- The wide_equalizer built from `wide_equalizer.ι f` is limiting. -/
def wideEqualizerIsWideEqualizer [Nonempty J] :
    IsLimit (Trident.ofι (wideEqualizer.ι f) (wideEqualizer.condition f)) :=
  IsLimit.ofIsoLimit (limit.isLimit _) (Trident.ext (Iso.refl _) (by tidy))
#align category_theory.limits.wide_equalizer_is_wide_equalizer CategoryTheory.Limits.wideEqualizerIsWideEqualizer

variable {f}

/-- A morphism `k : W ⟶ X` satisfying `∀ j₁ j₂, k ≫ f j₁ = k ≫ f j₂` factors through the
    wide equalizer of `f` via `wide_equalizer.lift : W ⟶ wide_equalizer f`. -/
abbrev wideEqualizer.lift [Nonempty J] {W : C} (k : W ⟶ X) (h : ∀ j₁ j₂, k ≫ f j₁ = k ≫ f j₂) :
    W ⟶ wideEqualizer f :=
  limit.lift (parallelFamily f) (Trident.ofι k h)
#align category_theory.limits.wide_equalizer.lift CategoryTheory.Limits.wideEqualizer.lift

@[simp, reassoc.1]
theorem wideEqualizer.lift_ι [Nonempty J] {W : C} (k : W ⟶ X) (h : ∀ j₁ j₂, k ≫ f j₁ = k ≫ f j₂) :
    wideEqualizer.lift k h ≫ wideEqualizer.ι f = k :=
  limit.lift_π _ _
#align category_theory.limits.wide_equalizer.lift_ι CategoryTheory.Limits.wideEqualizer.lift_ι

/-- A morphism `k : W ⟶ X` satisfying `∀ j₁ j₂, k ≫ f j₁ = k ≫ f j₂` induces a morphism
    `l : W ⟶ wide_equalizer f` satisfying `l ≫ wide_equalizer.ι f = k`. -/
def wideEqualizer.lift' [Nonempty J] {W : C} (k : W ⟶ X) (h : ∀ j₁ j₂, k ≫ f j₁ = k ≫ f j₂) :
    { l : W ⟶ wideEqualizer f // l ≫ wideEqualizer.ι f = k } :=
  ⟨wideEqualizer.lift k h, wideEqualizer.lift_ι _ _⟩
#align category_theory.limits.wide_equalizer.lift' CategoryTheory.Limits.wideEqualizer.lift'

/-- Two maps into a wide equalizer are equal if they are are equal when composed with the wide
    equalizer map. -/
@[ext]
theorem wideEqualizer.hom_ext [Nonempty J] {W : C} {k l : W ⟶ wideEqualizer f}
    (h : k ≫ wideEqualizer.ι f = l ≫ wideEqualizer.ι f) : k = l :=
  Trident.IsLimit.hom_ext (limit.isLimit _) h
#align category_theory.limits.wide_equalizer.hom_ext CategoryTheory.Limits.wideEqualizer.hom_ext

/-- A wide equalizer morphism is a monomorphism -/
instance wideEqualizer.ι_mono [Nonempty J] : Mono (wideEqualizer.ι f)
    where right_cancellation Z h k w := wideEqualizer.hom_ext w
#align category_theory.limits.wide_equalizer.ι_mono CategoryTheory.Limits.wideEqualizer.ι_mono

end

section

variable {f}

/-- The wide equalizer morphism in any limit cone is a monomorphism. -/
theorem mono_of_isLimit_parallelFamily [Nonempty J] {c : Cone (parallelFamily f)} (i : IsLimit c) :
    Mono (Trident.ι c) :=
  { right_cancellation := fun Z h k w => Trident.IsLimit.hom_ext i w }
#align category_theory.limits.mono_of_is_limit_parallel_family CategoryTheory.Limits.mono_of_isLimit_parallelFamily

end

section

/-- `has_wide_coequalizer f g` represents a particular choice of colimiting cocone
for the parallel family of morphisms `f`.
-/
abbrev HasWideCoequalizer :=
  HasColimit (parallelFamily f)
#align category_theory.limits.has_wide_coequalizer CategoryTheory.Limits.HasWideCoequalizer

variable [HasWideCoequalizer f]

/-- If a wide coequalizer of `f`, we can access an arbitrary choice of such by
    saying `wide_coequalizer f`. -/
abbrev wideCoequalizer : C :=
  colimit (parallelFamily f)
#align category_theory.limits.wide_coequalizer CategoryTheory.Limits.wideCoequalizer

/-- If a wide_coequalizer of `f` exists, we can access the corresponding projection by
    saying `wide_coequalizer.π f`. -/
abbrev wideCoequalizer.π : Y ⟶ wideCoequalizer f :=
  colimit.ι (parallelFamily f) one
#align category_theory.limits.wide_coequalizer.π CategoryTheory.Limits.wideCoequalizer.π

/-- An arbitrary choice of coequalizer cocone for a parallel family `f`.
-/
abbrev wideCoequalizer.cotrident : Cotrident f :=
  colimit.cocone (parallelFamily f)
#align category_theory.limits.wide_coequalizer.cotrident CategoryTheory.Limits.wideCoequalizer.cotrident

@[simp]
theorem wideCoequalizer.cotrident_π : (wideCoequalizer.cotrident f).π = wideCoequalizer.π f :=
  rfl
#align category_theory.limits.wide_coequalizer.cotrident_π CategoryTheory.Limits.wideCoequalizer.cotrident_π

@[simp]
theorem wideCoequalizer.cotrident_ι_app_one :
    (wideCoequalizer.cotrident f).ι.app one = wideCoequalizer.π f :=
  rfl
#align category_theory.limits.wide_coequalizer.cotrident_ι_app_one CategoryTheory.Limits.wideCoequalizer.cotrident_ι_app_one

@[reassoc.1]
theorem wideCoequalizer.condition (j₁ j₂ : J) :
    f j₁ ≫ wideCoequalizer.π f = f j₂ ≫ wideCoequalizer.π f :=
  Cotrident.condition j₁ j₂ <| colimit.cocone <| parallelFamily f
#align category_theory.limits.wide_coequalizer.condition CategoryTheory.Limits.wideCoequalizer.condition

/-- The cotrident built from `wide_coequalizer.π f` is colimiting. -/
def wideCoequalizerIsWideCoequalizer [Nonempty J] :
    IsColimit (Cotrident.ofπ (wideCoequalizer.π f) (wideCoequalizer.condition f)) :=
  IsColimit.ofIsoColimit (colimit.isColimit _) (Cotrident.ext (Iso.refl _) (by tidy))
#align category_theory.limits.wide_coequalizer_is_wide_coequalizer CategoryTheory.Limits.wideCoequalizerIsWideCoequalizer

variable {f}

/-- Any morphism `k : Y ⟶ W` satisfying `∀ j₁ j₂, f j₁ ≫ k = f j₂ ≫ k` factors through the
    wide coequalizer of `f` via `wide_coequalizer.desc : wide_coequalizer f ⟶ W`. -/
abbrev wideCoequalizer.desc [Nonempty J] {W : C} (k : Y ⟶ W) (h : ∀ j₁ j₂, f j₁ ≫ k = f j₂ ≫ k) :
    wideCoequalizer f ⟶ W :=
  colimit.desc (parallelFamily f) (Cotrident.ofπ k h)
#align category_theory.limits.wide_coequalizer.desc CategoryTheory.Limits.wideCoequalizer.desc

@[simp, reassoc.1]
theorem wideCoequalizer.π_desc [Nonempty J] {W : C} (k : Y ⟶ W) (h : ∀ j₁ j₂, f j₁ ≫ k = f j₂ ≫ k) :
    wideCoequalizer.π f ≫ wideCoequalizer.desc k h = k :=
  colimit.ι_desc _ _
#align category_theory.limits.wide_coequalizer.π_desc CategoryTheory.Limits.wideCoequalizer.π_desc

/-- Any morphism `k : Y ⟶ W` satisfying `∀ j₁ j₂, f j₁ ≫ k = f j₂ ≫ k` induces a morphism
    `l : wide_coequalizer f ⟶ W` satisfying `wide_coequalizer.π ≫ g = l`. -/
def wideCoequalizer.desc' [Nonempty J] {W : C} (k : Y ⟶ W) (h : ∀ j₁ j₂, f j₁ ≫ k = f j₂ ≫ k) :
    { l : wideCoequalizer f ⟶ W // wideCoequalizer.π f ≫ l = k } :=
  ⟨wideCoequalizer.desc k h, wideCoequalizer.π_desc _ _⟩
#align category_theory.limits.wide_coequalizer.desc' CategoryTheory.Limits.wideCoequalizer.desc'

/-- Two maps from a wide coequalizer are equal if they are equal when composed with the wide
    coequalizer map -/
@[ext]
theorem wideCoequalizer.hom_ext [Nonempty J] {W : C} {k l : wideCoequalizer f ⟶ W}
    (h : wideCoequalizer.π f ≫ k = wideCoequalizer.π f ≫ l) : k = l :=
  Cotrident.IsColimit.hom_ext (colimit.isColimit _) h
#align category_theory.limits.wide_coequalizer.hom_ext CategoryTheory.Limits.wideCoequalizer.hom_ext

/-- A wide coequalizer morphism is an epimorphism -/
instance wideCoequalizer.π_epi [Nonempty J] : Epi (wideCoequalizer.π f)
    where left_cancellation Z h k w := wideCoequalizer.hom_ext w
#align category_theory.limits.wide_coequalizer.π_epi CategoryTheory.Limits.wideCoequalizer.π_epi

end

section

variable {f}

/-- The wide coequalizer morphism in any colimit cocone is an epimorphism. -/
theorem epi_of_isColimit_parallelFamily [Nonempty J] {c : Cocone (parallelFamily f)}
    (i : IsColimit c) : Epi (c.ι.app one) :=
  { left_cancellation := fun Z h k w => Cotrident.IsColimit.hom_ext i w }
#align category_theory.limits.epi_of_is_colimit_parallel_family CategoryTheory.Limits.epi_of_isColimit_parallelFamily

end

variable (C)

/-- `has_wide_equalizers` represents a choice of wide equalizer for every family of morphisms -/
abbrev HasWideEqualizers :=
  ∀ J, HasLimitsOfShape (WalkingParallelFamily.{w} J) C
#align category_theory.limits.has_wide_equalizers CategoryTheory.Limits.HasWideEqualizers

/-- `has_wide_coequalizers` represents a choice of wide coequalizer for every family of morphisms -/
abbrev HasWideCoequalizers :=
  ∀ J, HasColimitsOfShape (WalkingParallelFamily.{w} J) C
#align category_theory.limits.has_wide_coequalizers CategoryTheory.Limits.HasWideCoequalizers

/-- If `C` has all limits of diagrams `parallel_family f`, then it has all wide equalizers -/
theorem hasWideEqualizers_of_hasLimit_parallelFamily
    [∀ {J : Type w} {X Y : C} {f : J → (X ⟶ Y)}, HasLimit (parallelFamily f)] :
    HasWideEqualizers.{w} C := fun J =>
  { HasLimit := fun F => hasLimitOfIso (diagramIsoParallelFamily F).symm }
#align category_theory.limits.has_wide_equalizers_of_has_limit_parallel_family CategoryTheory.Limits.hasWideEqualizers_of_hasLimit_parallelFamily

/-- If `C` has all colimits of diagrams `parallel_family f`, then it has all wide coequalizers -/
theorem hasWideCoequalizers_of_hasColimit_parallelFamily
    [∀ {J : Type w} {X Y : C} {f : J → (X ⟶ Y)}, HasColimit (parallelFamily f)] :
    HasWideCoequalizers.{w} C := fun J =>
  { HasColimit := fun F => hasColimitOfIso (diagramIsoParallelFamily F) }
#align category_theory.limits.has_wide_coequalizers_of_has_colimit_parallel_family CategoryTheory.Limits.hasWideCoequalizers_of_hasColimit_parallelFamily

instance (priority := 10) hasEqualizers_of_hasWideEqualizers [HasWideEqualizers.{w} C] :
    HasEqualizers C :=
  hasLimitsOfShape_of_equivalence.{w} walkingParallelFamilyEquivWalkingParallelPair
#align category_theory.limits.has_equalizers_of_has_wide_equalizers CategoryTheory.Limits.hasEqualizers_of_hasWideEqualizers

instance (priority := 10) hasCoequalizers_of_hasWideCoequalizers [HasWideCoequalizers.{w} C] :
    HasCoequalizers C :=
  hasColimitsOfShape_of_equivalence.{w} walkingParallelFamilyEquivWalkingParallelPair
#align category_theory.limits.has_coequalizers_of_has_wide_coequalizers CategoryTheory.Limits.hasCoequalizers_of_hasWideCoequalizers

end CategoryTheory.Limits


/-
Copyright (c) 2022 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import data.real.ennreal
import topology.continuous_function.bounded
import topology.metric_space.hausdorff_distance

/-!
# Thickened indicators

This file is about thickened indicators of sets in (pseudo e)metric spaces. For a decreasing
sequence of thickening radii tending to 0, the thickened indicators of a closed set form a
decreasing pointwise converging approximation of the indicator function of the set, where the
members of the approximating sequence are nonnegative bounded continuous functions.

## Main definitions

 * `thickened_indicator_aux δ E`: The `δ`-thickened indicator of a set `E` as an
   unbundled `ℝ≥0∞`-valued function.
 * `thickened_indicator δ E`: The `δ`-thickened indicator of a set `E` as a bundled
   bounded continuous `ℝ≥0`-valued function.

## Main results

 * For a sequence of thickening radii tending to 0, the `δ`-thickened indicators of a set `E` tend
   pointwise to the indicator of `closure E`.
   - `thickened_indicator_aux_tendsto_indicator_closure`: The version is for the
     unbundled `ℝ≥0∞`-valued functions.
   - `thickened_indicator_tendsto_indicator_closure`: The version is for the bundled `ℝ≥0`-valued
     bounded continuous functions.

-/
noncomputable theory
open_locale classical nnreal ennreal topology bounded_continuous_function

open nnreal ennreal set metric emetric filter

section thickened_indicator

variables {α : Type*} [pseudo_emetric_space α]

/-- The `δ`-thickened indicator of a set `E` is the function that equals `1` on `E`
and `0` outside a `δ`-thickening of `E` and interpolates (continuously) between
these values using `inf_edist _ E`.

`thickened_indicator_aux` is the unbundled `ℝ≥0∞`-valued function. See `thickened_indicator`
for the (bundled) bounded continuous function with `ℝ≥0`-values. -/
def thickened_indicator_aux (δ : ℝ) (E : set α) : α → ℝ≥0∞ :=
λ (x : α), (1 : ℝ≥0∞) - (inf_edist x E) / (ennreal.of_real δ)

lemma continuous_thickened_indicator_aux {δ : ℝ} (δ_pos : 0 < δ) (E : set α) :
  continuous (thickened_indicator_aux δ E) :=
begin
  unfold thickened_indicator_aux,
  let f := λ (x : α), (⟨1, (inf_edist x E) / (ennreal.of_real δ)⟩ : ℝ≥0 × ℝ≥0∞),
  let sub := λ (p : ℝ≥0 × ℝ≥0∞), ((p.1 : ℝ≥0∞) - p.2),
  rw (show (λ (x : α), ((1 : ℝ≥0∞)) - (inf_edist x E) / (ennreal.of_real δ)) = sub ∘ f, by refl),
  apply (@ennreal.continuous_nnreal_sub 1).comp,
  apply (ennreal.continuous_div_const (ennreal.of_real δ) _).comp continuous_inf_edist,
  norm_num [δ_pos],
end

lemma thickened_indicator_aux_le_one (δ : ℝ) (E : set α) (x : α) :
  thickened_indicator_aux δ E x ≤ 1 :=
by apply @tsub_le_self _ _ _ _ (1 : ℝ≥0∞)

lemma thickened_indicator_aux_lt_top {δ : ℝ} {E : set α} {x : α} :
  thickened_indicator_aux δ E x < ∞ :=
lt_of_le_of_lt (thickened_indicator_aux_le_one _ _ _) one_lt_top

lemma thickened_indicator_aux_closure_eq (δ : ℝ) (E : set α) :
  thickened_indicator_aux δ (closure E) = thickened_indicator_aux δ E :=
by simp_rw [thickened_indicator_aux, inf_edist_closure]

lemma thickened_indicator_aux_one (δ : ℝ) (E : set α) {x : α} (x_in_E : x ∈ E) :
  thickened_indicator_aux δ E x = 1 :=
by simp [thickened_indicator_aux, inf_edist_zero_of_mem x_in_E, tsub_zero]

lemma thickened_indicator_aux_one_of_mem_closure
  (δ : ℝ) (E : set α) {x : α} (x_mem : x ∈ closure E) :
  thickened_indicator_aux δ E x = 1 :=
by rw [←thickened_indicator_aux_closure_eq, thickened_indicator_aux_one δ (closure E) x_mem]

lemma thickened_indicator_aux_zero
  {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_out : x ∉ thickening δ E) :
  thickened_indicator_aux δ E x = 0 :=
begin
  rw [thickening, mem_set_of_eq, not_lt] at x_out,
  unfold thickened_indicator_aux,
  apply le_antisymm _ bot_le,
  have key := tsub_le_tsub (@rfl _ (1 : ℝ≥0∞)).le (ennreal.div_le_div x_out rfl.le),
  rw [ennreal.div_self (ne_of_gt (ennreal.of_real_pos.mpr δ_pos)) of_real_ne_top] at key,
  simpa using key,
end

lemma thickened_indicator_aux_mono {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
  thickened_indicator_aux δ₁ E ≤ thickened_indicator_aux δ₂ E :=
λ _, tsub_le_tsub (@rfl ℝ≥0∞ 1).le (ennreal.div_le_div rfl.le (of_real_le_of_real hle))

lemma indicator_le_thickened_indicator_aux (δ : ℝ) (E : set α) :
  E.indicator (λ _, (1 : ℝ≥0∞)) ≤ thickened_indicator_aux δ E :=
begin
  intro a,
  by_cases a ∈ E,
  { simp only [h, indicator_of_mem, thickened_indicator_aux_one δ E h, le_refl], },
  { simp only [h, indicator_of_not_mem, not_false_iff, zero_le], },
end

lemma thickened_indicator_aux_subset (δ : ℝ) {E₁ E₂ : set α} (subset : E₁ ⊆ E₂) :
  thickened_indicator_aux δ E₁ ≤ thickened_indicator_aux δ E₂ :=
λ _, tsub_le_tsub (@rfl ℝ≥0∞ 1).le (ennreal.div_le_div (inf_edist_anti subset) rfl.le)

/-- As the thickening radius δ tends to 0, the δ-thickened indicator of a set E (in α) tends
pointwise (i.e., w.r.t. the product topology on `α → ℝ≥0∞`) to the indicator function of the
closure of E.

This statement is for the unbundled `ℝ≥0∞`-valued functions `thickened_indicator_aux δ E`, see
`thickened_indicator_tendsto_indicator_closure` for the version for bundled `ℝ≥0`-valued
bounded continuous functions. -/
lemma thickened_indicator_aux_tendsto_indicator_closure
  {δseq : ℕ → ℝ} (δseq_lim : tendsto δseq at_top (𝓝 0)) (E : set α) :
  tendsto (λ n, (thickened_indicator_aux (δseq n) E)) at_top
    (𝓝 (indicator (closure E) (λ x, (1 : ℝ≥0∞)))) :=
begin
  rw tendsto_pi_nhds,
  intro x,
  by_cases x_mem_closure : x ∈ closure E,
  { simp_rw [thickened_indicator_aux_one_of_mem_closure _ E x_mem_closure],
    rw (show (indicator (closure E) (λ _, (1 : ℝ≥0∞))) x = 1,
        by simp only [x_mem_closure, indicator_of_mem]),
    exact tendsto_const_nhds, },
  { rw (show (closure E).indicator (λ _, (1 : ℝ≥0∞)) x = 0,
        by simp only [x_mem_closure, indicator_of_not_mem, not_false_iff]),
    rcases exists_real_pos_lt_inf_edist_of_not_mem_closure x_mem_closure with ⟨ε, ⟨ε_pos, ε_lt⟩⟩,
    rw metric.tendsto_nhds at δseq_lim,
    specialize δseq_lim ε ε_pos,
    simp only [dist_zero_right, real.norm_eq_abs, eventually_at_top, ge_iff_le] at δseq_lim,
    rcases δseq_lim with ⟨N, hN⟩,
    apply @tendsto_at_top_of_eventually_const _ _ _ _ _ _ _ N,
    intros n n_large,
    have key : x ∉ thickening ε E, by simpa only [thickening, mem_set_of_eq, not_lt] using ε_lt.le,
    refine le_antisymm _ bot_le,
    apply (thickened_indicator_aux_mono (lt_of_abs_lt (hN n n_large)).le E x).trans,
    exact (thickened_indicator_aux_zero ε_pos E key).le, },
end

/-- The `δ`-thickened indicator of a set `E` is the function that equals `1` on `E`
and `0` outside a `δ`-thickening of `E` and interpolates (continuously) between
these values using `inf_edist _ E`.

`thickened_indicator` is the (bundled) bounded continuous function with `ℝ≥0`-values.
See `thickened_indicator_aux` for the unbundled `ℝ≥0∞`-valued function. -/
@[simps] def thickened_indicator {δ : ℝ} (δ_pos : 0 < δ) (E : set α) : α →ᵇ ℝ≥0 :=
{ to_fun := λ (x : α), (thickened_indicator_aux δ E x).to_nnreal,
  continuous_to_fun := begin
    apply continuous_on.comp_continuous
            continuous_on_to_nnreal (continuous_thickened_indicator_aux δ_pos E),
    intro x,
    exact (lt_of_le_of_lt (@thickened_indicator_aux_le_one _ _ δ E x) one_lt_top).ne,
  end,
  map_bounded' := begin
    use 2,
    intros x y,
    rw [nnreal.dist_eq],
    apply (abs_sub _ _).trans,
    rw [nnreal.abs_eq, nnreal.abs_eq, ←one_add_one_eq_two],
    have key := @thickened_indicator_aux_le_one _ _ δ E,
    apply add_le_add;
    { norm_cast,
      refine (to_nnreal_le_to_nnreal ((lt_of_le_of_lt (key _) one_lt_top).ne) one_ne_top).mpr
             (key _), },
  end, }

lemma thickened_indicator.coe_fn_eq_comp {δ : ℝ} (δ_pos : 0 < δ) (E : set α) :
  ⇑(thickened_indicator δ_pos E) = ennreal.to_nnreal ∘ thickened_indicator_aux δ E := rfl

lemma thickened_indicator_le_one {δ : ℝ} (δ_pos : 0 < δ) (E : set α) (x : α) :
  thickened_indicator δ_pos E x ≤ 1 :=
begin
  rw [thickened_indicator.coe_fn_eq_comp],
  simpa using (to_nnreal_le_to_nnreal thickened_indicator_aux_lt_top.ne one_ne_top).mpr
    (thickened_indicator_aux_le_one δ E x),
end

lemma thickened_indicator_one_of_mem_closure
  {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_mem : x ∈ closure E) :
  thickened_indicator δ_pos E x = 1 :=
by rw [thickened_indicator_apply,
       thickened_indicator_aux_one_of_mem_closure δ E x_mem, one_to_nnreal]

lemma thickened_indicator_one {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_in_E : x ∈ E) :
  thickened_indicator δ_pos E x = 1 :=
thickened_indicator_one_of_mem_closure _ _ (subset_closure x_in_E)

lemma thickened_indicator_zero
  {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_out : x ∉ thickening δ E) :
  thickened_indicator δ_pos E x = 0 :=
by rw [thickened_indicator_apply, thickened_indicator_aux_zero δ_pos E x_out, zero_to_nnreal]

lemma indicator_le_thickened_indicator {δ : ℝ} (δ_pos : 0 < δ) (E : set α) :
  E.indicator (λ _, (1 : ℝ≥0)) ≤ thickened_indicator δ_pos E :=
begin
  intro a,
  by_cases a ∈ E,
  { simp only [h, indicator_of_mem, thickened_indicator_one δ_pos E h, le_refl], },
  { simp only [h, indicator_of_not_mem, not_false_iff, zero_le], },
end

lemma thickened_indicator_mono {δ₁ δ₂ : ℝ}
  (δ₁_pos : 0 < δ₁) (δ₂_pos : 0 < δ₂) (hle : δ₁ ≤ δ₂) (E : set α) :
  ⇑(thickened_indicator δ₁_pos E) ≤ thickened_indicator δ₂_pos E :=
begin
  intro x,
  apply (to_nnreal_le_to_nnreal thickened_indicator_aux_lt_top.ne
         thickened_indicator_aux_lt_top.ne).mpr,
  apply thickened_indicator_aux_mono hle,
end

lemma thickened_indicator_subset {δ : ℝ} (δ_pos : 0 < δ) {E₁ E₂ : set α} (subset : E₁ ⊆ E₂) :
  ⇑(thickened_indicator δ_pos E₁) ≤ thickened_indicator δ_pos E₂ :=
λ x, (to_nnreal_le_to_nnreal thickened_indicator_aux_lt_top.ne
      thickened_indicator_aux_lt_top.ne).mpr (thickened_indicator_aux_subset δ subset x)

/-- As the thickening radius δ tends to 0, the δ-thickened indicator of a set E (in α) tends
pointwise to the indicator function of the closure of E.

Note: This version is for the bundled bounded continuous functions, but the topology is not
the topology on `α →ᵇ ℝ≥0`. Coercions to functions `α → ℝ≥0` are done first, so the topology
instance is the product topology (the topology of pointwise convergence). -/
lemma thickened_indicator_tendsto_indicator_closure
  {δseq : ℕ → ℝ} (δseq_pos : ∀ n, 0 < δseq n) (δseq_lim : tendsto δseq at_top (𝓝 0)) (E : set α) :
  tendsto (λ (n : ℕ), (coe_fn : (α →ᵇ ℝ≥0) → (α → ℝ≥0)) (thickened_indicator (δseq_pos n) E))
    at_top (𝓝 (indicator (closure E) (λ x, (1 : ℝ≥0)))) :=
begin
  have key := thickened_indicator_aux_tendsto_indicator_closure δseq_lim E,
  rw tendsto_pi_nhds at *,
  intro x,
  rw (show indicator (closure E) (λ x, (1 : ℝ≥0)) x
         = (indicator (closure E) (λ x, (1 : ℝ≥0∞)) x).to_nnreal,
      by refine (congr_fun (comp_indicator_const 1 ennreal.to_nnreal zero_to_nnreal) x).symm),
  refine tendsto.comp (tendsto_to_nnreal _) (key x),
  by_cases x_mem : x ∈ closure E; simp [x_mem],
end

end thickened_indicator -- section


/-
Copyright (c) 2020 Kevin Lacker, Keeley Hoek, Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Lacker, Keeley Hoek, Scott Morrison
-/
import tactic.rewrite_search
import data.rat.defs
import data.real.basic

/-
These tests ensure that `rewrite_search` works on some relatively simple examples.
They do not monitor for performance regression, so be aware of that if you make changes.
-/

namespace tactic.rewrite_search.testing

private axiom foo' : [6] = [7]
private axiom bar' : [[5], [5]] = [[6], [6]]

example : [[7], [6]] = [[5], [5]] :=
begin
  success_if_fail { rewrite_search },
  rewrite_search [foo', bar']
end

@[rewrite] private axiom foo : [0] = [1]
@[rewrite] private axiom bar1 : [1] = [2]
@[rewrite] private axiom bar2 : [3] = [2]
@[rewrite] private axiom bar3 : [3] = [4]

private example : [[0], [0]] = [[4], [4]] := by rewrite_search
private example (x : unit) : [[0], [0]] = [[4], [4]] := by rewrite_search

@[rewrite] private axiom qux' : [[1], [2]] = [[6], [7]]
@[rewrite] private axiom qux'' : [6] = [7]
private example : [[1], [1]] = [[7], [7]] := by rewrite_search

constants f g : ℕ → ℕ → ℕ → ℕ
@[rewrite] axiom f_0_0 : ∀ a b c : ℕ, f a b c = f 0 b c
@[rewrite] axiom f_0_1 : ∀ a b c : ℕ, f a b c = f 1 b c
@[rewrite] axiom f_0_2 : ∀ a b c : ℕ, f a b c = f 2 b c
@[rewrite] axiom f_1_0 : ∀ a b c : ℕ, f a b c = f a 0 c
@[rewrite] axiom f_1_1 : ∀ a b c : ℕ, f a b c = f a 1 c
@[rewrite] axiom f_1_2 : ∀ a b c : ℕ, f a b c = f a 2 c
@[rewrite] axiom f_2_0 : ∀ a b c : ℕ, f a b c = f a b 0
@[rewrite] axiom f_2_1 : ∀ a b c : ℕ, f a b c = f a b 1
@[rewrite] axiom f_2_2 : ∀ a b c : ℕ, f a b c = f a b 2
@[rewrite] axiom g_0_0 : ∀ a b c : ℕ, g a b c = g 0 b c
@[rewrite] axiom g_0_1 : ∀ a b c : ℕ, g a b c = g 1 b c
@[rewrite] axiom g_0_2 : ∀ a b c : ℕ, g a b c = g 2 b c
@[rewrite] axiom g_1_0 : ∀ a b c : ℕ, g a b c = g a 0 c
@[rewrite] axiom g_1_1 : ∀ a b c : ℕ, g a b c = g a 1 c
@[rewrite] axiom g_1_2 : ∀ a b c : ℕ, g a b c = g a 2 c
@[rewrite] axiom g_2_0 : ∀ a b c : ℕ, g a b c = g a b 0
@[rewrite] axiom g_2_1 : ∀ a b c : ℕ, g a b c = g a b 1
@[rewrite] axiom g_2_2 : ∀ a b c : ℕ, g a b c = g a b 2
@[rewrite] axiom f_g : f 0 1 2 = g 2 0 1

lemma test_pathfinding : f 0 0 0 = g 0 0 0 := by rewrite_search

constant h : ℕ → ℕ
@[rewrite,simp] axiom a1 : h 0 = h 1
@[rewrite,simp] axiom a2 : h 1 = h 2
@[rewrite,simp] axiom a3 : h 2 = h 3
@[rewrite,simp] axiom a4 : h 3 = h 4

lemma test_linear_path : h 0 = h 4 := by rewrite_search

constants a b c d e : ℚ

lemma test_algebra : (a * (b + c)) * d = a * (b * d) + a * (c * d) :=
by rewrite_search [add_comm, add_assoc, mul_assoc, mul_comm, left_distrib, right_distrib]

lemma test_simpler_algebra : a + (b + c) = (a + b) + c :=
by rewrite_search [add_assoc]

def idf : ℝ → ℝ := id

/-
These problems test `rewrite_search`'s ability to carry on in the presence of multiple
expressions that `pp` to the same thing but are not actually equal.
-/
lemma test_pp_1 : idf (0 : ℕ) = idf (0 : ℚ) :=
by rewrite_search [rat.cast_zero, nat.cast_zero, add_comm]

lemma test_pp_2 : idf (0 : ℕ) + 1 = 1 + idf (0 : ℚ) :=
by rewrite_search [rat.cast_zero, nat.cast_zero, add_comm]

example (x : ℕ) : x = x := by rewrite_search

end tactic.rewrite_search.testing


/-
Copyright (c) 2021 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/

/- Tactics -/

-- This one comes directly from the documentation
macro "obtain " p:term " from " d:term : tactic =>
  `(tactic| match $d:term with | $p:term => ?_)

macro "rcases " d:term " with " p:term : tactic =>
  `(tactic| match $d:term with | $p:term => ?_)

macro "use " p:term : tactic => `(tactic| refine ⟨$p:term, ?_⟩)
macro "exfalso" : tactic => `(tactic| apply False.elim)
macro "left" : tactic => `(tactic| apply Or.inl)
macro "right" : tactic => `(tactic| apply Or.inr)
macro "by_cases" h:term : tactic => `(tactic| refine @Decidable.byCases $h:term _ _ ?_ ?_)

/- definition.lean -/

inductive mynat where
| zero : mynat
| succ (n : mynat) : mynat

notation "ℕ" => mynat  -- The one benefit of playing this game in Lean 4

namespace mynat

def beq : ℕ → ℕ → Bool
| zero,       zero        => true
| zero,       succ m      => false
| succ n,     zero        => false
| succ n,     succ m      => beq n m

theorem eqOfBeqEqTrue : {n m : ℕ} → Eq (beq n m) true → Eq n m
  | zero,   zero,   h => rfl
  | zero,   succ m, h => Bool.noConfusion h
  | succ n, zero,   h => Bool.noConfusion h
  | succ n, succ m, h =>
    have Eq (beq n m) true from h
    have Eq n m from eqOfBeqEqTrue this
    this ▸ rfl

theorem neOfBeqEqFalse : {n m : ℕ} → Eq (beq n m) false → Not (Eq n m)
  | zero,   zero,   h₁, h₂ => Bool.noConfusion h₁
  | zero,   succ m, h₁, h₂ => mynat.noConfusion h₂
  | succ n, zero,   h₁, h₂ => mynat.noConfusion h₂
  | succ n, succ m, h₁, h₂ =>
    have Eq (beq n m) false from h₁
    mynat.noConfusion h₂ (fun h₂ => absurd h₂ (neOfBeqEqFalse this))

protected def decEq (n m : ℕ) : Decidable (Eq n m) :=
  match h:beq n m with
  | true  => isTrue (eqOfBeqEqTrue h)
  | false => isFalse (neOfBeqEqFalse h)

instance : DecidableEq ℕ := mynat.decEq

def fromNat (n : Nat) : ℕ := match n with
| Nat.zero      => mynat.zero
| Nat.succ k    => mynat.succ $ fromNat k

instance : OfNat ℕ n where
    ofNat := fromNat n

theorem OneEqSuccZero : (1 : ℕ) = succ 0 := rfl

theorem ZeroNeSucc (m : ℕ) : (0 : ℕ) ≠ succ m := fun h => by cases h

theorem SuccInj {m n : ℕ} (h : succ m = succ n) : m = n := by cases h; rfl

/- add.lean -/

def add : ℕ → ℕ → ℕ
| m, 0          => m
| m, (succ n)   => succ (add m n)

instance : Add ℕ where
    add := mynat.add

theorem AddZero (m : ℕ) : m + 0 = m := rfl
theorem AddZero' (m : ℕ) : m + zero = m := rfl

theorem AddSucc (m n : ℕ) : m + succ n = succ (m + n) := rfl

/- mul.lean -/

def mul : ℕ → ℕ → ℕ
| m, zero   => zero
| m, succ n => mul m n + m

instance : Mul ℕ := ⟨mynat.mul⟩

theorem MulZero (m : ℕ) : m * 0 = 0 := rfl
theorem MulZero' (m : ℕ) : m * zero = zero := rfl

theorem MulSucc (m n : ℕ) : m * (succ n) = m * n + m := rfl

/- pow.lean -/

def pow : ℕ → ℕ → ℕ
| m, zero   => 1
| m, succ n => pow m n * m

instance : Pow ℕ := ⟨mynat.pow⟩

theorem PowZero (m : ℕ) : m ^ 0 = 1 := rfl
theorem PowZero' (m : ℕ) : m ^ zero = 1 := rfl

theorem PowSucc (m n : ℕ) : m ^ (succ n) = m ^ n * m := rfl

/- le.lean -/

def le (a b : ℕ) := ∃ (c : ℕ), b = a + c

instance : HasLessEq ℕ := ⟨mynat.le⟩

theorem LeIffExistsAdd (a b : ℕ) : a ≤ b ↔ ∃ (c : ℕ), b = a + c := Iff.rfl

/- lt.lean (?) -/

def lt (a b : ℕ) := a ≤ b ∧ ¬ (b ≤ a)

instance : HasLess ℕ := ⟨mynat.lt⟩

/- Tutorial world -/
theorem example1 (x y z : ℕ) : x * y + z = x * y + z := rfl

theorem example2 (x y : ℕ) (h : y = x + 7) : 2 * y = 2 * (x + 7) := by rw h

theorem example3 (a b : ℕ) (h : succ a = b) : succ (succ a) = succ b := by rw h

theorem AddSuccZero (a : ℕ) : a + succ 0 = succ a := AddSucc a 0

/- Addition world -/

theorem ZeroAdd (n : ℕ) : 0 + n = n := match n with
| zero      => rfl
| succ k    => by rw [AddSucc, ZeroAdd]

theorem ZeroAdd' (n : ℕ) : zero + n = n := ZeroAdd n

theorem AddAssoc (a b c : ℕ) : (a + b) + c = a + (b + c) := match c with
| zero      => rfl
| succ k    => by rw [AddSucc, AddSucc, AddAssoc, AddSucc]

theorem SuccAdd (a b : ℕ) : succ a + b = succ (a + b) := match b with
| zero      => by rw [AddZero', AddZero']
| succ k    => by rw [AddSucc, AddSucc, SuccAdd]

theorem AddComm (a b : ℕ) : a + b = b + a := match b with
| zero      => by rw [AddZero', ZeroAdd']
| succ k    => by rw [AddSucc, SuccAdd, AddComm]

theorem SuccEqAddOne (n : ℕ) : succ n = n + 1 := rfl

theorem AddRightComm (a b c : ℕ) : a + b + c = a + c + b := by rw [AddAssoc, AddComm b c, AddAssoc]

/- Multiplication world -/

theorem ZeroMul (m : ℕ) : 0 * m = 0 := match m with
| zero      => rfl
| succ k    => by rw [MulSucc, AddZero, ZeroMul]
theorem ZeroMul' (m : ℕ) : zero * m = zero := ZeroMul m

theorem MulOne (m : ℕ) : m * 1 = m := match m with
| zero      => rfl
| succ k    => by rw [OneEqSuccZero, MulSucc, MulZero, ZeroAdd]

theorem OneMul (m : ℕ) : 1 * m = m := match m with
| zero      => rfl
| succ k    => by rw [MulSucc, OneMul, SuccEqAddOne]

theorem MulAdd (t a b: ℕ) : t * (a + b) = t * a + t * b := match a with
| zero      => by rw [ZeroAdd', MulZero', ZeroAdd']
| succ k    => by rw [SuccAdd, MulSucc, MulSucc, MulAdd, AddAssoc, AddComm (t*b) t, AddAssoc]

theorem MulAssoc (a b c : ℕ) : (a * b) * c = a * (b * c) := match c with
| zero      => rfl
| succ k    => by rw [MulSucc, MulSucc, MulAdd, MulAssoc]

theorem SuccMul (a b : ℕ) : succ a * b = a * b + b := match b with
| zero      => rfl
| succ k    => by rw [MulSucc, MulSucc, SuccMul, AddAssoc, AddSucc, AddComm k a, ←AddSucc, AddAssoc]

theorem AddMul (a b t : ℕ) : (a + b) * t = a * t + b * t := match t with
| zero      => rfl
| succ k    => by rw [MulSucc, MulSucc, MulSucc, AddMul, AddAssoc, AddComm (b*k) (a+b), AddComm (b*k) b, AddAssoc a b (b*k), AddAssoc]

theorem MulComm (a b : ℕ) : a * b = b * a := match b with
| zero      => by rw [MulZero', ZeroMul']
| succ k    => by rw [MulSucc, SuccMul, MulComm]

theorem MulLeftComm (a b c : ℕ) : a * (b * c) = b * (a * c) := by rw [←MulAssoc a b c, MulComm a b, MulAssoc]

/- Power world -/

theorem ZeroPowZero : (0 : ℕ) ^ (0 : ℕ) = 1 := PowZero 0

theorem ZeroPowSucc (m : ℕ) : (0 : ℕ) ^ (succ m) = 0 := by rw [PowSucc, MulZero]

theorem PowOne (a : ℕ) : a ^ (1 : ℕ) = a := by rw [OneEqSuccZero, PowSucc, PowZero, OneMul]

theorem OnePow (m : ℕ) : (1 : ℕ) ^ m = 1 := match m with
| zero      => rfl
| succ k    => by rw [PowSucc, MulOne, OnePow]

theorem PowAdd (a m n : ℕ) : a ^ (m + n) = a ^ m * a ^ n := match n with
| zero      => by rw [AddZero', PowZero', MulOne]
| succ k    => by rw [PowSucc, AddSucc, PowSucc, ←MulAssoc, PowAdd]

theorem MulPow (a b n : ℕ) : (a * b) ^ n = a ^ n * b ^ n := match n with
| zero      => rfl
| succ k    => by rw [PowSucc, PowSucc, PowSucc, MulPow, MulAssoc, ←MulAssoc (b^k) a b, MulComm (b^k) a, MulAssoc (a^k) a, MulAssoc a]

theorem PowPow (a m n : ℕ) : (a ^ m) ^ n = a ^ (m * n) := match n with
| zero      => rfl
| succ k    => by rw [PowSucc, PowPow, ←PowAdd, MulSucc]

theorem PowTwoEqMulSelf (a : ℕ) : a^(2 : ℕ) = a * a := by { have h₁ : (2 : ℕ) = 1 + 1 := rfl; simp [h₁, PowAdd, PowOne] }

theorem TwoMulEqAddSelf (a : ℕ) : (2 : ℕ) * a = a + a := by { have h₁ : (2 : ℕ) = 1 + 1 := rfl; simp [h₁, AddMul, OneMul] }

theorem AddSquared (a b : ℕ) : (a + b) ^ 2 = a ^ 2 + b ^ 2 + 2 * a * b := by
    rw [PowTwoEqMulSelf, PowTwoEqMulSelf, PowTwoEqMulSelf, AddMul, MulAdd, TwoMulEqAddSelf, AddMul, MulAdd]
    rw [AddAssoc, AddComm (a*b), AddComm (b*a), MulComm b a, AddAssoc (b*b), AddAssoc]

/- Advanced Addition World -/

theorem SuccInj' {a b : ℕ} (hs : succ a = succ b) : a = b := SuccInj hs

theorem SuccSuccInj {a b : ℕ} (h : succ (succ a) = succ (succ b)) : a = b := SuccInj $ SuccInj h

theorem SuccEqSuccOfEq {a b : ℕ} : a = b → succ a = succ b := fun h => by rw [h]

theorem EqIffSuccEqSucc (a b : ℕ) : succ a = succ b ↔ a = b := Iff.intro (fun h => SuccInj' h) (fun h => SuccEqSuccOfEq h)

theorem AddRightCancel (a t b : ℕ) : a + t = b + t → a = b := fun h => by induction t with
| zero        => rw [AddZero', AddZero'] at h; exact h
| succ k ih   => rw [AddSucc, AddSucc] at h; exact ih $ SuccInj' h

theorem AddLeftCancel (t a b : ℕ) : t + a = t + b → a = b := fun h => by induction t with
| zero          => rw [ZeroAdd', ZeroAdd'] at h;  exact h
| succ k ih     => rw [SuccAdd, SuccAdd] at h; exact ih $ SuccInj h

theorem AddRightCancelIff (t a b: ℕ) : a + t = b + t ↔ a = b := by
    apply Iff.intro
    intro h
    exact AddRightCancel a t b h
    intro h
    rw h

theorem EqZeroOfAddRightEqSelf {a b : ℕ} : a + b = a → b = 0 := fun h => by
    have h' : a + b = a + 0 := by rw [AddZero, h]
    exact AddLeftCancel a b 0 h'

theorem SuccNeZero (a : ℕ) : succ a ≠ 0 := (ZeroNeSucc a).symm

theorem AddLeftEqZero {a b : ℕ} (H : a + b = 0) : b = 0 := by cases b with
| zero      => rfl
| succ b'   => rw [AddSucc] at H; exact False.elim $ SuccNeZero _ H

theorem AddRightEqZero {a b : ℕ} : a + b = 0 → a = 0 := fun H => by cases a with
| zero      => rfl
| succ b'   => rw [SuccAdd] at H; exact False.elim $ SuccNeZero _ H

theorem AddOneEqSucc (d : ℕ) : d + 1 = succ d := rfl

theorem NeSuccSelf (n : ℕ) : n ≠ succ n := by induction n with
| zero      => exact mynat.noConfusion
| succ k ih => intro h; exact ih $ SuccInj' h

/- Advanced Multiplication World -/

theorem EqSuccOfNonzero {a : ℕ} : a ≠ 0 → ∃ a' : ℕ, a = succ a' := match a with
| zero        => fun ha => False.elim (ha rfl)
| succ k      => fun _ => ⟨k, rfl⟩

theorem MulPos {a b : ℕ} : a ≠ 0 → b ≠ 0 → a * b ≠ 0 := match a with
| zero      => fun ha _ _ => ha rfl
| succ a'   => match b with
    | zero      => fun _ hb _ => hb rfl
    | succ b'   => fun _ _ hab => mynat.noConfusion hab

-- This doesn't work with `match ... with` for some reason
theorem EqZeroOrEqZeroOfMulEqZero {a b : ℕ} (h : a*b = 0) : a = 0 ∨ b = 0 := by cases a with
| zero      => left; rfl
| succ a'   => cases b with
    | zero      => right; rfl
    | succ b'   => { exfalso; exact MulPos (SuccNeZero a') (SuccNeZero b') h }

theorem MulEqZeroIff (a b : ℕ) : a * b = 0 ↔ a = 0 ∨ b = 0 := Iff.intro EqZeroOrEqZeroOfMulEqZero $ fun h => by cases h with
| Or.inl ha => rw [ha, ZeroMul]
| Or.inr hb => rw [hb, MulZero]

theorem MulLeftCancel (a b c : ℕ) (ha : a ≠ 0) : a * b = a * c → b = c := sorry

/- Inequality world -/

theorem OneAddLeSelf (x : ℕ) : x ≤ (1 : ℕ) + x := by { rw [LeIffExistsAdd]; exact ⟨1, AddComm 1 x⟩ }

theorem LeRefl (x : ℕ) : x ≤ x := by { rw [LeIffExistsAdd]; exact ⟨0, AddZero x⟩ }

theorem LeSucc (a b : ℕ) : a ≤ b → a ≤ (succ b) := fun h => by
    rw [LeIffExistsAdd] at h
    cases h with | Exists.intro x hx => { rw [hx, LeIffExistsAdd]; exact ⟨succ x, by rw [AddSucc]⟩ }

theorem ZeroLe (a : ℕ) : 0 ≤ a := by
    induction a with
    | zero     => exact LeRefl 0
    | succ k   => { apply LeSucc; assumption }

theorem LeTrans (a b c : ℕ) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c := by
    rw [LeIffExistsAdd] at hab
    rw [LeIffExistsAdd] at hbc
    cases hab with | Exists.intro x hx =>
    cases hbc with | Exists.intro y hy =>
        rw [hy, hx, AddAssoc]
        exact (LeIffExistsAdd _ _).mpr ⟨x+y, rfl⟩

theorem LeAntisymm (a b : ℕ) (hab : a ≤ b) (hba : b ≤ a) : a = b := by
    rw [LeIffExistsAdd] at hab
    rw [LeIffExistsAdd] at hba
    cases hab with | Exists.intro x hx =>
    cases hba with | Exists.intro y hy =>
    rw [hx, AddAssoc] at hy
    have h := EqZeroOfAddRightEqSelf hy.symm
    have hx' : x = 0 := AddRightEqZero h
    rw [hx', AddZero] at hx
    exact hx.symm

theorem LeZero (a : ℕ) (h : a ≤ 0) : a = 0 := by cases a with
| zero      => rfl
| succ k    => exact LeAntisymm _ _ h $ ZeroLe _

theorem SuccLeSucc (a b : ℕ) (h : a ≤ b) : succ a ≤ succ b := by
    rw [LeIffExistsAdd] at h
    cases h with | Exists.intro c hc =>
    rw [hc, LeIffExistsAdd]
    exact ⟨c, by rw [SuccAdd]⟩

theorem LeTotal (a b : ℕ) : a ≤ b ∨ b ≤ a := match a, b with
| zero,     zero        => Or.inl $ ZeroLe _
| succ a',  zero        => Or.inr $ ZeroLe _
| zero,     succ b'     => Or.inl $ ZeroLe _
| succ a',  succ b'     => by cases LeTotal a' b' with
    | Or.inl H => exact Or.inl $ SuccLeSucc a' b' H
    | Or.inr H => exact Or.inr $ SuccLeSucc b' a' H

theorem LeSuccSelf (a : ℕ) : a ≤ succ a := LeSucc _ _ $ LeRefl _

theorem AddLeAddRight {a b : ℕ} : a ≤ b → ∀ t, (a + t) ≤ (b + t) := fun h t => by induction t with
| zero          => simp [AddZero', h]
| succ t' ht    => simp [AddSucc, SuccLeSucc _ _ ht]

theorem LeOfSuccLeSucc (a b : ℕ) : succ a ≤ succ b → a ≤ b := fun h => by
    rw [LeIffExistsAdd] at h;
    rw [LeIffExistsAdd];
    cases h with | Exists.intro x hx =>
    refine ⟨x, ?_⟩
    rw [SuccAdd] at hx
    exact SuccInj hx

theorem NotSuccLeSelf (a : ℕ) : ¬ (succ a ≤ a) := fun h => NeSuccSelf _ (LeAntisymm _ _ h (LeSucc a a $ LeRefl a)).symm

theorem AddLeAddLeft {a b : ℕ} (h : a ≤ b) (t : ℕ) : t + a ≤ t + b := by induction t with
| zero          => simp [ZeroAdd', h]
| succ k hk     => rw [SuccAdd, SuccAdd]; exact SuccLeSucc _ _ hk

theorem LtAuxOne (a b : ℕ) : a ≤ b ∧ ¬ (b ≤ a) → succ a ≤ b := sorry

theorem LtAuxTwo (a b : ℕ) : succ a ≤ b → a ≤ b ∧ ¬ (b ≤ a) := sorry

theorem LtIffSuccLe (a b : ℕ) : a < b ↔ succ a ≤ b := sorry

example : ∃ x : ℕ, x = 0 := by
    use 0
    rfl


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.hom.aut
import logic.function.basic
import group_theory.subgroup.basic

/-!
# Semidirect product

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

This file defines semidirect products of groups, and the canonical maps in and out of the
semidirect product. The semidirect product of `N` and `G` given a hom `φ` from
`G` to the automorphism group of `N` is the product of sets with the group
`⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩`

## Key definitions

There are two homs into the semidirect product `inl : N →* N ⋊[φ] G` and
`inr : G →* N ⋊[φ] G`, and `lift` can be used to define maps `N ⋊[φ] G →* H`
out of the semidirect product given maps `f₁ : N →* H` and `f₂ : G →* H` that satisfy the
condition `∀ n g, f₁ (φ g n) = f₂ g * f₁ n * f₂ g⁻¹`

## Notation

This file introduces the global notation `N ⋊[φ] G` for `semidirect_product N G φ`

## Tags
group, semidirect product
-/
variables (N : Type*) (G : Type*) {H : Type*} [group N] [group G] [group H]

/-- The semidirect product of groups `N` and `G`, given a map `φ` from `G` to the automorphism
  group of `N`. It the product of sets with the group operation
  `⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩` -/
@[ext, derive decidable_eq]
structure semidirect_product (φ : G →* mul_aut N) :=
(left : N) (right : G)

attribute [pp_using_anonymous_constructor] semidirect_product

notation N` ⋊[`:35 φ:35`] `:0 G :35 := semidirect_product N G φ

namespace semidirect_product

variables {N G} {φ : G →* mul_aut N}

instance : group (N ⋊[φ] G) :=
{ one := ⟨1, 1⟩,
  mul := λ a b, ⟨a.1 * φ a.2 b.1, a.2 * b.2⟩,
  inv := λ x, ⟨φ x.2⁻¹ x.1⁻¹, x.2⁻¹⟩,
  mul_assoc := λ a b c, by ext; simp [mul_assoc],
  one_mul := λ a, ext _ _ (by simp) (one_mul a.2),
  mul_one := λ a, ext _ _ (by simp) (mul_one _),
  mul_left_inv := λ ⟨a, b⟩, ext _ _ (show φ b⁻¹ a⁻¹ * φ b⁻¹ a = 1, by simp) (mul_left_inv b) }

instance : inhabited (N ⋊[φ] G) := ⟨1⟩

@[simp] lemma one_left : (1 : N ⋊[φ] G).left = 1 := rfl
@[simp] lemma one_right : (1 : N ⋊[φ] G).right = 1 := rfl
@[simp] lemma inv_left (a : N ⋊[φ] G) : (a⁻¹).left = φ a.right⁻¹ a.left⁻¹ := rfl
@[simp] lemma inv_right (a : N ⋊[φ] G) : (a⁻¹).right = a.right⁻¹ := rfl
@[simp] lemma mul_left (a b : N ⋊[φ] G) : (a * b).left = a.left * φ a.right b.left := rfl
@[simp] lemma mul_right (a b : N ⋊[φ] G) : (a * b).right = a.right * b.right := rfl

/-- The canonical map `N →* N ⋊[φ] G` sending `n` to `⟨n, 1⟩` -/
def inl : N →* N ⋊[φ] G :=
{ to_fun := λ n, ⟨n, 1⟩,
  map_one' := rfl,
  map_mul' := by intros; ext; simp }

@[simp] lemma left_inl (n : N) : (inl n : N ⋊[φ] G).left = n := rfl
@[simp] lemma right_inl (n : N) : (inl n : N ⋊[φ] G).right = 1 := rfl

lemma inl_injective : function.injective (inl : N → N ⋊[φ] G) :=
function.injective_iff_has_left_inverse.2 ⟨left, left_inl⟩

@[simp] lemma inl_inj {n₁ n₂ : N} : (inl n₁ : N ⋊[φ] G) = inl n₂ ↔ n₁ = n₂ :=
inl_injective.eq_iff

/-- The canonical map `G →* N ⋊[φ] G` sending `g` to `⟨1, g⟩` -/
def inr : G →* N ⋊[φ] G :=
{ to_fun := λ g, ⟨1, g⟩,
  map_one' := rfl,
  map_mul' := by intros; ext; simp }

@[simp] lemma left_inr (g : G) : (inr g : N ⋊[φ] G).left = 1 := rfl
@[simp] lemma right_inr (g : G) : (inr g : N ⋊[φ] G).right = g := rfl

lemma inr_injective : function.injective (inr : G → N ⋊[φ] G) :=
function.injective_iff_has_left_inverse.2 ⟨right, right_inr⟩

@[simp] lemma inr_inj {g₁ g₂ : G} : (inr g₁ : N ⋊[φ] G) = inr g₂ ↔ g₁ = g₂ :=
inr_injective.eq_iff

lemma inl_aut (g : G) (n : N) : (inl (φ g n) : N ⋊[φ] G) = inr g * inl n * inr g⁻¹ :=
by ext; simp

lemma inl_aut_inv (g : G) (n : N) : (inl ((φ g)⁻¹ n) : N ⋊[φ] G) = inr g⁻¹ * inl n * inr g :=
by rw [← monoid_hom.map_inv, inl_aut, inv_inv]

@[simp]

@[simp] lemma inl_left_mul_inr_right (x : N ⋊[φ] G) : inl x.left * inr x.right = x :=
by ext; simp

/-- The canonical projection map `N ⋊[φ] G →* G`, as a group hom. -/
def right_hom : N ⋊[φ] G →* G :=
{ to_fun := semidirect_product.right,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

@[simp] lemma right_hom_eq_right : (right_hom :  N ⋊[φ] G → G) = right := rfl

@[simp] lemma right_hom_comp_inl : (right_hom : N ⋊[φ] G →* G).comp inl = 1 :=
by ext; simp [right_hom]

@[simp] lemma right_hom_comp_inr : (right_hom : N ⋊[φ] G →* G).comp inr = monoid_hom.id _ :=
by ext; simp [right_hom]

@[simp] lemma right_hom_inl (n : N) : right_hom (inl n : N ⋊[φ] G) = 1 :=
by simp [right_hom]

@[simp] lemma right_hom_inr (g : G) : right_hom (inr g : N ⋊[φ] G) = g :=
by simp [right_hom]

lemma right_hom_surjective : function.surjective (right_hom : N ⋊[φ] G → G) :=
function.surjective_iff_has_right_inverse.2 ⟨inr, right_hom_inr⟩

lemma range_inl_eq_ker_right_hom : (inl : N →* N ⋊[φ] G).range = right_hom.ker :=
le_antisymm
  (λ _, by simp [monoid_hom.mem_ker, eq_comm] {contextual := tt})
  (λ x hx, ⟨x.left, by ext; simp [*, monoid_hom.mem_ker] at *⟩)

section lift
variables (f₁ : N →* H) (f₂ : G →* H)
  (h : ∀ g, f₁.comp (φ g).to_monoid_hom = (mul_aut.conj (f₂ g)).to_monoid_hom.comp f₁)

/-- Define a group hom `N ⋊[φ] G →* H`, by defining maps `N →* H` and `G →* H`  -/
def lift (f₁ : N →* H) (f₂ : G →* H)
  (h : ∀ g, f₁.comp (φ g).to_monoid_hom = (mul_aut.conj (f₂ g)).to_monoid_hom.comp f₁) :
  N ⋊[φ] G →* H :=
{ to_fun := λ a, f₁ a.1 * f₂ a.2,
  map_one' := by simp,
  map_mul' := λ a b, begin
    have := λ n g, monoid_hom.ext_iff.1 (h n) g,
    simp only [mul_aut.conj_apply, monoid_hom.comp_apply, mul_equiv.coe_to_monoid_hom] at this,
    simp [this, mul_assoc]
  end }

@[simp] lemma lift_inl (n : N) : lift f₁ f₂ h (inl n) = f₁ n := by simp [lift]
@[simp] lemma lift_comp_inl : (lift f₁ f₂ h).comp inl = f₁ := by ext; simp

@[simp] lemma lift_inr (g : G) : lift f₁ f₂ h (inr g) = f₂ g := by simp [lift]
@[simp] lemma lift_comp_inr : (lift f₁ f₂ h).comp inr = f₂ := by ext; simp

lemma lift_unique (F : N ⋊[φ] G →* H) :
  F = lift (F.comp inl) (F.comp inr) (λ _, by ext; simp [inl_aut]) :=
begin
  ext,
  simp only [lift, monoid_hom.comp_apply, monoid_hom.coe_mk],
  rw [← F.map_mul, inl_left_mul_inr_right],
end

/-- Two maps out of the semidirect product are equal if they're equal after composition
  with both `inl` and `inr` -/
lemma hom_ext {f g : (N ⋊[φ] G) →* H} (hl : f.comp inl = g.comp inl)
  (hr : f.comp inr = g.comp inr) : f = g :=
by { rw [lift_unique f, lift_unique g], simp only * }

end lift

section map

variables {N₁ : Type*} {G₁ : Type*} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁}

/-- Define a map from `N ⋊[φ] G` to `N₁ ⋊[φ₁] G₁` given maps `N →* N₁` and `G →* G₁` that
  satisfy a commutativity condition `∀ n g, f₁ (φ g n) = φ₁ (f₂ g) (f₁ n)`.  -/
def map (f₁ : N →* N₁) (f₂ : G →* G₁)
  (h : ∀ g : G, f₁.comp (φ g).to_monoid_hom = (φ₁ (f₂ g)).to_monoid_hom.comp f₁) :
  N ⋊[φ] G →* N₁ ⋊[φ₁] G₁ :=
{ to_fun := λ x, ⟨f₁ x.1, f₂ x.2⟩,
  map_one' := by simp,
  map_mul' := λ x y, begin
    replace h := monoid_hom.ext_iff.1 (h x.right) y.left,
    ext; simp * at *,
  end }

variables (f₁ : N →* N₁) (f₂ : G →* G₁)
  (h : ∀ g : G, f₁.comp (φ g).to_monoid_hom = (φ₁ (f₂ g)).to_monoid_hom.comp f₁)

@[simp] lemma map_left (g : N ⋊[φ] G) : (map f₁ f₂ h g).left = f₁ g.left := rfl

@[simp] lemma map_right (g : N ⋊[φ] G) : (map f₁ f₂ h g).right = f₂ g.right := rfl

@[simp] lemma right_hom_comp_map : right_hom.comp (map f₁ f₂ h) = f₂.comp right_hom := rfl

@[simp] lemma map_inl (n : N) : map f₁ f₂ h (inl n) = inl (f₁ n) :=
by simp [map]

@[simp] lemma map_comp_inl : (map f₁ f₂ h).comp inl = inl.comp f₁ :=
by ext; simp

@[simp] lemma map_inr (g : G) : map f₁ f₂ h (inr g) = inr (f₂ g) :=
by simp [map]

@[simp] lemma map_comp_inr : (map f₁ f₂ h).comp inr = inr.comp f₂ :=
by ext; simp [map]

end map

end semidirect_product


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.sites.grothendieck
import category_theory.sites.pretopology
import category_theory.limits.lattice
import topology.sets.opens

/-!
# Grothendieck topology on a topological space

Define the Grothendieck topology and the pretopology associated to a topological space, and show
that the pretopology induces the topology.

The covering (pre)sieves on `X` are those for which the union of domains contains `X`.

## Tags

site, Grothendieck topology, space

## References

* [nLab, *Grothendieck topology*](https://ncatlab.org/nlab/show/Grothendieck+topology)
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]

## Implementation notes

We define the two separately, rather than defining the Grothendieck topology as that generated
by the pretopology for the purpose of having nice definitional properties for the sieves.
-/

universe u

namespace opens
variables (T : Type u) [topological_space T]

open category_theory topological_space category_theory.limits

/-- The Grothendieck topology associated to a topological space. -/
def grothendieck_topology : grothendieck_topology (opens T) :=
{ sieves := λ X S, ∀ x ∈ X, ∃ U (f : U ⟶ X), S f ∧ x ∈ U,
  top_mem' := λ X x hx, ⟨_, 𝟙 _, trivial, hx⟩,
  pullback_stable' := λ X Y S f hf y hy,
  begin
    rcases hf y (f.le hy) with ⟨U, g, hg, hU⟩,
    refine ⟨U ⊓ Y, hom_of_le inf_le_right, _, hU, hy⟩,
    apply S.downward_closed hg (hom_of_le inf_le_left),
  end,
  transitive' := λ X S hS R hR x hx,
  begin
    rcases hS x hx with ⟨U, f, hf, hU⟩,
    rcases hR hf _ hU with ⟨V, g, hg, hV⟩,
    exact ⟨_, g ≫ f, hg, hV⟩,
  end }

/-- The Grothendieck pretopology associated to a topological space. -/
def pretopology : pretopology (opens T) :=
{ coverings := λ X R, ∀ x ∈ X, ∃ U (f : U ⟶ X), R f ∧ x ∈ U,
  has_isos := λ X Y f i x hx,
        by exactI ⟨_, _, presieve.singleton_self _, (inv f).le hx⟩,
  pullbacks := λ X Y f S hS x hx,
  begin
    rcases hS _ (f.le hx) with ⟨U, g, hg, hU⟩,
    refine ⟨_, _, presieve.pullback_arrows.mk _ _ hg, _⟩,
    have : U ⊓ Y ≤ pullback g f,
      refine le_of_hom (pullback.lift (hom_of_le inf_le_left) (hom_of_le inf_le_right) rfl),
    apply this ⟨hU, hx⟩,
  end,
  transitive := λ X S Ti hS hTi x hx,
  begin
    rcases hS x hx with ⟨U, f, hf, hU⟩,
    rcases hTi f hf x hU with ⟨V, g, hg, hV⟩,
    exact ⟨_, _, ⟨_, g, f, hf, hg, rfl⟩, hV⟩,
  end }

/-- The pretopology associated to a space is the largest pretopology that
    generates the Grothendieck topology associated to the space. -/
@[simp]
lemma pretopology_of_grothendieck :
  pretopology.of_grothendieck _ (opens.grothendieck_topology T) = opens.pretopology T :=
begin
  apply le_antisymm,
  { intros X R hR x hx,
    rcases hR x hx with ⟨U, f, ⟨V, g₁, g₂, hg₂, _⟩, hU⟩,
    exact ⟨V, g₂, hg₂, g₁.le hU⟩ },
  { intros X R hR x hx,
    rcases hR x hx with ⟨U, f, hf, hU⟩,
    exact ⟨U, f, sieve.le_generate R U hf, hU⟩ },
end

/--
The pretopology associated to a space induces the Grothendieck topology associated to the space.
-/
@[simp]
lemma pretopology_to_grothendieck :
  pretopology.to_grothendieck _ (opens.pretopology T) = opens.grothendieck_topology T :=
begin
  rw ← pretopology_of_grothendieck,
  apply (pretopology.gi (opens T)).l_u_eq,
end

end opens


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.algebra.basic
import algebra.direct_sum.module
import algebra.direct_sum.ring

/-! # Additively-graded algebra structures on `⨁ i, A i`

This file provides `R`-algebra structures on external direct sums of `R`-modules.

Recall that if `A i` are a family of `add_comm_monoid`s indexed by an `add_monoid`, then an instance
of `direct_sum.gmonoid A` is a multiplication `A i → A j → A (i + j)` giving `⨁ i, A i` the
structure of a semiring. In this file, we introduce the `direct_sum.galgebra R A` class for the case
where all `A i` are `R`-modules. This is the extra structure needed to promote `⨁ i, A i` to an
`R`-algebra.

## Main definitions

* `direct_sum.galgebra R A`, the typeclass.
* `direct_sum.galgebra.of_submodules`, for creating the above instance from a collection of
  submodules.
* `direct_sum.to_algebra` extends `direct_sum.to_semiring` to produce an `alg_hom`.

-/

universes uι uR uA uB

variables {ι : Type uι}

namespace direct_sum
open_locale direct_sum

variables (R : Type uR) (A : ι → Type uA) {B : Type uB} [decidable_eq ι]

variables [comm_semiring R] [Π i, add_comm_monoid (A i)] [Π i, module R (A i)]
variables [add_monoid ι] [gsemiring A]

section

/-- A graded version of `algebra`. An instance of `direct_sum.galgebra R A` endows `(⨁ i, A i)`
with an `R`-algebra structure. -/
class galgebra :=
(to_fun : R →+ A 0)
(map_one : to_fun 1 = graded_monoid.ghas_one.one)
(map_mul : ∀ r s,
  graded_monoid.mk _ (to_fun (r * s)) = ⟨_, graded_monoid.ghas_mul.mul (to_fun r) (to_fun s)⟩)
(commutes : ∀ r x, graded_monoid.mk _ (to_fun r) * x = x * ⟨_, to_fun r⟩)
(smul_def : ∀ r (x : graded_monoid A), graded_monoid.mk x.1 (r • x.2) = ⟨_, to_fun (r)⟩ * x)

end

variables [semiring B] [galgebra R A] [algebra R B]

instance : algebra R (⨁ i, A i) :=
{ to_fun := (direct_sum.of A 0).comp galgebra.to_fun,
  map_zero' := add_monoid_hom.map_zero _,
  map_add' := add_monoid_hom.map_add _,
  map_one' := (direct_sum.of A 0).congr_arg galgebra.map_one,
  map_mul' := λ a b, begin
    simp only [add_monoid_hom.comp_apply],
    rw of_mul_of,
    apply dfinsupp.single_eq_of_sigma_eq (galgebra.map_mul a b),
  end,
  commutes' := λ r x, begin
    change add_monoid_hom.mul (direct_sum.of _ _ _) x =
      add_monoid_hom.mul.flip (direct_sum.of _ _ _) x,
    apply add_monoid_hom.congr_fun _ x,
    ext i xi : 2,
    dsimp only [add_monoid_hom.comp_apply, add_monoid_hom.mul_apply, add_monoid_hom.flip_apply],
    rw [of_mul_of, of_mul_of],
    apply dfinsupp.single_eq_of_sigma_eq (galgebra.commutes r ⟨i, xi⟩),
  end,
  smul_def' := λ r x, begin
    change distrib_mul_action.to_add_monoid_hom _ r x = add_monoid_hom.mul (direct_sum.of _ _ _) x,
    apply add_monoid_hom.congr_fun _ x,
    ext i xi : 2,
    dsimp only [add_monoid_hom.comp_apply, distrib_mul_action.to_add_monoid_hom_apply,
      add_monoid_hom.mul_apply],
    rw [direct_sum.of_mul_of, ←of_smul],
    apply dfinsupp.single_eq_of_sigma_eq (galgebra.smul_def r ⟨i, xi⟩),
  end }

lemma algebra_map_apply (r : R) :
  algebra_map R (⨁ i, A i) r = direct_sum.of A 0 (galgebra.to_fun r) := rfl

lemma algebra_map_to_add_monoid_hom :
  ↑(algebra_map R (⨁ i, A i)) = (direct_sum.of A 0).comp (galgebra.to_fun : R →+ A 0) := rfl

/-- A family of `linear_map`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
describes an `alg_hom` on `⨁ i, A i`. This is a stronger version of `direct_sum.to_semiring`.

Of particular interest is the case when `A i` are bundled subojects, `f` is the family of
coercions such as `submodule.subtype (A i)`, and the `[gmonoid A]` structure originates from
`direct_sum.gmonoid.of_add_submodules`, in which case the proofs about `ghas_one` and `ghas_mul`
can be discharged by `rfl`. -/
@[simps]
def to_algebra
  (f : Π i, A i →ₗ[R] B) (hone : f _ (graded_monoid.ghas_one.one) = 1)
  (hmul : ∀ {i j} (ai : A i) (aj : A j), f _ (graded_monoid.ghas_mul.mul ai aj) = f _ ai * f _ aj)
  (hcommutes : ∀ r, (f 0) (galgebra.to_fun r) = (algebra_map R B) r) :
  (⨁ i, A i) →ₐ[R] B :=
{ to_fun := to_semiring (λ i, (f i).to_add_monoid_hom) hone @hmul,
  commutes' := λ r, (direct_sum.to_semiring_of _ _ _ _ _).trans (hcommutes r),
  .. to_semiring (λ i, (f i).to_add_monoid_hom) hone @hmul}

/-- Two `alg_hom`s out of a direct sum are equal if they agree on the generators.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma alg_hom_ext' ⦃f g : (⨁ i, A i) →ₐ[R] B⦄
  (h : ∀ i, f.to_linear_map.comp (lof _ _ A i) = g.to_linear_map.comp (lof _ _ A i)) : f = g :=
alg_hom.to_linear_map_injective $ direct_sum.linear_map_ext _ h

lemma alg_hom_ext ⦃f g : (⨁ i, A i) →ₐ[R] B⦄ (h : ∀ i x, f (of A i x) = g (of A i x)) : f = g :=
alg_hom_ext' R A $ λ i, linear_map.ext $ h i

end direct_sum

/-! ### Concrete instances -/

/-- A direct sum of copies of a `algebra` inherits the algebra structure.

-/
@[simps]
instance algebra.direct_sum_galgebra {R A : Type*} [decidable_eq ι]
  [add_monoid ι] [comm_semiring R] [semiring A] [algebra R A] :
  direct_sum.galgebra R (λ i : ι, A) :=
{ to_fun := (algebra_map R A).to_add_monoid_hom,
  map_one := (algebra_map R A).map_one,
  map_mul := λ a b, sigma.ext (zero_add _).symm (heq_of_eq $ (algebra_map R A).map_mul a b),
  commutes := λ r ⟨ai, a⟩, sigma.ext ((zero_add _).trans (add_zero _).symm)
                                    (heq_of_eq $ algebra.commutes _ _),
  smul_def := λ r ⟨ai, a⟩, sigma.ext (zero_add _).symm (heq_of_eq $ algebra.smul_def _ _) }

namespace submodule

variables {R A : Type*} [comm_semiring R]

end submodule


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

universes v u

namespace Mathlib

/-!
# The four lemma

Consider the following commutative diagram with exact rows in an abelian category:

A ---f--> B ---g--> C ---h--> D
|         |         |         |
α         β         γ         δ
|         |         |         |
v         v         v         v
A' --f'-> B' --g'-> C' --h'-> D'

We prove the "mono" version of the four lemma: if α is an epimorphism and β and δ are monomorphisms,
then γ is a monomorphism.

## Future work

The "epi" four lemma and the five lemma, which is then an easy corollary.

## Tags

four lemma, diagram lemma, diagram chase
-/

namespace category_theory.abelian

/-- The four lemma, mono version. For names of objects and morphisms, consider the following
    diagram:

```
A ---f--> B ---g--> C ---h--> D
|         |         |         |
α         β         γ         δ
|         |         |         |
v         v         v         v
A' --f'-> B' --g'-> C' --h'-> D'
```
-/
theorem mono_of_epi_of_mono_of_mono {V : Type u} [category V] [abelian V] {A : V} {B : V} {C : V}
    {D : V} {A' : V} {B' : V} {C' : V} {D' : V} {f : A ⟶ B} {g : B ⟶ C} {h : C ⟶ D} {f' : A' ⟶ B'}
    {g' : B' ⟶ C'} {h' : C' ⟶ D'} {α : A ⟶ A'} {β : B ⟶ B'} {γ : C ⟶ C'} {δ : D ⟶ D'} [exact f g]
    [exact g h] [exact f' g'] (comm₁ : α ≫ f' = f ≫ β) (comm₂ : β ≫ g' = g ≫ γ)
    (comm₃ : γ ≫ h' = h ≫ δ) (hα : epi α) (hβ : mono β) (hδ : mono δ) : mono γ :=
  sorry

end Mathlib


/-
Copyright (c) 2021 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 data.nat.factorial.cast
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Polynomial.Pochhammer

/-!
# Cast of factorials

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

This file allows calculating factorials (including ascending and descending ones) as elements of a
semiring.

This is particularly crucial for `nat.desc_factorial` as subtraction on `ℕ` does **not** correspond
to subtraction on a general semiring. For example, we can't rely on existing cast lemmas to prove
`↑(a.desc_factorial 2) = ↑a * (↑a - 1)`. We must use the fact that, whenever `↑(a - 1)` is not equal
to `↑a - 1`, the other factor is `0` anyway.
-/

open Nat

variable (S : Type _)

namespace Nat

section Semiring

variable [Semiring S] (a b : ℕ)

/- warning: nat.cast_asc_factorial -> Nat.cast_ascFactorial is a dubious translation:
lean 3 declaration is
  forall (S : Type.{u1}) [_inst_1 : Semiring.{u1} S] (a : Nat) (b : Nat), Eq.{succ u1} S ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat S (HasLiftT.mk.{1, succ u1} Nat S (CoeTCₓ.coe.{1, succ u1} Nat S (Nat.castCoe.{u1} S (AddMonoidWithOne.toNatCast.{u1} S (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} S (NonAssocSemiring.toAddCommMonoidWithOne.{u1} S (Semiring.toNonAssocSemiring.{u1} S _inst_1))))))) (Nat.ascFactorial a b)) (Polynomial.eval.{u1} S _inst_1 (HAdd.hAdd.{u1, u1, u1} S S S (instHAdd.{u1} S (Distrib.toHasAdd.{u1} S (NonUnitalNonAssocSemiring.toDistrib.{u1} S (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} S (Semiring.toNonAssocSemiring.{u1} S _inst_1))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat S (HasLiftT.mk.{1, succ u1} Nat S (CoeTCₓ.coe.{1, succ u1} Nat S (Nat.castCoe.{u1} S (AddMonoidWithOne.toNatCast.{u1} S (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} S (NonAssocSemiring.toAddCommMonoidWithOne.{u1} S (Semiring.toNonAssocSemiring.{u1} S _inst_1))))))) a) (OfNat.ofNat.{u1} S 1 (OfNat.mk.{u1} S 1 (One.one.{u1} S (AddMonoidWithOne.toOne.{u1} S (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} S (NonAssocSemiring.toAddCommMonoidWithOne.{u1} S (Semiring.toNonAssocSemiring.{u1} S _inst_1)))))))) (pochhammer.{u1} S _inst_1 b))
but is expected to have type
  forall (S : Type.{u1}) [_inst_1 : Semiring.{u1} S] (a : Nat) (b : Nat), Eq.{succ u1} S (Nat.cast.{u1} S (Semiring.toNatCast.{u1} S _inst_1) (Nat.ascFactorial a b)) (Polynomial.eval.{u1} S _inst_1 (HAdd.hAdd.{u1, u1, u1} S S S (instHAdd.{u1} S (Distrib.toAdd.{u1} S (NonUnitalNonAssocSemiring.toDistrib.{u1} S (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} S (Semiring.toNonAssocSemiring.{u1} S _inst_1))))) (Nat.cast.{u1} S (Semiring.toNatCast.{u1} S _inst_1) a) (OfNat.ofNat.{u1} S 1 (One.toOfNat1.{u1} S (Semiring.toOne.{u1} S _inst_1)))) (pochhammer.{u1} S _inst_1 b))
Case conversion may be inaccurate. Consider using '#align nat.cast_asc_factorial Nat.cast_ascFactorialₓ'. -/
theorem cast_ascFactorial : (a.ascFactorial b : S) = (pochhammer S b).eval (a + 1) := by
  rw [← pochhammer_nat_eq_ascFactorial, pochhammer_eval_cast, Nat.cast_add, Nat.cast_one]
#align nat.cast_asc_factorial Nat.cast_ascFactorial

#print Nat.cast_descFactorial /-
theorem cast_descFactorial : (a.descFactorial b : S) = (pochhammer S b).eval (a - (b - 1) : ℕ) :=
  by
  rw [← pochhammer_eval_cast, pochhammer_nat_eq_descFactorial]
  cases b
  · simp_rw [desc_factorial_zero]
  simp_rw [add_succ, succ_sub_one]
  obtain h | h := le_total a b
  · rw [desc_factorial_of_lt (lt_succ_of_le h), desc_factorial_of_lt (lt_succ_of_le _)]
    rw [tsub_eq_zero_iff_le.mpr h, zero_add]
  · rw [tsub_add_cancel_of_le h]
#align nat.cast_desc_factorial Nat.cast_descFactorial
-/

#print Nat.cast_factorial /-
theorem cast_factorial : (a ! : S) = (pochhammer S a).eval 1 := by
  rw [← zero_asc_factorial, cast_asc_factorial, cast_zero, zero_add]
#align nat.cast_factorial Nat.cast_factorial
-/

end Semiring

section Ring

variable [Ring S] (a b : ℕ)

/- warning: nat.cast_desc_factorial_two -> Nat.cast_descFactorial_two is a dubious translation:
lean 3 declaration is
  forall (S : Type.{u1}) [_inst_1 : Ring.{u1} S] (a : Nat), Eq.{succ u1} S ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat S (HasLiftT.mk.{1, succ u1} Nat S (CoeTCₓ.coe.{1, succ u1} Nat S (Nat.castCoe.{u1} S (AddMonoidWithOne.toNatCast.{u1} S (AddGroupWithOne.toAddMonoidWithOne.{u1} S (AddCommGroupWithOne.toAddGroupWithOne.{u1} S (Ring.toAddCommGroupWithOne.{u1} S _inst_1))))))) (Nat.descFactorial a (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))) (HMul.hMul.{u1, u1, u1} S S S (instHMul.{u1} S (Distrib.toHasMul.{u1} S (Ring.toDistrib.{u1} S _inst_1))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat S (HasLiftT.mk.{1, succ u1} Nat S (CoeTCₓ.coe.{1, succ u1} Nat S (Nat.castCoe.{u1} S (AddMonoidWithOne.toNatCast.{u1} S (AddGroupWithOne.toAddMonoidWithOne.{u1} S (AddCommGroupWithOne.toAddGroupWithOne.{u1} S (Ring.toAddCommGroupWithOne.{u1} S _inst_1))))))) a) (HSub.hSub.{u1, u1, u1} S S S (instHSub.{u1} S (SubNegMonoid.toHasSub.{u1} S (AddGroup.toSubNegMonoid.{u1} S (AddGroupWithOne.toAddGroup.{u1} S (AddCommGroupWithOne.toAddGroupWithOne.{u1} S (Ring.toAddCommGroupWithOne.{u1} S _inst_1)))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat S (HasLiftT.mk.{1, succ u1} Nat S (CoeTCₓ.coe.{1, succ u1} Nat S (Nat.castCoe.{u1} S (AddMonoidWithOne.toNatCast.{u1} S (AddGroupWithOne.toAddMonoidWithOne.{u1} S (AddCommGroupWithOne.toAddGroupWithOne.{u1} S (Ring.toAddCommGroupWithOne.{u1} S _inst_1))))))) a) (OfNat.ofNat.{u1} S 1 (OfNat.mk.{u1} S 1 (One.one.{u1} S (AddMonoidWithOne.toOne.{u1} S (AddGroupWithOne.toAddMonoidWithOne.{u1} S (AddCommGroupWithOne.toAddGroupWithOne.{u1} S (Ring.toAddCommGroupWithOne.{u1} S _inst_1)))))))))
but is expected to have type
  forall (S : Type.{u1}) [_inst_1 : Ring.{u1} S] (a : Nat), Eq.{succ u1} S (Nat.cast.{u1} S (NonAssocRing.toNatCast.{u1} S (Ring.toNonAssocRing.{u1} S _inst_1)) (Nat.descFactorial a (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))) (HMul.hMul.{u1, u1, u1} S S S (instHMul.{u1} S (NonUnitalNonAssocRing.toMul.{u1} S (NonAssocRing.toNonUnitalNonAssocRing.{u1} S (Ring.toNonAssocRing.{u1} S _inst_1)))) (Nat.cast.{u1} S (NonAssocRing.toNatCast.{u1} S (Ring.toNonAssocRing.{u1} S _inst_1)) a) (HSub.hSub.{u1, u1, u1} S S S (instHSub.{u1} S (Ring.toSub.{u1} S _inst_1)) (Nat.cast.{u1} S (NonAssocRing.toNatCast.{u1} S (Ring.toNonAssocRing.{u1} S _inst_1)) a) (OfNat.ofNat.{u1} S 1 (One.toOfNat1.{u1} S (NonAssocRing.toOne.{u1} S (Ring.toNonAssocRing.{u1} S _inst_1))))))
Case conversion may be inaccurate. Consider using '#align nat.cast_desc_factorial_two Nat.cast_descFactorial_twoₓ'. -/
/-- Convenience lemma. The `a - 1` is not using truncated subtraction, as opposed to the definition
of `nat.desc_factorial` as a natural. -/
theorem cast_descFactorial_two : (a.descFactorial 2 : S) = a * (a - 1) :=
  by
  rw [cast_desc_factorial]
  cases a
  · rw [zero_tsub, cast_zero, pochhammer_ne_zero_eval_zero _ two_ne_zero, MulZeroClass.zero_mul]
  ·
    rw [succ_sub_succ, tsub_zero, cast_succ, add_sub_cancel, pochhammer_succ_right, pochhammer_one,
      Polynomial.X_mul, Polynomial.eval_mul_X, Polynomial.eval_add, Polynomial.eval_X, cast_one,
      Polynomial.eval_one]
#align nat.cast_desc_factorial_two Nat.cast_descFactorial_two

end Ring

end Nat


import data.list.basic

open list

variables {α : Type*} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by { unfold mk_symm, simp}

theorem reverse_mk_symm' (xs : list α) :
  let r := mk_symm xs in reverse r = r :=
by simp [mk_symm]

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp [reverse_mk_symm]

example (xs ys : list ℕ) (p : list ℕ → Prop)
  (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp [reverse_mk_symm] at h; assumption

@[simp] theorem reverse_mk_symm'' (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp

example (xs ys : list ℕ) (p : list ℕ → Prop)
  (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp at h; assumption

attribute [simp]
theorem reverse_mk_symm''' (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]