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

! This file was ported from Lean 3 source module geometry.manifold.whitney_embedding
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Geometry.Manifold.Diffeomorph
import Mathbin.Geometry.Manifold.Instances.Real
import Mathbin.Geometry.Manifold.PartitionOfUnity

/-!
# Whitney embedding theorem

In this file we prove a version of the Whitney embedding theorem: for any compact real manifold `M`,
for sufficiently large `n` there exists a smooth embedding `M → ℝ^n`.

## TODO

* Prove the weak Whitney embedding theorem: any `σ`-compact smooth `m`-dimensional manifold can be
  embedded into `ℝ^(2m+1)`. This requires a version of Sard's theorem: for a locally Lipschitz
  continuous map `f : ℝ^m → ℝ^n`, `m < n`, the range has Hausdorff dimension at most `m`, hence it
  has measure zero.

## Tags

partition of unity, smooth bump function, whitney theorem
-/

universe uι uE uH uM

variable {ι : Type uι} {E : Type uE} [NormedAddCommGroup E] [NormedSpace ℝ E]
  [FiniteDimensional ℝ E] {H : Type uH} [TopologicalSpace H] {I : ModelWithCorners ℝ E H}
  {M : Type uM} [TopologicalSpace M] [ChartedSpace H M] [SmoothManifoldWithCorners I M]

open Function Filter FiniteDimensional Set

open Topology Manifold Classical Filter BigOperators

noncomputable section

namespace SmoothBumpCovering

/-!
### Whitney embedding theorem

In this section we prove a version of the Whitney embedding theorem: for any compact real manifold
`M`, for sufficiently large `n` there exists a smooth embedding `M → ℝ^n`.
-/

variable [T2Space M] [hi : Fintype ι] {s : Set M} (f : SmoothBumpCovering ι I M s)

include hi

/-- Smooth embedding of `M` into `(E × ℝ) ^ ι`. -/
def embeddingPiTangent : C^∞⟮I, M; 𝓘(ℝ, ι → E × ℝ), ι → E × ℝ⟯
    where
  toFun x i := (f i x • extChartAt I (f.c i) x, f i x)
  contMdiff_toFun :=
    contMdiff_pi_space.2 fun i =>
      ((f i).smooth_smul contMdiffOn_extChartAt).prod_mk_space (f i).Smooth
#align smooth_bump_covering.embedding_pi_tangent SmoothBumpCovering.embeddingPiTangent

@[local simp]
theorem embeddingPiTangent_coe :
    ⇑f.embeddingPiTangent = fun x i => (f i x • extChartAt I (f.c i) x, f i x) :=
  rfl
#align smooth_bump_covering.embedding_pi_tangent_coe SmoothBumpCovering.embeddingPiTangent_coe

theorem embeddingPiTangent_injOn : InjOn f.embeddingPiTangent s :=
  by
  intro x hx y hy h
  simp only [embedding_pi_tangent_coe, funext_iff] at h
  obtain ⟨h₁, h₂⟩ := Prod.mk.inj_iff.1 (h (f.ind x hx))
  rw [f.apply_ind x hx] at h₂
  rw [← h₂, f.apply_ind x hx, one_smul, one_smul] at h₁
  have := f.mem_ext_chart_at_source_of_eq_one h₂.symm
  exact (extChartAt I (f.c _)).InjOn (f.mem_ext_chart_at_ind_source x hx) this h₁
#align smooth_bump_covering.embedding_pi_tangent_inj_on SmoothBumpCovering.embeddingPiTangent_injOn

theorem embeddingPiTangent_injective (f : SmoothBumpCovering ι I M) :
    Injective f.embeddingPiTangent :=
  injective_iff_injOn_univ.2 f.embeddingPiTangent_injOn
#align smooth_bump_covering.embedding_pi_tangent_injective SmoothBumpCovering.embeddingPiTangent_injective

