/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Calle Sönne

! This file was ported from Lean 3 source module topology.category.Profinite.basic
! leanprover-community/mathlib commit bcfa726826abd57587355b4b5b7e78ad6527b7e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Category.CompHaus.Basic
import Mathbin.Topology.Connected
import Mathbin.Topology.SubsetProperties
import Mathbin.Topology.LocallyConstant.Basic
import Mathbin.CategoryTheory.Adjunction.Reflective
import Mathbin.CategoryTheory.Monad.Limits
import Mathbin.CategoryTheory.Fintype

/-!
# The category of Profinite Types

We construct the category of profinite topological spaces,
often called profinite sets -- perhaps they could be called
profinite types in Lean.

The type of profinite topological spaces is called `Profinite`. It has a category
instance and is a fully faithful subcategory of `Top`. The fully faithful functor
is called `Profinite_to_Top`.

## Implementation notes

A profinite type is defined to be a topological space which is
compact, Hausdorff and totally disconnected.

## TODO

0. Link to category of projective limits of finite discrete sets.
1. finite coproducts
2. Clausen/Scholze topology on the category `Profinite`.

## Tags

profinite

-/

universe u

open CategoryTheory

open Topology

/-- The type of profinite topological spaces. -/
structure Profinite where
  toCompHaus : CompHaus
  [IsTotallyDisconnected : TotallyDisconnectedSpace to_CompHaus]
#align Profinite Profinite

namespace Profinite

/-- Construct a term of `Profinite` from a type endowed with the structure of a
compact, Hausdorff and totally disconnected topological space.
-/
def of (X : Type _) [TopologicalSpace X] [CompactSpace X] [T2Space X] [TotallyDisconnectedSpace X] :
    Profinite :=
  ⟨⟨⟨X⟩⟩⟩
#align Profinite.of Profinite.of

instance : Inhabited Profinite :=
  ⟨Profinite.of PEmpty⟩

instance category : Category Profinite :=
  InducedCategory.category toCompHaus
#align Profinite.category Profinite.category

instance concreteCategory : ConcreteCategory Profinite :=
  InducedCategory.concreteCategory _
#align Profinite.concrete_category Profinite.concreteCategory

instance hasForget₂ : HasForget₂ Profinite TopCat :=
  InducedCategory.hasForget₂ _
#align Profinite.has_forget₂ Profinite.hasForget₂

instance : CoeSort Profinite (Type _) :=
  ⟨fun X => X.toCompHaus⟩

instance {X : Profinite} : TotallyDisconnectedSpace X :=
  X.IsTotallyDisconnected

-- We check that we automatically infer that Profinite sets are compact and Hausdorff.
example {X : Profinite} : CompactSpace X :=
  inferInstance

example {X : Profinite} : T2Space X :=
  inferInstance

@[simp]
theorem coe_toCompHaus {X : Profinite} : (X.toCompHaus : Type _) = X :=
  rfl
#align Profinite.coe_to_CompHaus Profinite.coe_toCompHaus

@[simp]
theorem coe_id (X : Profinite) : (𝟙 X : X → X) = id :=
  rfl
#align Profinite.coe_id Profinite.coe_id

@[simp]
theorem coe_comp {X Y Z : Profinite} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g : X → Z) = g ∘ f :=
  rfl
#align Profinite.coe_comp Profinite.coe_comp

end Profinite

/-- The fully faithful embedding of `Profinite` in `CompHaus`. -/
@[simps]
def profiniteToCompHaus : Profinite ⥤ CompHaus :=
  inducedFunctor _ deriving Full, Faithful
#align Profinite_to_CompHaus profiniteToCompHaus

/-- The fully faithful embedding of `Profinite` in `Top`. This is definitionally the same as the
obvious composite. -/
@[simps]
def Profinite.toTop : Profinite ⥤ TopCat :=
  forget₂ _ _ deriving Full, Faithful
#align Profinite.to_Top Profinite.toTop

@[simp]
theorem Profinite.to_compHausToTop : profiniteToCompHaus ⋙ compHausToTop = Profinite.toTop :=
  rfl
#align Profinite.to_CompHaus_to_Top Profinite.to_compHausToTop

section Profinite

-- Without explicit universe annotations here, Lean introduces two universe variables and
-- unhelpfully defines a function `CompHaus.{max u₁ u₂} → Profinite.{max u₁ u₂}`.
/--
(Implementation) The object part of the connected_components functor from compact Hausdorff spaces
to Profinite spaces, given by quotienting a space by its connected components.
See: https://stacks.math.columbia.edu/tag/0900
-/
def CompHaus.toProfiniteObj (X : CompHaus.{u}) : Profinite.{u}
    where
  toCompHaus :=
    { toTop := TopCat.of (ConnectedComponents X)
      IsCompact := Quotient.compactSpace
      is_hausdorff := ConnectedComponents.t2 }
  IsTotallyDisconnected := ConnectedComponents.totallyDisconnectedSpace
#align CompHaus.to_Profinite_obj CompHaus.toProfiniteObj

/-- (Implementation) The bijection of homsets to establish the reflective adjunction of Profinite
spaces in compact Hausdorff spaces.
-/
def Profinite.toCompHausEquivalence (X : CompHaus.{u}) (Y : Profinite.{u}) :
    (CompHaus.toProfiniteObj X ⟶ Y) ≃ (X ⟶ profiniteToCompHaus.obj Y)
    where
  toFun f := f.comp ⟨Quotient.mk'', continuous_quotient_mk'⟩
  invFun g :=
    { toFun := Continuous.connectedComponentsLift g.2
      continuous_toFun := Continuous.connectedComponentsLift_continuous g.2 }
  left_inv f := ContinuousMap.ext <| ConnectedComponents.surjective_coe.forall.2 fun a => rfl
  right_inv f := ContinuousMap.ext fun x => rfl
#align Profinite.to_CompHaus_equivalence Profinite.toCompHausEquivalence

/-- The connected_components functor from compact Hausdorff spaces to profinite spaces,
left adjoint to the inclusion functor.
-/
def CompHaus.toProfinite : CompHaus ⥤ Profinite :=
  Adjunction.leftAdjointOfEquiv Profinite.toCompHausEquivalence fun _ _ _ _ _ => rfl
#align CompHaus.to_Profinite CompHaus.toProfinite

theorem CompHaus.toProfinite_obj' (X : CompHaus) :
    ↥(CompHaus.toProfinite.obj X) = ConnectedComponents X :=
  rfl
#align CompHaus.to_Profinite_obj' CompHaus.toProfinite_obj'

/-- Finite types are given the discrete topology. -/
def FintypeCat.botTopology (A : FintypeCat) : TopologicalSpace A :=
  ⊥
#align Fintype.bot_topology FintypeCat.botTopology

section DiscreteTopology

attribute [local instance] FintypeCat.botTopology

@[local instance]
theorem FintypeCat.discreteTopology (A : FintypeCat) : DiscreteTopology A :=
  ⟨rfl⟩
#align Fintype.discrete_topology FintypeCat.discreteTopology

/-- The natural functor from `Fintype` to `Profinite`, endowing a finite type with the
discrete topology. -/
@[simps]
def FintypeCat.toProfinite : FintypeCat ⥤ Profinite
    where
  obj A := Profinite.of A
  map _ _ f := ⟨f⟩
#align Fintype.to_Profinite FintypeCat.toProfinite

end DiscreteTopology

end Profinite

namespace Profinite

-- TODO the following construction of limits could be generalised
-- to allow diagrams in lower universes.
/-- An explicit limit cone for a functor `F : J ⥤ Profinite`, defined in terms of
`Top.limit_cone`. -/
def limitCone {J : Type u} [SmallCategory J] (F : J ⥤ Profinite.{u}) : Limits.Cone F
    where
  pt :=
    { toCompHaus := (CompHaus.limitCone.{u, u} (F ⋙ profiniteToCompHaus)).pt
      IsTotallyDisconnected :=
        by
        change TotallyDisconnectedSpace ↥{ u : ∀ j : J, F.obj j | _ }
        exact Subtype.totallyDisconnectedSpace }
  π := { app := (CompHaus.limitCone.{u, u} (F ⋙ profiniteToCompHaus)).π.app }
#align Profinite.limit_cone Profinite.limitCone

/-- The limit cone `Profinite.limit_cone F` is indeed a limit cone. -/
def limitConeIsLimit {J : Type u} [SmallCategory J] (F : J ⥤ Profinite.{u}) :
    Limits.IsLimit (limitCone F)
    where
  lift S :=
    (CompHaus.limitConeIsLimit.{u, u} (F ⋙ profiniteToCompHaus)).lift
      (profiniteToCompHaus.mapCone S)
  uniq S m h := (CompHaus.limitConeIsLimit.{u, u} _).uniq (profiniteToCompHaus.mapCone S) _ h
#align Profinite.limit_cone_is_limit Profinite.limitConeIsLimit

/-- The adjunction between CompHaus.to_Profinite and Profinite.to_CompHaus -/
def toProfiniteAdjToCompHaus : CompHaus.toProfinite ⊣ profiniteToCompHaus :=
  Adjunction.adjunctionOfEquivLeft _ _
#align Profinite.to_Profinite_adj_to_CompHaus Profinite.toProfiniteAdjToCompHaus

/-- The category of profinite sets is reflective in the category of compact hausdroff spaces -/
instance toCompHaus.reflective : Reflective profiniteToCompHaus
    where toIsRightAdjoint := ⟨CompHaus.toProfinite, Profinite.toProfiniteAdjToCompHaus⟩
#align Profinite.to_CompHaus.reflective Profinite.toCompHaus.reflective

noncomputable instance toCompHaus.createsLimits : CreatesLimits profiniteToCompHaus :=
  monadicCreatesLimits _
#align Profinite.to_CompHaus.creates_limits Profinite.toCompHaus.createsLimits

noncomputable instance toTop.reflective : Reflective Profinite.toTop :=
  Reflective.comp profiniteToCompHaus compHausToTop
#align Profinite.to_Top.reflective Profinite.toTop.reflective

noncomputable instance toTop.createsLimits : CreatesLimits Profinite.toTop :=
  monadicCreatesLimits _
#align Profinite.to_Top.creates_limits Profinite.toTop.createsLimits

instance hasLimits : Limits.HasLimits Profinite :=
  has_limits_of_has_limits_creates_limits Profinite.toTop
#align Profinite.has_limits Profinite.hasLimits

