(** The solution set condition. In Freyd's adjoint functor theorem it is assumed that (Comma (Func_From_SingletonCat x) G) satisfies solution set condition.  A category C satisfies solution set condition if there is a type A, a function f : A → C such that for any object (c : C) there exists a (t : A) such that there is a morphism h : (f t) –≻ c. In short, f is jointly weakly initial. *)
Record Solution_Set_Cond (C : Category) :=
{
SSC_Type : Type;
SSC_Objs : SSC_Type → C;
SSC_jointly_weakly_initial :>
∀ (c : C), {t : SSC_Type & ((SSC_Objs t) –≻ c)%morphism}
}
.
Arguments SSC_Type {_} _.
Arguments SSC_Objs {_} _ _.
Arguments SSC_jointly_weakly_initial {_} _ _.
Basic_Cons.Terminal
Basic_Cons.Equalizer
Basic_Cons.Limits
Basic_Cons.Facts.Equalizer_Monic
.
(** We show that a category that is complete and satisfies solution set condition has an initial object. This initial object is the equalizer of all endo-morphisms d : W –≻ W, where W is the generalized product of the function (SSC_Objs) of the solution set condition. *)
Section Complete_SSC_Initial.
Context
{C : Category}
(CC : Complete C)
(SSC : Solution_Set_Cond C)
.
(** The product of objects producing SSC. *)
Definition SSC_Prod : (Π (SSC_Objs SSC))%object
:=
(LimitOf (Discr_Func (SSC_Objs SSC))).
(** SSC_Prod is weakly initial. I.e., it has an arrow (not necessarily unique) to any other object. *)
Definition SSC_Prod_WI (c : C) :
(SSC_Prod –≻ c)%morphism
:=
(
(projT2 (SSC_jointly_weakly_initial SSC c))
∘
(
Trans
(cone_edge SSC_Prod)
(projT1 (SSC_jointly_weakly_initial SSC c))
)
)%morphism
.
(** The constant function from endomorphisms of SSC_Prod that returns SSC_Prod.  *)
Definition endomorph_const (h : (SSC_Prod –≻ SSC_Prod)%morphism) : C
:=
SSC_Prod
.
(** The product of SSC_Prod with endomorphisms as index. *)
Definition Endo_Prod : (Π endomorph_const)%object
:=
(LimitOf (Discr_Func endomorph_const)).
(** Cone to (Discr_Func endomorph_const) that maps to ids. *)
Program Definition Cone_Endo_Prod_ids : Cone (Discr_Func endomorph_const)
:=
{|
cone_apex :=
{|
FO := fun _ => SSC_Prod;
FA := fun _ _ _ => id
|};
cone_edge :=
{|
Trans := fun _ => id
|}
|}
.
(** Morphism that projects to ids. *)
Definition morph_to_Endo_Prod_ids : (SSC_Prod –≻ Endo_Prod)%morphism
:=
Trans (LRKE_morph_ex Endo_Prod Cone_Endo_Prod_ids) tt.
(** Cone to (Discr_Func endomorph_const) that maps to ids. *)
Program Definition Cone_Endo_Prod_endomorphs :
Cone (Discr_Func endomorph_const)
:=
{|
cone_apex :=
{|
FO := fun _ => SSC_Prod;
FA := fun _ _ _ => id
|};
cone_edge :=
{|
Trans := fun h => h
|}
|}
.
(** Morphism that projects to endomorphisms. *)
Definition morph_to_Endo_Prod_endomorphs : (SSC_Prod –≻ Endo_Prod)%morphism
:=
Trans (LRKE_morph_ex Endo_Prod Cone_Endo_Prod_endomorphs) tt.
Definition ids_endomorphs_equalizer :
Equalizer
morph_to_Endo_Prod_endomorphs
morph_to_Endo_Prod_ids
:=
Equalizer_as_Limit
morph_to_Endo_Prod_endomorphs
morph_to_Endo_Prod_ids
(LimitOf
(Equalizer_Producing_Func
morph_to_Endo_Prod_endomorphs
morph_to_Endo_Prod_ids)
)
.
(** ids_endomorphs_equalizer is weakly initial. I.e., it has an arrow (not necessarily unique) to any other object. *)
Definition ids_endomorphs_equalizer_WI (c : C) :
(ids_endomorphs_equalizer –≻ c)%morphism
:=
(SSC_Prod_WI c ∘ equalizer_morph ids_endomorphs_equalizer)%morphism
.

(* Specifications: *)
(** composing any endomorphism after equalizer morphism of ids_endomorphs_equalizer is the same as the equalizer morphism of ids_endomorphs_equalizer. *)
Theorem ids_endomorphs_equalizer_morph_neutralizes_endomorphs
(d : (SSC_Prod –≻ SSC_Prod)%morphism)
:
(d ∘ equalizer_morph ids_endomorphs_equalizer)%morphism
= equalizer_morph ids_endomorphs_equalizer
.