theorem comp_embeddingPiTangent_mfderiv (x : M) (hx : x ∈ s) :
    ((ContinuousLinearMap.fst ℝ E ℝ).comp
            (@ContinuousLinearMap.proj ℝ _ ι (fun _ => E × ℝ) _ _ (fun _ => inferInstance)
              (f.ind x hx))).comp
        (mfderiv I 𝓘(ℝ, ι → E × ℝ) f.embeddingPiTangent x) =
      mfderiv I I (chartAt H (f.c (f.ind x hx))) x :=
  by
  set L :=
    (ContinuousLinearMap.fst ℝ E ℝ).comp
      (@ContinuousLinearMap.proj ℝ _ ι (fun _ => E × ℝ) _ _ (fun _ => inferInstance) (f.ind x hx))
  have := L.has_mfderiv_at.comp x f.embedding_pi_tangent.mdifferentiable_at.has_mfderiv_at
  convert hasMfderivAt_unique this _
  refine' (hasMfderivAt_extChartAt I (f.mem_chart_at_ind_source x hx)).congr_of_eventuallyEq _
  refine' (f.eventually_eq_one x hx).mono fun y hy => _
  simp only [embedding_pi_tangent_coe, ContinuousLinearMap.coe_comp', (· ∘ ·),
    ContinuousLinearMap.coe_fst', ContinuousLinearMap.proj_apply]
  rw [hy, Pi.one_apply, one_smul]
#align smooth_bump_covering.comp_embedding_pi_tangent_mfderiv SmoothBumpCovering.comp_embeddingPiTangent_mfderiv

theorem embeddingPiTangent_ker_mfderiv (x : M) (hx : x ∈ s) :
    LinearMap.ker (mfderiv I 𝓘(ℝ, ι → E × ℝ) f.embeddingPiTangent x) = ⊥ :=
  by
  apply bot_unique
  rw [←
    (mdifferentiable_chart I (f.c (f.ind x hx))).ker_mfderiv_eq_bot
      (f.mem_chart_at_ind_source x hx),
    ← comp_embedding_pi_tangent_mfderiv]
  exact LinearMap.ker_le_ker_comp _ _
#align smooth_bump_covering.embedding_pi_tangent_ker_mfderiv SmoothBumpCovering.embeddingPiTangent_ker_mfderiv

theorem embeddingPiTangent_injective_mfderiv (x : M) (hx : x ∈ s) :
    Injective (mfderiv I 𝓘(ℝ, ι → E × ℝ) f.embeddingPiTangent x) :=
  LinearMap.ker_eq_bot.1 (f.embeddingPiTangent_ker_mfderiv x hx)
#align smooth_bump_covering.embedding_pi_tangent_injective_mfderiv SmoothBumpCovering.embeddingPiTangent_injective_mfderiv

omit hi

/-- Baby version of the **Whitney weak embedding theorem**: if `M` admits a finite covering by
supports of bump functions, then for some `n` it can be immersed into the `n`-dimensional
Euclidean space. -/
theorem exists_immersion_euclidean [Finite ι] (f : SmoothBumpCovering ι I M) :
    ∃ (n : ℕ)(e : M → EuclideanSpace ℝ (Fin n)),
      Smooth I (𝓡 n) e ∧ Injective e ∧ ∀ x : M, Injective (mfderiv I (𝓡 n) e x) :=
  by
  cases nonempty_fintype ι
  set F := EuclideanSpace ℝ (Fin <| finrank ℝ (ι → E × ℝ))
  letI : IsNoetherian ℝ (E × ℝ) := IsNoetherian.iff_fg.2 inferInstance
  letI : FiniteDimensional ℝ (ι → E × ℝ) := IsNoetherian.iff_fg.1 inferInstance
  set eEF : (ι → E × ℝ) ≃L[ℝ] F :=
    ContinuousLinearEquiv.ofFinrankEq finrank_euclidean_space_fin.symm
  refine'
    ⟨_, eEF ∘ f.embedding_pi_tangent, eEF.to_diffeomorph.smooth.comp f.embedding_pi_tangent.smooth,
      eEF.injective.comp f.embedding_pi_tangent_injective, fun x => _⟩
  rw [mfderiv_comp _ eEF.differentiable_at.mdifferentiable_at
      f.embedding_pi_tangent.mdifferentiable_at,
    eEF.mfderiv_eq]
  exact eEF.injective.comp (f.embedding_pi_tangent_injective_mfderiv _ trivial)
#align smooth_bump_covering.exists_immersion_euclidean SmoothBumpCovering.exists_immersion_euclidean

end SmoothBumpCovering

/-- Baby version of the Whitney weak embedding theorem: if `M` admits a finite covering by
supports of bump functions, then for some `n` it can be embedded into the `n`-dimensional
Euclidean space. -/
theorem exists_embedding_euclidean_of_compact [T2Space M] [CompactSpace M] :
    ∃ (n : ℕ)(e : M → EuclideanSpace ℝ (Fin n)),
      Smooth I (𝓡 n) e ∧ ClosedEmbedding e ∧ ∀ x : M, Injective (mfderiv I (𝓡 n) e x) :=
  by
  rcases SmoothBumpCovering.exists_isSubordinate I isClosed_univ fun (x : M) _ => univ_mem with
    ⟨ι, f, -⟩
  haveI := f.fintype
  rcases f.exists_immersion_euclidean with ⟨n, e, hsmooth, hinj, hinj_mfderiv⟩
  exact ⟨n, e, hsmooth, hsmooth.continuous.closed_embedding hinj, hinj_mfderiv⟩
#align exists_embedding_euclidean_of_compact exists_embedding_euclidean_of_compact


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

import category_theory.abelian.exact
import category_theory.preadditive.injective
import category_theory.preadditive.yoneda.limits
import category_theory.preadditive.yoneda.injective

/-!
# Injective objects in abelian categories

* Objects in an abelian categories are injective if and only if the preadditive Yoneda functor
  on them preserves finite colimits.
-/

noncomputable theory

open category_theory
open category_theory.limits
open category_theory.injective
open opposite

universes v u

namespace category_theory

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

/-- The preadditive Yoneda functor on `J` preserves colimits if `J` is injective. -/
def preserves_finite_colimits_preadditive_yoneda_obj_of_injective (J : C)
  [hP : injective J] : preserves_finite_colimits (preadditive_yoneda_obj J) :=
begin
  letI := (injective_iff_preserves_epimorphisms_preadditive_yoneda_obj' J).mp hP,
  apply functor.preserves_finite_colimits_of_preserves_epis_and_kernels,
end

/-- An object is injective if its preadditive Yoneda functor preserves finite colimits. -/
lemma injective_of_preserves_finite_colimits_preadditive_yoneda_obj (J : C)
  [hP : preserves_finite_colimits (preadditive_yoneda_obj J)] : injective J :=
begin
  rw injective_iff_preserves_epimorphisms_preadditive_yoneda_obj',
  apply_instance
end

end category_theory


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

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

/-!

# Multi-(co)equalizers

A *multiequalizer* is an equalizer of two morphisms between two products.
Since both products and equalizers are limits, such an object is again a limit.
This file provides the diagram whose limit is indeed such an object.
In fact, it is well-known that any limit can be obtained as a multiequalizer.
The dual construction (multicoequalizers) is also provided.

## Projects

Prove that a multiequalizer can be identified with
an equalizer between products (and analogously for multicoequalizers).

Prove that the limit of any diagram is a multiequalizer (and similarly for colimits).

-/

namespace CategoryTheory.Limits

open CategoryTheory

universe w v u

/-- The type underlying the multiequalizer diagram. -/
--@[nolint unused_arguments]
inductive WalkingMulticospan {L R : Type w} (fst snd : R → L) : Type w
  | left : L → WalkingMulticospan fst snd
  | right : R → WalkingMulticospan fst snd
#align category_theory.limits.walking_multicospan CategoryTheory.Limits.WalkingMulticospan

/-- The type underlying the multiecoqualizer diagram. -/
--@[nolint unused_arguments]
inductive WalkingMultispan {L R : Type w} (fst snd : L → R) : Type w
  | left : L → WalkingMultispan fst snd
  | right : R → WalkingMultispan fst snd
#align category_theory.limits.walking_multispan CategoryTheory.Limits.WalkingMultispan

namespace WalkingMulticospan

variable {L R : Type w} {fst snd : R → L}

instance [Inhabited L] : Inhabited (WalkingMulticospan fst snd) :=
  ⟨left default⟩

/-- Morphisms for `WalkingMulticospan`. -/
inductive Hom : ∀ _ _ : WalkingMulticospan fst snd, Type w
  | id (A) : Hom A A
  | fst (b) : Hom (left (fst b)) (right b)
  | snd (b) : Hom (left (snd b)) (right b)
#align category_theory.limits.walking_multicospan.hom CategoryTheory.Limits.WalkingMulticospan.Hom

/- Porting note: simpNF says the LHS of this internal identifier simplifies
(which it does, using Hom.id_eq_id) -/
attribute [-simp, nolint simpNF] WalkingMulticospan.Hom.id.sizeOf_spec

instance {a : WalkingMulticospan fst snd} : Inhabited (Hom a a) :=
  ⟨Hom.id _⟩

/-- Composition of morphisms for `WalkingMulticospan`. -/
def Hom.comp : ∀ {A B C : WalkingMulticospan fst snd} (_ : Hom A B) (_ : Hom B C), Hom A C
  | _, _, _, Hom.id X, f => f
  | _, _, _, Hom.fst b, Hom.id _ => Hom.fst b
  | _, _, _, Hom.snd b, Hom.id _ => Hom.snd b
#align category_theory.limits.walking_multicospan.hom.comp CategoryTheory.Limits.WalkingMulticospan.Hom.comp

instance : SmallCategory (WalkingMulticospan fst snd) where
  Hom := Hom
  id := Hom.id
  comp := Hom.comp
  id_comp := by
    rintro (_ | _) (_ | _) (_ | _ | _) <;> rfl
  comp_id := by
    rintro (_ | _) (_ | _) (_ | _ | _) <;> rfl
  assoc := by
    rintro (_ | _) (_ | _) (_ | _) (_ | _) (_ | _ | _) (_ | _ | _) (_ | _ | _) <;> rfl

@[simp] -- Porting note: added simp lemma
lemma Hom.id_eq_id (X : WalkingMulticospan fst snd) :
  Hom.id X = 𝟙 X := rfl

@[simp] -- Porting note: added simp lemma
lemma Hom.comp_eq_comp {X Y Z : WalkingMulticospan fst snd}
  (f : X ⟶ Y) (g : Y ⟶ Z) : Hom.comp f g = f ≫ g := rfl

end WalkingMulticospan

namespace WalkingMultispan

variable {L R : Type v} {fst snd : L → R}

instance [Inhabited L] : Inhabited (WalkingMultispan fst snd) :=
  ⟨left default⟩

/-- Morphisms for `WalkingMultispan`. -/
inductive Hom : ∀ _ _ : WalkingMultispan fst snd, Type v
  | id (A) : Hom A A
  | fst (a) : Hom (left a) (right (fst a))
  | snd (a) : Hom (left a) (right (snd a))
#align category_theory.limits.walking_multispan.hom CategoryTheory.Limits.WalkingMultispan.Hom

/- Porting note: simpNF says the LHS of this internal identifier simplifies
(which it does, using Hom.id_eq_id) -/
attribute [-simp, nolint simpNF] WalkingMultispan.Hom.id.sizeOf_spec

instance {a : WalkingMultispan fst snd} : Inhabited (Hom a a) :=
  ⟨Hom.id _⟩

/-- Composition of morphisms for `WalkingMultispan`. -/
def Hom.comp : ∀ {A B C : WalkingMultispan fst snd} (_ : Hom A B) (_ : Hom B C), Hom A C
  | _, _, _, Hom.id X, f => f
  | _, _, _, Hom.fst a, Hom.id _ => Hom.fst a
  | _, _, _, Hom.snd a, Hom.id _ => Hom.snd a
#align category_theory.limits.walking_multispan.hom.comp CategoryTheory.Limits.WalkingMultispan.Hom.comp

instance : SmallCategory (WalkingMultispan fst snd) where
  Hom := Hom
  id := Hom.id
  comp := Hom.comp
  id_comp := by
    rintro (_ | _) (_ | _) (_ | _ | _) <;> rfl
  comp_id := by
    rintro (_ | _) (_ | _) (_ | _ | _) <;> rfl
  assoc := by
    rintro (_ | _) (_ | _) (_ | _) (_ | _) (_ | _ | _) (_ | _ | _) (_ | _ | _) <;> rfl

@[simp] -- Porting note: added simp lemma
lemma Hom.id_eq_id (X : WalkingMultispan fst snd) :
  Hom.id X = 𝟙 X := rfl

@[simp] -- Porting note: added simp lemma
lemma Hom.comp_eq_comp {X Y Z : WalkingMultispan fst snd}
  (f : X ⟶ Y) (g : Y ⟶ Z) : Hom.comp f g = f ≫ g := rfl

end WalkingMultispan

/-- This is a structure encapsulating the data necessary to define a `Multicospan`. -/
--@[nolint has_nonempty_instance]
structure MulticospanIndex (C : Type u) [Category.{v} C] where
  (L R : Type w)
  (fstTo sndTo : R → L)
  left : L → C
  right : R → C
  fst : ∀ b, left (fstTo b) ⟶ right b
  snd : ∀ b, left (sndTo b) ⟶ right b
#align category_theory.limits.multicospan_index CategoryTheory.Limits.MulticospanIndex

/-- This is a structure encapsulating the data necessary to define a `Multispan`. -/
--@[nolint has_nonempty_instance]
structure MultispanIndex (C : Type u) [Category.{v} C] where
  (L R : Type w)
  (fstFrom sndFrom : L → R)
  left : L → C
  right : R → C
  fst : ∀ a, left a ⟶ right (fstFrom a)
  snd : ∀ a, left a ⟶ right (sndFrom a)
#align category_theory.limits.multispan_index CategoryTheory.Limits.MultispanIndex

namespace MulticospanIndex

variable {C : Type u} [Category.{v} C] (I : MulticospanIndex C)

/-- The multicospan associated to `I : MulticospanIndex`. -/
def multicospan : WalkingMulticospan I.fstTo I.sndTo ⥤ C where
  obj x :=
    match x with
    | WalkingMulticospan.left a => I.left a
    | WalkingMulticospan.right b => I.right b
  map {x y} f :=
    match x, y, f with
    | _, _, WalkingMulticospan.Hom.id x => 𝟙 _
    | _, _, WalkingMulticospan.Hom.fst b => I.fst _
    | _, _, WalkingMulticospan.Hom.snd b => I.snd _
  map_id := by
    rintro (_ | _) <;> rfl
  map_comp := by
    rintro (_ | _) (_ | _) (_ | _) (_ | _ | _) (_ | _ | _) <;> aesop_cat
#align category_theory.limits.multicospan_index.multicospan CategoryTheory.Limits.MulticospanIndex.multicospan

@[simp]
theorem multicospan_obj_left (a) : I.multicospan.obj (WalkingMulticospan.left a) = I.left a :=
  rfl
#align category_theory.limits.multicospan_index.multicospan_obj_left CategoryTheory.Limits.MulticospanIndex.multicospan_obj_left

@[simp]
theorem multicospan_obj_right (b) : I.multicospan.obj (WalkingMulticospan.right b) = I.right b :=
  rfl
#align category_theory.limits.multicospan_index.multicospan_obj_right CategoryTheory.Limits.MulticospanIndex.multicospan_obj_right

@[simp]
theorem multicospan_map_fst (b) : I.multicospan.map (WalkingMulticospan.Hom.fst b) = I.fst b :=
  rfl
#align category_theory.limits.multicospan_index.multicospan_map_fst CategoryTheory.Limits.MulticospanIndex.multicospan_map_fst

@[simp]
theorem multicospan_map_snd (b) : I.multicospan.map (WalkingMulticospan.Hom.snd b) = I.snd b :=
  rfl
#align category_theory.limits.multicospan_index.multicospan_map_snd CategoryTheory.Limits.MulticospanIndex.multicospan_map_snd

variable [HasProduct I.left] [HasProduct I.right]

/-- The induced map `∏ I.left ⟶ ∏ I.right` via `I.fst`. -/
noncomputable def fstPiMap : ∏ I.left ⟶ ∏ I.right :=
  Pi.lift fun b => Pi.π I.left (I.fstTo b) ≫ I.fst b
#align category_theory.limits.multicospan_index.fst_pi_map CategoryTheory.Limits.MulticospanIndex.fstPiMap

/-- The induced map `∏ I.left ⟶ ∏ I.right` via `I.snd`. -/
noncomputable def sndPiMap : ∏ I.left ⟶ ∏ I.right :=
  Pi.lift fun b => Pi.π I.left (I.sndTo b) ≫ I.snd b
#align category_theory.limits.multicospan_index.snd_pi_map CategoryTheory.Limits.MulticospanIndex.sndPiMap

@[reassoc (attr := simp)]
theorem fstPiMap_π (b) : I.fstPiMap ≫ Pi.π I.right b = Pi.π I.left _ ≫ I.fst b := by
  simp [fstPiMap]
#align category_theory.limits.multicospan_index.fst_pi_map_π CategoryTheory.Limits.MulticospanIndex.fstPiMap_π

@[reassoc (attr := simp)]
theorem sndPiMap_π (b) : I.sndPiMap ≫ Pi.π I.right b = Pi.π I.left _ ≫ I.snd b := by
  simp [sndPiMap]
#align category_theory.limits.multicospan_index.snd_pi_map_π CategoryTheory.Limits.MulticospanIndex.sndPiMap_π

/-- Taking the multiequalizer over the multicospan index is equivalent to taking the equalizer over
the two morphsims `∏ I.left ⇉ ∏ I.right`. This is the diagram of the latter.
-/
@[simps!]
protected noncomputable def parallelPairDiagram :=
  parallelPair I.fstPiMap I.sndPiMap
#align category_theory.limits.multicospan_index.parallel_pair_diagram CategoryTheory.Limits.MulticospanIndex.parallelPairDiagram

end MulticospanIndex

namespace MultispanIndex

variable {C : Type u} [Category.{v} C] (I : MultispanIndex C)

/-- The multispan associated to `I : MultispanIndex`. -/
def multispan : WalkingMultispan I.fstFrom I.sndFrom ⥤ C where
  obj x :=
    match x with
    | WalkingMultispan.left a => I.left a
    | WalkingMultispan.right b => I.right b
  map {x y} f :=
    match x, y, f with
    | _, _, WalkingMultispan.Hom.id x => 𝟙 _
    | _, _, WalkingMultispan.Hom.fst b => I.fst _
    | _, _, WalkingMultispan.Hom.snd b => I.snd _
  map_id := by
    rintro (_ | _) <;> rfl
  map_comp := by
    rintro (_ | _) (_ | _) (_ | _) (_ | _ | _) (_ | _ | _) <;> aesop_cat
#align category_theory.limits.multispan_index.multispan CategoryTheory.Limits.MultispanIndex.multispan

@[simp]
theorem multispan_obj_left (a) : I.multispan.obj (WalkingMultispan.left a) = I.left a :=
  rfl
#align category_theory.limits.multispan_index.multispan_obj_left CategoryTheory.Limits.MultispanIndex.multispan_obj_left

@[simp]
theorem multispan_obj_right (b) : I.multispan.obj (WalkingMultispan.right b) = I.right b :=
  rfl
#align category_theory.limits.multispan_index.multispan_obj_right CategoryTheory.Limits.MultispanIndex.multispan_obj_right

@[simp]
theorem multispan_map_fst (a) : I.multispan.map (WalkingMultispan.Hom.fst a) = I.fst a :=
  rfl
#align category_theory.limits.multispan_index.multispan_map_fst CategoryTheory.Limits.MultispanIndex.multispan_map_fst

@[simp]
theorem multispan_map_snd (a) : I.multispan.map (WalkingMultispan.Hom.snd a) = I.snd a :=
  rfl
#align category_theory.limits.multispan_index.multispan_map_snd CategoryTheory.Limits.MultispanIndex.multispan_map_snd

variable [HasCoproduct I.left] [HasCoproduct I.right]

/-- The induced map `∐ I.left ⟶ ∐ I.right` via `I.fst`. -/
noncomputable def fstSigmaMap : ∐ I.left ⟶ ∐ I.right :=
  Sigma.desc fun b => I.fst b ≫ Sigma.ι _ (I.fstFrom b)
#align category_theory.limits.multispan_index.fst_sigma_map CategoryTheory.Limits.MultispanIndex.fstSigmaMap

/-- The induced map `∐ I.left ⟶ ∐ I.right` via `I.snd`. -/
noncomputable def sndSigmaMap : ∐ I.left ⟶ ∐ I.right :=
  Sigma.desc fun b => I.snd b ≫ Sigma.ι _ (I.sndFrom b)
#align category_theory.limits.multispan_index.snd_sigma_map CategoryTheory.Limits.MultispanIndex.sndSigmaMap

@[reassoc (attr := simp)]
theorem ι_fstSigmaMap (b) : Sigma.ι I.left b ≫ I.fstSigmaMap = I.fst b ≫ Sigma.ι I.right _ := by
  simp [fstSigmaMap]
#align category_theory.limits.multispan_index.ι_fst_sigma_map CategoryTheory.Limits.MultispanIndex.ι_fstSigmaMap

@[reassoc (attr := simp)]
theorem ι_sndSigmaMap (b) : Sigma.ι I.left b ≫ I.sndSigmaMap = I.snd b ≫ Sigma.ι I.right _ := by
  simp [sndSigmaMap]
#align category_theory.limits.multispan_index.ι_snd_sigma_map CategoryTheory.Limits.MultispanIndex.ι_sndSigmaMap

/--
Taking the multicoequalizer over the multispan index is equivalent to taking the coequalizer over
the two morphsims `∐ I.left ⇉ ∐ I.right`. This is the diagram of the latter.
-/
protected noncomputable abbrev parallelPairDiagram :=
  parallelPair I.fstSigmaMap I.sndSigmaMap
#align category_theory.limits.multispan_index.parallel_pair_diagram CategoryTheory.Limits.MultispanIndex.parallelPairDiagram

end MultispanIndex

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

/-- A multifork is a cone over a multicospan. -/
--@[nolint has_nonempty_instance]
abbrev Multifork (I : MulticospanIndex C) :=
  Cone I.multicospan
#align category_theory.limits.multifork CategoryTheory.Limits.Multifork

/-- A multicofork is a cocone over a multispan. -/
--@[nolint has_nonempty_instance]
abbrev Multicofork (I : MultispanIndex C) :=
  Cocone I.multispan
#align category_theory.limits.multicofork CategoryTheory.Limits.Multicofork

namespace Multifork

variable {I : MulticospanIndex C} (K : Multifork I)

/-- The maps from the cone point of a multifork to the objects on the left. -/
def ι (a : I.L) : K.pt ⟶ I.left a :=
  K.π.app (WalkingMulticospan.left _)
#align category_theory.limits.multifork.ι CategoryTheory.Limits.Multifork.ι

@[simp]
theorem app_left_eq_ι (a) : K.π.app (WalkingMulticospan.left a) = K.ι a :=
  rfl
#align category_theory.limits.multifork.app_left_eq_ι CategoryTheory.Limits.Multifork.app_left_eq_ι

@[simp]
theorem app_right_eq_ι_comp_fst (b) :
    K.π.app (WalkingMulticospan.right b) = K.ι (I.fstTo b) ≫ I.fst b := by
  rw [← K.w (WalkingMulticospan.Hom.fst b)]
  rfl
#align category_theory.limits.multifork.app_right_eq_ι_comp_fst CategoryTheory.Limits.Multifork.app_right_eq_ι_comp_fst

@[reassoc]
theorem app_right_eq_ι_comp_snd (b) :
    K.π.app (WalkingMulticospan.right b) = K.ι (I.sndTo b) ≫ I.snd b := by
  rw [← K.w (WalkingMulticospan.Hom.snd b)]
  rfl
#align category_theory.limits.multifork.app_right_eq_ι_comp_snd CategoryTheory.Limits.Multifork.app_right_eq_ι_comp_snd

@[reassoc (attr := simp)]
theorem hom_comp_ι (K₁ K₂ : Multifork I) (f : K₁ ⟶ K₂) (j : I.L) : f.Hom ≫ K₂.ι j = K₁.ι j :=
  f.w _
#align category_theory.limits.multifork.hom_comp_ι CategoryTheory.Limits.Multifork.hom_comp_ι

/-- Construct a multifork using a collection `ι` of morphisms. -/
@[simps]
def ofι (I : MulticospanIndex C) (P : C) (ι : ∀ a, P ⟶ I.left a)
    (w : ∀ b, ι (I.fstTo b) ≫ I.fst b = ι (I.sndTo b) ≫ I.snd b) : Multifork I where
  pt := P
  π :=
    { app := fun x =>
        match x with
        | WalkingMulticospan.left a => ι _
        | WalkingMulticospan.right b => ι (I.fstTo b) ≫ I.fst b
      naturality := by
        rintro (_ | _) (_ | _) (_ | _ | _) <;>
          dsimp <;>
          simp only [Category.id_comp, Category.comp_id, Functor.map_id,
            MulticospanIndex.multicospan_obj_left, MulticospanIndex.multicospan_obj_right]
        apply w }
#align category_theory.limits.multifork.of_ι CategoryTheory.Limits.Multifork.ofι

@[reassoc (attr := simp)]
theorem condition (b) : K.ι (I.fstTo b) ≫ I.fst b = K.ι (I.sndTo b) ≫ I.snd b := by
  rw [← app_right_eq_ι_comp_fst, ← app_right_eq_ι_comp_snd]
#align category_theory.limits.multifork.condition CategoryTheory.Limits.Multifork.condition

/-- This definition provides a convenient way to show that a multifork is a limit. -/
@[simps]
def IsLimit.mk (lift : ∀ E : Multifork I, E.pt ⟶ K.pt)
    (fac : ∀ (E : Multifork I) (i : I.L), lift E ≫ K.ι i = E.ι i)
    (uniq : ∀ (E : Multifork I) (m : E.pt ⟶ K.pt), (∀ i : I.L, m ≫ K.ι i = E.ι i) → m = lift E) :
    IsLimit K :=
  { lift
    fac := by
      rintro E (a | b)
      · apply fac
      · rw [← E.w (WalkingMulticospan.Hom.fst b), ← K.w (WalkingMulticospan.Hom.fst b), ←
          Category.assoc]
        congr 1
        apply fac
    uniq := by
      rintro E m hm
      apply uniq
      intro i
      apply hm }
#align category_theory.limits.multifork.is_limit.mk CategoryTheory.Limits.Multifork.IsLimit.mk

variable [HasProduct I.left] [HasProduct I.right]

@[reassoc (attr := simp)]
theorem pi_condition : Pi.lift K.ι ≫ I.fstPiMap = Pi.lift K.ι ≫ I.sndPiMap := by
  ext
  discrete_cases
  simp
#align category_theory.limits.multifork.pi_condition CategoryTheory.Limits.Multifork.pi_condition

/-- Given a multifork, we may obtain a fork over `∏ I.left ⇉ ∏ I.right`. -/
@[simps pt]
noncomputable def toPiFork (K : Multifork I) : Fork I.fstPiMap I.sndPiMap where
  pt := K.pt
  π :=
    { app := fun x =>
        match x with
        | WalkingParallelPair.zero => Pi.lift K.ι
        | WalkingParallelPair.one => Pi.lift K.ι ≫ I.fstPiMap
      naturality := by
        rintro (_ | _) (_ | _) (_ | _ | _) <;>
          dsimp <;>
          simp only [Category.id_comp, Functor.map_id, parallelPair_obj_zero, Category.comp_id,
            pi_condition, parallelPair_obj_one] }
#align category_theory.limits.multifork.to_pi_fork CategoryTheory.Limits.Multifork.toPiFork

@[simp]
theorem toPiFork_π_app_zero : K.toPiFork.ι = Pi.lift K.ι :=
  rfl
#align category_theory.limits.multifork.to_pi_fork_π_app_zero CategoryTheory.Limits.Multifork.toPiFork_π_app_zero

@[simp, nolint simpNF] -- Porting note: dsimp cannot prove this
theorem toPiFork_π_app_one : K.toPiFork.π.app WalkingParallelPair.one = Pi.lift K.ι ≫ I.fstPiMap :=
  rfl
#align category_theory.limits.multifork.to_pi_fork_π_app_one CategoryTheory.Limits.Multifork.toPiFork_π_app_one

variable (I)

/-- Given a fork over `∏ I.left ⇉ ∏ I.right`, we may obtain a multifork. -/
@[simps pt]
noncomputable def ofPiFork (c : Fork I.fstPiMap I.sndPiMap) : Multifork I where
  pt := c.pt
  π :=
    { app := fun x =>
        match x with
        | WalkingMulticospan.left a => c.ι ≫ Pi.π _ _
        | WalkingMulticospan.right b => c.ι ≫ I.fstPiMap ≫ Pi.π _ _
      naturality := by
        rintro (_ | _) (_ | _) (_ | _ | _)
        · simp
        · simp
        · dsimp ; rw [c.condition_assoc] ; simp
        · simp }
#align category_theory.limits.multifork.of_pi_fork CategoryTheory.Limits.Multifork.ofPiFork

@[simp]
theorem ofPiFork_π_app_left (c : Fork I.fstPiMap I.sndPiMap) (a) :
    (ofPiFork I c).ι a = c.ι ≫ Pi.π _ _ :=
  rfl
#align category_theory.limits.multifork.of_pi_fork_π_app_left CategoryTheory.Limits.Multifork.ofPiFork_π_app_left

@[simp, nolint simpNF] -- Porting note: dsimp cannot prove this
theorem ofPiFork_π_app_right (c : Fork I.fstPiMap I.sndPiMap) (a) :
    (ofPiFork I c).π.app (WalkingMulticospan.right a) = c.ι ≫ I.fstPiMap ≫ Pi.π _ _ :=
  rfl
#align category_theory.limits.multifork.of_pi_fork_π_app_right CategoryTheory.Limits.Multifork.ofPiFork_π_app_right

end Multifork

namespace MulticospanIndex

variable (I : MulticospanIndex C) [HasProduct I.left] [HasProduct I.right]

--attribute [local tidy] tactic.case_bash

/-- `Multifork.toPiFork` as a functor. -/
@[simps]
noncomputable def toPiForkFunctor : Multifork I ⥤ Fork I.fstPiMap I.sndPiMap where
  obj := Multifork.toPiFork
  map {K₁ K₂} f :=
    { Hom := f.Hom
      w := by
        rintro (_ | _)
        · apply limit.hom_ext
          dsimp
          simp
        · apply limit.hom_ext
          intros j
          simp only [Multifork.toPiFork_π_app_one, Multifork.pi_condition, Category.assoc]
          dsimp [sndPiMap]
          simp }
#align category_theory.limits.multicospan_index.to_pi_fork_functor CategoryTheory.Limits.MulticospanIndex.toPiForkFunctor

/-- `Multifork.ofPiFork` as a functor. -/
@[simps]
noncomputable def ofPiForkFunctor : Fork I.fstPiMap I.sndPiMap ⥤ Multifork I where
  obj := Multifork.ofPiFork I
  map {K₁ K₂} f :=
    { Hom := f.Hom
      w := by rintro (_ | _) <;> simp }
#align category_theory.limits.multicospan_index.of_pi_fork_functor CategoryTheory.Limits.MulticospanIndex.ofPiForkFunctor

/-- The category of multiforks is equivalent to the category of forks over `∏ I.left ⇉ ∏ I.right`.
It then follows from `CategoryTheory.IsLimit.ofPreservesConeTerminal` (or `reflects`) that it
preserves and reflects limit cones.
-/
@[simps]
noncomputable def multiforkEquivPiFork : Multifork I ≌ Fork I.fstPiMap I.sndPiMap where
  functor := toPiForkFunctor I
  inverse := ofPiForkFunctor I
  unitIso :=
    NatIso.ofComponents
      (fun K =>
        Cones.ext (Iso.refl _)
          (by
            rintro (_ | _) <;> dsimp <;>
              simp [← Fork.app_one_eq_ι_comp_left, -Fork.app_one_eq_ι_comp_left]))
      fun {K₁ K₂} f => by dsimp ; ext ; simp
  counitIso :=
    NatIso.ofComponents
      (fun K =>
        Fork.ext (Iso.refl _)
          (by dsimp ; ext ⟨j⟩ ; dsimp ; simp
            ))
      fun {K₁ K₂} f => by dsimp ; ext ; simp
#align category_theory.limits.multicospan_index.multifork_equiv_pi_fork CategoryTheory.Limits.MulticospanIndex.multiforkEquivPiFork

end MulticospanIndex

namespace Multicofork

variable {I : MultispanIndex C} (K : Multicofork I)

/-- The maps to the cocone point of a multicofork from the objects on the right. -/
def π (b : I.R) : I.right b ⟶ K.pt :=
  K.ι.app (WalkingMultispan.right _)
#align category_theory.limits.multicofork.π CategoryTheory.Limits.Multicofork.π

@[simp]
theorem π_eq_app_right (b) : K.ι.app (WalkingMultispan.right _) = K.π b :=
  rfl
#align category_theory.limits.multicofork.π_eq_app_right CategoryTheory.Limits.Multicofork.π_eq_app_right

@[simp]
theorem fst_app_right (a) : K.ι.app (WalkingMultispan.left a) = I.fst a ≫ K.π _ := by
  rw [← K.w (WalkingMultispan.Hom.fst a)]
  rfl
#align category_theory.limits.multicofork.fst_app_right CategoryTheory.Limits.Multicofork.fst_app_right

@[reassoc]
theorem snd_app_right (a) : K.ι.app (WalkingMultispan.left a) = I.snd a ≫ K.π _ := by
  rw [← K.w (WalkingMultispan.Hom.snd a)]
  rfl
#align category_theory.limits.multicofork.snd_app_right CategoryTheory.Limits.Multicofork.snd_app_right

@[reassoc (attr := simp)] -- Porting note: added simp lemma
lemma π_comp_hom (K₁ K₂ : Multicofork I) (f : K₁ ⟶ K₂) (b : I.R) : K₁.π b ≫ f.Hom = K₂.π b :=
  f.w _

/-- Construct a multicofork using a collection `π` of morphisms. -/
@[simps]
def ofπ (I : MultispanIndex C) (P : C) (π : ∀ b, I.right b ⟶ P)
    (w : ∀ a, I.fst a ≫ π (I.fstFrom a) = I.snd a ≫ π (I.sndFrom a)) : Multicofork I where
  pt := P
  ι :=
    { app := fun x =>
        match x with
        | WalkingMultispan.left a => I.fst a ≫ π _
        | WalkingMultispan.right b => π _
      naturality := by
        rintro (_ | _) (_ | _) (_ | _ | _) <;> dsimp <;>
          simp only [Functor.map_id, MultispanIndex.multispan_obj_left,
            Category.id_comp, Category.comp_id, MultispanIndex.multispan_obj_right]
        symm
        apply w }
#align category_theory.limits.multicofork.of_π CategoryTheory.Limits.Multicofork.ofπ

@[reassoc (attr := simp)]
theorem condition (a) : I.fst a ≫ K.π (I.fstFrom a) = I.snd a ≫ K.π (I.sndFrom a) := by
  rw [← K.snd_app_right, ← K.fst_app_right]
#align category_theory.limits.multicofork.condition CategoryTheory.Limits.Multicofork.condition

/-- This definition provides a convenient way to show that a multicofork is a colimit. -/
@[simps]
def IsColimit.mk (desc : ∀ E : Multicofork I, K.pt ⟶ E.pt)
    (fac : ∀ (E : Multicofork I) (i : I.R), K.π i ≫ desc E = E.π i)
    (uniq : ∀ (E : Multicofork I) (m : K.pt ⟶ E.pt), (∀ i : I.R, K.π i ≫ m = E.π i) → m = desc E) :
    IsColimit K :=
  { desc
    fac := by
      rintro S (a | b)
      · rw [← K.w (WalkingMultispan.Hom.fst a), ← S.w (WalkingMultispan.Hom.fst a),
          Category.assoc]
        congr 1
        apply fac
      · apply fac
    uniq := by
      intro S m hm
      apply uniq
      intro i
      apply hm }
#align category_theory.limits.multicofork.is_colimit.mk CategoryTheory.Limits.Multicofork.IsColimit.mk

variable [HasCoproduct I.left] [HasCoproduct I.right]

@[reassoc (attr := simp)]
theorem sigma_condition : I.fstSigmaMap ≫ Sigma.desc K.π = I.sndSigmaMap ≫ Sigma.desc K.π := by
  ext
  discrete_cases
  simp
#align category_theory.limits.multicofork.sigma_condition CategoryTheory.Limits.Multicofork.sigma_condition

/-- Given a multicofork, we may obtain a cofork over `∐ I.left ⇉ ∐ I.right`. -/
@[simps pt]
noncomputable def toSigmaCofork (K : Multicofork I) : Cofork I.fstSigmaMap I.sndSigmaMap where
  pt := K.pt
  ι :=
    { app := fun x =>
        match x with
        | WalkingParallelPair.zero => I.fstSigmaMap ≫ Sigma.desc K.π
        | WalkingParallelPair.one => Sigma.desc K.π
      naturality := by
        rintro (_ | _) (_ | _) (_ | _ | _) <;> dsimp <;>
          simp only [Functor.map_id, parallelPair_obj_zero,
            parallelPair_obj_one, sigma_condition, Category.id_comp, Category.comp_id] }
#align category_theory.limits.multicofork.to_sigma_cofork CategoryTheory.Limits.Multicofork.toSigmaCofork

@[simp]
theorem toSigmaCofork_π : K.toSigmaCofork.π = Sigma.desc K.π :=
  rfl
#align category_theory.limits.multicofork.to_sigma_cofork_π CategoryTheory.Limits.Multicofork.toSigmaCofork_π

variable (I)

/-- Given a cofork over `∐ I.left ⇉ ∐ I.right`, we may obtain a multicofork. -/
@[simps pt]
noncomputable def ofSigmaCofork (c : Cofork I.fstSigmaMap I.sndSigmaMap) : Multicofork I where
  pt := c.pt
  ι :=
    { app := fun x =>
        match x with
        | WalkingMultispan.left a => (Sigma.ι I.left a : _) ≫ I.fstSigmaMap ≫ c.π
        | WalkingMultispan.right b => (Sigma.ι I.right b : _) ≫ c.π
      naturality := by
        rintro (_ | _) (_ | _) (_ | _ | _) <;> dsimp
        · simp
        · simp
        · dsimp ; rw [c.condition] ; simp
        · simp }
#align category_theory.limits.multicofork.of_sigma_cofork CategoryTheory.Limits.Multicofork.ofSigmaCofork

-- Porting note: dsimp cannot prove this... once ofSigmaCofork_ι_app_right' is defined
@[simp, nolint simpNF]
theorem ofSigmaCofork_ι_app_left (c : Cofork I.fstSigmaMap I.sndSigmaMap) (a) :
    (ofSigmaCofork I c).ι.app (WalkingMultispan.left a) =
      (Sigma.ι I.left a : _) ≫ I.fstSigmaMap ≫ c.π :=
  rfl
#align category_theory.limits.multicofork.of_sigma_cofork_ι_app_left CategoryTheory.Limits.Multicofork.ofSigmaCofork_ι_app_left

-- @[simp] -- Porting note: LHS simplifies to obtain the normal form below
theorem ofSigmaCofork_ι_app_right (c : Cofork I.fstSigmaMap I.sndSigmaMap) (b) :
    (ofSigmaCofork I c).ι.app (WalkingMultispan.right b) = (Sigma.ι I.right b : _) ≫ c.π :=
  rfl
#align category_theory.limits.multicofork.of_sigma_cofork_ι_app_right CategoryTheory.Limits.Multicofork.ofSigmaCofork_ι_app_right

@[simp]
theorem ofSigmaCofork_ι_app_right' (c : Cofork I.fstSigmaMap I.sndSigmaMap) (b) :
    π (ofSigmaCofork I c) b = (Sigma.ι I.right b : _) ≫ c.π :=
  rfl

end Multicofork

namespace MultispanIndex

variable (I : MultispanIndex C) [HasCoproduct I.left] [HasCoproduct I.right]

--attribute [local tidy] tactic.case_bash

/-- `Multicofork.toSigmaCofork` as a functor. -/
@[simps]
noncomputable def toSigmaCoforkFunctor : Multicofork I ⥤ Cofork I.fstSigmaMap I.sndSigmaMap where
  obj := Multicofork.toSigmaCofork
  map {K₁ K₂} f := {
    Hom := f.Hom
    w := by
      rintro (_|_)
      all_goals {
        apply colimit.hom_ext
        rintro ⟨j⟩
        simp } }
#align category_theory.limits.multispan_index.to_sigma_cofork_functor CategoryTheory.Limits.MultispanIndex.toSigmaCoforkFunctor

/-- `Multicofork.ofSigmaCofork` as a functor. -/
@[simps]
noncomputable def ofSigmaCoforkFunctor : Cofork I.fstSigmaMap I.sndSigmaMap ⥤ Multicofork I where
  obj := Multicofork.ofSigmaCofork I
  map {K₁ K₂} f :=
    { Hom := f.Hom
      w := by --sorry --by rintro (_ | _) <;> simp
        rintro (_ | _)
        -- porting note; in mathlib3, `simp` worked. What seems to be happening is that
        -- the `simp` set is not confluent, and mathlib3 found
        -- `Multicofork.ofSigmaCofork_ι_app_left` before `Multicofork.fst_app_right`,
        -- but mathlib4 finds `Multicofork.fst_app_right` first.
        { simp [-Multicofork.fst_app_right] }
        -- porting note: similarly here, the `simp` set seems to be non-confluent
        { simp [-Multicofork.ofSigmaCofork_pt] } }

/--
The category of multicoforks is equivalent to the category of coforks over `∐ I.left ⇉ ∐ I.right`.
It then follows from `CategoryTheory.IsColimit.ofPreservesCoconeInitial` (or `reflects`) that
it preserves and reflects colimit cocones.
-/
@[simps]
noncomputable def multicoforkEquivSigmaCofork :
    Multicofork I ≌ Cofork I.fstSigmaMap I.sndSigmaMap where
  functor := toSigmaCoforkFunctor I
  inverse := ofSigmaCoforkFunctor I
  unitIso :=
    NatIso.ofComponents (fun K => Cocones.ext (Iso.refl _) (by
      rintro (_ | _)
      { dsimp; simp }
      -- porting note; `dsimp, simp` worked in mathlib3.
      { dsimp [Multicofork.ofSigmaCofork]; simp } ))
      fun {K₁ K₂} f => by
        -- porting note: in mathlib3 `ext` works and I don't
        -- really understand why it doesn't work here
        apply Limits.CoconeMorphism.ext
        simp
  counitIso :=
    NatIso.ofComponents
      (fun K =>
        Cofork.ext (Iso.refl _)
          (by
            -- porting note: in mathlib3 this was just `ext` and I don't know why it's not here
            apply Limits.colimit.hom_ext
            rintro ⟨j⟩
            dsimp
            -- porting note: the last element was `cofan.mk_ι_app` in mathlib3 but at the
            -- time of writing this was not being generated by `@[simps]` on `Cofan.mk` in lean4
            simp only [Category.comp_id, colimit.ι_desc, Cofan.mk_ι]
            rfl))
      fun {K₁ K₂} f => by
        -- porting note: in mathlib3 the next line was just `ext`
        apply Limits.CoconeMorphism.ext
        dsimp
        simp
#align category_theory.limits.multispan_index.multicofork_equiv_sigma_cofork CategoryTheory.Limits.MultispanIndex.multicoforkEquivSigmaCofork

end MultispanIndex

/-- For `I : MulticospanIndex C`, we say that it has a multiequalizer if the associated
  multicospan has a limit. -/
abbrev HasMultiequalizer (I : MulticospanIndex C) :=
  HasLimit I.multicospan
#align category_theory.limits.has_multiequalizer CategoryTheory.Limits.HasMultiequalizer

noncomputable section

/-- The multiequalizer of `I : MulticospanIndex C`. -/
abbrev multiequalizer (I : MulticospanIndex C) [HasMultiequalizer I] : C :=
  limit I.multicospan
#align category_theory.limits.multiequalizer CategoryTheory.Limits.multiequalizer

/-- For `I : MultispanIndex C`, we say that it has a multicoequalizer if
  the associated multicospan has a limit. -/
abbrev HasMulticoequalizer (I : MultispanIndex C) :=
  HasColimit I.multispan
#align category_theory.limits.has_multicoequalizer CategoryTheory.Limits.HasMulticoequalizer

/-- The multiecoqualizer of `I : MultispanIndex C`. -/
abbrev multicoequalizer (I : MultispanIndex C) [HasMulticoequalizer I] : C :=
  colimit I.multispan
#align category_theory.limits.multicoequalizer CategoryTheory.Limits.multicoequalizer

namespace Multiequalizer

variable (I : MulticospanIndex C) [HasMultiequalizer I]

/-- The canonical map from the multiequalizer to the objects on the left. -/
abbrev ι (a : I.L) : multiequalizer I ⟶ I.left a :=
  limit.π _ (WalkingMulticospan.left a)
#align category_theory.limits.multiequalizer.ι CategoryTheory.Limits.Multiequalizer.ι

/-- The multifork associated to the multiequalizer. -/
abbrev multifork : Multifork I :=
  limit.cone _
#align category_theory.limits.multiequalizer.multifork CategoryTheory.Limits.Multiequalizer.multifork

@[simp]
theorem multifork_ι (a) : (Multiequalizer.multifork I).ι a = Multiequalizer.ι I a :=
  rfl
#align category_theory.limits.multiequalizer.multifork_ι CategoryTheory.Limits.Multiequalizer.multifork_ι

@[simp]
theorem multifork_π_app_left (a) :
    (Multiequalizer.multifork I).π.app (WalkingMulticospan.left a) = Multiequalizer.ι I a :=
  rfl
#align category_theory.limits.multiequalizer.multifork_π_app_left CategoryTheory.Limits.Multiequalizer.multifork_π_app_left

@[reassoc]
theorem condition (b) :
    Multiequalizer.ι I (I.fstTo b) ≫ I.fst b = Multiequalizer.ι I (I.sndTo b) ≫ I.snd b :=
  Multifork.condition _ _
#align category_theory.limits.multiequalizer.condition CategoryTheory.Limits.Multiequalizer.condition

/-- Construct a morphism to the multiequalizer from its universal property. -/
abbrev lift (W : C) (k : ∀ a, W ⟶ I.left a)
    (h : ∀ b, k (I.fstTo b) ≫ I.fst b = k (I.sndTo b) ≫ I.snd b) : W ⟶ multiequalizer I :=
  limit.lift _ (Multifork.ofι I _ k h)
#align category_theory.limits.multiequalizer.lift CategoryTheory.Limits.Multiequalizer.lift

@[reassoc] -- Porting note: simp can prove this, removed attribute
theorem lift_ι (W : C) (k : ∀ a, W ⟶ I.left a)
    (h : ∀ b, k (I.fstTo b) ≫ I.fst b = k (I.sndTo b) ≫ I.snd b) (a) :
    Multiequalizer.lift I _ k h ≫ Multiequalizer.ι I a = k _ :=
  limit.lift_π _ _
#align category_theory.limits.multiequalizer.lift_ι CategoryTheory.Limits.Multiequalizer.lift_ι

@[ext]

variable [HasProduct I.left] [HasProduct I.right]

instance : HasEqualizer I.fstPiMap I.sndPiMap :=
  ⟨⟨⟨_, IsLimit.ofPreservesConeTerminal I.multiforkEquivPiFork.functor (limit.isLimit _)⟩⟩⟩

/-- The multiequalizer is isomorphic to the equalizer of `∏ I.left ⇉ ∏ I.right`. -/
def isoEqualizer : multiequalizer I ≅ equalizer I.fstPiMap I.sndPiMap :=
  limit.isoLimitCone
    ⟨_, IsLimit.ofPreservesConeTerminal I.multiforkEquivPiFork.inverse (limit.isLimit _)⟩
#align category_theory.limits.multiequalizer.iso_equalizer CategoryTheory.Limits.Multiequalizer.isoEqualizer

/-- The canonical injection `multiequalizer I ⟶ ∏ I.left`. -/
def ιPi : multiequalizer I ⟶ ∏ I.left :=
  (isoEqualizer I).hom ≫ equalizer.ι I.fstPiMap I.sndPiMap
#align category_theory.limits.multiequalizer.ι_pi CategoryTheory.Limits.Multiequalizer.ιPi

@[reassoc (attr := simp)]
theorem ιPi_π (a) : ιPi I ≫ Pi.π I.left a = ι I a := by
  rw [ιPi, Category.assoc, ← Iso.eq_inv_comp, isoEqualizer]
  simp
#align category_theory.limits.multiequalizer.ι_pi_π CategoryTheory.Limits.Multiequalizer.ιPi_π

instance : Mono (ιPi I) := mono_comp _ _

end Multiequalizer

namespace Multicoequalizer

variable (I : MultispanIndex C) [HasMulticoequalizer I]

/-- The canonical map from the multiequalizer to the objects on the left. -/
abbrev π (b : I.R) : I.right b ⟶ multicoequalizer I :=
  colimit.ι I.multispan (WalkingMultispan.right _)
#align category_theory.limits.multicoequalizer.π CategoryTheory.Limits.Multicoequalizer.π

/-- The multicofork associated to the multicoequalizer. -/
abbrev multicofork : Multicofork I :=
  colimit.cocone _
#align category_theory.limits.multicoequalizer.multicofork CategoryTheory.Limits.Multicoequalizer.multicofork

@[simp]
theorem multicofork_π (b) : (Multicoequalizer.multicofork I).π b = Multicoequalizer.π I b :=
  rfl
#align category_theory.limits.multicoequalizer.multicofork_π CategoryTheory.Limits.Multicoequalizer.multicofork_π

-- @[simp] -- Porting note: LHS simplifies to obtain the normal form below
theorem multicofork_ι_app_right (b) :
    (Multicoequalizer.multicofork I).ι.app (WalkingMultispan.right b) = Multicoequalizer.π I b :=
  rfl
#align category_theory.limits.multicoequalizer.multicofork_ι_app_right CategoryTheory.Limits.Multicoequalizer.multicofork_ι_app_right

@[simp]
theorem multicofork_ι_app_right' (b) :
    colimit.ι (MultispanIndex.multispan I) (WalkingMultispan.right b) = π I b :=
  rfl

@[reassoc]
theorem condition (a) :
    I.fst a ≫ Multicoequalizer.π I (I.fstFrom a) = I.snd a ≫ Multicoequalizer.π I (I.sndFrom a) :=
  Multicofork.condition _ _
#align category_theory.limits.multicoequalizer.condition CategoryTheory.Limits.Multicoequalizer.condition

/-- Construct a morphism from the multicoequalizer from its universal property. -/
abbrev desc (W : C) (k : ∀ b, I.right b ⟶ W)
    (h : ∀ a, I.fst a ≫ k (I.fstFrom a) = I.snd a ≫ k (I.sndFrom a)) : multicoequalizer I ⟶ W :=
  colimit.desc _ (Multicofork.ofπ I _ k h)
#align category_theory.limits.multicoequalizer.desc CategoryTheory.Limits.Multicoequalizer.desc

@[reassoc] -- Porting note: simp can prove this, removed attribute
theorem π_desc (W : C) (k : ∀ b, I.right b ⟶ W)
    (h : ∀ a, I.fst a ≫ k (I.fstFrom a) = I.snd a ≫ k (I.sndFrom a)) (b) :
    Multicoequalizer.π I b ≫ Multicoequalizer.desc I _ k h = k _ :=
  colimit.ι_desc _ _
#align category_theory.limits.multicoequalizer.π_desc CategoryTheory.Limits.Multicoequalizer.π_desc

@[ext]
theorem hom_ext {W : C} (i j : multicoequalizer I ⟶ W)
    (h : ∀ b, Multicoequalizer.π I b ≫ i = Multicoequalizer.π I b ≫ j) : i = j :=
  colimit.hom_ext
    (by
      rintro (a | b)
      · simp_rw [← colimit.w I.multispan (WalkingMultispan.Hom.fst a), Category.assoc, h]
      · apply h)
#align category_theory.limits.multicoequalizer.hom_ext CategoryTheory.Limits.Multicoequalizer.hom_ext

variable [HasCoproduct I.left] [HasCoproduct I.right]

instance : HasCoequalizer I.fstSigmaMap I.sndSigmaMap :=
  ⟨⟨⟨_,
      IsColimit.ofPreservesCoconeInitial
        I.multicoforkEquivSigmaCofork.functor (colimit.isColimit _)⟩⟩⟩

/-- The multicoequalizer is isomorphic to the coequalizer of `∐ I.left ⇉ ∐ I.right`. -/
def isoCoequalizer : multicoequalizer I ≅ coequalizer I.fstSigmaMap I.sndSigmaMap :=
  colimit.isoColimitCocone
    ⟨_,
      IsColimit.ofPreservesCoconeInitial I.multicoforkEquivSigmaCofork.inverse
        (colimit.isColimit _)⟩
#align category_theory.limits.multicoequalizer.iso_coequalizer CategoryTheory.Limits.Multicoequalizer.isoCoequalizer

/-- The canonical projection `∐ I.right ⟶ multicoequalizer I`. -/
def sigmaπ : ∐ I.right ⟶ multicoequalizer I :=
  coequalizer.π I.fstSigmaMap I.sndSigmaMap ≫ (isoCoequalizer I).inv
#align category_theory.limits.multicoequalizer.sigma_π CategoryTheory.Limits.Multicoequalizer.sigmaπ

@[reassoc (attr := simp)]
theorem ι_sigmaπ (b) : Sigma.ι I.right b ≫ sigmaπ I = π I b := by
  rw [sigmaπ, ← Category.assoc, Iso.comp_inv_eq, isoCoequalizer]
  simp only [MultispanIndex.multicoforkEquivSigmaCofork_inverse,
    MultispanIndex.ofSigmaCoforkFunctor_obj, colimit.isoColimitCocone_ι_hom,
    Multicofork.ofSigmaCofork_pt, colimit.cocone_x, Multicofork.π_eq_app_right]
  rfl
#align category_theory.limits.multicoequalizer.ι_sigma_π CategoryTheory.Limits.Multicoequalizer.ι_sigmaπ

instance : Epi (sigmaπ I) := epi_comp _ _

end Multicoequalizer

end

end CategoryTheory.Limits


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.submonoid.operations
import Mathlib.algebra.big_operators.basic
import Mathlib.algebra.free_monoid
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Submonoids: membership criteria

In this file we prove various facts about membership in a submonoid:

* `list_prod_mem`, `multiset_prod_mem`, `prod_mem`: if each element of a collection belongs
  to a multiplicative submonoid, then so does their product;
* `list_sum_mem`, `multiset_sum_mem`, `sum_mem`: if each element of a collection belongs
  to an additive submonoid, then so does their sum;
* `pow_mem`, `nsmul_mem`: if `x ∈ S` where `S` is a multiplicative (resp., additive) submonoid and
  `n` is a natural number, then `x^n` (resp., `n •ℕ x`) belongs to `S`;
* `mem_supr_of_directed`, `coe_supr_of_directed`, `mem_Sup_of_directed_on`,
  `coe_Sup_of_directed_on`: the supremum of a directed collection of submonoid is their union.
* `sup_eq_range`, `mem_sup`: supremum of two submonoids `S`, `T` of a commutative monoid is the set
  of products;
* `closure_singleton_eq`, `mem_closure_singleton`: the multiplicative (resp., additive) closure
  of `{x}` consists of powers (resp., natural multiples) of `x`.

## Tags
submonoid, submonoids
-/

namespace submonoid

/-- Product of a list of elements in a submonoid is in the submonoid. -/
theorem Mathlib.add_submonoid.list_sum_mem {M : Type u_1} [add_monoid M] (S : add_submonoid M) {l : List M} : (∀ (x : M), x ∈ l → x ∈ S) → list.sum l ∈ S := sorry

/-- Product of a multiset of elements in a submonoid of a `comm_monoid` is in the submonoid. -/
theorem Mathlib.add_submonoid.multiset_sum_mem {M : Type u_1} [add_comm_monoid M] (S : add_submonoid M) (m : multiset M) : (∀ (a : M), a ∈ m → a ∈ S) → multiset.sum m ∈ S := sorry

/-- Product of elements of a submonoid of a `comm_monoid` indexed by a `finset` is in the
    submonoid. -/
theorem Mathlib.add_submonoid.sum_mem {M : Type u_1} [add_comm_monoid M] (S : add_submonoid M) {ι : Type u_2} {t : finset ι} {f : ι → M} (h : ∀ (c : ι), c ∈ t → f c ∈ S) : (finset.sum t fun (c : ι) => f c) ∈ S := sorry

theorem pow_mem {M : Type u_1} [monoid M] (S : submonoid M) {x : M} (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S := sorry

theorem mem_supr_of_directed {M : Type u_1} [monoid M] {ι : Sort u_2} [hι : Nonempty ι] {S : ι → submonoid M} (hS : directed LessEq S) {x : M} : (x ∈ supr fun (i : ι) => S i) ↔ ∃ (i : ι), x ∈ S i := sorry

theorem Mathlib.add_submonoid.coe_supr_of_directed {M : Type u_1} [add_monoid M] {ι : Sort u_2} [Nonempty ι] {S : ι → add_submonoid M} (hS : directed LessEq S) : ↑(supr fun (i : ι) => S i) = set.Union fun (i : ι) => ↑(S i) := sorry

theorem Mathlib.add_submonoid.mem_Sup_of_directed_on {M : Type u_1} [add_monoid M] {S : set (add_submonoid M)} (Sne : set.nonempty S) (hS : directed_on LessEq S) {x : M} : x ∈ Sup S ↔ ∃ (s : add_submonoid M), ∃ (H : s ∈ S), x ∈ s := sorry

theorem Mathlib.add_submonoid.coe_Sup_of_directed_on {M : Type u_1} [add_monoid M] {S : set (add_submonoid M)} (Sne : set.nonempty S) (hS : directed_on LessEq S) : ↑(Sup S) = set.Union fun (s : add_submonoid M) => set.Union fun (H : s ∈ S) => ↑s := sorry

theorem mem_sup_left {M : Type u_1} [monoid M] {S : submonoid M} {T : submonoid M} {x : M} : x ∈ S → x ∈ S ⊔ T :=
  (fun (this : S ≤ S ⊔ T) => this) le_sup_left

theorem Mathlib.add_submonoid.mem_sup_right {M : Type u_1} [add_monoid M] {S : add_submonoid M} {T : add_submonoid M} {x : M} : x ∈ T → x ∈ S ⊔ T :=
  (fun (this : T ≤ S ⊔ T) => this) le_sup_right

theorem Mathlib.add_submonoid.mem_supr_of_mem {M : Type u_1} [add_monoid M] {ι : Type u_2} {S : ι → add_submonoid M} (i : ι) {x : M} : x ∈ S i → x ∈ supr S :=
  (fun (this : S i ≤ supr S) => this) (le_supr S i)

theorem mem_Sup_of_mem {M : Type u_1} [monoid M] {S : set (submonoid M)} {s : submonoid M} (hs : s ∈ S) {x : M} : x ∈ s → x ∈ Sup S :=
  (fun (this : s ≤ Sup S) => this) (le_Sup hs)

end submonoid

namespace free_monoid

theorem closure_range_of {α : Type u_3} : submonoid.closure (set.range of) = ⊤ := sorry

end free_monoid

namespace submonoid

theorem closure_singleton_eq {M : Type u_1} [monoid M] (x : M) : closure (singleton x) = monoid_hom.mrange (coe_fn (powers_hom M) x) := sorry

/-- The submonoid generated by an element of a monoid equals the set of natural number powers of
    the element. -/
theorem mem_closure_singleton {M : Type u_1} [monoid M] {x : M} {y : M} : y ∈ closure (singleton x) ↔ ∃ (n : ℕ), x ^ n = y := sorry

theorem mem_closure_singleton_self {M : Type u_1} [monoid M] {y : M} : y ∈ closure (singleton y) :=
  iff.mpr mem_closure_singleton (Exists.intro 1 (pow_one y))

theorem closure_singleton_one {M : Type u_1} [monoid M] : closure (singleton 1) = ⊥ := sorry

theorem Mathlib.add_submonoid.closure_eq_mrange {M : Type u_1} [add_monoid M] (s : set M) : add_submonoid.closure s = add_monoid_hom.mrange (coe_fn free_add_monoid.lift coe) := sorry

theorem Mathlib.add_submonoid.exists_list_of_mem_closure {M : Type u_1} [add_monoid M] {s : set M} {x : M} (hx : x ∈ add_submonoid.closure s) : ∃ (l : List M), ∃ (hl : ∀ (y : M), y ∈ l → y ∈ s), list.sum l = x := sorry

/-- The submonoid generated by an element. -/
def powers {N : Type u_3} [monoid N] (n : N) : submonoid N :=
  copy (monoid_hom.mrange (coe_fn (powers_hom N) n)) (set.range (pow n)) sorry

@[simp] theorem mem_powers {N : Type u_3} [monoid N] (n : N) : n ∈ powers n :=
  Exists.intro 1 (pow_one n)

theorem powers_eq_closure {N : Type u_3} [monoid N] (n : N) : powers n = closure (singleton n) :=
  ext fun (x : N) => iff.symm mem_closure_singleton

theorem powers_subset {N : Type u_3} [monoid N] {n : N} {P : submonoid N} (h : n ∈ P) : powers n ≤ P := sorry

end submonoid

namespace submonoid

theorem sup_eq_range {N : Type u_3} [comm_monoid N] (s : submonoid N) (t : submonoid N) : s ⊔ t = monoid_hom.mrange (monoid_hom.coprod (subtype s) (subtype t)) := sorry

theorem Mathlib.add_submonoid.mem_sup {N : Type u_3} [add_comm_monoid N] {s : add_submonoid N} {t : add_submonoid N} {x : N} : x ∈ s ⊔ t ↔ ∃ (y : N), ∃ (H : y ∈ s), ∃ (z : N), ∃ (H : z ∈ t), y + z = x := sorry

end submonoid

namespace add_submonoid

theorem nsmul_mem {A : Type u_2} [add_monoid A] (S : add_submonoid A) {x : A} (hx : x ∈ S) (n : ℕ) : n •ℕ x ∈ S := sorry

theorem closure_singleton_eq {A : Type u_2} [add_monoid A] (x : A) : closure (singleton x) = add_monoid_hom.mrange (coe_fn (multiples_hom A) x) := sorry

/-- The `add_submonoid` generated by an element of an `add_monoid` equals the set of
natural number multiples of the element. -/
theorem mem_closure_singleton {A : Type u_2} [add_monoid A] {x : A} {y : A} : y ∈ closure (singleton x) ↔ ∃ (n : ℕ), n •ℕ x = y := sorry

theorem closure_singleton_zero {A : Type u_2} [add_monoid A] : closure (singleton 0) = ⊥ := sorry

/-- The additive submonoid generated by an element. -/
def multiples {A : Type u_2} [add_monoid A] (x : A) : add_submonoid A :=
  copy (add_monoid_hom.mrange (coe_fn (multiples_hom A) x)) (set.range fun (i : ℕ) => i •ℕ x) sorry

@[simp] theorem mem_multiples {A : Type u_2} [add_monoid A] (x : A) : x ∈ multiples x :=
  Exists.intro 1 (one_nsmul x)

theorem multiples_eq_closure {A : Type u_2} [add_monoid A] (x : A) : multiples x = closure (singleton x) :=
  ext fun (x_1 : A) => iff.symm mem_closure_singleton

theorem multiples_subset {A : Type u_2} [add_monoid A] {x : A} {P : add_submonoid A} (h : x ∈ P) : multiples x ≤ P := sorry


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.algebra.big_operators.ring
import Mathlib.PostPort

universes u_1 u_4 u_2 u_3 u_5 u_6

namespace Mathlib

/-!
Results about "big operations" over a `fintype`, and consequent
results about cardinalities of certain types.

## Implementation note
This content had previously been in `data.fintype`, but was moved here to avoid
requiring `algebra.big_operators` (and hence many other imports) as a
dependency of `fintype`.
-/

namespace fintype

theorem prod_bool {α : Type u_1} [comm_monoid α] (f : Bool → α) :
    (finset.prod finset.univ fun (b : Bool) => f b) = f tt * f false :=
  sorry

theorem card_eq_sum_ones {α : Type u_1} [fintype α] :
    card α = finset.sum finset.univ fun (a : α) => 1 :=
  finset.card_eq_sum_ones finset.univ

theorem prod_extend_by_one {α : Type u_1} {ι : Type u_4} [DecidableEq ι] [fintype ι] [comm_monoid α]
    (s : finset ι) (f : ι → α) :
    (finset.prod finset.univ fun (i : ι) => ite (i ∈ s) (f i) 1) =
        finset.prod s fun (i : ι) => f i :=
  sorry

theorem sum_eq_zero {α : Type u_1} {M : Type u_4} [fintype α] [add_comm_monoid M] (f : α → M)
    (h : ∀ (a : α), f a = 0) : (finset.sum finset.univ fun (a : α) => f a) = 0 :=
  finset.sum_eq_zero fun (a : α) (ha : a ∈ finset.univ) => h a

theorem sum_congr {α : Type u_1} {M : Type u_4} [fintype α] [add_comm_monoid M] (f : α → M)
    (g : α → M) (h : ∀ (a : α), f a = g a) :
    (finset.sum finset.univ fun (a : α) => f a) = finset.sum finset.univ fun (a : α) => g a :=
  finset.sum_congr rfl fun (a : α) (ha : a ∈ finset.univ) => h a

theorem sum_eq_single {α : Type u_1} {M : Type u_4} [fintype α] [add_comm_monoid M] {f : α → M}
    (a : α) (h : ∀ (x : α), x ≠ a → f x = 0) : (finset.sum finset.univ fun (x : α) => f x) = f a :=
  finset.sum_eq_single a (fun (x : α) (_x : x ∈ finset.univ) (hx : x ≠ a) => h x hx)
    fun (ha : ¬a ∈ finset.univ) => false.elim (ha (finset.mem_univ a))

theorem sum_unique {β : Type u_2} {M : Type u_4} [add_comm_monoid M] [unique β] (f : β → M) :
    (finset.sum finset.univ fun (x : β) => f x) = f Inhabited.default :=
  sorry

/-- If a product of a `finset` of a subsingleton type has a given
value, so do the terms in that product. -/
theorem eq_of_subsingleton_of_sum_eq {M : Type u_4} [add_comm_monoid M] {ι : Type u_1}
    [subsingleton ι] {s : finset ι} {f : ι → M} {b : M} (h : (finset.sum s fun (i : ι) => f i) = b)
    (i : ι) (H : i ∈ s) : f i = b :=
  finset.eq_of_card_le_one_of_sum_eq (finset.card_le_one_of_subsingleton s) h

end fintype

theorem is_compl.prod_mul_prod {α : Type u_1} {M : Type u_4} [fintype α] [DecidableEq α]
    [comm_monoid M] {s : finset α} {t : finset α} (h : is_compl s t) (f : α → M) :
    ((finset.prod s fun (i : α) => f i) * finset.prod t fun (i : α) => f i) =
        finset.prod finset.univ fun (i : α) => f i :=
  sorry

theorem finset.prod_mul_prod_compl {α : Type u_1} {M : Type u_4} [fintype α] [DecidableEq α]
    [comm_monoid M] (s : finset α) (f : α → M) :
    ((finset.prod s fun (i : α) => f i) * finset.prod (sᶜ) fun (i : α) => f i) =
        finset.prod finset.univ fun (i : α) => f i :=
  is_compl.prod_mul_prod is_compl_compl f

theorem finset.sum_compl_add_sum {α : Type u_1} {M : Type u_4} [fintype α] [DecidableEq α]
    [add_comm_monoid M] (s : finset α) (f : α → M) :
    ((finset.sum (sᶜ) fun (i : α) => f i) + finset.sum s fun (i : α) => f i) =
        finset.sum finset.univ fun (i : α) => f i :=
  is_compl.sum_add_sum (is_compl.symm is_compl_compl) f

theorem fin.prod_univ_def {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin n → β) :
    (finset.prod finset.univ fun (i : fin n) => f i) = list.prod (list.map f (list.fin_range n)) :=
  sorry

theorem fin.sum_of_fn {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin n → β) :
    list.sum (list.of_fn f) = finset.sum finset.univ fun (i : fin n) => f i :=
  sorry

/-- A product of a function `f : fin 0 → β` is `1` because `fin 0` is empty -/
@[simp] theorem fin.prod_univ_zero {β : Type u_2} [comm_monoid β] (f : fin 0 → β) :
    (finset.prod finset.univ fun (i : fin 0) => f i) = 1 :=
  rfl

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f x`, for some `x : fin (n + 1)` times the remaining product -/
theorem fin.prod_univ_succ_above {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β)
    (x : fin (n + 1)) :
    (finset.prod finset.univ fun (i : fin (n + 1)) => f i) =
        f x * finset.prod finset.univ fun (i : fin n) => f (coe_fn (fin.succ_above x) i) :=
  sorry

/-- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f x`, for some `x : fin (n + 1)` plus the remaining product -/
theorem fin.sum_univ_succ_above {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin (n + 1) → β)
    (x : fin (n + 1)) :
    (finset.sum finset.univ fun (i : fin (n + 1)) => f i) =
        f x + finset.sum finset.univ fun (i : fin n) => f (coe_fn (fin.succ_above x) i) :=
  fin.prod_univ_succ_above (fun (i : fin (n + 1)) => f i) x

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f 0` plus the remaining product -/
theorem fin.prod_univ_succ {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) :
    (finset.prod finset.univ fun (i : fin (n + 1)) => f i) =
        f 0 * finset.prod finset.univ fun (i : fin n) => f (fin.succ i) :=
  fin.prod_univ_succ_above f 0

/-- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f 0` plus the remaining product -/
theorem fin.sum_univ_succ {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) :
    (finset.sum finset.univ fun (i : fin (n + 1)) => f i) =
        f 0 + finset.sum finset.univ fun (i : fin n) => f (fin.succ i) :=
  fin.sum_univ_succ_above f 0

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f (fin.last n)` plus the remaining product -/
theorem fin.prod_univ_cast_succ {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) :
    (finset.prod finset.univ fun (i : fin (n + 1)) => f i) =
        (finset.prod finset.univ fun (i : fin n) => f (coe_fn fin.cast_succ i)) * f (fin.last n) :=
  sorry

/-- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f (fin.last n)` plus the remaining sum -/
theorem fin.sum_univ_cast_succ {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) :
    (finset.sum finset.univ fun (i : fin (n + 1)) => f i) =
        (finset.sum finset.univ fun (i : fin n) => f (coe_fn fin.cast_succ i)) + f (fin.last n) :=
  fin.prod_univ_cast_succ fun (i : fin (n + 1)) => f i

@[simp] theorem fintype.card_sigma {α : Type u_1} (β : α → Type u_2) [fintype α]
    [(a : α) → fintype (β a)] :
    fintype.card (sigma β) = finset.sum finset.univ fun (a : α) => fintype.card (β a) :=
  finset.card_sigma finset.univ fun (a : α) => (fun (_x : α) => finset.univ) a

-- FIXME ouch, this should be in the main file.

@[simp] theorem fintype.card_sum (α : Type u_1) (β : Type u_2) [fintype α] [fintype β] :
    fintype.card (α ⊕ β) = fintype.card α + fintype.card β :=
  sorry

@[simp] theorem finset.card_pi {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} (s : finset α)
    (t : (a : α) → finset (δ a)) :
    finset.card (finset.pi s t) = finset.prod s fun (a : α) => finset.card (t a) :=
  multiset.card_pi (finset.val s) fun (a : α) => (fun (a : α) => finset.val (t a)) a

@[simp] theorem fintype.card_pi_finset {α : Type u_1} [DecidableEq α] [fintype α] {δ : α → Type u_2}
    (t : (a : α) → finset (δ a)) :
    finset.card (fintype.pi_finset t) = finset.prod finset.univ fun (a : α) => finset.card (t a) :=
  sorry

@[simp] theorem fintype.card_pi {α : Type u_1} {β : α → Type u_2} [DecidableEq α] [fintype α]
    [f : (a : α) → fintype (β a)] :
    fintype.card ((a : α) → β a) = finset.prod finset.univ fun (a : α) => fintype.card (β a) :=
  fintype.card_pi_finset fun (_x : α) => finset.univ

-- FIXME ouch, this should be in the main file.

@[simp] theorem fintype.card_fun {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype α]
    [fintype β] : fintype.card (α → β) = fintype.card β ^ fintype.card α :=
  sorry

@[simp] theorem card_vector {α : Type u_1} [fintype α] (n : ℕ) :
    fintype.card (vector α n) = fintype.card α ^ n :=
  sorry

@[simp] theorem finset.prod_attach_univ {α : Type u_1} {β : Type u_2} [fintype α] [comm_monoid β]
    (f : (Subtype fun (a : α) => a ∈ finset.univ) → β) :
    (finset.prod (finset.attach finset.univ)
          fun (x : Subtype fun (a : α) => a ∈ finset.univ) => f x) =
        finset.prod finset.univ fun (x : α) => f { val := x, property := finset.mem_univ x } :=
  sorry

/-- Taking a product over `univ.pi t` is the same as taking the product over `fintype.pi_finset t`.
  `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`, but differ
  in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and
  `fintype.pi_finset t` is a `finset (Π a, t a)`. -/
theorem finset.prod_univ_pi {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype α]
    [comm_monoid β] {δ : α → Type u_3} {t : (a : α) → finset (δ a)}
    (f : ((a : α) → a ∈ finset.univ → δ a) → β) :
    (finset.prod (finset.pi finset.univ t) fun (x : (a : α) → a ∈ finset.univ → δ a) => f x) =
        finset.prod (fintype.pi_finset t)
          fun (x : (a : α) → δ a) => f fun (a : α) (_x : a ∈ finset.univ) => x a :=
  sorry

/-- The product over `univ` of a sum can be written as a sum over the product of sets,
  `fintype.pi_finset`. `finset.prod_sum` is an alternative statement when the product is not
  over `univ` -/
theorem finset.prod_univ_sum {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype α]
    [comm_semiring β] {δ : α → Type u_1} [(a : α) → DecidableEq (δ a)] {t : (a : α) → finset (δ a)}
    {f : (a : α) → δ a → β} :
    (finset.prod finset.univ fun (a : α) => finset.sum (t a) fun (b : δ a) => f a b) =
        finset.sum (fintype.pi_finset t)
          fun (p : (a : α) → δ a) => finset.prod finset.univ fun (x : α) => f x (p x) :=
  sorry

/-- Summing `a^s.card * b^(n-s.card)` over all finite subsets `s` of a fintype of cardinality `n`
gives `(a + b)^n`. The "good" proof involves expanding along all coordinates using the fact that
`x^n` is multilinear, but multilinear maps are only available now over rings, so we give instead
a proof reducing to the usual binomial theorem to have a result over semirings. -/
theorem fintype.sum_pow_mul_eq_add_pow (α : Type u_1) [fintype α] {R : Type u_2} [comm_semiring R]
    (a : R) (b : R) :
    (finset.sum finset.univ
          fun (s : finset α) => a ^ finset.card s * b ^ (fintype.card α - finset.card s)) =
        (a + b) ^ fintype.card α :=
  finset.sum_pow_mul_eq_add_pow a b finset.univ

theorem fin.sum_pow_mul_eq_add_pow {n : ℕ} {R : Type u_1} [comm_semiring R] (a : R) (b : R) :
    (finset.sum finset.univ
          fun (s : finset (fin n)) => a ^ finset.card s * b ^ (n - finset.card s)) =
        (a + b) ^ n :=
  sorry

theorem function.bijective.sum_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [fintype α]
    [fintype β] [add_comm_monoid γ] {f : α → β} (hf : function.bijective f) (g : β → γ) :
    (finset.sum finset.univ fun (i : α) => g (f i)) = finset.sum finset.univ fun (i : β) => g i :=
  sorry

theorem equiv.sum_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [fintype α] [fintype β]
    [add_comm_monoid γ] (e : α ≃ β) (f : β → γ) :
    (finset.sum finset.univ fun (i : α) => f (coe_fn e i)) =
        finset.sum finset.univ fun (i : β) => f i :=
  function.bijective.sum_comp (equiv.bijective e) f

/-- It is equivalent to sum a function over `fin n` or `finset.range n`. -/
theorem fin.sum_univ_eq_sum_range {α : Type u_1} [add_comm_monoid α] (f : ℕ → α) (n : ℕ) :
    (finset.sum finset.univ fun (i : fin n) => f ↑i) =
        finset.sum (finset.range n) fun (i : ℕ) => f i :=
  sorry

theorem finset.prod_fin_eq_prod_range {β : Type u_2} [comm_monoid β] {n : ℕ} (c : fin n → β) :
    (finset.prod finset.univ fun (i : fin n) => c i) =
        finset.prod (finset.range n)
          fun (i : ℕ) =>
            dite (i < n) (fun (h : i < n) => c { val := i, property := h }) fun (h : ¬i < n) => 1 :=
  sorry

theorem finset.prod_subtype {α : Type u_1} {M : Type u_2} [comm_monoid M] {p : α → Prop}
    {F : fintype (Subtype p)} (s : finset α) (h : ∀ (x : α), x ∈ s ↔ p x) (f : α → M) :
    (finset.prod s fun (a : α) => f a) = finset.prod finset.univ fun (a : Subtype p) => f ↑a :=
  sorry

theorem finset.sum_to_finset_eq_subtype {α : Type u_1} {M : Type u_2} [add_comm_monoid M]
    [fintype α] (p : α → Prop) [decidable_pred p] (f : α → M) :
    (finset.sum (set.to_finset (set_of fun (x : α) => p x)) fun (a : α) => f a) =
        finset.sum finset.univ fun (a : Subtype p) => f ↑a :=
  sorry

theorem finset.prod_fiberwise {α : Type u_1} {β : Type u_2} {γ : Type u_3} [DecidableEq β]
    [fintype β] [comm_monoid γ] (s : finset α) (f : α → β) (g : α → γ) :
    (finset.prod finset.univ
          fun (b : β) =>
            finset.prod (finset.filter (fun (a : α) => f a = b) s) fun (a : α) => g a) =
        finset.prod s fun (a : α) => g a :=
  finset.prod_fiberwise_of_maps_to (fun (x : α) (_x : x ∈ s) => finset.mem_univ (f x))
    fun (a : α) => g a

theorem fintype.prod_fiberwise {α : Type u_1} {β : Type u_2} {γ : Type u_3} [fintype α]
    [DecidableEq β] [fintype β] [comm_monoid γ] (f : α → β) (g : α → γ) :
    (finset.prod finset.univ
          fun (b : β) => finset.prod finset.univ fun (a : Subtype fun (a : α) => f a = b) => g ↑a) =
        finset.prod finset.univ fun (a : α) => g a :=
  sorry

theorem fintype.prod_dite {α : Type u_1} {β : Type u_2} [fintype α] {p : α → Prop}
    [decidable_pred p] [comm_monoid β] (f : (a : α) → p a → β) (g : (a : α) → ¬p a → β) :
    (finset.prod finset.univ fun (a : α) => dite (p a) (f a) (g a)) =
        (finset.prod finset.univ
            fun (a : Subtype fun (a : α) => p a) => f (↑a) (subtype.property a)) *
          finset.prod finset.univ
            fun (a : Subtype fun (a : α) => ¬p a) => g (↑a) (subtype.property a) :=
  sorry

theorem fintype.sum_sum_elim {α₁ : Type u_4} {α₂ : Type u_5} {M : Type u_6} [fintype α₁]
    [fintype α₂] [add_comm_monoid M] (f : α₁ → M) (g : α₂ → M) :
    (finset.sum finset.univ fun (x : α₁ ⊕ α₂) => sum.elim f g x) =
        (finset.sum finset.univ fun (a₁ : α₁) => f a₁) +
          finset.sum finset.univ fun (a₂ : α₂) => g a₂ :=
  sorry

theorem fintype.prod_sum_type {α₁ : Type u_4} {α₂ : Type u_5} {M : Type u_6} [fintype α₁]
    [fintype α₂] [comm_monoid M] (f : α₁ ⊕ α₂ → M) :
    (finset.prod finset.univ fun (x : α₁ ⊕ α₂) => f x) =
        (finset.prod finset.univ fun (a₁ : α₁) => f (sum.inl a₁)) *
          finset.prod finset.univ fun (a₂ : α₂) => f (sum.inr a₂) :=
  sorry

namespace list

theorem prod_take_of_fn {α : Type u_1} [comm_monoid α] {n : ℕ} (f : fin n → α) (i : ℕ) :
    prod (take i (of_fn f)) =
        finset.prod (finset.filter (fun (j : fin n) => subtype.val j < i) finset.univ)
          fun (j : fin n) => f j :=
  sorry

-- `to_additive` does not work on `prod_take_of_fn` because of `0 : ℕ` in the proof.

-- Use `multiplicative` instead.

theorem sum_take_of_fn {α : Type u_1} [add_comm_monoid α] {n : ℕ} (f : fin n → α) (i : ℕ) :
    sum (take i (of_fn f)) =
        finset.sum (finset.filter (fun (j : fin n) => subtype.val j < i) finset.univ)
          fun (j : fin n) => f j :=
  prod_take_of_fn f i

theorem prod_of_fn {α : Type u_1} [comm_monoid α] {n : ℕ} {f : fin n → α} :
    prod (of_fn f) = finset.prod finset.univ fun (i : fin n) => f i :=
  sorry

theorem alternating_sum_eq_finset_sum {G : Type u_1} [add_comm_group G] (L : List G) :
    alternating_sum L =
        finset.sum finset.univ
          fun (i : fin (length L)) => (-1) ^ ↑i •ℤ nth_le L (↑i) (fin.is_lt i) :=
  sorry

theorem alternating_prod_eq_finset_prod {G : Type u_1} [comm_group G] (L : List G) :
    alternating_prod L =
        finset.prod finset.univ
          fun (i : fin (length L)) => nth_le L (↑i) (subtype.property i) ^ (-1) ^ ↑i :=
  sorry

end Mathlib


/-
Copyright (c) 2022 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Patrick Massot
-/

import topology.separation

/-!
# The topological support of a function

In this file we define the topological support of a function `f`, `tsupport f`,
as the closure of the support of `f`.

Furthermore, we say that `f` has compact support if the topological support of `f` is compact.

## Main definitions

* `function.mul_tsupport` & `function.tsupport`
* `function.has_compact_mul_support` & `function.has_compact_support`

## Implementation Notes

* We write all lemmas for multiplicative functions, and use `@[to_additive]` to get the more common
  additive versions.
* We do not put the definitions in the `function` namespace, following many other topological
  definitions that are in the root namespace (compare `embedding` vs `function.embedding`).
-/

open function set filter
open_locale topological_space

variables {X α α' β γ δ M E R : Type*}

section one
variables [has_one α]
variables [topological_space X]

/-- The topological support of a function is the closure of its support, i.e. the closure of the
  set of all elements where the function is not equal to 1. -/
@[to_additive
/-" The topological support of a function is the closure of its support. i.e. the closure of the
  set of all elements where the function is nonzero. "-/]
def mul_tsupport (f : X → α) : set X := closure (mul_support f)

@[to_additive]
lemma subset_mul_tsupport (f : X → α) : mul_support f ⊆ mul_tsupport f :=
subset_closure

@[to_additive]
lemma is_closed_mul_tsupport (f : X → α) : is_closed (mul_tsupport f) :=
is_closed_closure

@[to_additive]
lemma mul_tsupport_eq_empty_iff {f : X → α} : mul_tsupport f = ∅ ↔ f = 1 :=
by rw [mul_tsupport, closure_empty_iff, mul_support_eq_empty_iff]

@[to_additive]
lemma image_eq_zero_of_nmem_mul_tsupport {f : X → α} {x : X} (hx : x ∉ mul_tsupport f) : f x = 1 :=
mul_support_subset_iff'.mp (subset_mul_tsupport f) x hx

@[to_additive]
lemma range_subset_insert_image_mul_tsupport (f : X → α) :
  range f ⊆ insert 1 (f '' mul_tsupport f) :=
(range_subset_insert_image_mul_support f).trans $
  insert_subset_insert $ image_subset _ subset_closure

@[to_additive]
lemma range_eq_image_mul_tsupport_or (f : X → α) :
  range f = f '' mul_tsupport f ∨ range f = insert 1 (f '' mul_tsupport f) :=
(wcovby_insert _ _).eq_or_eq (image_subset_range _ _) (range_subset_insert_image_mul_tsupport f)

end one

section

variables [topological_space α] [topological_space α']
variables [has_one β] [has_one γ] [has_one δ]
variables {g : β → γ} {f : α → β} {f₂ : α → γ} {m : β → γ → δ} {x : α}

@[to_additive]
lemma not_mem_closure_mul_support_iff_eventually_eq : x ∉ mul_tsupport f ↔ f =ᶠ[𝓝 x] 1 :=
by simp_rw [mul_tsupport, mem_closure_iff_nhds, not_forall, not_nonempty_iff_eq_empty,
    ← disjoint_iff_inter_eq_empty, disjoint_mul_support_iff, eventually_eq_iff_exists_mem]

/-- A function `f` *has compact multiplicative support* or is *compactly supported* if the closure
of the multiplicative support of `f` is compact. In a T₂ space this is equivalent to `f` being equal
to `1` outside a compact set. -/
@[to_additive
/-" A function `f` *has compact support* or is *compactly supported* if the closure of the support
of `f` is compact. In a T₂ space this is equivalent to `f` being equal to `0` outside a compact
set. "-/]
def has_compact_mul_support (f : α → β) : Prop :=
is_compact (mul_tsupport f)

@[to_additive]
lemma has_compact_mul_support_def :
  has_compact_mul_support f ↔ is_compact (closure (mul_support f)) :=
by refl

@[to_additive]
lemma exists_compact_iff_has_compact_mul_support [t2_space α] :
  (∃ K : set α, is_compact K ∧ ∀ x ∉ K, f x = 1) ↔ has_compact_mul_support f :=
by simp_rw [← nmem_mul_support, ← mem_compl_iff, ← subset_def, compl_subset_compl,
    has_compact_mul_support_def, exists_compact_superset_iff]

@[to_additive]
lemma has_compact_mul_support.intro [t2_space α] {K : set α}
  (hK : is_compact K) (hfK : ∀ x ∉ K, f x = 1) : has_compact_mul_support f :=
exists_compact_iff_has_compact_mul_support.mp ⟨K, hK, hfK⟩

@[to_additive]
lemma has_compact_mul_support.is_compact (hf : has_compact_mul_support f) :
  is_compact (mul_tsupport f) :=
hf

@[to_additive]
lemma has_compact_mul_support_iff_eventually_eq :
  has_compact_mul_support f ↔ f =ᶠ[coclosed_compact α] 1 :=
⟨ λ h, mem_coclosed_compact.mpr ⟨mul_tsupport f, is_closed_mul_tsupport _, h,
    λ x, not_imp_comm.mpr $ λ hx, subset_mul_tsupport f hx⟩,
  λ h, let ⟨C, hC⟩ := mem_coclosed_compact'.mp h in
    compact_of_is_closed_subset hC.2.1 (is_closed_mul_tsupport _) (closure_minimal hC.2.2 hC.1)⟩

@[to_additive]
lemma has_compact_mul_support.is_compact_range [topological_space β]
  (h : has_compact_mul_support f) (hf : continuous f) : is_compact (range f) :=
begin
  cases range_eq_image_mul_tsupport_or f with h2 h2; rw [h2],
  exacts [h.image hf, (h.image hf).insert 1]
end

@[to_additive]
lemma has_compact_mul_support.mono' {f' : α → γ} (hf : has_compact_mul_support f)
  (hff' : mul_support f' ⊆ mul_tsupport f) : has_compact_mul_support f' :=
compact_of_is_closed_subset hf is_closed_closure $ closure_minimal hff' is_closed_closure

@[to_additive]
lemma has_compact_mul_support.mono {f' : α → γ} (hf : has_compact_mul_support f)
  (hff' : mul_support f' ⊆ mul_support f) : has_compact_mul_support f' :=
hf.mono' $ hff'.trans subset_closure

@[to_additive]
lemma has_compact_mul_support.comp_left (hf : has_compact_mul_support f) (hg : g 1 = 1) :
  has_compact_mul_support (g ∘ f) :=
hf.mono $ mul_support_comp_subset hg f

@[to_additive]
lemma has_compact_mul_support_comp_left (hg : ∀ {x}, g x = 1 ↔ x = 1) :
  has_compact_mul_support (g ∘ f) ↔ has_compact_mul_support f :=
by simp_rw [has_compact_mul_support_def, mul_support_comp_eq g @hg f]

@[to_additive]
lemma has_compact_mul_support.comp_closed_embedding (hf : has_compact_mul_support f)
  {g : α' → α} (hg : closed_embedding g) : has_compact_mul_support (f ∘ g) :=
begin
  rw [has_compact_mul_support_def, function.mul_support_comp_eq_preimage],
  refine compact_of_is_closed_subset (hg.is_compact_preimage hf) is_closed_closure _,
  rw [hg.to_embedding.closure_eq_preimage_closure_image],
  exact preimage_mono (closure_mono $ image_preimage_subset _ _)
end

@[to_additive]
lemma has_compact_mul_support.comp₂_left (hf : has_compact_mul_support f)
  (hf₂ : has_compact_mul_support f₂) (hm : m 1 1 = 1) :
  has_compact_mul_support (λ x, m (f x) (f₂ x)) :=
begin
  rw [has_compact_mul_support_iff_eventually_eq] at hf hf₂ ⊢,
  filter_upwards [hf, hf₂] using λ x hx hx₂, by simp_rw [hx, hx₂, pi.one_apply, hm]
end

end

section monoid

variables [topological_space α] [monoid β]
variables {f f' : α → β} {x : α}

@[to_additive]
lemma has_compact_mul_support.mul (hf : has_compact_mul_support f)
  (hf' : has_compact_mul_support f') : has_compact_mul_support (f * f') :=
by apply hf.comp₂_left hf' (mul_one 1) -- `by apply` speeds up elaboration

end monoid

section distrib_mul_action

variables [topological_space α] [monoid_with_zero R] [add_monoid M] [distrib_mul_action R M]
variables {f : α → R} {f' : α → M} {x : α}

lemma has_compact_support.smul_left (hf : has_compact_support f') : has_compact_support (f • f') :=
begin
  rw [has_compact_support_iff_eventually_eq] at hf ⊢,
  refine hf.mono (λ x hx, by simp_rw [pi.smul_apply', hx, pi.zero_apply, smul_zero])
end

end distrib_mul_action

section smul_with_zero

variables [topological_space α] [has_zero R] [has_zero M] [smul_with_zero R M]
variables {f : α → R} {f' : α → M} {x : α}

lemma has_compact_support.smul_right (hf : has_compact_support f) : has_compact_support (f • f') :=
begin
  rw [has_compact_support_iff_eventually_eq] at hf ⊢,
  refine hf.mono (λ x hx, by simp_rw [pi.smul_apply', hx, pi.zero_apply, zero_smul])
end

lemma has_compact_support.smul_left' (hf : has_compact_support f') : has_compact_support (f • f') :=
begin
  rw [has_compact_support_iff_eventually_eq] at hf ⊢,
  refine hf.mono (λ x hx, by simp_rw [pi.smul_apply', hx, pi.zero_apply, smul_zero'])
end

end smul_with_zero

section mul_zero_class

variables [topological_space α] [mul_zero_class β]
variables {f f' : α → β} {x : α}

lemma has_compact_support.mul_right (hf : has_compact_support f) : has_compact_support (f * f') :=
begin
  rw [has_compact_support_iff_eventually_eq] at hf ⊢,
  refine hf.mono (λ x hx, by simp_rw [pi.mul_apply, hx, pi.zero_apply, zero_mul])
end

lemma has_compact_support.mul_left (hf : has_compact_support f') : has_compact_support (f * f') :=
begin
  rw [has_compact_support_iff_eventually_eq] at hf ⊢,
  refine hf.mono (λ x hx, by simp_rw [pi.mul_apply, hx, pi.zero_apply, mul_zero])
end

end mul_zero_class

namespace locally_finite

variables {ι : Type*} {U : ι → set X} [topological_space X] [has_one R]

/-- If a family of functions `f` has locally-finite multiplicative support, subordinate to a family
of open sets, then for any point we can find a neighbourhood on which only finitely-many members of
`f` are not equal to 1. -/
@[to_additive
/-" If a family of functions `f` has locally-finite support, subordinate to a family of open sets,
then for any point we can find a neighbourhood on which only finitely-many members of `f` are
non-zero. "-/]
lemma exists_finset_nhd_mul_support_subset
  {f : ι → X → R} (hlf : locally_finite (λ i, mul_support (f i)))
  (hso : ∀ i, mul_tsupport (f i) ⊆ U i) (ho : ∀ i, is_open (U i)) (x : X) :
  ∃ (is : finset ι) {n : set X} (hn₁ : n ∈ 𝓝 x) (hn₂ : n ⊆ ⋂ i ∈ is, U i), ∀ (z ∈ n),
    mul_support (λ i, f i z) ⊆ is :=
begin
  obtain ⟨n, hn, hnf⟩ := hlf x,
  classical,
  let is := hnf.to_finset.filter (λ i, x ∈ U i),
  let js := hnf.to_finset.filter (λ j, x ∉ U j),
  refine ⟨is, n ∩ (⋂ j ∈ js, (mul_tsupport (f j))ᶜ) ∩ (⋂ i ∈ is, U i),
    inter_mem (inter_mem hn _) _, inter_subset_right _ _, λ z hz, _⟩,
  { exact (bInter_finset_mem js).mpr (λ j hj, is_closed.compl_mem_nhds
      (is_closed_mul_tsupport _) (set.not_mem_subset (hso j) (finset.mem_filter.mp hj).2)), },
  { exact (bInter_finset_mem is).mpr (λ i hi, (ho i).mem_nhds (finset.mem_filter.mp hi).2) },
  { have hzn : z ∈ n,
    { rw inter_assoc at hz,
      exact mem_of_mem_inter_left hz, },
    replace hz := mem_of_mem_inter_right (mem_of_mem_inter_left hz),
    simp only [finset.mem_filter, finite.mem_to_finset, mem_set_of_eq, mem_Inter, and_imp] at hz,
    suffices : mul_support (λ i, f i z) ⊆ hnf.to_finset,
    { refine hnf.to_finset.subset_coe_filter_of_subset_forall _ this (λ i hi, _),
      specialize hz i ⟨z, ⟨hi, hzn⟩⟩,
      contrapose hz,
      simp [hz, subset_mul_tsupport (f i) hi], },
    intros i hi,
    simp only [finite.coe_to_finset, mem_set_of_eq],
    exact ⟨z, ⟨hi, hzn⟩⟩, },
end

end locally_finite


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import order.filter.basic
import data.real.basic
import topology.basic
import topology.instances.real
import data.complex.exponential
import topology.algebra.infinite_sum
import data.nat.basic
import analysis.specific_limits
import analysis.calculus.deriv
import analysis.asymptotics
import formal_ml.nat
import formal_ml.core

lemma abs_eq_norm {a:ℝ}:abs a = ∥a∥ := rfl

---Results about the reals--------------------------------------------------------------------------

--Unused (except in classical_limit.lean)
lemma inv_pow_cancel2 (x:ℝ) (n:ℕ):(x≠ 0) → (x⁻¹)^n * (x)^n = 1 :=
begin
  intro A1,
  rw ← mul_pow,
  rw inv_mul_cancel,
  simp,
  apply A1,
end

lemma real_nat_abs_coe {n:ℕ}:abs (n:ℝ)= (n:ℝ) :=
begin
  have A1:abs (n:ℝ) =((abs n):ℝ) := rfl,
  rw A1,
  simp,
end

lemma abs_pos_of_nonzero {x:ℝ}:x ≠ 0 → 0 < abs x :=
begin
  intro A1,
  have A2:x < 0 ∨ x = 0 ∨ 0 < x := lt_trichotomy x 0,
  cases A2,
  {
    apply abs_pos_of_neg A2,
  },
  cases A2,
  {
    exfalso,
    apply A1,
    apply A2,
  },
  {
    apply abs_pos_of_pos A2,
  }
end

lemma pow_two_pos (n:ℕ):0 < (2:ℝ)^n :=
begin
  apply pow_pos,
  apply zero_lt_two,
end

lemma pow_nonneg_of_nonneg {x:ℝ} {k:ℕ}:0 ≤ x → 0 ≤ x^k :=
begin
  intro A1,
  induction k,
  {
    simp,
    apply le_of_lt,
    apply zero_lt_one,
  },
  {
    rw pow_succ,
    apply mul_nonneg,
    apply A1,
    apply k_ih,
  }
end

lemma real_pow_mono {x y:real} {k:ℕ}:
  0 ≤ x →
x ≤ y → x^k ≤ y^k :=
begin
  intros A0 A1,
  induction k,
  {
    simp,
  },
  {
    rw pow_succ,
    rw pow_succ,
    apply mul_le_mul,
    {
      exact A1,
    },
    {
      apply k_ih,
    },
    {
      simp,
      apply pow_nonneg_of_nonneg,
      apply A0,
    },
    {
      simp,
      apply le_trans,
      apply A0,
      apply A1,
    },
  }
end

lemma div_inv (x:ℝ):1/x = x⁻¹ :=
begin
  simp,
end

lemma inv_exp (n:ℕ):((2:ℝ)^n)⁻¹  = ((2:ℝ)⁻¹)^n :=
begin
  induction n,
  {
    simp,
  },
  {
    have A1:nat.succ n_n = 1 + n_n,
    {
      apply nat_succ_one_add,
    },
    rw A1,
    rw pow_add,
    rw pow_add,
    simp,
    rw mul_inv',
  }
end

lemma abs_mul_eq_mul_abs (a b:ℝ):(0 ≤ a) → abs (a * b) = a * abs (b) :=
begin
  intro A1,
  rw abs_mul,
  rw abs_of_nonneg,
  apply A1,
end

lemma pos_of_pos_of_mul_pos {a b:ℝ}:(0 ≤ a) → (0 < a * b) → 0 < b :=
begin
  intros A1 A2,
  have A3:0 < b ∨ (b ≤ 0),
  {
    apply lt_or_ge,
  },
  cases A3,
  {
    apply A3,
  },
  {
    exfalso,
    have A3A:(a * b)≤ 0,
    {
      apply mul_nonpos_of_nonneg_of_nonpos,
      apply A1,
      apply A3,
    },
    apply not_lt_of_le A3A,
    apply A2,
  }
end

lemma inv_pos_of_pos {a:ℝ}:(0 < a) → 0 < (a⁻¹) :=
begin
  intro A1,
  apply pos_of_pos_of_mul_pos,
  apply le_of_lt,
  apply A1,
  rw mul_inv_cancel,
  apply zero_lt_one,
  intro A2,
  rw A2 at A1,
  apply lt_irrefl _ A1,
end

lemma inv_lt_one_of_one_lt {a:ℝ}:(1 < a) → (a⁻¹)< 1 :=
begin
  intro A1,
  have A2:0 < a,
  {
    apply lt_trans,
    apply zero_lt_one,
    apply A1,
  },
  have A3:0 < a⁻¹,
  {
    apply inv_pos_of_pos A2,
  },
  have A4:a⁻¹ * 1 < a⁻¹ * a,
  {
    apply mul_lt_mul_of_pos_left,
    apply A1,
    apply A3,
  },
  rw inv_mul_cancel at A4,
  rw mul_one at A4,
  apply A4,
  {
    intro A5,
    rw A5 at A2,
    apply lt_irrefl _ A2,
  }
end

lemma div_def {a b:ℝ}:a/b = a * b⁻¹ := rfl

--Raise to a linear ordered field (or a linear ordered division ring?).
--Unused.
lemma div_lt_div_of_lt_of_lt {a b c:ℝ}:(0<c) → (a < b) → (a/c < b/c) :=
begin
  intros A1 A2,
  rw div_def,
  rw div_def,
  apply mul_lt_mul_of_pos_right,
  apply A2,
  apply inv_pos_of_pos,
  apply A1,
end

--TODO: replace with half_lt_self
lemma epsilon_half_lt_epsilon {α:Type*} [linear_ordered_field α] {ε:α}: 0 < ε → (ε / 2) < ε :=
begin
 apply half_lt_self,
end

--TODO: replace with inv_nonneg.mpr.
lemma inv_nonneg_of_nonneg {a:ℝ}:(0 ≤ a) → (0 ≤ a⁻¹) :=
begin
  apply inv_nonneg.mpr,
end

lemma move_le {a b c:ℝ}:(0 < c) → (a ≤ b * c) → (a * c⁻¹) ≤ b :=
begin
  intros A1 A2,
  have A3:0 < c⁻¹ := inv_pos_of_pos A1,
  have A4:(a * c⁻¹) ≤ (b * c) * (c⁻¹),
  {
    apply mul_le_mul_of_nonneg_right,
    apply A2,
    apply le_of_lt,
    apply A3,
  },
  have A5:b * c * c⁻¹ = b,
  {
    rw mul_assoc,
    rw mul_inv_cancel,
    rw mul_one,
    symmetry,
    apply ne_of_lt,
    apply A1,
  },
  rw A5 at A4,
  apply A4,
end

lemma move_le2 {a b c:ℝ}:(0 < c) → (a * c⁻¹) ≤ b → (a ≤ b * c) :=
begin
  intros A1 A2,
  have A4:(a * c⁻¹) * c ≤ (b * c),
  {
    apply mul_le_mul_of_nonneg_right,
    apply A2,
    apply le_of_lt,
    apply A1,
  },
  have A5:a * c⁻¹ * c = a,
  {
    rw mul_assoc,
    rw inv_mul_cancel,
    rw mul_one,
    symmetry,
    apply ne_of_lt,
    apply A1,
  },
  rw A5 at A4,
  apply A4,
end

--Probably a repeat.
--nlinarith failed.
lemma inv_decreasing {x y:ℝ}:(0 < x) → (x < y)→ (y⁻¹ < x⁻¹) :=
begin
  intros A1 A2,
  have A3:0< y,
  {
    apply lt_trans,
    apply A1,
    apply A2,
  },
  have A4:0 < x * y,
  {
    apply mul_pos;assumption,
  },
  have A5:x⁻¹ * x < x⁻¹ * y,
  {
    apply mul_lt_mul_of_pos_left,
    apply A2,
    apply inv_pos_of_pos,
    apply A1,
  },
  rw inv_mul_cancel at A5,
  have A6:1 * y⁻¹ < x⁻¹ * y * y⁻¹,
  {
    apply mul_lt_mul_of_pos_right,
    apply A5,
    apply inv_pos_of_pos,
    apply A3,
  },
  rw one_mul at A6,
  rw mul_assoc at A6,
  rw mul_inv_cancel at A6,
  rw mul_one at A6,
  apply A6,
  {
    intro A7,
    rw A7 at A3,
    apply lt_irrefl 0 A3,
  },
  {
    intro A7,
    rw A7 at A1,
    apply lt_irrefl 0 A1,
  }
end

lemma abs_nonzero_pos {x:ℝ}:(x ≠ 0) → (0 < abs (x)) :=
begin
  intro A1,
  have A2:(x < 0 ∨ x = 0 ∨ 0 < x) := lt_trichotomy x 0,
  cases A2,
  {
    apply abs_pos_of_neg,
    apply A2,
  },
  cases A2,
  {
    exfalso,
    apply A1,
    apply A2,
  },
  {
    apply abs_pos_of_pos,
    apply A2,
  },
end

lemma diff_ne_zero_of_ne {x x':ℝ}:(x ≠ x') → (x - x' ≠ 0) :=
begin
  intro A1,
  intro A2,
  apply A1,
  linarith [A2],
end

--nlinarith failed
lemma abs_diff_pos {x x':ℝ}:(x ≠ x') → (0 < abs (x - x')) :=
begin
  intro A1,
  apply abs_nonzero_pos,
  apply diff_ne_zero_of_ne A1,
end

--nlinarith failed
lemma neg_inv_of_neg {x:ℝ}:x < 0 → (x⁻¹ < 0) :=
begin
  intro A1,
  have A2:x⁻¹ < 0 ∨ (0 ≤ x⁻¹) := lt_or_le x⁻¹ 0,
  cases A2,
  {
    apply A2,
  },
  {
    exfalso,
    have A3:(x * x⁻¹ ≤ 0),
    {
      apply mul_nonpos_of_nonpos_of_nonneg,
      apply le_of_lt,
      apply A1,
      apply A2,
    },
    rw mul_inv_cancel at A3,

    apply not_lt_of_le A3,
    apply zero_lt_one,
    intro A4,
    rw A4 at A1,
    apply lt_irrefl (0:ℝ),
    apply A1,
  }
end

lemma sub_inv {a b:ℝ}:a - (a - b) = b :=
begin
  linarith,
end

--Classical, but filter_util.lean still has dependencies.
lemma x_in_Ioo {x r:ℝ}:(0 < r) → (x∈ set.Ioo (x- r) (x + r)) :=
begin
  intro A1,
  simp [A1],
end

--Classical.
lemma abs_lt2 {x x' r:ℝ}:
  (abs (x' - x) < r) ↔ ((x - r < x') ∧  (x' < x + r)) :=
begin
  rw abs_lt,
  split;intros A1;cases A1 with A2 A3;split,
  {
    apply add_lt_of_lt_sub_left A2,
  },
  {
    apply lt_add_of_sub_left_lt A3,
  },
  {
    apply lt_sub_left_of_add_lt A2,
  },
  {
    apply sub_left_lt_of_lt_add A3,
  }
end

--Classical.
lemma abs_lt_iff_in_Ioo {x x' r:ℝ}:
  (abs (x' - x) < r) ↔ x' ∈ set.Ioo (x - r) (x + r) :=
begin
  apply iff.trans,
  apply abs_lt2,
  simp,
end

--TODO: replace with neg_neg_of_pos
lemma neg_lt_of_pos {x:ℝ}:(0 < x) → (-x < 0) :=
begin
  apply neg_neg_of_pos,
end

--Classical.
lemma abs_lt_iff_in_Ioo2 {x x' r:ℝ}:
  (abs (x - x') < r) ↔ x' ∈ set.Ioo (x - r) (x + r) :=
begin
  have A1:abs (x - x')=abs (x' - x),
  {
    have A1A:x' - x = -(x - x'),
    {
      simp,
    },
    rw A1A,
    rw abs_neg,
  },
  rw A1,
  apply abs_lt_iff_in_Ioo,
end

--Unlikely novel.
lemma real_lt_coe {a b:ℕ}:a < b → (a:ℝ) < (b:ℝ) :=
begin
  simp,
end

lemma add_of_sub {a b c:ℝ}:a - b = c ↔ a = b + c :=
begin
  split;intros A1;linarith [A1],
end

--linarith and nlinarith fails.
lemma sub_half_eq_half {a:ℝ}:(a - a * 2⁻¹)=a * 2⁻¹ :=
begin
    rw add_of_sub,
    rw ← div_def,
    simp,
end

--linarith and nlinarith fails.
lemma half_pos2:0 < (2:ℝ)⁻¹ :=
begin
  apply inv_pos_of_pos,
  apply zero_lt_two,
end

/- The halfway point is in the middle. -/
lemma half_bound_lower {a b:ℝ}:a < b → a < (a + b)/2 :=
begin
  intro A1,
  linarith [A1],
end

lemma half_bound_upper {a b:ℝ}:a < b → (a + b)/2 < b :=
begin
  intro A1,
  linarith [A1],
end

lemma lt_of_sub_lt_sub {a b c:ℝ}:a - c < b - c → a < b :=
begin
  intro A1,
  linarith [A1],
end

lemma abs_antisymm {a b:ℝ}:abs (a - b) = abs (b - a) :=
begin
  have A1:-(a-b)=(b - a),
  {
    simp,
  },
  rw ← A1,
  rw abs_neg,
end

lemma add_sub_triangle {a b c:ℝ}:(a - b) = (a - c) + (c - b) :=
begin
  linarith,
end

lemma abs_triangle {a b c:ℝ}:abs (a - b) ≤ abs (a - c) + abs (c - b) :=
begin
  have h_nonneg_or_neg:∀ a:ℝ, (0 ≤ a)∨ (a<0),
  {intros a,have A1:=lt_or_ge a 0, cases A1,apply or.inr A1, apply or.inl A1},
  cases (h_nonneg_or_neg  (a - b)) with A1 A1;
  cases (h_nonneg_or_neg  (a - c)) with A2 A2;
  cases (h_nonneg_or_neg  (c - b)) with A3 A3;
  simp [A1,A2,A3,abs_of_nonneg,abs_of_neg];
  linarith,
end

lemma pow_complex {x:ℝ} {n:ℕ}:((x:ℂ)^n).re=(x^n) :=
begin
  induction n,
  {
    simp,
  },
  {
    rw pow_succ,
    rw pow_succ,
    simp,
    rw n_ih,
    simp,
  }
end

lemma div_complex {x y:ℝ}:((x:ℂ)/(y:ℂ)).re=x/y :=
begin
  rw complex.div_re,
  simp,
  have A1:y=0 ∨ y≠ 0 := eq_or_ne,
  cases A1,
  {
    rw A1,
    simp,
  },
  {
    rw mul_div_mul_right,
    apply A1,
  }
end

lemma complex_norm_sq_nat {y:ℕ}:complex.norm_sq (y:ℂ) = ((y:ℝ) * (y:ℝ)) :=
begin
  unfold complex.norm_sq,
  simp,
end

lemma num_denom_eq (a b c d:ℝ): (a = b) → (c = d) → (a/c)=(b/d) :=
begin
  intros A1 A2,
  rw A1,
  rw A2,
end

lemma complex_pow_div_complex_re {x:ℝ} {n:ℕ} {y:ℕ}:(((x:ℂ)^n)/(y:ℂ)).re=x^n/(y:ℝ) :=
begin
  rw complex.div_re,
  simp,
  have A1:(y:ℝ)=0 ∨ (y:ℝ) ≠ 0 := eq_or_ne,
  cases A1,
  {
    rw A1,
    simp,
  },
  {
    rw complex_norm_sq_nat,
    rw mul_div_mul_right,
    apply num_denom_eq,
    {
      rw pow_complex,
    },
    {
      refl,
    },
    apply A1,
  }
end

lemma half_lt_one:(2:ℝ)⁻¹ < 1 :=
begin
  have A1:1/(2:ℝ) < 1 := epsilon_half_lt_epsilon zero_lt_one,
  rw div_def at A1,
  rw one_mul at A1,
  apply A1,
end

lemma half_pos_lit:0 < (2:ℝ)⁻¹ :=
begin
  apply inv_pos_of_pos,
  apply zero_lt_two,
end

/-
lemma div_re_eq_re_div_re (x y:ℂ):(x / y).re = (x.re)/(y.re) :=
begin
  simp,
end
-/

--It is a common pattern that we calculate the distance to the middle,
--and then show that if you add or subtract it, you get to that middle.
lemma half_equal {x y ε:ℝ}:ε = (x - y)/2 → x - ε = y + ε :=
begin
  intro A1,
  have A2:(x - ε) + (ε - y) = (y + ε) + (ε - y),
  {
    rw ← add_sub_triangle,
    rw ← add_sub_assoc,

    rw add_comm (y+ε),
    rw add_comm y ε,
    rw ← add_assoc,
    rw add_sub_assoc,
    rw sub_self,
    rw add_zero,
    rw A1,
    simp,
  },
  apply add_right_cancel A2,
end

lemma real.unit_frac_pos (n:ℕ):0 < (1/((n:real) + 1)) :=
begin
  simp,
  -- ⊢ 0 < ↑n + 1
  rw add_comm,
  apply add_pos_of_pos_of_nonneg,
  {
    apply zero_lt_one,
  },
  {
    simp,
  },
end

--TODO:Unlikely to be novel.
--Solvable by linarith.
lemma real.sub_lt_sub_of_lt {a b c:real}:a < b →
  a - c < b - c :=
begin
  simp,
end

lemma real.rat_le_rat_iff {q r:ℚ}:q ≤ r ↔ (q:ℝ) ≤  (r:ℝ) :=
begin
  rw ← real.of_rat_eq_cast,
  rw ← real.of_rat_eq_cast,
  rw le_iff_lt_or_eq,
  rw le_iff_lt_or_eq,
  split;intros A3;cases A3,
  {
    left,
    rw real.of_rat_lt,
    apply A3,
  },
  {
    right,
    simp,
    apply A3,
  },
  {
    left,
    rw ← real.of_rat_lt,
    apply A3,
  },
  {
    right,
    simp at A3,
    apply A3,
  },
end

lemma real.eq_add_of_sub_eq {a b c:real}:
  a - b = c → a = b + c :=
begin
  intros A1,
  linarith [A1],
end

lemma real.sub_add_sub {a b c:real}:(a - b) + (b - c) = a - c := by linarith


/-
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 category_theory.category.Pointed
! leanprover-community/mathlib commit c8ab806ef73c20cab1d87b5157e43a82c205f28e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.ConcreteCategory.Basic

/-!
# The category of pointed types

This defines `Pointed`, the category of pointed types.

## TODO

* Monoidal structure
* Upgrade `Type_to_Pointed` to an equivalence
-/

open CategoryTheory

universe u

variable {α β : Type _}

/-- The category of pointed types. -/
structure Pointed : Type (u + 1) where
  /-- the underlying type -/
  X : Type u
  /-- the distinguished element -/
  point : X
set_option linter.uppercaseLean3 false in
#align Pointed Pointed

namespace Pointed

instance : CoeSort Pointed (Type _) :=
  ⟨X⟩

-- porting note: protected attribute does not work
--attribute [protected] Pointed.X

/-- Turns a point into a pointed type. -/
def of {X : Type _} (point : X) : Pointed :=
  ⟨X, point⟩
set_option linter.uppercaseLean3 false in
#align Pointed.of Pointed.of

@[simp]
theorem coe_of {X : Type _} (point : X) : ↥(of point) = X :=
  rfl
set_option linter.uppercaseLean3 false in
#align Pointed.coe_of Pointed.coe_of

alias of ← _root_.Prod.Pointed
set_option linter.uppercaseLean3 false in
#align prod.Pointed Prod.Pointed

instance : Inhabited Pointed :=
  ⟨of ((), ())⟩

/-- Morphisms in `Pointed`. -/
@[ext]
protected structure Hom (X Y : Pointed.{u}) : Type u where
  /-- the underlying map -/
  toFun : X → Y
  /-- compatibility with the distinguished points -/
  map_point : toFun X.point = Y.point
set_option linter.uppercaseLean3 false in
#align Pointed.hom Pointed.Hom

namespace Hom

/-- The identity morphism of `X : Pointed`. -/
@[simps]
def id (X : Pointed) : Pointed.Hom X X :=
  ⟨_root_.id, rfl⟩
set_option linter.uppercaseLean3 false in
#align Pointed.hom.id Pointed.Hom.id

instance (X : Pointed) : Inhabited (Pointed.Hom X X) :=
  ⟨id X⟩

/-- Composition of morphisms of `Pointed`. -/
@[simps]
def comp {X Y Z : Pointed.{u}} (f : Pointed.Hom X Y) (g : Pointed.Hom Y Z) : Pointed.Hom X Z :=
  ⟨g.toFun ∘ f.toFun, by rw [Function.comp_apply, f.map_point, g.map_point]⟩
set_option linter.uppercaseLean3 false in
#align Pointed.hom.comp Pointed.Hom.comp

end Hom

instance largeCategory : LargeCategory Pointed
    where
  Hom := Pointed.Hom
  id := Hom.id
  comp := @Hom.comp
set_option linter.uppercaseLean3 false in
#align Pointed.large_category Pointed.largeCategory

instance concreteCategory : ConcreteCategory Pointed where
  Forget :=
    { obj := Pointed.X
      map := @Hom.toFun }
  forget_faithful := ⟨@Hom.ext⟩
set_option linter.uppercaseLean3 false in
#align Pointed.concrete_category Pointed.concreteCategory

/-- Constructs a isomorphism between pointed types from an equivalence that preserves the point
between them. -/
@[simps]
def Iso.mk {α β : Pointed} (e : α ≃ β) (he : e α.point = β.point) : α ≅ β where
  hom := ⟨e, he⟩
  inv := ⟨e.symm, e.symm_apply_eq.2 he.symm⟩
  hom_inv_id := Pointed.Hom.ext _ _ e.symm_comp_self
  inv_hom_id := Pointed.Hom.ext _ _ e.self_comp_symm
set_option linter.uppercaseLean3 false in
#align Pointed.iso.mk Pointed.Iso.mk

end Pointed

/-- `Option` as a functor from types to pointed types. This is the free functor. -/
@[simps]
def typeToPointed : Type u ⥤ Pointed.{u} where
  obj X := ⟨Option X, none⟩
  map f := ⟨Option.map f, rfl⟩
  map_id _ := Pointed.Hom.ext _ _ Option.map_id
  map_comp _ _ := Pointed.Hom.ext _ _ (Option.map_comp_map _ _).symm
set_option linter.uppercaseLean3 false in
#align Type_to_Pointed typeToPointed

/-- `Type_to_Pointed` is the free functor. -/
def typeToPointedForgetAdjunction : typeToPointed ⊣ forget Pointed :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun X Y =>
        { toFun := fun f => f.toFun ∘ Option.some
          invFun := fun f => ⟨fun o => o.elim Y.point f, rfl⟩
          left_inv := fun f => by
            apply Pointed.Hom.ext
            funext x
            cases x
            . exact f.map_point.symm
            . rfl
          right_inv := fun f => funext fun _ => rfl }
      homEquiv_naturality_left_symm := fun f g => by
        apply Pointed.Hom.ext
        funext x
        cases x <;> rfl }
set_option linter.uppercaseLean3 false in
#align Type_to_Pointed_forget_adjunction typeToPointedForgetAdjunction