instance hasColimits : Limits.HasColimits Profinite :=
  has_colimits_of_reflective profiniteToCompHaus
#align Profinite.has_colimits Profinite.hasColimits

noncomputable instance forgetPreservesLimits : Limits.PreservesLimits (forget Profinite) := by
  apply limits.comp_preserves_limits Profinite.toTop (forget TopCat)
#align Profinite.forget_preserves_limits Profinite.forgetPreservesLimits

variable {X Y : Profinite.{u}} (f : X ⟶ Y)

/-- Any morphism of profinite spaces is a closed map. -/
theorem isClosedMap : IsClosedMap f :=
  CompHaus.isClosedMap _
#align Profinite.is_closed_map Profinite.isClosedMap

/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
theorem isIso_of_bijective (bij : Function.Bijective f) : IsIso f :=
  haveI := CompHaus.isIso_of_bijective (Profinite_to_CompHaus.map f) bij
  is_iso_of_fully_faithful profiniteToCompHaus _
#align Profinite.is_iso_of_bijective Profinite.isIso_of_bijective

/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
noncomputable def isoOfBijective (bij : Function.Bijective f) : X ≅ Y :=
  letI := Profinite.isIso_of_bijective f bij
  as_iso f
#align Profinite.iso_of_bijective Profinite.isoOfBijective

instance forget_reflectsIsomorphisms : ReflectsIsomorphisms (forget Profinite) :=
  ⟨by intro A B f hf <;> exact Profinite.isIso_of_bijective _ ((is_iso_iff_bijective f).mp hf)⟩
#align Profinite.forget_reflects_isomorphisms Profinite.forget_reflectsIsomorphisms

/-- Construct an isomorphism from a homeomorphism. -/
@[simps Hom inv]
def isoOfHomeo (f : X ≃ₜ Y) : X ≅ Y
    where
  Hom := ⟨f, f.Continuous⟩
  inv := ⟨f.symm, f.symm.Continuous⟩
  hom_inv_id' := by
    ext x
    exact f.symm_apply_apply x
  inv_hom_id' := by
    ext x
    exact f.apply_symm_apply x
#align Profinite.iso_of_homeo Profinite.isoOfHomeo

/-- Construct a homeomorphism from an isomorphism. -/
@[simps]
def homeoOfIso (f : X ≅ Y) : X ≃ₜ Y where
  toFun := f.Hom
  invFun := f.inv
  left_inv x := by
    change (f.hom ≫ f.inv) x = x
    rw [iso.hom_inv_id, coe_id, id.def]
  right_inv x := by
    change (f.inv ≫ f.hom) x = x
    rw [iso.inv_hom_id, coe_id, id.def]
  continuous_toFun := f.Hom.Continuous
  continuous_invFun := f.inv.Continuous
#align Profinite.homeo_of_iso Profinite.homeoOfIso

/-- The equivalence between isomorphisms in `Profinite` and homeomorphisms
of topological spaces. -/
@[simps]
def isoEquivHomeo : (X ≅ Y) ≃ (X ≃ₜ Y)
    where
  toFun := homeoOfIso
  invFun := isoOfHomeo
  left_inv f := by
    ext
    rfl
  right_inv f := by
    ext
    rfl
#align Profinite.iso_equiv_homeo Profinite.isoEquivHomeo

theorem epi_iff_surjective {X Y : Profinite.{u}} (f : X ⟶ Y) : Epi f ↔ Function.Surjective f :=
  by
  constructor
  · contrapose!
    rintro ⟨y, hy⟩ hf
    skip
    let C := Set.range f
    have hC : IsClosed C := (isCompact_range f.continuous).IsClosed
    let U := Cᶜ
    have hyU : y ∈ U := by
      refine' Set.mem_compl _
      rintro ⟨y', hy'⟩
      exact hy y' hy'
    have hUy : U ∈ 𝓝 y := hC.compl_mem_nhds hyU
    obtain ⟨V, hV, hyV, hVU⟩ := is_topological_basis_clopen.mem_nhds_iff.mp hUy
    classical
      let Z := of (ULift.{u} <| Fin 2)
      let g : Y ⟶ Z := ⟨(LocallyConstant.ofClopen hV).map ULift.up, LocallyConstant.continuous _⟩
      let h : Y ⟶ Z := ⟨fun _ => ⟨1⟩, continuous_const⟩
      have H : h = g := by
        rw [← cancel_epi f]
        ext x
        dsimp [LocallyConstant.ofClopen]
        rw [if_neg]
        · rfl
        refine' mt (fun α => hVU α) _
        simp only [Set.mem_range_self, not_true, not_false_iff, Set.mem_compl_iff]
      apply_fun fun e => (e y).down  at H
      dsimp [LocallyConstant.ofClopen] at H
      rw [if_pos hyV] at H
      exact top_ne_bot H
  · rw [← CategoryTheory.epi_iff_surjective]
    apply (forget Profinite).epi_of_epi_map
#align Profinite.epi_iff_surjective Profinite.epi_iff_surjective

theorem mono_iff_injective {X Y : Profinite.{u}} (f : X ⟶ Y) : Mono f ↔ Function.Injective f :=
  by
  constructor
  · intro h
    haveI : limits.preserves_limits profiniteToCompHaus := inferInstance
    haveI : mono (Profinite_to_CompHaus.map f) := inferInstance
    rwa [← CompHaus.mono_iff_injective]
  · rw [← CategoryTheory.mono_iff_injective]
    apply (forget Profinite).mono_of_mono_map
#align Profinite.mono_iff_injective Profinite.mono_iff_injective

end Profinite


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.deriv
import Mathlib.analysis.calculus.times_cont_diff
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# One-dimensional iterated derivatives

We define the `n`-th derivative of a function `f : 𝕜 → F` as a function
`iterated_deriv n f : 𝕜 → F`, as well as a version on domains `iterated_deriv_within n f s : 𝕜 → F`,
and prove their basic properties.

## Main definitions and results

Let `𝕜` be a nondiscrete normed field, and `F` a normed vector space over `𝕜`. Let `f : 𝕜 → F`.

* `iterated_deriv n f` is the `n`-th derivative of `f`, seen as a function from `𝕜` to `F`.
  It is defined as the `n`-th Fréchet derivative (which is a multilinear map) applied to the
  vector `(1, ..., 1)`, to take advantage of all the existing framework, but we show that it
  coincides with the naive iterative definition.
* `iterated_deriv_eq_iterate` states that the `n`-th derivative of `f` is obtained by starting
  from `f` and differentiating it `n` times.
* `iterated_deriv_within n f s` is the `n`-th derivative of `f` within the domain `s`. It only
  behaves well when `s` has the unique derivative property.
* `iterated_deriv_within_eq_iterate` states that the `n`-th derivative of `f` in the domain `s` is
  obtained by starting from `f` and differentiating it `n` times within `s`. This only holds when
  `s` has the unique derivative property.

## Implementation details

The results are deduced from the corresponding results for the more general (multilinear) iterated
Fréchet derivative. For this, we write `iterated_deriv n f` as the composition of
`iterated_fderiv 𝕜 n f` and a continuous linear equiv. As continuous linear equivs respect
differentiability and commute with differentiation, this makes it possible to prove readily that
the derivative of the `n`-th derivative is the `n+1`-th derivative in `iterated_deriv_within_succ`,
by translating the corresponding result `iterated_fderiv_within_succ_apply_left` for the
iterated Fréchet derivative.
-/

/-- The `n`-th iterated derivative of a function from `𝕜` to `F`, as a function from `𝕜` to `F`. -/
def iterated_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] (n : ℕ) (f : 𝕜 → F) (x : 𝕜) : F :=
  coe_fn (iterated_fderiv 𝕜 n f x) fun (i : fin n) => 1

/-- The `n`-th iterated derivative of a function from `𝕜` to `F` within a set `s`, as a function
from `𝕜` to `F`. -/
def iterated_deriv_within {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] (n : ℕ) (f : 𝕜 → F) (s : set 𝕜) (x : 𝕜) : F :=
  coe_fn (iterated_fderiv_within 𝕜 n f s x) fun (i : fin n) => 1

theorem iterated_deriv_within_univ {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} : iterated_deriv_within n f set.univ = iterated_deriv n f := sorry

/-! ### Properties of the iterated derivative within a set -/

theorem iterated_deriv_within_eq_iterated_fderiv_within {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} {x : 𝕜} : iterated_deriv_within n f s x = coe_fn (iterated_fderiv_within 𝕜 n f s x) fun (i : fin n) => 1 :=
  rfl

/-- Write the iterated derivative as the composition of a continuous linear equiv and the iterated
Fréchet derivative -/
theorem iterated_deriv_within_eq_equiv_comp {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} : iterated_deriv_within n f s =
  ⇑(continuous_linear_equiv.symm (continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F)) ∘
    iterated_fderiv_within 𝕜 n f s :=
  funext fun (x : 𝕜) => Eq.refl (iterated_deriv_within n f s x)

/-- Write the iterated Fréchet derivative as the composition of a continuous linear equiv and the
iterated derivative. -/
theorem iterated_fderiv_within_eq_equiv_comp {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} : iterated_fderiv_within 𝕜 n f s = ⇑(continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F) ∘ iterated_deriv_within n f s := sorry

/-- The `n`-th Fréchet derivative applied to a vector `(m 0, ..., m (n-1))` is the derivative
multiplied by the product of the `m i`s. -/
theorem iterated_fderiv_within_apply_eq_iterated_deriv_within_mul_prod {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} {x : 𝕜} {m : fin n → 𝕜} : coe_fn (iterated_fderiv_within 𝕜 n f s x) m =
  (finset.prod finset.univ fun (i : fin n) => m i) • iterated_deriv_within n f s x := sorry

@[simp] theorem iterated_deriv_within_zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {s : set 𝕜} : iterated_deriv_within 0 f s = f := sorry

