src/RepresentableStructure_ch7_2.v

   1 (*******************************************************************************)
   2 (* Chapter 7.2: Representable Structure                                        *)
   3 (*******************************************************************************)
   4
   5 Generalizable All Variables.
   6 Require Import Preamble.
   7 Require Import Categories_ch1_3.
   8 Require Import Functors_ch1_4.
   9 Require Import Isomorphisms_ch1_5.
  10 Require Import EpicMonic_ch2_1.
  11 Require Import ProductCategories_ch1_6_1.
  12 Require Import OppositeCategories_ch1_6_2.
  13 Require Import Enrichment_ch2_8.
  14 Require Import Subcategories_ch7_1.
  15 Require Import NaturalTransformations_ch7_4.
  16 Require Import NaturalIsomorphisms_ch7_5.
  17 Require Import MonoidalCategories_ch7_8.
  18 Require Import Coherence_ch7_8.
  19
  20 Section RepresentableStructure.
  21   Context `(ec:ECategory(mn:=mn)(V:=V)).
  22
  23   Definition hom_contravariant {a:ec}{d e:ec}(f:EI~~{V}~~>(d~~>e)) := #(pmon_cancell mn _)⁻¹ >>> (f ⋉ (_ ~~> a)) >>> ecomp.
  24   Definition hom_covariant     {a:ec}{d e:ec}(f:EI~~{V}~~>(d~~>e)) := #(pmon_cancelr mn _)⁻¹ >>> ((a ~~> d) ⋊ f) >>> ecomp.
  25
  26   Lemma hom_covariant_distributes     {a b c:ec}{x}(f:a~~{ec}~~>b)(g:b~~{ec}~~>c)
  27      : hom_covariant (f >>> g) ~~ (hom_covariant (a:=x) f) >>> (hom_covariant g).
  28      set (f >>> g) as fg; simpl in fg; unfold fg; clear fg.
  29      unfold hom_covariant.
  30      repeat setoid_rewrite associativity.
  31      apply comp_respects; try reflexivity.
  32      set (@ecomp_is_functorial) as qq.
  33      repeat setoid_rewrite associativity in qq.
  34      apply qq.
  35      Qed.
  36
  37   (*
  38   Lemma hom_swap {a b c d:ec}(f:a~~{ec}~~>b)(g:c~~{ec}~~>d)
  39      : hom_covariant f >>> hom_contravariant g ~~ hom_contravariant g >>> hom_covariant f.
  40      etransitivity.
  41      unfold hom_covariant.
  42      unfold hom_contravariant.
  43      Defined.
  44
  45   Definition YonedaBiFunctor_fmor (a b:ec⁽ºᑭ⁾ ×× ec)(f:a~~{ec⁽ºᑭ⁾ ×× ec}~~>b)
  46         : ((fst_obj _ _ a)~~>(snd_obj _ _ a))~~{V}~~>((fst_obj _ _ b)~~>(snd_obj _ _ b)).
  47     destruct a as [a1 a2].
  48     destruct b as [b1 b2].
  49     case f as [f1 f2]; intros.
  50     exact ( hom_contravariant (a:=a2) f1 >>> hom_covariant (a:=b1) f2 ).
  51     Defined.
  52
  53   Definition YonedaBiFunctor : Functor (ec⁽ºᑭ⁾ ×× ec) V (fun a => (fst_obj _ _ a)~~>(snd_obj _ _ a)).
  54     refine {| fmor := fun a b f => YonedaBiFunctor_fmor a b f |}.
  55     abstract (intros; destruct a; destruct b; destruct f;
  56               destruct f';
  57               destruct H;
  58               repeat (apply comp_respects; try reflexivity); simpl;
  59               [ apply (@fmor_respects _ _ _ _ _ _ (fun x => (bin_obj x _))); auto
  60               | apply (fmor_respects ((o1 ~~> o0) ⋊-)); auto ]).
  61     abstract (
  62       destruct a; unfold YonedaBiFunctor_fmor;
  63       unfold hom_covariant;
  64       unfold hom_contravariant;
  65       etransitivity; simpl;
  66       [ apply comp_respects; setoid_rewrite associativity; simpl;
  67         [ etransitivity; [ apply comp_respects; [ reflexivity | apply eleft_identity ] | apply iso_comp2 ]
  68         | etransitivity; [ apply comp_respects; [ reflexivity | apply eright_identity ] | apply iso_comp2 ]
  69         ]
  70       | apply left_identity ]
  71       ).
  72     abstract (destruct a; destruct b; destruct c;
  73               destruct f;
  74               destruct g; unfold YonedaBiFunctor_fmor;
  75               setoid_rewrite juggle3;
  76               setoid_rewrite hom_swap;
  77               setoid_rewrite <- juggle3;
  78               setoid_rewrite <- hom_contravariant_distributes;
  79               setoid_rewrite <- hom_covariant_distributes;
  80               simpl;
  81               apply comp_respects;
  82               reflexivity).
  83     Defined.
  84
  85   Definition HomFunctorºᑭ (X:ec) : Functor ec⁽ºᑭ⁾ V (fun a => a~~>X) := func_rlecnac X >>>> YonedaBiFunctor.
  86   *)
  87
  88   Definition HomFunctor   (X:ec) : Functor ec     V (ehom X).
  89     refine {| fmor := @hom_covariant X |}.
  90     intros.
  91       unfold hom_covariant.
  92       apply comp_respects; try reflexivity.
  93       apply comp_respects; try reflexivity.
  94       apply fmor_respects; auto.
  95     intros.
  96       unfold hom_covariant.
  97       apply (epic _ (iso_epic ((pmon_cancelr mn) (X ~~> a)))).
  98       setoid_rewrite <- associativity.
  99       setoid_rewrite <- associativity.
 100       setoid_rewrite iso_comp1.
 101       setoid_rewrite left_identity.
 102       setoid_rewrite right_identity.
 103       apply (@eright_identity).
 104     intros.
 105       symmetry.
 106       apply hom_covariant_distributes.
 107       Defined.
 108
 109   (*
 110   Lemma undo_homfunctor `(f:a~~{ec}~~>b) : f ~~ eid _ >>> (HomFunctor a \ f).
 111     simpl.
 112     setoid_rewrite <- associativity.
 113     unfold hom_contravariant.
 114     repeat setoid_rewrite <- associativity.
 115     setoid_rewrite juggle1.
 116     setoid_rewrite eleft_identity.
 117     repeat setoid_rewrite <- associativity.
 118     setoid_rewrite juggle1.
 119     setoid_rewrite iso_comp1.
 120     setoid_rewrite right_identity.
 121     unfold hom_covariant.
 122     repeat setoid_rewrite <- associativity.
 123     set (ni_commutes (@pmon_cancelr _ _ _ _ _ _ mn) (eid a)) as qq.
 124     simpl in qq.
 125     apply iso_shift_right' in qq.
 126     apply symmetry in qq.
 127     setoid_rewrite <- associativity in qq.
 128     apply iso_shift_left' in qq.
 129     apply symmetry in qq.
 130     setoid_rewrite qq.
 131     setoid_rewrite associativity.
 132     setoid_rewrite juggle3.
 133     setoid_rewrite (centralmor_first(CentralMorphism:=eid_central(ECategory:=ec) a)).
 134     repeat setoid_rewrite associativity.
 135     setoid_rewrite eleft_identity.
 136     set (ni_commutes (@pmon_cancell _ _ _ _ _ _ mn) f) as qqq.
 137     simpl in qqq.
 138     setoid_rewrite <- qqq.
 139     setoid_rewrite <- associativity.
 140     set (coincide pmon_triangle) as qqqq.
 141     setoid_rewrite qqqq.
 142     setoid_rewrite iso_comp1.
 143     setoid_rewrite left_identity.
 144     set (@eqv_equivalence) as qmt.
 145     apply qmt.
 146     Qed.
 147     *)
 148
 149 End RepresentableStructure.
 150 Opaque HomFunctor.
 151
 152 Structure MonoidalEnrichment {e:Enrichment} :=
 153 { me_enr         :=e
 154 ; me_fobj        : prod_obj e e -> e
 155 ; me_f           : Functor (e ×× e) e me_fobj
 156 ; me_i           : e
 157 ; me_mon         : MonoidalCat e me_fobj me_f me_i
 158 ; me_mf          : MonoidalFunctor me_mon (enr_v_mon e) (HomFunctor e me_i)
 159 }.
 160 Implicit Arguments MonoidalEnrichment [ ].
 161 Coercion me_mon : MonoidalEnrichment >-> MonoidalCat.
 162 Coercion me_enr : MonoidalEnrichment >-> Enrichment.
 163
 164 (* an enrichment for which hom(I,-) is monoidal, full, faithful, and conservative *)
 165 Structure MonicMonoidalEnrichment {e}{me:MonoidalEnrichment e} :=
 166 { ffme_enr             := me
 167 ; ffme_mf_full         : FullFunctor         (HomFunctor e (me_i me))
 168 ; ffme_mf_faithful     : FaithfulFunctor     (HomFunctor e (me_i me))
 169 ; ffme_mf_conservative : ConservativeFunctor (HomFunctor e (me_i me))
 170 }.
 171 Implicit Arguments MonicMonoidalEnrichment [ ].
 172 Coercion ffme_enr : MonicMonoidalEnrichment >-> MonoidalEnrichment.
 173 Transparent HomFunctor.
 174
 175 Structure SurjectiveMonicMonoidalEnrichment (e:Enrichment) :=
 176 { smme_se       : SurjectiveEnrichment e
 177 ; smme_monoidal : MonoidalEnrichment e
 178 ; smme_me       : MonicMonoidalEnrichment _ smme_monoidal
 179 }.
 180 Coercion smme_se : SurjectiveMonicMonoidalEnrichment >-> SurjectiveEnrichment.
 181 Coercion smme_me : SurjectiveMonicMonoidalEnrichment >-> MonicMonoidalEnrichment.
 182
 183 (* like SurjectiveMonicMonoidalEnrichment, but the Enrichment is a field, not a parameter *)
 184 Structure SMME :=
 185 { smme_e   : Enrichment
 186 ; smme_see : SurjectiveEnrichment smme_e
 187 ; smme_mon : MonoidalEnrichment smme_e
 188 ; smme_mee : MonicMonoidalEnrichment _ smme_mon
 189 }.
 190 Coercion smme_e   : SMME >-> Enrichment.
 191 Coercion smme_see : SMME >-> SurjectiveEnrichment.
 192 Coercion smme_mon : SMME >-> MonoidalEnrichment.
 193 Coercion smme_mee : SMME >-> MonicMonoidalEnrichment.