@[simp] theorem iterated_deriv_within_one {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {s : set 𝕜} (hs : unique_diff_on 𝕜 s) {x : 𝕜} (hx : x ∈ s) : iterated_deriv_within 1 f s x = deriv_within f s x := sorry

/-- If the first `n` derivatives within a set of a function are continuous, and its first `n-1`
derivatives are differentiable, then the function is `C^n`. This is not an equivalence in general,
but this is an equivalence when the set has unique derivatives, see
`times_cont_diff_on_iff_continuous_on_differentiable_on_deriv`. -/
theorem times_cont_diff_on_of_continuous_on_differentiable_on_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {s : set 𝕜} {n : with_top ℕ} (Hcont : ∀ (m : ℕ), ↑m ≤ n → continuous_on (fun (x : 𝕜) => iterated_deriv_within m f s x) s) (Hdiff : ∀ (m : ℕ), ↑m < n → differentiable_on 𝕜 (fun (x : 𝕜) => iterated_deriv_within m f s x) s) : times_cont_diff_on 𝕜 n f s := sorry

/-- To check that a function is `n` times continuously differentiable, it suffices to check that its
first `n` derivatives are differentiable. This is slightly too strong as the condition we
require on the `n`-th derivative is differentiability instead of continuity, but it has the
advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal).
-/
theorem times_cont_diff_on_of_differentiable_on_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {s : set 𝕜} {n : with_top ℕ} (h : ∀ (m : ℕ), ↑m ≤ n → differentiable_on 𝕜 (iterated_deriv_within m f s) s) : times_cont_diff_on 𝕜 n f s := sorry

/-- On a set with unique derivatives, a `C^n` function has derivatives up to `n` which are
continuous. -/
theorem times_cont_diff_on.continuous_on_iterated_deriv_within {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {s : set 𝕜} {n : with_top ℕ} {m : ℕ} (h : times_cont_diff_on 𝕜 n f s) (hmn : ↑m ≤ n) (hs : unique_diff_on 𝕜 s) : continuous_on (iterated_deriv_within m f s) s := sorry

/-- On a set with unique derivatives, a `C^n` function has derivatives less than `n` which are
differentiable. -/
theorem times_cont_diff_on.differentiable_on_iterated_deriv_within {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {s : set 𝕜} {n : with_top ℕ} {m : ℕ} (h : times_cont_diff_on 𝕜 n f s) (hmn : ↑m < n) (hs : unique_diff_on 𝕜 s) : differentiable_on 𝕜 (iterated_deriv_within m f s) s := sorry

/-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be
reformulated in terms of the one-dimensional derivative on sets with unique derivatives. -/
theorem times_cont_diff_on_iff_continuous_on_differentiable_on_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {s : set 𝕜} {n : with_top ℕ} (hs : unique_diff_on 𝕜 s) : times_cont_diff_on 𝕜 n f s ↔
  (∀ (m : ℕ), ↑m ≤ n → continuous_on (iterated_deriv_within m f s) s) ∧
    ∀ (m : ℕ), ↑m < n → differentiable_on 𝕜 (iterated_deriv_within m f s) s := sorry

/-- The `n+1`-th iterated derivative within a set with unique derivatives can be obtained by
differentiating the `n`-th iterated derivative. -/
theorem iterated_deriv_within_succ {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} {x : 𝕜} (hxs : unique_diff_within_at 𝕜 s x) : iterated_deriv_within (n + 1) f s x = deriv_within (iterated_deriv_within n f s) s x := sorry

/-- The `n`-th iterated derivative within a set with unique derivatives can be obtained by
iterating `n` times the differentiation operation. -/
theorem iterated_deriv_within_eq_iterate {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} {x : 𝕜} (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) : iterated_deriv_within n f s x = nat.iterate (fun (g : 𝕜 → F) => deriv_within g s) n f x := sorry

/-- The `n+1`-th iterated derivative within a set with unique derivatives can be obtained by
taking the `n`-th derivative of the derivative. -/
theorem iterated_deriv_within_succ' {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} {x : 𝕜} (hxs : unique_diff_on 𝕜 s) (hx : x ∈ s) : iterated_deriv_within (n + 1) f s x = iterated_deriv_within n (deriv_within f s) s x := sorry

/-! ### Properties of the iterated derivative on the whole space -/

theorem iterated_deriv_eq_iterated_fderiv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {x : 𝕜} : iterated_deriv n f x = coe_fn (iterated_fderiv 𝕜 n f x) fun (i : fin n) => 1 :=
  rfl

/-- Write the iterated derivative as the composition of a continuous linear equiv and the iterated
Fréchet derivative -/
theorem iterated_deriv_eq_equiv_comp {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} : iterated_deriv n f =
  ⇑(continuous_linear_equiv.symm (continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F)) ∘ iterated_fderiv 𝕜 n f :=
  funext fun (x : 𝕜) => Eq.refl (iterated_deriv n f x)

/-- Write the iterated Fréchet derivative as the composition of a continuous linear equiv and the
iterated derivative. -/
theorem iterated_fderiv_eq_equiv_comp {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} : iterated_fderiv 𝕜 n f = ⇑(continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F) ∘ iterated_deriv n f := sorry

/-- The `n`-th Fréchet derivative applied to a vector `(m 0, ..., m (n-1))` is the derivative
multiplied by the product of the `m i`s. -/
theorem iterated_fderiv_apply_eq_iterated_deriv_mul_prod {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} {x : 𝕜} {m : fin n → 𝕜} : coe_fn (iterated_fderiv 𝕜 n f x) m = (finset.prod finset.univ fun (i : fin n) => m i) • iterated_deriv n f x := sorry

@[simp] theorem iterated_deriv_zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} : iterated_deriv 0 f = f := sorry

@[simp] theorem iterated_deriv_one {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} : iterated_deriv 1 f = deriv f := sorry

/-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be
reformulated in terms of the one-dimensional derivative. -/
theorem times_cont_diff_iff_iterated_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {n : with_top ℕ} : times_cont_diff 𝕜 n f ↔
  (∀ (m : ℕ), ↑m ≤ n → continuous (iterated_deriv m f)) ∧ ∀ (m : ℕ), ↑m < n → differentiable 𝕜 (iterated_deriv m f) := sorry

/-- To check that a function is `n` times continuously differentiable, it suffices to check that its
first `n` derivatives are differentiable. This is slightly too strong as the condition we
require on the `n`-th derivative is differentiability instead of continuity, but it has the
advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal).
-/
theorem times_cont_diff_of_differentiable_iterated_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {n : with_top ℕ} (h : ∀ (m : ℕ), ↑m ≤ n → differentiable 𝕜 (iterated_deriv m f)) : times_cont_diff 𝕜 n f :=
  iff.mpr times_cont_diff_iff_iterated_deriv
    { left := fun (m : ℕ) (hm : ↑m ≤ n) => differentiable.continuous (h m hm),
      right := fun (m : ℕ) (hm : ↑m < n) => h m (le_of_lt hm) }

theorem times_cont_diff.continuous_iterated_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {n : with_top ℕ} (m : ℕ) (h : times_cont_diff 𝕜 n f) (hmn : ↑m ≤ n) : continuous (iterated_deriv m f) :=
  and.left (iff.mp times_cont_diff_iff_iterated_deriv h) m hmn

theorem times_cont_diff.differentiable_iterated_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} {n : with_top ℕ} (m : ℕ) (h : times_cont_diff 𝕜 n f) (hmn : ↑m < n) : differentiable 𝕜 (iterated_deriv m f) :=
  and.right (iff.mp times_cont_diff_iff_iterated_deriv h) m hmn

/-- The `n+1`-th iterated derivative can be obtained by differentiating the `n`-th
iterated derivative. -/
theorem iterated_deriv_succ {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} : iterated_deriv (n + 1) f = deriv (iterated_deriv n f) := sorry

/-- The `n`-th iterated derivative can be obtained by iterating `n` times the
differentiation operation. -/
theorem iterated_deriv_eq_iterate {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} : iterated_deriv n f = nat.iterate deriv n f := sorry

/-- The `n+1`-th iterated derivative can be obtained by taking the `n`-th derivative of the
derivative. -/
theorem iterated_deriv_succ' {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {F : Type u_2} [normed_group F] [normed_space 𝕜 F] {n : ℕ} {f : 𝕜 → F} : iterated_deriv (n + 1) f = iterated_deriv n (deriv f) := sorry


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
  by apply And.intro
     exact hp
     apply And.intro
     exact hq
     exact hp


structure Bar (α : Type) where
  a : α
  x : Nat → α

structure Baz (α : Type) where
  a : α → α
  β : Type
  b : α → β

set_option structureDiamondWarning false

structure Foo1 (α : Type) extends Bar (α → α), Baz α

#check Foo1.mk

def f1 (x : Nat) : Foo1 Nat :=
  { a := id
    x := (· + ·)
    b := fun _ => "" }

structure Boo1 (α : Type) extends Baz α where
  x1 : α

structure Boo2 (α : Type) extends Boo1 α where
  x2 : α

structure Foo2 (α : Type) extends Bar (α → α), Boo2 α

#check Foo2.mk

def f2 (v : Nat) : Foo2 Nat :=
  { a  := id
    x  := (· + ·)
    b  := fun _ => ""
    x1 := 1
    x2 := v }

theorem ex2 (v : Nat) : (f2 v |>.x2) = v :=
  rfl

#print Foo2.toBar
#print Foo2.toBoo2


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import category_theory.limits.shapes.zero_morphisms
import category_theory.limits.shapes.kernels
import category_theory.abelian.basic
import category_theory.subobject.lattice
import order.atoms

/-!
# Simple objects

We define simple objects in any category with zero morphisms.
A simple object is an object `Y` such that any monomorphism `f : X ⟶ Y`
is either an isomorphism or zero (but not both).

This is formalized as a `Prop` valued typeclass `simple X`.

In some contexts, especially representation theory, simple objects are called "irreducibles".

If a morphism `f` out of a simple object is nonzero and has a kernel, then that kernel is zero.
(We state this as `kernel.ι f = 0`, but should add `kernel f ≅ 0`.)

When the category is abelian, being simple is the same as being cosimple (although we do not
state a separate typeclass for this).
As a consequence, any nonzero epimorphism out of a simple object is an isomorphism,
and any nonzero morphism into a simple object has trivial cokernel.

We show that any simple object is indecomposable.
-/

noncomputable theory

open category_theory.limits

namespace category_theory

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

section
variables [has_zero_morphisms C]

/-- An object is simple if monomorphisms into it are (exclusively) either isomorphisms or zero. -/
class simple (X : C) : Prop :=
(mono_is_iso_iff_nonzero : ∀ {Y : C} (f : Y ⟶ X) [mono f], is_iso f ↔ (f ≠ 0))

/-- A nonzero monomorphism to a simple object is an isomorphism. -/
lemma is_iso_of_mono_of_nonzero {X Y : C} [simple Y] {f : X ⟶ Y} [mono f] (w : f ≠ 0) :
  is_iso f :=
(simple.mono_is_iso_iff_nonzero f).mpr w

lemma simple.of_iso {X Y : C} [simple Y] (i : X ≅ Y) : simple X :=
{ mono_is_iso_iff_nonzero := λ Z f m, begin
    resetI,
    haveI : mono (f ≫ i.hom) := mono_comp _ _,
    split,
    { introsI h w,
      haveI j : is_iso (f ≫ i.hom), apply_instance,
      rw simple.mono_is_iso_iff_nonzero at j,
      unfreezingI { subst w, },
      simpa using j, },
    { intro h,
      haveI j : is_iso (f ≫ i.hom),
      { apply is_iso_of_mono_of_nonzero,
        intro w, apply h,
        simpa using (cancel_mono i.inv).2 w, },
      rw [←category.comp_id f, ←i.hom_inv_id, ←category.assoc],
      apply_instance, },
  end }

lemma simple.iff_of_iso {X Y : C} (i : X ≅ Y) : simple X ↔ simple Y :=
⟨λ h, by exactI simple.of_iso i.symm, λ h, by exactI simple.of_iso i⟩

lemma kernel_zero_of_nonzero_from_simple
  {X Y : C} [simple X] {f : X ⟶ Y} [has_kernel f] (w : f ≠ 0) :
  kernel.ι f = 0 :=
begin
  classical,
  by_contra,
  haveI := is_iso_of_mono_of_nonzero h,
  exact w (eq_zero_of_epi_kernel f),
end

/--
A nonzero morphism `f` to a simple object is an epimorphism
(assuming `f` has an image, and `C` has equalizers).
-/
-- See also `mono_of_nonzero_from_simple`, which requires `preadditive C`.
lemma epi_of_nonzero_to_simple [has_equalizers C] {X Y : C} [simple Y]
  {f : X ⟶ Y} [has_image f] (w : f ≠ 0) : epi f :=
begin
  rw ←image.fac f,
  haveI : is_iso (image.ι f) := is_iso_of_mono_of_nonzero (λ h, w (eq_zero_of_image_eq_zero h)),
  apply epi_comp,
end

lemma mono_to_simple_zero_of_not_iso
  {X Y : C} [simple Y] {f : X ⟶ Y} [mono f] (w : is_iso f → false) : f = 0 :=
begin
  classical,
  by_contra,
  exact w (is_iso_of_mono_of_nonzero h)
end

lemma id_nonzero (X : C) [simple.{v} X] : 𝟙 X ≠ 0 :=
(simple.mono_is_iso_iff_nonzero (𝟙 X)).mp (by apply_instance)

instance (X : C) [simple.{v} X] : nontrivial (End X) :=
nontrivial_of_ne 1 0 (id_nonzero X)

section

lemma simple.not_is_zero (X : C) [simple X] : ¬ is_zero X :=
by simpa [limits.is_zero.iff_id_eq_zero] using id_nonzero X

variable [has_zero_object C]
open_locale zero_object

variables (C)

/-- We don't want the definition of 'simple' to include the zero object, so we check that here. -/
lemma zero_not_simple [simple (0 : C)] : false :=
(simple.mono_is_iso_iff_nonzero (0 : (0 : C) ⟶ (0 : C))).mp ⟨⟨0, by tidy⟩⟩ rfl

end
end

-- We next make the dual arguments, but for this we must be in an abelian category.
section abelian
variables [abelian C]

/-- In an abelian category, an object satisfying the dual of the definition of a simple object is
    simple. -/
lemma simple_of_cosimple (X : C) (h : ∀ {Z : C} (f : X ⟶ Z) [epi f], is_iso f ↔ (f ≠ 0)) :
  simple X :=
⟨λ Y f I,
 begin
  classical,
  fsplit,
  { introsI,
    have hx := cokernel.π_of_epi f,
    by_contra,
    substI h,
    exact (h _).mp (cokernel.π_of_zero _ _) hx },
  { intro hf,
    suffices : epi f,
    { exactI is_iso_of_mono_of_epi _ },
    apply preadditive.epi_of_cokernel_zero,
    by_contra h',
    exact cokernel_not_iso_of_nonzero hf ((h _).mpr h') }
 end⟩

/-- A nonzero epimorphism from a simple object is an isomorphism. -/
lemma is_iso_of_epi_of_nonzero {X Y : C} [simple X] {f : X ⟶ Y} [epi f] (w : f ≠ 0) :
  is_iso f :=
begin
  -- `f ≠ 0` means that `kernel.ι f` is not an iso, and hence zero, and hence `f` is a mono.
  haveI : mono f :=
    preadditive.mono_of_kernel_zero (mono_to_simple_zero_of_not_iso (kernel_not_iso_of_nonzero w)),
  exact is_iso_of_mono_of_epi f,
end

lemma cokernel_zero_of_nonzero_to_simple
  {X Y : C} [simple Y] {f : X ⟶ Y} (w : f ≠ 0) :
  cokernel.π f = 0 :=
begin
  classical,
  by_contradiction h,
  haveI := is_iso_of_epi_of_nonzero h,
  exact w (eq_zero_of_mono_cokernel f),
end

lemma epi_from_simple_zero_of_not_iso
  {X Y : C} [simple X] {f : X ⟶ Y} [epi f] (w : is_iso f → false) : f = 0 :=
begin
  classical,
  by_contra,
  exact w (is_iso_of_epi_of_nonzero h),
end

end abelian

section indecomposable
variables [preadditive C] [has_binary_biproducts C]

-- There are another three potential variations of this lemma,
-- but as any one suffices to prove `indecomposable_of_simple` we will not give them all.
lemma biprod.is_iso_inl_iff_is_zero (X Y : C) : is_iso (biprod.inl : X ⟶ X ⊞ Y) ↔ is_zero Y :=
begin
  rw [biprod.is_iso_inl_iff_id_eq_fst_comp_inl, ←biprod.total, add_right_eq_self],
  split,
  { intro h, replace h := h =≫ biprod.snd,
    simpa [←is_zero.iff_is_split_epi_eq_zero (biprod.snd : X ⊞ Y ⟶ Y)] using h, },
  { intro h, rw is_zero.iff_is_split_epi_eq_zero (biprod.snd : X ⊞ Y ⟶ Y) at h,
    rw [h, zero_comp], },
end

/-- Any simple object in a preadditive category is indecomposable. -/
lemma indecomposable_of_simple (X : C) [simple X] : indecomposable X :=
⟨simple.not_is_zero X,
λ Y Z i, begin
  refine or_iff_not_imp_left.mpr (λ h, _),
  rw is_zero.iff_is_split_mono_eq_zero (biprod.inl : Y ⟶ Y ⊞ Z) at h,
  change biprod.inl ≠ 0 at h,
  rw ←(simple.mono_is_iso_iff_nonzero biprod.inl) at h,
  { rwa biprod.is_iso_inl_iff_is_zero at h, },
  { exact simple.of_iso i.symm, },
  { apply_instance, },
end⟩

end indecomposable

section subobject
variables [has_zero_morphisms C] [has_zero_object C]

open_locale zero_object
open subobject

instance {X : C} [simple X] : nontrivial (subobject X) :=
nontrivial_of_not_is_zero (simple.not_is_zero X)

instance {X : C} [simple X] : is_simple_order (subobject X) :=
{ eq_bot_or_eq_top := begin
  rintro ⟨⟨⟨(Y : C), ⟨⟨⟩⟩, (f : Y ⟶ X)⟩, (m : mono f)⟩⟩, resetI,
  change mk f = ⊥ ∨ mk f = ⊤,
  by_cases h : f = 0,
  { exact or.inl (mk_eq_bot_iff_zero.mpr h), },
  { refine or.inr ((is_iso_iff_mk_eq_top _).mp ((simple.mono_is_iso_iff_nonzero f).mpr h)), }
end, }

/-- If `X` has subobject lattice `{⊥, ⊤}`, then `X` is simple. -/
lemma simple_of_is_simple_order_subobject (X : C) [is_simple_order (subobject X)] : simple X :=
begin
  split, introsI, split,
  { introI i,
    rw subobject.is_iso_iff_mk_eq_top at i,
    intro w,
    rw ←subobject.mk_eq_bot_iff_zero at w,
    exact is_simple_order.bot_ne_top (w.symm.trans i), },
  { intro i,
    rcases is_simple_order.eq_bot_or_eq_top (subobject.mk f) with h|h,
    { rw subobject.mk_eq_bot_iff_zero at h,
      exact false.elim (i h), },
    { exact (subobject.is_iso_iff_mk_eq_top _).mpr h, }, }
end

/-- `X` is simple iff it has subobject lattice `{⊥, ⊤}`. -/
lemma simple_iff_subobject_is_simple_order (X : C) : simple X ↔ is_simple_order (subobject X) :=
⟨by { introI h, apply_instance, },
 by { introI h, exact simple_of_is_simple_order_subobject X, }⟩

/-- A subobject is simple iff it is an atom in the subobject lattice. -/
lemma subobject_simple_iff_is_atom {X : C} (Y : subobject X) : simple (Y : C) ↔ is_atom Y :=
(simple_iff_subobject_is_simple_order _).trans
  ((order_iso.is_simple_order_iff (subobject_order_iso Y)).trans
    set.is_simple_order_Iic_iff_is_atom)

end subobject

end category_theory


import .preprocess

open lia tactic

instance : decidable_eq (fm atom) :=
by mk_dec_eq_instance

def of_as_true_le {x y : int} (h₂ : as_true (has_le.le x y)) : (has_le.le x y) :=
match (int.decidable_le x y), h₂ with
| (is_true h_c),  h₂ := h_c
| (is_false h_c), h₂ := false.elim h₂
end

def of_as_true_dvd {x y : int} (h₂ : as_true (has_dvd.dvd x y)) : (has_dvd.dvd x y) :=
match (int.decidable_dvd x y), h₂ with
| (is_true h_c),  h₂ := h_c
| (is_false h_c), h₂ := false.elim h₂
end

def of_as_false_dvd {x y : int} (h : as_false (has_dvd.dvd x y)) : ¬(has_dvd.dvd x y) :=
match (int.decidable_dvd x y), h with
| (is_true h_c),  h := false.elim h
| (is_false h_c), h := h_c
end

meta def dec_triv_tac : tactic unit :=
do t ← target,
   to_expr ``(@of_as_true %%t) >>= apply,
   triv

meta def show_le : tactic unit :=
papply ``(of_as_true_le) >> triv

meta def show_dvd : tactic unit :=
papply ``(of_as_true_dvd) >> triv

meta def show_ndvd : tactic unit :=
papply ``(of_as_false_dvd) >> triv

meta def unfold_I :=
`[simp only [I, interp, atom_type.val, lia.val,
             list.dot_prod, list.map, list.zip_pad,
             list.sum_exp, list.foldl, int.one_mul,
             int.neg_one_mul, int.zero_add,
             int.zero_mul, int.mul_zero]]

meta def rewrite_ite_eq_of :=
`[rewrite ite_eq_of,
  swap_goals, dec_triv_tac]

meta def rewrite_ite_eq_of_not :=
`[rewrite ite_eq_of_not,
  swap_goals, dec_triv_tac]

meta def rewrite_filter_map_cons_none :=
`[rewrite list.filter_map_cons_none,
  swap_goals, refl]

meta def rewrite_filter_map_cons_some :=
`[rewrite list.filter_map_cons_some,
  swap_goals, refl]

meta def prove_ex_iff_ex :=
`[repeat {apply ex_iff_ex, intro x}, simp, refl]

meta def rewrite_cooper :=
`[rewrite iff.symm (qe_cooper_prsv _ _ _)]

lemma  not_or_of_not_and_not {a b : Prop} (h : ¬ a ∧ ¬ b) : ¬ (a ∨ b) :=
iff.elim_right not_or_distrib h

meta def show_fm : fm atom → tactic unit
| ⊤' := triv
| ⊥' := failed
| (p ∧' q) :=
  do papply ``(and.intro),
     show_fm p, show_fm q
| (p ∨' q) :=
  (papply ``(or.inl) >> show_fm p)
  <|> (papply ``(or.inr) >> show_fm q)
| (A' (atom.le _ _)) := triv
| (A' (atom.dvd _ _ _)) := show_dvd
| (A' (atom.ndvd _ _ _)) := show_ndvd
| (¬' ⊤') := failed
| (¬' ⊥') := papply ``(not_false) >> skip
| ¬'(p ∧' q) :=
  do papply ``(not_and_of_not_or_not),
     show_fm  (¬'p ∨' ¬'q)
| ¬'(p ∨' q) :=
  do papply ``(not_or_of_not_and_not),
     show_fm  (¬'p ∧' ¬'q)
| (¬'(A' (atom.le _ _))) :=
  papply ``(not_false) >> skip
| (¬'(A' (atom.dvd _ _ _))) := show_ndvd
| (¬'(A' (atom.ndvd _ _ _))) :=
  papply ``(not_not_intro) >> show_dvd
| (¬' ¬' p) := papply ``(not_not_intro) >> show_fm p
| _ := trace "Invalid input : remaining quantifier" >> failed

meta def dec_fm_core : fm atom → tactic bool
| ⊤' := return true
| ⊥' := return false
| (A' (atom.le i [])) :=
  match int.decidable_le i 0 with
  | (is_true _) := return true
  | (is_false _) := return false
  end
| (A' (atom.le _ (k::ks))) :=
  trace "Remaining free variables : le atom" >> failed
| (A' (atom.dvd d i [])) :=
  -- trace "Deciding : " >> trace d >> trace " | " >> trace i >>
  match int.decidable_dvd d i with
  | (is_true _) := return true
  | (is_false _) := return false
  end
| (A' (atom.dvd _ _ (k::ks))) :=
  trace "Remaining free variables : dvd atom " >> failed
| (A' (atom.ndvd d i [])) :=
  match int.decidable_dvd d i with
  | (is_true _) := return false
  | (is_false _) := return true
  end
| (A' (atom.ndvd d i (k::ks))) :=
  -- trace "Coeffs : " >> trace (k::ks) >>
  trace "Remaining free variables : ndvd atom" >> failed
| (p ∧' q) :=
  do bp ← dec_fm_core p,
     bq ← dec_fm_core q,
     --trace "Result of evalulating ",
     --trace (p ∧' q), trace " : ", trace (bp && bq),
     return $ bp && bq
| (p ∨' q) :=
  do bp ← dec_fm_core p,
     bq ← dec_fm_core q,
     --trace "Result of evalulating ",
     --trace (p ∨' q), trace " : ", trace (bp || bq),
     return $ bp || bq
| (¬' p) :=
  do bp ← dec_fm_core p,
     --trace "Result of evalulating ",
     --trace (¬' p), trace " : ", trace (bnot bp),
     return (bnot bp)
| (∃' p) := trace "Remaining quantifiers" >> failed

meta def dec_fm (p : fm atom) : tactic unit :=
monad.cond (dec_fm_core p) admit failed

meta def trace_fm:=
do `(I %%fe' []) ← target,
   eval_expr (fm atom) fe' >>= trace

meta def cooper : tactic unit :=
do reflect_goal,
   `(I %%fe []) ← target,
   papply ``((qe_cooper_prsv %%fe _ _).elim_left),
   `(I %%fe' []) ← target,
   eval_expr (fm atom) fe' >>= show_fm,
   dec_triv_tac,
   skip

meta def cooper_vm : tactic unit :=
do reflect_goal,
   `(I %%fe []) ← target,
   papply ``((qe_cooper_prsv %%fe _ _).elim_left),
   `(I %%fe' []) ← target,
   eval_expr (fm atom) fe' >>= dec_fm,
   dec_triv_tac,
   skip


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

/-!
# Limits over essentially small indexing categories

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

If `C` has limits of size `w` and `J` is `w`-essentially small, then `C` has limits of shape `J`.

-/

universes w₁ w₂ v₁ v₂ u₁ u₂

noncomputable theory

open category_theory

namespace category_theory.limits
variables (J : Type u₂) [category.{v₂} J] (C : Type u₁) [category.{v₁} C]

lemma has_limits_of_shape_of_essentially_small [essentially_small.{w₁} J]
  [has_limits_of_size.{w₁ w₁} C] : has_limits_of_shape J C :=
has_limits_of_shape_of_equivalence $ equivalence.symm $ equiv_small_model.{w₁} J

lemma has_colimits_of_shape_of_essentially_small [essentially_small.{w₁} J]
  [has_colimits_of_size.{w₁ w₁} C] : has_colimits_of_shape J C :=
has_colimits_of_shape_of_equivalence $ equivalence.symm $ equiv_small_model.{w₁} J

lemma has_products_of_shape_of_small (β : Type w₂) [small.{w₁} β] [has_products.{w₁} C] :
  has_products_of_shape β C :=
has_limits_of_shape_of_equivalence $ discrete.equivalence $ equiv.symm $ equiv_shrink β

lemma has_coproducts_of_shape_of_small (β : Type w₂) [small.{w₁} β] [has_coproducts.{w₁} C] :
  has_coproducts_of_shape β C :=
has_colimits_of_shape_of_equivalence $ discrete.equivalence $ equiv.symm $ equiv_shrink β

end category_theory.limits


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

import category_theory.category
import abelian
import exact
import hom_to_mathlib
import pseudoelements
import tactic.diagram_chase

open category_theory
open category_theory.limits
open category_theory.abelian
open category_theory.abelian.pseudoelements

local attribute [instance] object_to_sort
local attribute [instance] hom_to_fun

universes v u
section
variables {V : Type u} [𝒱 : category.{v} V] [abelian.{v} V]
include 𝒱

section four
variables {A B C D A' B' C' D' : V}
variables {f : A ⟶ B} {g : B ⟶ C} {h : C ⟶ D}
variables {f' : A' ⟶ B'} {g' : B' ⟶ C'} {h' : C' ⟶ D'}
variables {α : A ⟶ A'} {β : B ⟶ B'} {γ : C ⟶ C'} {δ : D ⟶ D'}
variables (fg : exact f g) (gh : exact g h) (fg' : exact f' g') (gh' : exact g' h')
variables (comm₁ : α ≫ f' = f ≫ β) (comm₂ : β ≫ g' = g ≫ γ) (comm₃ : γ ≫ h' = h ≫ δ)
include fg gh fg' gh' comm₁ comm₂ comm₃

lemma four (hα : epi α) (hβ : mono β) (hδ : mono δ) : mono γ :=
mono_of_zero_of_map_zero _ $ assume (c : C) (hc : γ c = 0), show c = 0, from

  have h c = 0, from
    suffices δ (h c) = 0, from zero_of_map_zero _ (pseudo_injective_of_mono _) _ this,
    calc δ (h c) = h' (γ c) : by rw [←comp_apply, ←comm₃, comp_apply]
             ... = h' 0     : by rw hc
             ... = 0        : apply_zero _,

  exists.elim ((pseudo_exact_of_exact gh).2 _ this) $ assume (b : B) (hb : g b = c),
    have g' (β b) = 0, from
      calc g' (β b) = γ (g b) : by rw [←comp_apply, comm₂, comp_apply]
                ... = γ c     : by rw hb
                ... = 0       : hc,

    exists.elim ((pseudo_exact_of_exact fg').2 _ this) $ assume (a' : A') (ha' : f' a' = β b),
      exists.elim (pseudo_surjective_of_epi α a') $ assume (a : A) (ha : α a = a'),

      have f a = b, from
        suffices β (f a) = β b, from pseudo_injective_of_mono _ this,
        calc β (f a) = f' (α a) : by rw [←comp_apply, ←comm₁, comp_apply]
                 ... = f' a'    : by rw ha
                 ... = β b      : ha',

      calc c = g b     : hb.symm
         ... = g (f a) : by rw this
         ... = 0       : (pseudo_exact_of_exact fg).1 _

lemma four' [epi α] [mono β] [mono δ] : mono γ :=
mono_of_zero_of_map_zero _ $ λ c hc,
begin
  chase c using [g, β, f', α] with b b' a' a,
  have : f a = b, by commutativity,
  commutativity
end

end four

section kernels
variables {P Q R P' Q' R' : V}
variables {f : P ⟶ Q} {g : Q ⟶ R} {f' : P' ⟶ Q'} {g' : Q' ⟶ R'}
variables {α : P ⟶ P'} {β : Q ⟶ Q'} {γ : R ⟶ R'}
variables (comm₁ : α ≫ f' = f ≫ β) (comm₂ : β ≫ g' = g ≫ γ)
variables (fg : exact f g) (fg' : exact f' g')
variables [mono f']

include comm₁ comm₂ fg fg'

lemma kernels' : ∃! (u : kernel α ⟶ kernel β) (v : kernel β ⟶ kernel γ),
  (kernel.ι α ≫ f = u ≫ kernel.ι β) ∧ (kernel.ι β ≫ g = v ≫ kernel.ι γ)
  ∧ exact u v :=
begin
  obtain ⟨u, hu₁, hu₂⟩ := kernel.lift'' β (kernel.ι α ≫ f) (begin
    rw category.assoc, rw ←comm₁, rw ←category.assoc,
    rw kernel.condition, rw has_zero_morphisms.zero_comp,
  end),
  obtain ⟨v, hv₁, hv₂⟩ := kernel.lift'' γ (kernel.ι β ≫ g) (begin
    rw category.assoc, rw ←comm₂, rw ←category.assoc,
    rw kernel.condition, rw has_zero_morphisms.zero_comp,
  end),

  refine ⟨u, ⟨v, ⟨hu₁.symm, hv₁.symm, exact_of_pseudo_exact _ _ ⟨_, _⟩⟩,
    λ v', by rintro ⟨_, h, _⟩; exact hv₂ _ h.symm⟩,
    λ u', by rintro ⟨_, ⟨h, _⟩, _⟩; exact hu₂ _ h.symm⟩,

  { intro a,
    apply zero_of_map_zero _ (pseudo_injective_of_mono (kernel.ι γ)),
    calc (kernel.ι γ : kernel γ ⟶ R) (v (u a))
          = (u ≫ v ≫ kernel.ι γ) a : by rw [←comp_apply, ←comp_apply]
      ... = (u ≫ kernel.ι β ≫ g) a : by rw hv₁
      ... = (kernel.ι α ≫ f ≫ g) a : by rw [←category.assoc, hu₁, category.assoc]
      ... = (kernel.ι α ≫ 0 : kernel α ⟶ R) a : by rw fg.1
      ... = 0 : by rw [has_zero_morphisms.comp_zero, zero_apply] },
  { intros b hb,

    have : g ((kernel.ι β : kernel β ⟶ Q) b) = 0,
    calc g ((kernel.ι β : kernel β ⟶ Q) b)
          = (kernel.ι γ : kernel γ ⟶ R) (v b) : by rw [←comp_apply, ←hv₁, comp_apply]
      ... = (kernel.ι γ : kernel γ ⟶ R) 0 : by rw hb
      ... = 0 : apply_zero _,

    obtain ⟨a', ha'⟩ := (pseudo_exact_of_exact fg).2 _ this,

    have : α a' = 0,
    { apply zero_of_map_zero _ (pseudo_injective_of_mono f'),
      calc f' (α a') = β (f a') : by rw [←comp_apply, comm₁, comp_apply]
      ... = β ((kernel.ι β : kernel β ⟶ Q) b) : by rw ha'
      ... = 0 : (pseudo_exact_of_exact (kernel_exact β)).1 _ },

    obtain ⟨a, ha⟩ := (pseudo_exact_of_exact (kernel_exact α)).2 _ this,

    use a,

    apply pseudo_injective_of_mono (kernel.ι β),
    calc (kernel.ι β : kernel β → Q) (u a)
          = f ((kernel.ι α : kernel α ⟶ P) a) : by rw [←comp_apply, hu₁, comp_apply]
      ... = f a' : by rw ha
      ... = (kernel.ι β : kernel β ⟶ Q) b : ha' }
end

end kernels

end

namespace kernels_full
variables {V : Type u} [𝒱 : category.{v} V] [abelian.{v} V]
include 𝒱

variables {A B C D E F G H I : V}
variables {γ : A ⟶ D} {δ : B ⟶ E} {ε : C ⟶ F} {θ : D ⟶ G} {l : E ⟶ H} {μ : F ⟶ I}
variables {ζ : D ⟶ E} {η : E ⟶ F} {ν : G ⟶ H} {ξ : H ⟶ I}
variables (comm₁ : ζ ≫ l = θ ≫ ν) (comm₂ : η ≫ μ = l ≫ ξ)
variables (γθ : exact γ θ) (δl : exact δ l) (εμ : exact ε μ)
variables (ζη : exact ζ η) (νξ : exact ν ξ)
include comm₁ comm₂ γθ δl εμ ζη νξ

def fill_left [mono δ] : { x : A ⟶ B // x ≫ δ = γ ≫ ζ } :=
kernel_fork.is_limit.lift' (kernel_of_mono_exact _ _ δl) (γ ≫ ζ) $
  by rw [category.assoc, comm₁, ←category.assoc, γθ.1, has_zero_morphisms.zero_comp]

def fill_right [mono ε] : { x : B ⟶ C // x ≫ ε = δ ≫ η } :=
kernel_fork.is_limit.lift' (kernel_of_mono_exact _ _ εμ) (δ ≫ η) $
  by rw [category.assoc, comm₂, ←category.assoc, δl.1, has_zero_morphisms.zero_comp]

variables {α : A ⟶ B} {β : B ⟶ C}
variables (comm₃ : α ≫ δ = γ ≫ ζ) (comm₄ : β ≫ ε = δ ≫ η)
include comm₃ comm₄

lemma fill_left_unique [mono δ] : α = fill_left comm₁ comm₂ γθ δl εμ ζη νξ :=
begin
  apply (kernel_of_mono_exact _ _ δl).hom_ext,
  intro j,
  cases j,
  { erw (fill_left comm₁ comm₂ γθ δl εμ ζη νξ).2,
    erw comm₃ },
  { simp only [kernel_fork.app_one],
    erw has_zero_morphisms.comp_zero,
    erw has_zero_morphisms.comp_zero }
end

lemma fill_right_unique [mono ε] : β = fill_right comm₁ comm₂ γθ δl εμ ζη νξ :=
begin
  apply (kernel_of_mono_exact _ _ εμ).hom_ext,
  intro j,
  cases j,
  { erw (fill_right comm₁ comm₂ γθ δl εμ ζη νξ).2,
    erw comm₄ },
  { simp only [kernel_fork.app_one],
    erw has_zero_morphisms.comp_zero,
    erw has_zero_morphisms.comp_zero }
end

lemma kernels [mono δ] [mono ε] [mono ν] : exact α β :=
begin
  apply exact_of_pseudo_exact,
  split,
  { intro a,
    commutativity },
  { intros b hb,
    chase b using [δ, ζ, γ] with e d a,
    exact ⟨a, by commutativity⟩ }
end

lemma kernels' [mono δ] [mono ε] [mono ν] : exact α β :=
begin
  apply exact_of_pseudo_exact,
  split,

  { intro a,
    apply zero_of_map_zero _ (pseudo_injective_of_mono ε),
    calc ε (β (α a)) = (α ≫ β ≫ ε) a : by rw [←comp_apply, ←comp_apply]
      ... = (α ≫ δ ≫ η) a : by rw comm₄
      ... = (γ ≫ ζ ≫ η) a : by rw [←category.assoc, comm₃, category.assoc]
      ... = (γ ≫ (0 : D ⟶ F)) a : by rw ζη.1
      ... = 0 : by rw [has_zero_morphisms.comp_zero, zero_apply] },

  { intros b hb,

    have : η (δ b) = 0,
    calc η (δ b) = ε (β b) : by rw [←comp_apply, ←comm₄, comp_apply]
      ... = ε 0 : by rw hb
      ... = 0 : apply_zero _,

    obtain ⟨d, hd⟩ := (pseudo_exact_of_exact ζη).2 _ this,

    have : θ d = 0,
    { apply zero_of_map_zero _ (pseudo_injective_of_mono ν),
      calc ν (θ d) = l (ζ d) : by rw [←comp_apply, ←comm₁, comp_apply]
        ... = l (δ b) : by rw hd
        ... = 0 : (pseudo_exact_of_exact δl).1 _ },

    obtain ⟨a, ha⟩ := (pseudo_exact_of_exact γθ).2 _ this,

    use a,

    apply pseudo_injective_of_mono δ,
    calc δ (α a) = ζ (γ a) : by rw [←comp_apply, comm₃, comp_apply]
      ... = ζ d : by rw ha
      ... = δ b : hd }
end

end kernels_full


import Mathlib.Data.Nat.Basic

/-
A summary of this file (28 Feb 2023):
+ Add some results about internals of Range and For to aid proofs
-/

open Std Std.Range Std.Range.forIn

variable {β : Type u} {m : Type u → Type v} [Monad m]

namespace ForInStep

/- Boolean version of .isDone -/
def isDone : ForInStep α → Bool
  | .done _ => true
  | _       => false

/- Boolean version of .isYield -/
def isYield : ForInStep α → Bool
  | .yield _ => true
  | _        => false

/- Propositional version of .isDone -/
def isDone' : ForInStep α → Prop := λ s => s.isDone

/- Propositional version of .isYield -/
def isYield' : ForInStep α → Prop := λ s => s.isYield

def extractStep : ForInStep β → m β
  | .done b  => pure b
  | .yield b => pure b

theorem isDoneEqIsDone' (s : ForInStep β) : s.isDone = s.isDone' := rfl

theorem isYieldEqIsYield' (s : ForInStep β) : s.isYield = s.isYield' := rfl

theorem isDoneOrIsYield (s : ForInStep β) : s.isDone ∨ s.isYield := by
  cases s <;> simp [isDone, isYield]

theorem notIsDoneAndIsYield (s : ForInStep β) : ¬(s.isDone ∧ s.isYield) := by
  cases s <;> simp [isDone, isYield]

end ForInStep

namespace Std.Range

/-
Results about `loop`
-/

theorem emptyStep' {start stop : ℕ} {init : β} {f : ℕ → β → Id (ForInStep β)} (hs : stop ≤ start) :
  loop f fuel start stop 1 init = init := by
  cases start <;> cases fuel <;> simp [loop, not_lt_of_ge hs]
  simp [Nat.le_zero.1 hs]

theorem emptyStep {k : ℕ} {init : β} {f : ℕ → β → Id (ForInStep β)} :
  Range.forIn [k : k] init f = init := emptyStep' Nat.le.refl

-- We can decompose a for loop range into two parts and execute them separately
-- The results are only stated for `Id` monad, not sure how to generalise
theorem rangeDecompose [Monad m] [LawfulMonad m]
  (start mid stop : ℕ) (hs : start ≤ mid ∧ mid ≤ stop)
  {f : ℕ → β → m (ForInStep β)} (hf : ∀ i r, SatisfiesM ForInStep.isYield' (f i r)) :
  Range.forIn [start:stop] init f =
    Range.forIn [start:mid] init f >>= λ b => Range.forIn [mid:stop] b f := by
  sorry

-- The results are only stated for `Id` monad, not sure how to generalise
-- theorem singleStep (start stop : ℕ) (hs : start ≤ stop) {f : ℕ → β → Id (ForInStep β)} :
--   Range.forIn (mkRange' start stop.succ) init f =
--     f stop (Id.run (Range.forIn (mkRange' start mid) init f)) := by
--   sorry

end Std.Range

private def ff := λ i r => if i ≥ 100 then ForInStep.done (r + 1) else ForInStep.yield (r + 1)

#eval Id.run (Range.forIn { start := 3, stop := 13 } 5 ff)
#eval Id.run (Range.forIn { start := 93, stop := 103 } 5 ff)


/-
Copyright (c) 2017 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Jesse Michael Han
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.hint
import Mathlib.PostPort

universes l u

namespace Mathlib

/-!
# The `finish` family of tactics

These tactics do straightforward things: they call the simplifier, split conjunctive assumptions,
eliminate existential quantifiers on the left, and look for contradictions. They rely on ematching
and congruence closure to try to finish off a goal at the end.

The procedures *do* split on disjunctions and recreate the smt state for each terminal call, so
they are only meant to be used on small, straightforward problems.

## Main definitions

We provide the following tactics:

* `finish`  -- solves the goal or fails
* `clarify` -- makes as much progress as possible while not leaving more than one goal
* `safe`    -- splits freely, finishes off whatever subgoals it can, and leaves the rest

All accept an optional list of simplifier rules, typically definitions that should be expanded.
(The equations and identities should not refer to the local context.)

-/

namespace tactic

namespace interactive

end interactive

end tactic

namespace auto

/-! ### Utilities -/

-- stolen from interactive.lean

/--
Configuration information for the auto tactics.
* `(use_simp := tt)`: call the simplifier
* `(max_ematch_rounds := 20)`: for the "done" tactic
-/
structure auto_config
where
  use_simp : Bool
  max_ematch_rounds : ℕ

/-!
### Preprocess goal.

We want to move everything to the left of the sequent arrow. For intuitionistic logic,
we replace the goal `p` with `∀ f, (p → f) → f` and introduce.
-/

theorem by_contradiction_trick (p : Prop) (h : ∀ (f : Prop), (p → f) → f) : p :=
  h p id

/-!
### Normalize hypotheses

Bring conjunctions to the outside (for splitting),
bring universal quantifiers to the outside (for ematching). The classical normalizer
eliminates `a → b` in favor of `¬ a ∨ b`.

For efficiency, we push negations inwards from the top down. (For example, consider
simplifying `¬ ¬ (p ∨ q)`.)
-/

theorem not_not_eq (p : Prop) : (¬¬p) = p :=
  propext not_not

theorem not_and_eq (p : Prop) (q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) :=
  propext not_and_distrib

theorem not_or_eq (p : Prop) (q : Prop) : (¬(p ∨ q)) = (¬p ∧ ¬q) :=
  propext not_or_distrib

theorem not_forall_eq {α : Type u} (s : α → Prop) : (¬∀ (x : α), s x) = ∃ (x : α), ¬s x :=
  propext not_forall

theorem not_exists_eq {α : Type u} (s : α → Prop) : (¬∃ (x : α), s x) = ∀ (x : α), ¬s x :=
  propext not_exists

theorem not_implies_eq (p : Prop) (q : Prop) : (¬(p → q)) = (p ∧ ¬q) :=
  propext not_imp

theorem classical.implies_iff_not_or (p : Prop) (q : Prop) : p → q ↔ ¬p ∨ q :=
  imp_iff_not_or

def common_normalize_lemma_names : List name := sorry

def classical_normalize_lemma_names : List name := sorry

/-- optionally returns an equivalent expression and proof of equivalence -/
/-- given an expr `e`, returns a new expression and a proof of equality -/
/-!
### Eliminate existential quantifiers
-/

/-- eliminate an existential quantifier if there is one -/
/-- eliminate all existential quantifiers, fails if there aren't any -/
/-!
### Substitute if there is a hypothesis `x = t` or `t = x`
-/

/-- carries out a subst if there is one, fails otherwise -/
/-!
### Split all conjunctions
-/

/-- Assumes `pr` is a proof of `t`. Adds the consequences of `t` to the context
 and returns `tt` if anything nontrivial has been added. -/
/-- return `tt` if any progress is made -/
/-- return `tt` if any progress is made -/
/-- fail if no progress is made -/
/-!
### Eagerly apply all the preprocessing rules
-/

/-- Eagerly apply all the preprocessing rules -/
/-!
### Terminal tactic
-/

/--
The terminal tactic, used to try to finish off goals:
- Call the contradiction tactic.
- Open an SMT state, and use ematching and congruence closure, with all the universal
  statements in the context.

TODO(Jeremy): allow users to specify attribute for ematching lemmas?
-/
/--
`done` first attempts to close the goal using `contradiction`. If this fails, it creates an
SMT state and will repeatedly use `ematch` (using `ematch` lemmas in the environment,
universally quantified assumptions, and the supplied lemmas `ps`) and congruence closure.
-/
/-!
### Tactics that perform case splits
-/

inductive case_option
where
| force : case_option
| at_most_one : case_option
| accept : case_option

-- three possible outcomes:

--   finds something to case, the continuations succeed ==> returns tt

--   finds something to case, the continutations fail ==> fails

--   doesn't find anything to case ==> returns ff

/-!
### The main tactics
-/

/--
`safe_core s ps cfg opt` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `s`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `ps`) and congruence closure.

`safe_core` is complete for propositional logic. Depending on the form of `opt`
it will:

- (if `opt` is `case_option.force`) fail if it does not close the goal,
- (if `opt` is `case_option.at_most_one`) fail if it produces more than one goal, and
- (if `opt` is `case_option.accept`) ignore the number of goals it produces.
-/
/--
`clarify` is `safe_core`, but with the `(opt : case_option)`
parameter fixed at `case_option.at_most_one`.
-/
/--
`safe` is `safe_core`, but with the `(opt : case_option)`
parameter fixed at `case_option.accept`.
-/
/--
`finish` is `safe_core`, but with the `(opt : case_option)`
parameter fixed at `case_option.force`.
-/
end auto

/-! ### interactive versions -/

namespace tactic

namespace interactive

/--
`clarify [h1,...,hn] using [e1,...,en]` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `h1,...,hn`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `e1,...,en`) and congruence closure.

`clarify` is complete for propositional logic.

Either of the supplied simp lemmas or the supplied ematch lemmas are optional.

`clarify` will fail if it produces more than one goal.
-/
/--
`safe [h1,...,hn] using [e1,...,en]` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `h1,...,hn`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `e1,...,en`) and congruence closure.

`safe` is complete for propositional logic.

Either of the supplied simp lemmas or the supplied ematch lemmas are optional.

`safe` ignores the number of goals it produces, and should never fail.
-/
/--
`finish [h1,...,hn] using [e1,...,en]` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `h1,...,hn`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `e1,...,en`) and congruence closure.

`finish` is complete for propositional logic.

Either of the supplied simp lemmas or the supplied ematch lemmas are optional.

`finish` will fail if it does not close the goal.
-/
/--
These tactics do straightforward things: they call the simplifier, split conjunctive assumptions,


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

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

/-!
# Split coequalizers

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

We define what it means for a triple of morphisms `f g : X ⟶ Y`, `π : Y ⟶ Z` to be a split
coequalizer: there is a section `s` of `π` and a section `t` of `g`, which additionally satisfy
`t ≫ f = π ≫ s`.

In addition, we show that every split coequalizer is a coequalizer
(`category_theory.is_split_coequalizer.is_coequalizer`) and absolute
(`category_theory.is_split_coequalizer.map`)

A pair `f g : X ⟶ Y` has a split coequalizer if there is a `Z` and `π : Y ⟶ Z` making `f,g,π` a
split coequalizer.
A pair `f g : X ⟶ Y` has a `G`-split coequalizer if `G f, G g` has a split coequalizer.

These definitions and constructions are useful in particular for the monadicity theorems.

## TODO

Dualise to split equalizers.
-/

namespace CategoryTheory

universe v v₂ u u₂

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

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

variable (G : C ⥤ D)

variable {X Y : C} (f g : X ⟶ Y)

#print CategoryTheory.IsSplitCoequalizer /-
/-- A split coequalizer diagram consists of morphisms

      f   π
    X ⇉ Y → Z
      g

satisfying `f ≫ π = g ≫ π` together with morphisms

      t   s
    X ← Y ← Z

satisfying `s ≫ π = 𝟙 Z`, `t ≫ g = 𝟙 Y` and `t ≫ f = π ≫ s`.

The name "coequalizer" is appropriate, since any split coequalizer is a coequalizer, see
`category_theory.is_split_coequalizer.is_coequalizer`.
Split coequalizers are also absolute, since a functor preserves all the structure above.
-/
structure IsSplitCoequalizer {Z : C} (π : Y ⟶ Z) where
  rightSection : Z ⟶ Y
  leftSection : Y ⟶ X
  condition : f ≫ π = g ≫ π
  rightSection_π : right_section ≫ π = 𝟙 Z
  leftSection_bottom : left_section ≫ g = 𝟙 Y
  leftSection_top : left_section ≫ f = π ≫ right_section
#align category_theory.is_split_coequalizer CategoryTheory.IsSplitCoequalizer
-/

instance {X : C} : Inhabited (IsSplitCoequalizer (𝟙 X) (𝟙 X) (𝟙 X)) :=
  ⟨⟨𝟙 _, 𝟙 _, rfl, Category.id_comp _, Category.id_comp _, rfl⟩⟩

open IsSplitCoequalizer

attribute [reassoc.1] condition

attribute [simp, reassoc.1] right_section_π left_section_bottom left_section_top

variable {f g}

/- warning: category_theory.is_split_coequalizer.map -> CategoryTheory.IsSplitCoequalizer.map is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y} {g : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y} {Z : C} {π : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) Y Z}, (CategoryTheory.IsSplitCoequalizer.{u1, u3} C _inst_1 X Y f g Z π) -> (forall (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), CategoryTheory.IsSplitCoequalizer.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Y) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y f) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F X Y g) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Z) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 F Y Z π))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y} {g : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y} {Z : C} {π : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) Y Z}, (CategoryTheory.IsSplitCoequalizer.{u1, u3} C _inst_1 X Y f g Z π) -> (forall (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), CategoryTheory.IsSplitCoequalizer.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Y) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y f) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) X Y g) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Z) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) Y Z π))
Case conversion may be inaccurate. Consider using '#align category_theory.is_split_coequalizer.map CategoryTheory.IsSplitCoequalizer.mapₓ'. -/
/-- Split coequalizers are absolute: they are preserved by any functor. -/
@[simps]
def IsSplitCoequalizer.map {Z : C} {π : Y ⟶ Z} (q : IsSplitCoequalizer f g π) (F : C ⥤ D) :
    IsSplitCoequalizer (F.map f) (F.map g) (F.map π)
    where
  rightSection := F.map q.rightSection
  leftSection := F.map q.leftSection
  condition := by rw [← F.map_comp, q.condition, F.map_comp]
  rightSection_π := by rw [← F.map_comp, q.right_section_π, F.map_id]
  leftSection_bottom := by rw [← F.map_comp, q.left_section_bottom, F.map_id]
  leftSection_top := by rw [← F.map_comp, q.left_section_top, F.map_comp]
#align category_theory.is_split_coequalizer.map CategoryTheory.IsSplitCoequalizer.map

section

open Limits

#print CategoryTheory.IsSplitCoequalizer.asCofork /-
/-- A split coequalizer clearly induces a cofork. -/
@[simps pt]
def IsSplitCoequalizer.asCofork {Z : C} {h : Y ⟶ Z} (t : IsSplitCoequalizer f g h) : Cofork f g :=
  Cofork.ofπ h t.condition
#align category_theory.is_split_coequalizer.as_cofork CategoryTheory.IsSplitCoequalizer.asCofork
-/

/- warning: category_theory.is_split_coequalizer.as_cofork_π -> CategoryTheory.IsSplitCoequalizer.asCofork_π is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y} {g : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y} {Z : C} {h : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) Y Z} (t : CategoryTheory.IsSplitCoequalizer.{u1, u2} C _inst_1 X Y f g Z h), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 (CategoryTheory.Limits.parallelPair.{u1, u2} C _inst_1 X Y f g) CategoryTheory.Limits.WalkingParallelPair.one) (CategoryTheory.Functor.obj.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 (CategoryTheory.Functor.obj.{u1, u1, u2, max u1 u2} C _inst_1 (CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.Functor.category.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.Functor.const.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.Limits.Cocone.pt.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 (CategoryTheory.Limits.parallelPair.{u1, u2} C _inst_1 X Y f g) (CategoryTheory.IsSplitCoequalizer.asCofork.{u1, u2} C _inst_1 X Y f g Z h t))) CategoryTheory.Limits.WalkingParallelPair.one)) (CategoryTheory.Limits.Cofork.π.{u1, u2} C _inst_1 X Y f g (CategoryTheory.IsSplitCoequalizer.asCofork.{u1, u2} C _inst_1 X Y f g Z h t)) h
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {X : C} {Y : C} {f : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y} {g : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) X Y} {Z : C} {h : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) Y Z} (t : CategoryTheory.IsSplitCoequalizer.{u1, u2} C _inst_1 X Y f g Z h), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 (CategoryTheory.Limits.parallelPair.{u1, u2} C _inst_1 X Y f g)) CategoryTheory.Limits.WalkingParallelPair.one) (Prefunctor.obj.{1, succ u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.CategoryStruct.toQuiver.{0, 0} CategoryTheory.Limits.WalkingParallelPair (CategoryTheory.Category.toCategoryStruct.{0, 0} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 (Prefunctor.obj.{succ u1, succ u1, u2, max u1 u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) (CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.CategoryStruct.toQuiver.{u1, max u2 u1} (CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.Category.toCategoryStruct.{u1, max u2 u1} (CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.Functor.category.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1))) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u2, max u2 u1} C _inst_1 (CategoryTheory.Functor.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.Functor.category.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1) (CategoryTheory.Functor.const.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1)) (CategoryTheory.Limits.Cocone.pt.{0, u1, 0, u2} CategoryTheory.Limits.WalkingParallelPair CategoryTheory.Limits.walkingParallelPairHomCategory C _inst_1 (CategoryTheory.Limits.parallelPair.{u1, u2} C _inst_1 X Y f g) (CategoryTheory.IsSplitCoequalizer.asCofork.{u1, u2} C _inst_1 X Y f g Z h t)))) CategoryTheory.Limits.WalkingParallelPair.one)) (CategoryTheory.Limits.Cofork.π.{u1, u2} C _inst_1 X Y f g (CategoryTheory.IsSplitCoequalizer.asCofork.{u1, u2} C _inst_1 X Y f g Z h t)) h
Case conversion may be inaccurate. Consider using '#align category_theory.is_split_coequalizer.as_cofork_π CategoryTheory.IsSplitCoequalizer.asCofork_πₓ'. -/
@[simp]
theorem IsSplitCoequalizer.asCofork_π {Z : C} {h : Y ⟶ Z} (t : IsSplitCoequalizer f g h) :
    t.asCofork.π = h :=
  rfl
#align category_theory.is_split_coequalizer.as_cofork_π CategoryTheory.IsSplitCoequalizer.asCofork_π

#print CategoryTheory.IsSplitCoequalizer.isCoequalizer /-
/--
The cofork induced by a split coequalizer is a coequalizer, justifying the name. In some cases it
is more convenient to show a given cofork is a coequalizer by showing it is split.
-/
def IsSplitCoequalizer.isCoequalizer {Z : C} {h : Y ⟶ Z} (t : IsSplitCoequalizer f g h) :
    IsColimit t.asCofork :=
  Cofork.IsColimit.mk' _ fun s =>
    ⟨t.rightSection ≫ s.π, by
      dsimp
      rw [← t.left_section_top_assoc, s.condition, t.left_section_bottom_assoc], fun m hm => by
      simp [← hm]⟩
#align category_theory.is_split_coequalizer.is_coequalizer CategoryTheory.IsSplitCoequalizer.isCoequalizer
-/

end

variable (f g)

#print CategoryTheory.HasSplitCoequalizer /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`splittable] [] -/
/--
The pair `f,g` is a split pair if there is a `h : Y ⟶ Z` so that `f, g, h` forms a split coequalizer
in `C`.
-/
class HasSplitCoequalizer : Prop where
  splittable : ∃ (Z : C)(h : Y ⟶ Z), Nonempty (IsSplitCoequalizer f g h)
#align category_theory.has_split_coequalizer CategoryTheory.HasSplitCoequalizer
-/

#print CategoryTheory.Functor.IsSplitPair /-
/--
The pair `f,g` is a `G`-split pair if there is a `h : G Y ⟶ Z` so that `G f, G g, h` forms a split
coequalizer in `D`.
-/
abbrev Functor.IsSplitPair : Prop :=
  HasSplitCoequalizer (G.map f) (G.map g)
#align category_theory.functor.is_split_pair CategoryTheory.Functor.IsSplitPair
-/

#print CategoryTheory.HasSplitCoequalizer.coequalizerOfSplit /-
/-- Get the coequalizer object from the typeclass `is_split_pair`. -/
noncomputable def HasSplitCoequalizer.coequalizerOfSplit [HasSplitCoequalizer f g] : C :=
  (HasSplitCoequalizer.splittable f g).some
#align category_theory.has_split_coequalizer.coequalizer_of_split CategoryTheory.HasSplitCoequalizer.coequalizerOfSplit
-/

#print CategoryTheory.HasSplitCoequalizer.coequalizerπ /-
/-- Get the coequalizer morphism from the typeclass `is_split_pair`. -/
noncomputable def HasSplitCoequalizer.coequalizerπ [HasSplitCoequalizer f g] :
    Y ⟶ HasSplitCoequalizer.coequalizerOfSplit f g :=
  (HasSplitCoequalizer.splittable f g).choose_spec.some
#align category_theory.has_split_coequalizer.coequalizer_π CategoryTheory.HasSplitCoequalizer.coequalizerπ
-/

#print CategoryTheory.HasSplitCoequalizer.isSplitCoequalizer /-
/-- The coequalizer morphism `coequalizer_ι` gives a split coequalizer on `f,g`. -/
noncomputable def HasSplitCoequalizer.isSplitCoequalizer [HasSplitCoequalizer f g] :
    IsSplitCoequalizer f g (HasSplitCoequalizer.coequalizerπ f g) :=
  Classical.choice (HasSplitCoequalizer.splittable f g).choose_spec.choose_spec
#align category_theory.has_split_coequalizer.is_split_coequalizer CategoryTheory.HasSplitCoequalizer.isSplitCoequalizer
-/

/- warning: category_theory.map_is_split_pair -> CategoryTheory.map_is_split_pair is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y) (g : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y) [_inst_3 : CategoryTheory.HasSplitCoequalizer.{u1, u3} C _inst_1 X Y f g], CategoryTheory.HasSplitCoequalizer.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 G X) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 G Y) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 G X Y f) (CategoryTheory.Functor.map.{u1, u2, u3, u4} C _inst_1 D _inst_2 G X Y g)
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) {X : C} {Y : C} (f : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y) (g : Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) X Y) [_inst_3 : CategoryTheory.HasSplitCoequalizer.{u1, u3} C _inst_1 X Y f g], CategoryTheory.HasSplitCoequalizer.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 G) X) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 G) Y) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 G) X Y f) (Prefunctor.map.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 G) X Y g)
Case conversion may be inaccurate. Consider using '#align category_theory.map_is_split_pair CategoryTheory.map_is_split_pairₓ'. -/
/-- If `f, g` is split, then `G f, G g` is split. -/
instance map_is_split_pair [HasSplitCoequalizer f g] : HasSplitCoequalizer (G.map f) (G.map g)
    where splittable :=
    ⟨_, _, ⟨IsSplitCoequalizer.map (HasSplitCoequalizer.isSplitCoequalizer f g) _⟩⟩
#align category_theory.map_is_split_pair CategoryTheory.map_is_split_pair

namespace Limits

#print CategoryTheory.Limits.hasCoequalizer_of_hasSplitCoequalizer /-
/-- If a pair has a split coequalizer, it has a coequalizer. -/
instance (priority := 1) hasCoequalizer_of_hasSplitCoequalizer [HasSplitCoequalizer f g] :
    HasCoequalizer f g :=
  HasColimit.mk ⟨_, (HasSplitCoequalizer.isSplitCoequalizer f g).isCoequalizer⟩
#align category_theory.limits.has_coequalizer_of_has_split_coequalizer CategoryTheory.Limits.hasCoequalizer_of_hasSplitCoequalizer
-/

end Limits

end CategoryTheory