Set Implicit Arguments. Unset Strict Implicit. Require Export ord. Ltac cw := autorewrite with cw; try tv; try am. Module Category. Export Universe. Module Notations. Open Local Scope string_scope. Definition Objects := R "Objects". Definition Composition := R "Composition". Definition Identity := R "Identity". Definition Structure := R "Structure". (*** the latter is a placeholder for any additional structure we might want to put on ****) Definition objects a := V Objects a. Definition morphisms a := V Underlying a. Definition composition a := V Composition a. Definition identity a := V Identity a. Definition structure a := V Structure a. Definition create (o m:E) (c : E2) (i:E1) (s:E):= denote Objects o ( denote Underlying m ( denote Composition (L m (fun u => L (Z m (fun v => source u = target v)) (c u))) ( denote Identity (L o i) ( denote Structure s ( stop))))). Lemma objects_create :forall o m c i s, objects (create o m c i s) = o. ir; uf objects; uf create. drw. Qed. Lemma morphisms_create : forall o m c i s, morphisms (create o m c i s) = m. ir; uf morphisms; uf create. drw. Qed. Lemma structure_create : forall o m c i s, structure (create o m c i s) = s. Proof. ir; uf structure; uf create. drw. Qed. Lemma composition_create : forall o m c i s, composition (create o m c i s) = L m (fun u => (L (Z m (fun v => source u = target v)) (c u))). Proof. ir. uf create. uf composition. drw. Qed. Lemma identity_create : forall o m c i s, identity (create o m c i s) = L o i. Proof. ir. uf create. uf identity. drw. Qed. Hint Rewrite objects_create morphisms_create composition_create identity_create : cw. Definition comp a u v := V v (V u (composition a)). Definition id a x := V x (identity a). Definition like a := a = create (objects a) (morphisms a) (comp a) (id a) (structure a). Lemma create_extensionality : forall o m c i s o1 m1 c1 i1 s1, o = o1 -> m = m1 -> (forall u v, inc u m -> inc v m -> source u = target v -> c u v = c1 u v) -> (forall x, inc x o -> i x = i1 x) -> s = s1 -> create o m c i s = create o1 m1 c1 i1 s1. Proof. ir. wr H. wr H0. assert (lem1: L m (fun u => L (Z m (fun v => source u = target v)) (c u)) = L m (fun u => L (Z m (fun v => source u = target v)) (c1 u))). ap Function.create_extensionality. tv. ir. ap Function.create_extensionality. tv. ir. ap H1. am. Ztac. Ztac. assert (lem2: L o i = L o i1). ap Function.create_extensionality. tv. au. uf create. rw lem1. rw lem2. rw H3. reflexivity. Qed. Lemma create_like : forall o m c i s, like (create o m c i s). Proof. ir. uf like. ap create_extensionality. rw objects_create; tv. rw morphisms_create; tv. ir. uf comp. rw composition_create. rw create_V_rewrite. rw create_V_rewrite. tv. Ztac. am. ir. uf id. rw identity_create. rw create_V_rewrite. tv. am. rw structure_create. tv. Qed. Definition is_ob a x := inc x (objects a). Definition is_mor a u := inc u (morphisms a). End Notations. Export Notations. Lemma is_ob_create : forall o m c i s x, is_ob (create o m c i s) x = (inc x o). Proof. ir. uf is_ob. cw. Qed. Lemma is_mor_create : forall o m c i s u, is_mor (create o m c i s) u = (inc u m). Proof. ir. uf is_mor. cw. Qed. Lemma comp_create : forall o m c i s u v, inc u m -> inc v m -> source u = target v -> comp (create o m c i s) u v = c u v. Proof. ir. uf comp. cw. aw. Ztac. Qed. Lemma id_create : forall o m c i s x, inc x o -> id (create o m c i s) x = i x. Proof. ir. uf id. cw. aw. Qed. (**** axioms ****) Definition are_composable a f g := is_mor a f & is_mor a g & source f = target g. Definition is_ob_facts a x := is_ob a x & is_mor a (id a x) & source (id a x) = x & target (id a x) = x & (forall f, is_mor a f-> source f = x -> comp a f (id a x) = f) & (forall f, is_mor a f-> target f = x -> comp a (id a x) f = f). Definition is_mor_facts a f:= is_mor a f & is_ob a (source f) & is_ob a (target f) & comp a (id a (target f)) f = f & comp a f (id a (source f)) = f & Arrow.like f. Definition are_composable_facts a f g:= are_composable a f g & is_mor a (comp a f g) & source (comp a f g) = source g & target (comp a f g) = target f. Definition axioms a := (forall x, is_ob a x = is_ob_facts a x) & (forall u, is_mor a u = is_mor_facts a u) & (forall u v, are_composable a u v = are_composable_facts a u v) & (forall u v w, are_composable a u v -> are_composable a v w -> (comp a (comp a u v) w) = (comp a u (comp a v w))) & like a. Definition composable a u v := axioms a & are_composable a u v. Definition mor a u := axioms a & is_mor a u. Definition ob a x := axioms a & is_ob a x. Definition mor_facts c u := mor c u & ob c (source u) & ob c (target u) & comp c (id c (target u)) u = u & comp c u (id c (source u)) = u & Arrow.like u. Lemma mor_facts_rw : forall c u, mor c u = mor_facts c u. Proof. ir. ap iff_eq; ir. cp H; uh H; ee. cp H; uh H; ee. rwi H3 H1. uh H1; ee. uhg; xd. uhg; xd. uhg; xd. uh H; ee; am. Qed. Definition ob_facts c x := ob c x & mor c (id c x) & composable c (id c x) (id c x) & source (id c x) = x & target (id c x) = x & comp c (id c x) (id c x) = (id c x)& (forall u, mor c u -> source u = x -> comp c u (id c x) = u)& (forall u, mor c u -> target u = x -> comp c (id c x) u = u). Lemma ob_facts_rw : forall c x, ob c x = ob_facts c x. Proof. ir. ap iff_eq; ir. cp H; uh H; ee. cp H; uh H; ee. clear H6. cp H1; uh H1; ee. rwi H H6. uh H6; ee. uhg; xd. uhg; xd. uhg; xd. uhg; xd. rw H8; rw H9; tv. ir. ap H10. lu. am. ir. ap H11; lu. lu. Qed. Definition composable_facts c u v := axioms c & are_composable c u v & mor c u & mor c v & mor c (comp c u v)& source u = target v & source (comp c u v) = source v & target (comp c u v) = target u. Lemma composable_facts_rw : forall c u v, composable c u v = composable_facts c u v. Proof. ir; ap iff_eq; ir. cp H; uh H; ee. cp H; uh H; ee. clear H6. uhg; dj; try am. uhg; ee. am. lu. uhg; ee; lu. rwi H4 H1. uh H1; ee. uhg; ee; try am. uh H7; ee; am. rwi H4 H7. uh H7. ee. am. rwi H4 H7. uh H7. ee. am. uhg; uh H; xd. Qed. Lemma show_composable : forall c u v, mor c u -> mor c v -> source u = target v -> composable c u v. Proof. ir. cp H; uh H; ee. cp H; uh H; ee. uhg; ee. am. uh H0; ee. uhg; ee; try am. Qed. Lemma show_composable_facts : forall c u v, mor c u -> mor c v -> source u = target v -> composable_facts c u v. Proof. ir. wr composable_facts_rw; ap show_composable; am. Qed. Definition associativity_facts c u v w := composable_facts c u v & composable_facts c v w & composable_facts c u (comp c v w) & composable_facts c (comp c u v) w & comp c u (comp c v w) = comp c (comp c u v) w. Lemma show_associativity_facts : forall c u v w, composable c u v -> composable c v w -> associativity_facts c u v w. Proof. ir. cp H; uh H; ee. cp H; uh H; ee. clear H7. uhg. do 4 (wr composable_facts_rw). ee; try am. rwi composable_facts_rw H0; rwi composable_facts_rw H1. uh H0; uh H1; ee. ap show_composable. am. am. rw H20. am. ap show_composable. rwi composable_facts_rw H1; uh H1; ee; am. rwi composable_facts_rw H0; uh H0; ee; am. rwi composable_facts_rw H1; uh H1; ee. rw H12. uh H0; ee. uh H14; ee. am. sy; ap H6. am. uh H0; ee; am. Qed. Definition morphism_property (o m:E) (c:E2) (i:E1) u:= inc u m & inc (source u) o & inc (target u) o & c u (i (source u)) = u & c (i (target u)) u = u & Arrow.like u. Definition object_property (o m:E) (i:E1) x := inc x o & inc (i x) m & source (i x) = x & target (i x) = x. Definition composable_property (m:E) (c:E2) u v:= inc u m & inc v m & source u = target v & inc (c u v) m & source (c u v) = source v & target (c u v) = target u. Definition property (o m:E) (c:E2) (i:E1) := (forall x, inc x o = object_property o m i x) & (forall u, inc u m = morphism_property o m c i u) & (forall u v, inc u m -> inc v m -> source u = target v -> composable_property m c u v) & (forall u v w, inc u m -> inc v m -> inc w m -> source u = target v -> source v = target w -> c (c u v) w = c u (c v w)). Lemma are_composable_create_rw : forall o m c i s u v, are_composable (create o m c i s) u v = (inc u m & inc v m & source u = target v). Proof. ir. ap iff_eq; ir. uh H. rwi is_mor_create H. rwi is_mor_create H. xd. uhg. do 2 (rw is_mor_create). xd. Qed. Lemma create_axioms : forall o m (c : E2) (i:E1) (s:E), property o m c i -> axioms (create o m c i s). Proof. ir. set (k:=(create o m c i s)). assert (lem1 : forall u v, are_composable k u v = (inc u m & inc v m & source u = target v)). ir. ap iff_eq; ir. ufi k H0. rwi are_composable_create_rw H0. xd. uf k. rw are_composable_create_rw. xd. uh H; ee. assert (lem2: forall u, is_mor k u = inc u m). ir. ap iff_eq; ir. ufi k H3. rwi is_mor_create H3. am. uf k; rw is_mor_create; am. assert (lem3: forall u v, inc u m -> inc v m -> source u = target v -> comp k u v = c u v). ir. uf k. rw comp_create; tv. assert (lem5: forall x, inc x o -> id k x = i x). ir. uf k. rw id_create. tv. am. assert (lem6: forall (x:E), is_ob k x = inc x o). ir; ap iff_eq; ir. ufi k H3. rwi is_ob_create H3. am. uf k; rw is_ob_create; am. (*** the proof of axioms ***) (*** mor facts ***) uhg; ee; ir. ap iff_eq; ir. cp H3; rwi lem6 H3. rwi H H3. uh H3; ee. uhg; dj. am. rw lem2. rw lem5. am. am. rw lem5; am. rw lem5; am. rw lem5. rw lem3. rwi lem2 H12. rwi H0 H12. uh H12; ee. wr H13. am. wr lem2. am. wr lem5. wr lem2. am. am. rw H7. am. am. rw lem3. rw lem5. rwi lem2 H13. rwi H0 H13. uh H13; ee. wr H14. am. lu. wr lem2. am. wr lem2. am. rw H10. sy; am. lu. ap iff_eq; ir. rwi lem2 H3. rwi H0 H3. uh H3; ee. uhg; ee. rw lem2; am. rw lem6; am. rw lem6; am. rw lem3. rw lem5. am. am. rww lem5. rwi H H5. lu. am. rww lem5. rwi H0 H3. uh H3; ee. rwi H H10. uh H10; ee. am. rww lem3. rw lem5. am. am. rw lem5. rwi H H4. uh H4; ee. am. am. rw lem5. rwi H H4. uh H4; ee. sy; am. am. am. lu. ap iff_eq; ir. cp H3; uh H3; ee. rwi lem2 H3. rwi lem2 H5. util (H1 u v). am. am. am. uh H7; ee. uhg; xd. rw lem2. rww lem3. rww lem3. rww lem3. lu. (*** associativity ***) assert (inc u m). wr lem2; lu. assert (inc v m). wr lem2; lu. assert (inc w m). wr lem2; lu. assert (source u = target v). lu. assert (source v = target w). lu. rww lem3. rww lem3. rww lem3. rww lem3. rwi lem1 H3; rwi lem1 H4; ee. ap H2; try am. rww lem3. cp (H1 _ _ H6 H7 H9). lu. rww lem3. cp (H1 _ _ H5 H6 H8). util (H1 v w). am. am. am. uh H11; ee. rw H16. am. util (H1 u v). am. am. am. rw lem3. uh H10; ee. am. am. am. am. rww lem3. util (H1 u v). am. am. am. uh H10; ee. rw H14. am. uf k. ap create_like. Qed. Lemma ob_existence_rw : forall a x, ob a x = (exists f, (mor a f & source f = x)). Proof. ir. ap iff_eq; ir. rwi ob_facts_rw H. uh H; ee. sh (id a x); xd. nin H. ee. rwi mor_facts_rw H. uh H; ee. wr H0; am. Qed. Lemma left_id: forall a b x u, ob a x -> mor a u -> target u = x -> a = b -> comp a (id b x) u = u. Proof. ir. rwi mor_facts_rw H0; uh H0; ee. wr H2; wr H1; am. Qed. Lemma right_id : forall a b x u, ob a x -> mor a u -> source u = x -> a= b -> comp a u (id b x) = u. Proof. ir. rwi mor_facts_rw H0; uh H0; ee. wr H2; wr H1; am. Qed. Lemma left_id_unique : forall a e x, axioms a -> mor a e -> source e = x -> (forall f, composable a e f -> comp a e f = f) -> e = id a x. Proof. ir. rwi mor_facts_rw H0. wr H1. uh H0; ee. transitivity (comp a e (id a x)). rw right_id; try tv; try lu. wr H1; am. wr H2. wr H1; tv. ap show_composable. am. rwi ob_facts_rw H3; uh H3; ee; am. rwi ob_facts_rw H3; uh H3; ee; sy; am. Qed. Lemma right_id_unique : forall a e x, axioms a -> mor a e -> target e = x -> (forall f, composable a f e -> comp a f e = f) -> e = id a x. Proof. ir. rwi mor_facts_rw H0. wr H1. uh H0; ee. transitivity (comp a (id a (target e)) e). rw left_id; try tv; try lu. ap H2. ap show_composable. rwi ob_facts_rw H4; uh H4; ee; am. am. rwi ob_facts_rw H4; uh H4; ee; am. Qed. Definition same_data (o m : E) (c : E2) (i: E1) (o1 m1 : E) (c1 : E2) (i1: E1):= (forall x, inc x o = inc x o1) & (forall u, inc u m = inc u m1) & (forall u v, inc u m -> inc v m -> source u = target v -> c u v = c1 u v) & (forall x, inc x o -> i x = i1 x). Lemma ob_create : forall o m c i s x, property o m c i-> ob (create o m c i s) x = inc x o. Proof. ir. set (k:= create o m c i s). assert (lem0 : axioms k). uf k; ap create_axioms; am. assert (lem1 : forall x, ob k x = is_ob k x). ir. ap iff_eq; ir. lu. uhg; ee; am. rw lem1. uf k; rw is_ob_create; tv. Qed. Lemma mor_create : forall o m c i s u, property o m c i-> mor (create o m c i s) u = inc u m. Proof. ir. set (k:= create o m c i s). assert (lem0 : axioms k). uf k; ap create_axioms; am. assert (lem1 : forall u, mor k u = is_mor k u). ir. ap iff_eq; ir. lu. uhg; ee; am. rw lem1. uf k; rw is_mor_create; tv. Qed. Lemma uncomp : forall a b u v u1 v1, a = b -> u = u1 -> v = v1 -> comp a u v = comp b u1 v1. Proof. ir. rw H; rw H0; rw H1; tv. Qed. Lemma U_morphisms : forall a, (U a) = morphisms a. Proof. ir. tv. Qed. Lemma is_mor_mor : forall a u, axioms a -> is_mor a u -> mor a u. Proof. ir. uh H; ee. rwi H1 H0. uhg; uh H0; xd. uhg; au. Qed. Lemma is_ob_ob : forall a x, axioms a -> is_ob a x -> ob a x. Proof. ir. uh H; ee. rwi H H0. uhg; uh H0; xd. uhg; au. Qed. Lemma ob_is_ob : forall a x, ob a x -> is_ob a x. Proof. ir. lu. Qed. Lemma mor_id : forall a x, ob a x -> mor a (id a x). Proof. ir. rwi ob_facts_rw H; uh H; ee. am. Qed. Lemma mor_id_rw : forall a x, ob a x -> mor a (id a x) = True. Proof. ir. ap iff_eq; ir; try tv. app mor_id. Qed. Lemma source_id : forall a x, ob a x -> source (id a x) = x. Proof. ir. rwi ob_facts_rw H; uh H; ee. am. Qed. Lemma target_id : forall a x, ob a x -> target (id a x) = x. Proof. ir. rwi ob_facts_rw H; uh H; ee. am. Qed. Lemma ob_source : forall a u, mor a u -> ob a (source u) = True. Proof. ir. rwi mor_facts_rw H; uh H; ee. ap iff_eq; ir; try tv; try am. Qed. Lemma ob_target : forall a u, mor a u -> ob a (target u) = True. Proof. ir. rwi mor_facts_rw H; uh H; ee. ap iff_eq; ir; try tv; try am. Qed. Lemma mor_comp : forall a b u v, mor a u -> mor a v -> source u = target v -> a = b -> mor a (comp b u v)= True. Proof. ir. wr H2. assert (composable_facts a u v). ap show_composable_facts; am. ap iff_eq; ir; try tv; try am. lu. Qed. Lemma source_comp : forall a u v, mor a u -> mor a v -> source u = target v -> source (comp a u v) = source v. Proof. ir. assert (composable_facts a u v). ap show_composable_facts; am. lu. Qed. Lemma target_comp : forall a u v, mor a u -> mor a v -> source u = target v ->target (comp a u v) = target u. Proof. ir. assert (composable_facts a u v). ap show_composable_facts; am. lu. Qed. Lemma assoc : forall a b u v w, mor a u -> mor a v -> mor a w -> source u = target v -> source v = target w -> a= b -> comp a (comp b u v) w = comp a u (comp b v w). Proof. ir. wr H4. assert (associativity_facts a u v w). ap show_associativity_facts; ap show_composable; am. uh H5; ee. sy; am. Qed. Lemma mor_arrow_like : forall a u, mor a u -> Arrow.like u. Proof. ir. rwi mor_facts_rw H. lu. Qed. Hint Rewrite left_id right_id mor_id_rw source_id target_id ob_source ob_target mor_comp source_comp target_comp : cw. Lemma mor_inc_U : forall a u, mor a u -> inc u (U a). Proof. ir. change (is_mor a u); lu. Qed. Lemma mor_is_mor : forall a u, mor a u -> is_mor a u. Proof. ir. lu. Qed. Definition opp' a := Notations.create (objects a) (Image.create (morphisms a) flip) (fun u v => flip (comp a (flip v) (flip u))) (fun x => flip (id a x)) (structure a). Lemma is_ob_opp' : forall a x, is_ob (opp' a) x = is_ob a x. Proof. ir. uf opp'. rw is_ob_create. tv. Qed. Lemma structure_opp' : forall a, structure (opp' a) = structure a. Proof. ir. uf opp'. rww structure_create. Qed. Lemma inc_image_create_flip : forall a u, inc u (Image.create (morphisms a) flip) = is_mor (opp' a) u. Proof. ir. uf opp'. rw is_mor_create. tv. Qed. Lemma is_mor_opp' : forall a u, is_mor (opp' a) u = is_mor a (flip u). Proof. ir. uf opp'. rw is_mor_create. rw Image.inc_rw. app iff_eq; ir. nin H. ee. wr H0. rw flip_flip. am. sh (flip u). ee. am. rww flip_flip. Qed. Lemma comp_opp' : forall a u v, is_mor (opp' a) u -> is_mor (opp' a) v -> source u = target v -> comp (opp' a) u v = flip (comp a (flip v) (flip u)). Proof. ir. uf opp'. rw comp_create. tv. rww inc_image_create_flip. rww inc_image_create_flip. am. Qed. Lemma id_opp' : forall a x, is_ob (opp' a) x -> id (opp' a) x = flip (id a x). Proof. ir. uf opp'. rw id_create. tv. ufi opp' H. rwi is_ob_create H. am. Qed. Lemma opp'_opp' : forall a, axioms a -> opp' (opp' a) = a. Proof. ir. assert (like a). lu. uh H0. transitivity (create (objects a) (morphisms a) (comp a) (id a) (structure a)). assert (Image.create (Image.create (morphisms a) flip) flip = morphisms a). ap extensionality; uhg; ir. rwi Image.inc_rw H1. nin H1. ee. rwi Image.inc_rw H1. nin H1. ee. wr H2. wr H3. rw flip_flip. am. ap Image.show_inc. sh (flip x). ee. ap Image.show_inc. sh x. ee. am. tv. rww flip_flip. uf opp'. ap create_extensionality. rww objects_create. rw morphisms_create. am. rw morphisms_create. rw H1. ir. rw comp_create. rw flip_flip. rw flip_flip. rww flip_flip. ap Image.show_inc. sh v; ee; try am. tv. ap Image.show_inc. sh u; ee; try tv; try am. rw source_flip. rw target_flip. sy; am. apply mor_arrow_like with a. app is_mor_mor. apply mor_arrow_like with a. app is_mor_mor. rw objects_create. ir. rw id_create. rww flip_flip. am. rww structure_create. sy; am. Qed. Lemma opp'_axioms : forall a, axioms a -> axioms (opp' a). Proof. ir. assert (morli : forall u, is_mor a u -> Arrow.like u). ir. uh H; ee. rwi H1 H0. uh H0; ee. am. assert (obidli : forall x, is_ob a x -> Arrow.like (id a x)). ir. uh H. ee. rwi H H0. uh H0. ee. ap morli. am. assert (flifli : forall u, flip (flip u) = u). ir. rw flip_flip. tv. uf opp'. ap create_axioms. assert (ax : axioms a). am. uh H; ee. assert (alike : like a). am. clear H3. uhg; dj; try (ap iff_eq; ir). assert (ob a x). apply is_ob_ob. am. am. uhg; ee. am. ap Image.show_inc. sh (id a x). ee. ap mor_is_mor. ap mor_id. ap is_ob_ob. am. am. tv. rw source_flip. rww target_id. ap obidli. am. rw target_flip. rww source_id. app obidli. lu. assert (mor a (flip u)). rwi Image.inc_rw H4. nin H4; ee. ap is_mor_mor. am. wr H5. rw flip_flip. am. uhg; ee. am. wr (flifli u). rw source_flip. uh H5; ee. rwi H0 H6. lu. ap morli. lu. wr source_flip. ap ob_is_ob. rww ob_source. rw like_flip. ap morli. lu. rw flip_flip. rw left_id. rww flip_flip. wr target_flip. rww ob_target. rw like_flip. ap morli. lu. am. rw target_flip. reflexivity. rw like_flip. ap morli. lu. tv. rw flip_flip. rw right_id. rww flip_flip. wr source_flip. rww ob_source. rw like_flip. ap morli. lu. am. rw source_flip. reflexivity. rw like_flip. ap morli. lu. tv. rw like_flip. ap morli. lu. lu. assert (mor a (flip u)). rwi Image.inc_rw H5. nin H5; ee. wr H8. rw flip_flip. app is_mor_mor. assert (mor a (flip v)). rwi Image.inc_rw H6. nin H6; ee. wr H9. rw flip_flip. app is_mor_mor. assert (Arrow.like u). rw like_flip. ap morli. ap mor_is_mor. am. assert (Arrow.like v). rw like_flip. ap morli. ap mor_is_mor. am. uhg; ee. am. am. am. ap Image.show_inc. sh (comp a (flip v) (flip u)). ee. ap mor_is_mor. rw mor_comp. tv. am. am. rw source_flip. rw target_flip. sy; am. rw like_flip. ap morli. ap mor_is_mor. tv. rw like_flip. ap morli. ap mor_is_mor. am. tv. tv. rw source_flip. rw target_comp. rww target_flip. am. am. rw source_flip. rw target_flip. sy; am. am. am. ap morli. ap mor_is_mor. rw mor_comp. tv. am. am. rw source_flip. rw target_flip. sy; am. tv. am. tv. rw target_flip. rw source_comp. rww source_flip. am. am. rw source_flip. rww target_flip. sy; am. am. ap morli. ap mor_is_mor. rw mor_comp. tv. am. am. rww source_flip. rww target_flip. sy; am. tv. rw flip_flip. rw flip_flip. assert (mor a (flip u)). rwi Image.inc_rw H6. nin H6; ee. wr H11. rw flip_flip. app is_mor_mor. assert (mor a (flip v)). rwi Image.inc_rw H7. nin H7; ee. wr H12. rw flip_flip. app is_mor_mor. assert (mor a (flip w)). rwi Image.inc_rw H8. nin H8; ee. wr H13. rw flip_flip. app is_mor_mor. assert (Arrow.like u). rw like_flip. ap morli. ap mor_is_mor. am. assert (Arrow.like v). rw like_flip. ap morli. ap mor_is_mor. am. assert (Arrow.like w). rw like_flip. ap morli. ap mor_is_mor. am. rw assoc. tv. am. am. am. rww source_flip. rww target_flip. sy; am. sy; rww source_flip; rww target_flip. tv. Qed. Definition opp a := Y (axioms a) (opp' a) a. Lemma axioms_opp : forall a, axioms (opp a) = axioms a. Proof. ir. apply by_cases with (axioms a); ir. assert (opp a = opp' a). uf opp. ap (Y_if H). tv. rw H0. ap iff_eq; ir. am. ap opp'_axioms. am. assert (opp a = a). uf opp. ap (Y_if_not H). tv. rww H0. Qed. Lemma opp_axioms : forall a, axioms a -> axioms (opp a). Proof. ir. rww axioms_opp. Qed. Lemma opp_opp : forall a, opp (opp a) = a. Proof. ir. apply by_cases with (axioms a); ir. assert (opp a = opp' a). uf opp. ap (Y_if H). tv. rw H0. assert (axioms (opp' a)). ap opp'_axioms. am. assert (opp (opp' a) = opp' (opp' a)). uf opp. ap (Y_if H1). reflexivity. rw H2. rw opp'_opp'. tv. am. assert (opp a = a). uf opp. ap (Y_if_not H). tv. rw H0. uf opp. ap (Y_if_not H). tv. Qed. Lemma structure_opp : forall a, structure (opp a) = structure a. Proof. ir. apply by_cases with (axioms a); ir. assert (opp a = opp' a). uf opp. ap (Y_if H). tv. rw H0. rww structure_opp'. assert (opp a = a). uf opp. ap (Y_if_not H). tv. rww H0. Qed. Lemma ob_opp' : forall a x, axioms a -> ob (opp' a) x = ob a x. Proof. ir. sy. ap iff_eq; ir. uhg; ee. ap opp'_axioms. lu. rw is_ob_opp'. lu. uhg; ee. am. wr is_ob_opp'. lu. Qed. Lemma mor_opp' : forall a u, axioms a -> mor (opp' a) u = mor a (flip u). Proof. ir. assert (lem : forall b v, axioms b -> mor (opp' b) v -> mor b (flip v)). ir. uhg; ee. am. uh H1; ee. rwi is_mor_opp' H2. am. ap iff_eq; ir. au. assert (u = flip (flip u)). rw flip_flip; tv. uhg; ee. ap opp'_axioms. am. rw is_mor_opp'. app mor_is_mor. Qed. Lemma unfold_opp : forall a, axioms a -> opp a = opp' a. Proof. ir. uf opp. ap (Y_if H). tv. Qed. Lemma ob_opp : forall a x, ob (opp a) x = ob a x. Proof. ir. ap iff_eq; ir. assert (axioms a). wr axioms_opp. uh H; ee; am. rwi unfold_opp H. rwi ob_opp' H. am. am. am. assert (axioms a). uh H; ee; am. rww unfold_opp. rww ob_opp'. Qed. Lemma mor_opp : forall a u, mor (opp a) u = mor a (flip u). Proof. ir. ap iff_eq; ir. assert (axioms a). wr axioms_opp. uh H; ee; am. rwi unfold_opp H. rwi mor_opp' H. am. am. am. assert (axioms a). uh H; ee; am. rww unfold_opp. rww mor_opp'. Qed. Lemma comp_opp : forall a u v, mor (opp a) u -> mor (opp a) v -> source u = target v -> comp (opp a) u v = flip (comp a (flip v) (flip u)). Proof. ir. assert (axioms a). wr axioms_opp. uh H; ee; am. rw unfold_opp. rw comp_opp'. tv. ap mor_is_mor. wrr unfold_opp. ap mor_is_mor. wrr unfold_opp. tv. am. Qed. Lemma id_opp : forall a x, ob (opp a) x -> id (opp a) x = flip (id a x). Proof. ir. assert (axioms a). wr axioms_opp. uh H; ee; am. rw unfold_opp. rww id_opp'. ap ob_is_ob. wrr unfold_opp. am. Qed. Lemma composable_opp : forall a u v, axioms a -> composable (opp a) u v = composable a (flip v) (flip u). Proof. ir. ap iff_eq; ir. rwi composable_facts_rw H0; ap show_composable; try (wr mor_opp; lu); try (rw mor_opp; lu). rw source_flip. rw target_flip; try (sy; lu). apply mor_arrow_like with (opp a); lu. apply mor_arrow_like with (opp a); lu. rwi composable_facts_rw H0. ap show_composable. uh H0; ee. rww mor_opp. rww mor_opp. lu. uh H0; ee. wr source_flip. wr target_flip. sy; am. rw like_flip. apply mor_arrow_like with a; lu. rw like_flip; apply mor_arrow_like with a; lu. Qed. Definition are_inverse a u v := mor a u & mor a v & source u = target v & source v = target u & comp a u v = id a (source v) & comp a v u = id a (source u). Lemma are_inverse_symm :forall a u v, are_inverse a u v -> are_inverse a v u. Proof. ir. uh H; ee. uhg; ee; try am. Qed. Definition invertible a u := exists v, are_inverse a u v. Definition inverse a u := choose (are_inverse a u). Lemma invertible_inverse : forall a u, invertible a u -> are_inverse a u (inverse a u). Proof. ir. exact (choose_pr H). Qed. Lemma inverse_unique : forall a u v w, are_inverse a u v -> are_inverse a u w -> v = w. Proof. ir. uh H; uh H0; ee. transitivity (comp a (comp a v u) w). rw assoc. rw H4. rw right_id. tv. uh H0; ee. cw. am. rww H3. tv. am. am. am. am. am. tv. rw H10. cw. cw. sy; am. Qed. Lemma inverse_uni : forall v w, (exists a, exists u, (are_inverse a u v & are_inverse a u w)) -> v = w. Proof. ir. nin H. nin H. ee. exact (inverse_unique H H0). Qed. Lemma inverse_eq : forall a u v, are_inverse a u v -> inverse a u = v. Proof. ir. ap inverse_uni. sh a. sh u. ee. ap invertible_inverse. uhg. sh v; am. am. Qed. Lemma inverse_invertible : forall a u, invertible a u -> invertible a (inverse a u). Proof. ir. uhg. sh u. ap are_inverse_symm. ap invertible_inverse. am. Qed. Lemma inverse_inverse : forall a u, invertible a u -> inverse a (inverse a u) = u. Proof. ir. apply inverse_unique with a (inverse a u). ap invertible_inverse. ap inverse_invertible. am. ap are_inverse_symm. ap invertible_inverse. am. Qed. Lemma source_inverse : forall a u, invertible a u -> source (inverse a u) = target u. Proof. ir. cp (invertible_inverse H). uh H0; ee. lu. Qed. Lemma target_inverse : forall a u, invertible a u -> target (inverse a u) = source u. Proof. ir. cp (invertible_inverse H). uh H0; ee. sy; lu. Qed. Lemma left_inverse : forall a u, invertible a u -> comp a (inverse a u) u = id a (source u). Proof. ir. cp (invertible_inverse H). uh H0; ee. am. Qed. Lemma right_inverse : forall a u, invertible a u -> comp a u (inverse a u) = id a (target u). Proof. ir. cp (invertible_inverse H). uh H0; ee. rwi source_inverse H4. am. am. Qed. Lemma mor_inverse : forall a u, invertible a u -> mor a (inverse a u). Proof. ir. cp (invertible_inverse H). uh H0; ee. lu. Qed. Lemma mor_inverse_rw : forall a b u, invertible a u -> a = b -> mor a (inverse b u) = True. Proof. ir. app iff_eq; ir. wr H0. app mor_inverse. Qed. Hint Rewrite source_inverse target_inverse left_inverse right_inverse mor_inverse_rw :cw. Lemma composable_inverse_left : forall a u, invertible a u -> composable a (inverse a u) u. Proof. ir. cp (invertible_inverse H). uh H0; ee. ap show_composable; lu. Qed. Lemma composable_inverse_right : forall a u, invertible a u -> composable a u (inverse a u). Proof. ir. cp (invertible_inverse H). uh H0; ee. ap show_composable; lu. Qed. Lemma composable_inverse : forall a u v, composable a u v -> invertible a u -> invertible a v -> composable a (inverse a v) (inverse a u). Proof. ir. cp (invertible_inverse H0). cp (invertible_inverse H1). cp H. rwi composable_facts_rw H; uh H; ee. ap show_composable. lu. uh H2; ee. am. rw source_inverse; try am. rw target_inverse; try am. sy; am. Qed. Lemma invertible_comp_are_inverse : forall a u v, composable a u v -> invertible a u -> invertible a v -> are_inverse a (comp a u v) (comp a (inverse a v) (inverse a u)). Proof. ir. cp (invertible_inverse H0). cp (invertible_inverse H1). cp H. rwi composable_facts_rw H; uh H; ee. assert (lemA: (mor a (inverse a u))). uh H2; ee; am. assert (lemB: (mor a (inverse a v))). uh H3; ee; am. assert (lemC: (source (inverse a u) = target u)). rw source_inverse. tv. am. assert (lemD: (target (inverse a u) = source u)). rw target_inverse. tv. am. assert (lemE: (source (inverse a v) = target v)). rw source_inverse. tv. am. assert (lemF: (target (inverse a v) = source v)). rw target_inverse. tv. am. assert (lemG: (target v = source u)). uh H4; ee; sy; am. assert (lemJ: (source (inverse a v) = target (inverse a u))). rw lemE; rw lemD; tv. assert (lemH: (composable a (inverse a v) (inverse a u))). uhg; ee. am. uhg; ee. app mor_is_mor. app mor_is_mor. am. uhg; ee; try am. rww mor_comp. rww source_comp. rww target_comp. rww lemF. rww target_comp. rww source_comp. rw assoc. assert (comp a v (comp a (inverse a v) (inverse a u))= inverse a u). wr assoc. uh H3; ee. rw H15. rw lemE. rw left_id. tv. rww ob_target. am. rww lemD. tv. am. am. am. rww lemF. am. tv. rw H12. rw source_comp. rw lemC. rww right_inverse. am. am. am. am. am. rww mor_comp. am. rww target_comp. sy; am. tv. rw assoc. assert (comp a (inverse a u) (comp a u v) = v). wrr assoc. rww left_inverse. rww left_id. rww ob_source. rw H12. rww left_inverse. rww source_comp. am. am. rww mor_comp. am. rww target_comp. tv. Qed. Lemma invertible_comp : forall a u v, composable a u v -> invertible a u -> invertible a v -> invertible a (comp a u v). Proof. ir. uhg; sh (comp a (inverse a v) (inverse a u)). ap invertible_comp_are_inverse; am. Qed. Lemma inverse_comp : forall a u v, composable a u v -> invertible a u -> invertible a v -> inverse a (comp a u v) = comp a (inverse a v) (inverse a u). Proof. ir. ap inverse_eq. ap invertible_comp_are_inverse; am. Qed. Lemma identity_are_inverse : forall a x, ob a x -> are_inverse a (id a x) (id a x). Proof. ir. rwi ob_facts_rw H. uh H; ee. uhg; ee; try am. cw. cw. cw. cw. Qed. Lemma inverse_id1 : forall a x, ob a x -> inverse a (id a x) = id a x. Proof. ir. ap inverse_eq. ap identity_are_inverse; am. Qed. Hint Rewrite inverse_id1 : cw. Lemma invertible_id : forall a b x, a = b -> ob a x -> invertible a (id b x). Proof. ir. wr H. uhg; ee. sh (id a x). uhg; dj. app mor_id. app mor_id. rww source_id. rww target_id. rww source_id. rww target_id. rww source_id. rww left_id. rww target_id. rww source_id. rww left_id. rww target_id. Qed. Lemma inverse_id : forall a b x, a = b -> ob a x -> inverse a (id b x) = id a x. Proof. ir. wr H. assert (invertible a (id a x)). app invertible_id. transitivity (comp a (inverse a (id a x)) (id a x)). rww right_id. app mor_inverse. rww source_inverse. rww target_id. rww left_inverse. rww source_id. Qed. Ltac alike := match goal with id1 : (mor _ ?X1) |- (Arrow.like ?X1) => exact (mor_arrow_like id1) | _=>fail end. End Category. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Ltac fw := autorewrite with fw; try tv; try am. Module Functor. Export Umorphism. Export Category. (**** creation and extraction ****) Definition fmor f u := ev f u. Definition fob f x := source (fmor f (id (source f) x)). Definition create := Umorphism.create. Lemma source_create : forall a b fm, source (create a b fm) = a. Proof. ir. uf create. uf Umorphism.create. rw Arrow.source_create. tv. Qed. Lemma target_create : forall a b fm, target (create a b fm) = b. Proof. ir. uf create. uf Umorphism.create. rww Arrow.target_create. Qed. Lemma fmor_create : forall a b fm u, mor a u -> fmor (create a b fm) u = (fm u). Proof. ir. uf create. rw Umorphism.ev_create. tv. change (is_mor a u). lu. Qed. Hint Rewrite source_create target_create fmor_create : fw. Lemma fob_create : forall a b fm x, ob a x -> fob (create a b fm) x = source (fm (id a x)) . Proof. ir. uf fob. rw fmor_create. rw source_create. tv. rw source_create. cw. Qed. Definition axioms f := let a := source f in let b := target f in (Umorphism.like f) & (Category.axioms a) & (Category.axioms b) & (forall x, ob a x -> ob b (fob f x)) & (forall x, ob a x -> id b (fob f x) = fmor f (id a x)) & (forall u, mor a u -> mor b (fmor f u)) & (forall u, mor a u -> source (fmor f u) = fob f (source u)) & (forall u, mor a u -> target (fmor f u) = fob f (target u)) & (forall u v, mor a u -> mor a v -> source u = target v -> comp b (fmor f u) (fmor f v) = fmor f (comp a u v)). Definition property a b fo fm := (Category.axioms a) & (Category.axioms b) & (forall x, ob a x -> ob b (fo x)) & (forall x, ob a x -> id b (fo x) = fm (id a x)) & (forall u, mor a u -> mor b (fm u)) & (forall u, mor a u -> source (fm u) = fo (source u)) & (forall u, mor a u -> target (fm u) = fo (target u)) & (forall u v, mor a u -> mor a v -> source u = target v-> comp b (fm u) (fm v) = fm (comp a u v)). Lemma fob_property_create : forall a b fo fm x, property a b fo fm -> ob a x -> fob (create a b fm) x = fo x. Proof. ir. rww fob_create. uh H; ee. rw H5. cw. cw. Qed. Lemma create_axioms : forall a b (fm:E1), (exists fo, property a b fo fm) -> axioms (create a b fm). Proof. ir. uhg. do 10 (try (rw source_create)). do 10 (try (rw target_create)). do 10 (try (rw fmor_create)). nin H. ee; ir; try (rw fmor_create); try (rw (fob_property_create (a:= a) (b:=b) (fo := x) (fm := fm))). uf create. ap Umorphism.create_like. lu. lu. uh H; ee. app H2. am. am. uh H; ee. app H3. am. am. cw. uh H; ee. app H4. am. uh H; ee. app H5. am. cw. am. uh H; ee. app H6. am. cw. am. rww fmor_create. rww fmor_create. uh H; ee. rww H9. cw. am. Qed. Lemma axioms_property : forall f, axioms f -> property (source f) (target f) (fob f) (fmor f). Proof. ir. uh H; ee. uhg; xd. Qed. Lemma functor_arrow_like : forall f, axioms f -> Arrow.like f. Proof. ir. uh H; ee. ap Umorphism.like_arrow_like. am. Qed. Lemma create_recovers : forall f, axioms f -> create (source f) (target f) (fmor f) = f. Proof. ir. uh H; ee. uh H. am. Qed. Lemma axioms_extensionality : forall f g, axioms f -> axioms g -> source f = source g -> target f = target g -> (forall u, mor (source f) u-> fmor f u = fmor g u) -> f = g. Proof. ir. wr (create_recovers H). wr (create_recovers H0). wr H1. wr H2. uf create. uf Umorphism.create. ap uneq. ap Function.create_extensionality. tv. ir. ap H3. change (is_mor (source f) x) in H4. app is_mor_mor. uh H; ee. am. Qed. Lemma category_axioms_source : forall f, axioms f -> Category.axioms (source f) = True. Proof. ir. app iff_eq; ir. lu. Qed. Lemma category_axioms_target : forall f, axioms f -> Category.axioms (target f)= True. Proof. ir. app iff_eq; ir. lu. Qed. Hint Rewrite category_axioms_source category_axioms_target : fw. Lemma ob_fob : forall f x, axioms f -> ob (source f) x -> ob (target f) (fob f x). Proof. ir. uh H; ee. au. Qed. Lemma ob_fobv : forall a f x, axioms f -> ob (source f) x -> a = target f -> ob a (fob f x) = True. Proof. ir. app iff_eq; ir. rw H1. ap ob_fob; am. Qed. Lemma mor_fmor : forall f u, axioms f -> mor (source f) u -> mor (target f) (fmor f u). Proof. ir. uh H; ee. au. Qed. Lemma mor_fmorv : forall a f u, axioms f -> mor (source f) u -> a = target f -> mor a (fmor f u) = True. Proof. ir. app iff_eq; ir. rw H1. ap mor_fmor; am. Qed. Hint Rewrite ob_fobv mor_fmorv : fw. Lemma source_fmor : forall f u, axioms f -> mor (source f) u -> source (fmor f u) = fob f (source u). Proof. ir. uh H; ee. au. Qed. Lemma target_fmor : forall f u, axioms f -> mor (source f) u -> target (fmor f u) = fob f (target u). Proof. ir. uh H; ee. au. Qed. Hint Rewrite source_fmor target_fmor : fw. Lemma id_fob : forall f x, axioms f -> ob (source f) x -> id (target f) (fob f x) = fmor f (id (source f) x). Proof. ir. uh H; ee. au. Qed. Lemma fmor_id : forall f a x, axioms f -> source f = a -> ob a x -> fmor f (id a x) = id (target f) (fob f x). Proof. ir. wr H0. wrr id_fob. rww H0. Qed. Hint Rewrite fmor_id : fw. Lemma comp_fmor : forall f u v, axioms f -> mor (source f) u -> mor (source f) v -> source u = target v -> comp (target f) (fmor f u) (fmor f v) = fmor f (comp (source f) u v). Proof. ir. uh H; ee. au. Qed. Lemma comp_fmorv : forall a f f1 u v, axioms f -> f = f1 -> mor (source f) u -> mor (source f) v -> source u = target v -> a = target f -> comp a (fmor f u) (fmor f1 v) = fmor f (comp (source f) u v). Proof. ir. rw H4. wr H0. ap comp_fmor; am. Qed. Lemma fmor_compv : forall a f u v, axioms f -> a = source f -> mor a u -> mor a v -> source u = target v -> fmor f (comp a u v) = comp (target f) (fmor f u) (fmor f v). Proof. ir. rw H0. sy. rw comp_fmor. tv. am. wr H0; am. wrr H0. am. Qed. Definition fcompose := Umorphism.compose. Lemma source_fcompose : forall f g, source (fcompose f g) = source g. Proof. ir. uf fcompose. uf compose. fw. Qed. Lemma target_fcompose : forall f g, target (fcompose f g) = target f. Proof. ir. uf fcompose. uf compose. fw. Qed. Hint Rewrite source_fcompose target_fcompose: fw. Lemma fmor_fcompose : forall f g u, axioms f -> axioms g -> source f = target g -> mor (source g) u -> fmor (fcompose f g) u = fmor f (fmor g u). Proof. ir. uf fcompose. uf compose. rw fmor_create. tv. am. Qed. Lemma fob_fcompose : forall f g x, axioms f -> axioms g -> source f = target g -> ob (source g) x -> fob (fcompose f g) x = fob f (fob g x). Proof. ir. uf fcompose. uf compose. rw fob_create. tv. fw. cw. fw. fw. am. Qed. Hint Rewrite fob_fcompose fmor_fcompose : fw. Lemma fcompose_axioms : forall f g, axioms f -> axioms g -> source f = target g -> axioms (fcompose f g). Proof. ir. uf fcompose. change (axioms (create (source g) (target f) (fun y => fmor f (fmor g y)))). ap create_axioms. sh (fun x => fob f (fob g x)). uhg; dj. uh H0; ee; am. uh H; ee; am. ap ob_fob. am. rw H1. ap ob_fob. am. am. rw id_fob. ap uneq. rw H1. ap id_fob. am. am. am. rw H1; ap ob_fob; am. ap mor_fmor. am. rw H1. ap mor_fmor. am. am. rw source_fmor. ap uneq. rw source_fmor. tv. am. am. am. rw H1; ap mor_fmor; am. rw target_fmor. ap uneq. rw target_fmor. tv. am. am. am. rw H1; ap mor_fmor; am. rw comp_fmor. ap uneq. rw H1. ap comp_fmor. am. am. am. am. am. rw H1. fw. rw H1. fw. rw source_fmor. rw target_fmor. rww H11. am. am. am. am. Qed. Lemma fcompose_axioms_rw : forall f g, axioms f -> axioms g -> source f = target g -> axioms (fcompose f g) = True. Proof. ir. app iff_eq; ir. app fcompose_axioms. Qed. Hint Rewrite fcompose_axioms_rw : fw. Lemma functor_umorphism_axioms : forall f, axioms f -> Umorphism.axioms f. Proof. ir. uhg; ee. uhg; ee. uhg; ee. ir. change (is_mor (target f) (fmor f x)). change (is_mor (source f) x) in H0. assert (mor (target f) (fmor f x)). ap mor_fmor. am. ap is_mor_mor. lu. am. lu. Qed. Lemma fcompose_assoc : forall f g h, axioms f -> axioms g -> axioms h -> source f = target g -> source g = target h -> fcompose (fcompose f g) h = fcompose f (fcompose g h). Proof. ir. uf fcompose. ap Umorphism.associativity. uhg; ee; try am. ap functor_umorphism_axioms. am. app functor_umorphism_axioms. uhg; ee; try am. app functor_umorphism_axioms. app functor_umorphism_axioms. Qed. Definition fidentity a := Umorphism.identity a. Lemma source_fidentity : forall a, source (fidentity a) = a. Proof. ir. uf fidentity. rww Umorphism.source_identity. Qed. Lemma target_fidentity : forall a, target (fidentity a) = a. Proof. ir. uf fidentity. rww Umorphism.target_identity. Qed. Lemma fmor_fidentity : forall a u, mor a u -> fmor (fidentity a) u = u. Proof. ir. uf fidentity; uf fmor. rww Umorphism.ev_identity. change (is_mor a u). lu. Qed. Lemma fob_fidentity : forall a x, ob a x -> fob (fidentity a) x = x. Proof. ir. uf fidentity. uf fob. uf fmor. rww Umorphism.source_identity. rww Umorphism.ev_identity. rw source_id. tv. am. change (is_mor a (id a x)). assert (mor a (id a x)). cw. lu. Qed. Hint Rewrite source_fidentity target_fidentity fmor_fidentity fob_fidentity : fw. Lemma fidentity_axioms : forall a, Category.axioms a -> axioms (fidentity a) = True. Proof. ir. app iff_eq; ir. uhg; ee. uf fidentity. uf Umorphism.identity. app Umorphism.create_like. fw. fw. ir. fw. rwi source_fidentity H1; am. rwi source_fidentity H1; am. ir; fw; try (rwi source_fidentity H1; cw). ir; fw; try (rwi source_fidentity H1; cw). ir; fw; try (rwi source_fidentity H1; cw). ir; fw; try (rwi source_fidentity H1; cw). ir; fw; try (rwi source_fidentity H1; cw); try (rwi source_fidentity H2; cw). Qed. Hint Rewrite fidentity_axioms : fw. Lemma left_fidentity : forall a f, axioms f -> a = target f -> fcompose (fidentity a) f = f. Proof. ir. rw H0; clear H0. assert (lemA: axioms (fidentity (target f))). fw. assert (lemB: (axioms (fcompose (fidentity (target f)) f))). app fcompose_axioms. rww source_fidentity. ap axioms_extensionality; ir. am. am. rww source_fcompose. rww target_fcompose. rww target_fidentity. rwi source_fcompose H0. rww fmor_fcompose. rww fmor_fidentity. app mor_fmor. rww source_fidentity. Qed. Lemma right_fidentity : forall a f, axioms f -> a = source f -> fcompose f (fidentity a) = f. Proof. ir. rw H0; clear H0. assert (lemA: axioms (fidentity (source f))). fw. assert (lemB: (axioms (fcompose f (fidentity (source f))))). app fcompose_axioms. rww target_fidentity. ap axioms_extensionality; ir. am. am. rww source_fcompose. rww source_fidentity. rww target_fcompose. rwi source_fcompose H0. rwi source_fidentity H0. rww fmor_fcompose. rww fmor_fidentity. rww target_fidentity. rww source_fidentity. Qed. Hint Rewrite left_fidentity right_fidentity : fw. Lemma are_inverse_fmor : forall a f u v, Functor.axioms f -> are_inverse (source f) u v -> target f = a -> are_inverse a (fmor f u) (fmor f v). Proof. ir. wr H1. cp H0. uh H2; ee. uh H2; uh H3; ee. uhg; ee. fw. app is_mor_mor. fw. app is_mor_mor. rww source_fmor. rw target_fmor. rww H4. am. app is_mor_mor. app is_mor_mor. rww source_fmor. rw target_fmor. rww H5. am. app is_mor_mor. app is_mor_mor. fw. rww comp_fmor. rww H6. fw. cw. app is_mor_mor. app is_mor_mor. app is_mor_mor. app is_mor_mor. rww comp_fmor. rww H7. fw. app is_mor_mor. cw. app is_mor_mor. app is_mor_mor. app is_mor_mor. Qed. Lemma invertible_fmor : forall a f u, Functor.axioms f -> invertible (source f) u -> target f = a -> invertible a (fmor f u). Proof. ir. wr H1. uhg. uh H0. nin H0. sh (fmor f x). app are_inverse_fmor. Qed. Lemma fmor_inverse : forall a f u, Functor.axioms f -> invertible (source f) u -> source f = a -> fmor f (inverse a u) = inverse (target f) (fmor f u). Proof. ir. ap inverse_uni. sh (target f). sh (fmor f u). ee. app are_inverse_fmor. rw H1. app invertible_inverse. wrr H1. app invertible_inverse. app invertible_fmor. Qed. Lemma inverse_fmor : forall a f u, Functor.axioms f -> invertible (source f) u -> target f = a -> inverse a (fmor f u) = fmor f (inverse (source f) u). Proof. ir. wr H1. rww fmor_inverse. Qed. Definition constant_functor a b x := Functor.create a b (fun u:E => id b x). Lemma source_constant_functor : forall a b x, source (constant_functor a b x) = a. Proof. ir. uf constant_functor. fw. Qed. Lemma target_constant_functor : forall a b x, target (constant_functor a b x) = b. Proof. ir. uf constant_functor. fw. Qed. Lemma fmor_constant_functor : forall a b x u, mor a u -> fmor (constant_functor a b x) u = id b x. Proof. ir. uf constant_functor. fw. Qed. Lemma fob_constant_functor : forall a b x y, ob a y -> ob b x -> fob (constant_functor a b x) y = x. Proof. ir. uf constant_functor. rww fob_create. fw. cw. Qed. Hint Rewrite source_constant_functor target_constant_functor fmor_constant_functor fob_constant_functor: fw. Lemma constant_functor_axioms : forall a b x, Category.axioms a -> Category.axioms b -> ob b x -> Functor.axioms (constant_functor a b x). Proof. ir. uf constant_functor. ap Functor.create_axioms. sh (fun y:E => x). uhg; ee. am. am. ir. am. ir. tv. ir. cw. ir. cw. ir. cw. ir. cw. app mor_id. rww source_id. Qed. Definition is_constant f := Functor.axioms f & (exists x, (ob (target f) x) & f = constant_functor (source f) (target f) x). (**** note that the trivial functor from the empty category to the empty category is not constant by this definition since there has to exist an object of target f *************************************) Lemma constant_functor_is_constant : forall a b x, Category.axioms a -> ob b x -> is_constant (constant_functor a b x). Proof. ir. uhg. ee. ap constant_functor_axioms. am. lu. am. sh x; ee. fw. rw source_constant_functor. rw target_constant_functor. tv. Qed. Lemma constant_functor_criterion : forall a b x f, source f = a -> target f = b -> Functor.axioms f -> ob b x -> (forall u, mor a u -> fmor f u = id b x) -> f = constant_functor a b x. Proof. ir. ap axioms_extensionality. am. app constant_functor_axioms. wr H. uh H1; ee; am. wr H0; uh H1; ee; am. rww source_constant_functor. rww target_constant_functor. ir. rww fmor_constant_functor. ap H3. wrr H. wrr H. Qed. Lemma fcompose_right_constant_functor : forall a b x f, Functor.axioms f -> source f = b -> Category.axioms a -> ob b x -> fcompose f (constant_functor a b x) = constant_functor a (target f) (fob f x). Proof. ir. ap constant_functor_criterion. rw source_fcompose. rw source_constant_functor. tv. rw target_fcompose. tv. ir. ap fcompose_axioms. am. ap constant_functor_axioms. am. wr H0; uh H; ee; am. am. rww target_constant_functor. fw. rww H0. ir. rww fmor_fcompose. rww fmor_constant_functor. fw. ap constant_functor_axioms. am. wr H0; uh H; ee; am. am. rww target_constant_functor. rww source_constant_functor. Qed. Lemma fcompose_left_constant_functor : forall a b x f, Functor.axioms f -> target f = a -> Category.axioms b -> ob b x -> fcompose (constant_functor a b x) f = constant_functor (source f) b x. Proof. ir. ap constant_functor_criterion. rww source_fcompose. rww target_fcompose. rww target_constant_functor. app fcompose_axioms. ap constant_functor_axioms. wr H0; uh H; ee; am. am. am. sy; rww source_constant_functor. am. ir. rw fmor_fcompose. rww fmor_constant_functor. wr H0; app mor_fmor. ap constant_functor_axioms. wr H0; uh H; ee; am. am. am. am. sy; rww source_constant_functor. am. Qed. Lemma is_constant_fcompose : forall f g, Functor.axioms f -> Functor.axioms g -> source f = target g -> is_constant g -> is_constant (fcompose f g). Proof. ir. uhg. ee. app fcompose_axioms. uh H2. ee. nin H3; ee. sh (fob f x). ee. rww target_fcompose. app ob_fob. rww H1. rw source_fcompose. rw target_fcompose. ap constant_functor_criterion. rww source_fcompose. rww target_fcompose. app fcompose_axioms. app ob_fob. rww H1. ir. rww fmor_fcompose. rw H4. rww fmor_constant_functor. fw. Qed. (*** oppf = opposite functor ****) Definition oppf' f := Functor.create (opp (source f)) (opp (target f)) (fun u => flip (fmor f (flip u))). Lemma source_oppf' : forall f, source (oppf' f) = opp (source f). Proof. ir. uf oppf'. rww source_create. Qed. Lemma target_oppf' : forall f, target (oppf' f) = opp (target f). Proof. ir. uf oppf'. rww target_create. Qed. Lemma fmor_oppf' : forall f u, mor (source (oppf' f)) u -> fmor (oppf' f) u = flip (fmor f (flip u)). Proof. ir. uf oppf'. rw fmor_create. tv. rwi source_oppf' H. am. Qed. Lemma fob_oppf' : forall f x, Functor.axioms f -> ob (source (oppf' f)) x -> fob (oppf' f) x = fob f x. Proof. ir. rwi source_oppf' H0. rwi ob_opp H0. uf fob. rw fmor_oppf'. rw source_flip. rw source_oppf'. rw id_opp. rw flip_flip. rw target_fmor. rw source_fmor. rw target_id. rww source_id. am. am. app mor_id. am. app mor_id. rw ob_opp. am. apply mor_arrow_like with (target f). ap mor_fmor. am. rw source_oppf'. rw id_opp. rw flip_flip. app mor_id. rww ob_opp. rw source_oppf'. rw mor_opp. rw id_opp. rw flip_flip. app mor_id. rww ob_opp. Qed. Lemma oppf'_axioms : forall f, Functor.axioms f -> Functor.axioms (oppf' f). Proof. ir. uhg; ee. uf oppf'. uf create. ap Umorphism.create_like. rw source_oppf'. ap opp_axioms. lu. rw target_oppf'. ap opp_axioms. lu. ir. rw target_oppf'. rw fob_oppf'. rw ob_opp. ap ob_fob. am. rwi source_oppf' H0. rwi ob_opp H0. am. am. am. ir. cp H0. rwi source_oppf' H1. rwi ob_opp H1. rw target_oppf'. rw fmor_oppf'. rw source_oppf'. rw id_opp. rw id_opp. rw flip_flip. rw fmor_id. rw fob_oppf'. tv. am. am. am. tv. am. rww ob_opp. rw ob_opp. rw fob_oppf'. app ob_fob. am. am. rw source_oppf'. rw id_opp. rw mor_opp. rw flip_flip. app mor_id. rww ob_opp. ir. rw target_oppf'. rw fmor_oppf'. rw mor_opp. rw flip_flip. ap mor_fmor. am. rwi source_oppf' H0. rwi mor_opp H0. am. uh H; ee; am. ir. rw fmor_oppf'. rw source_flip. rw target_fmor. rw target_flip. rw fob_oppf'. tv. am. rw source_oppf'. rw ob_opp. assert (source u = target (flip u)). rww target_flip. apply mor_arrow_like with (source (oppf' f)). am. rw H1. rw ob_target. tv. rwi source_oppf' H0. rwi mor_opp H0. am. alike. am. rwi source_oppf' H0. rwi mor_opp H0. am. apply mor_arrow_like with (target f). ap mor_fmor. am. rwi source_oppf' H0. rwi mor_opp H0. am. uh H; ee; am. ir. rw fmor_oppf'. rw fob_oppf'. rw target_flip. rw source_fmor. rw source_flip. tv. apply mor_arrow_like with (source (oppf' f)). am. am. rwi source_oppf' H0. rwi mor_opp H0. am. apply mor_arrow_like with (target f). ap mor_fmor. am. rwi source_oppf' H0. rwi mor_opp H0. am. am. rw source_oppf'. rw ob_opp. assert (target u = source (flip u)). rww source_flip. apply mor_arrow_like with (source (oppf' f)). am. rw H1. rw ob_source. tv. rwi source_oppf' H0. rwi mor_opp H0. am. uh H; ee; am. ir. assert (Arrow.like u). apply mor_arrow_like with (source (oppf' f)). am. assert (Arrow.like v). apply mor_arrow_like with (source (oppf' f)). am. assert (mor (source f) (flip u)). rwi source_oppf' H0. rwi mor_opp H0. am. assert (mor (source f) (flip v)). rwi source_oppf' H1. rwi mor_opp H1. am. rw target_oppf'. rww fmor_oppf'. rww fmor_oppf'. rw comp_opp. rw flip_flip. rw flip_flip. rw fmor_oppf'. rw source_oppf'. rw comp_opp. rw flip_flip. rw comp_fmor. tv. am. am. am. rww source_flip. rww target_flip. sy; am. rww mor_opp. rww mor_opp. am. rww mor_comp. rw mor_opp. rw flip_flip. app mor_fmor. rw mor_opp. rw flip_flip. app mor_fmor. rw source_flip. rw target_flip. rw target_fmor. rw source_fmor. ap uneq. rww target_flip. rww source_flip. am. am. am. am. apply mor_arrow_like with (target f). app mor_fmor. apply mor_arrow_like with (target f). app mor_fmor. Qed. Lemma fcompose_oppf' : forall f g, Functor.axioms f -> Functor.axioms g -> source f = target g -> fcompose (oppf' f) (oppf' g) = oppf' (fcompose f g). Proof. ir. assert (axioms (oppf' f)). app oppf'_axioms. assert (axioms (oppf' g)). app oppf'_axioms. assert (axioms (fcompose f g)). app fcompose_axioms. ap axioms_extensionality. ap fcompose_axioms. am. am. rw source_oppf'. rw target_oppf'. rww H1. ap oppf'_axioms. am. rw source_fcompose. rw source_oppf'. rw source_oppf'. rw source_fcompose. tv. rw target_fcompose. rw target_oppf'. rw target_oppf'. rw target_fcompose. tv. ir. rwi source_fcompose H5. cp H5. rwi source_oppf' H6. rwi mor_opp H6. rw fmor_fcompose. rw fmor_oppf'. rw fmor_oppf'. rw flip_flip. rw fmor_oppf'. rw fmor_fcompose. tv. am. am. am. am. rw source_oppf'. rw source_fcompose. rw mor_opp. am. am. assert (source (oppf' f) = target (oppf' g)). rw source_oppf'. rw target_oppf'. rw H1. tv. rw H7. ap mor_fmor. am. am. am. am. rw source_oppf'. rw target_oppf'. rw H1. tv. am. Qed. Lemma oppf'_fidentity : forall a, Category.axioms a -> oppf' (fidentity a) = fidentity (opp a). Proof. ir. assert (Category.axioms (opp a)). app opp_axioms. assert (axioms (oppf' (fidentity a))). app oppf'_axioms. rww fidentity_axioms. ap axioms_extensionality. am. rww fidentity_axioms. rww source_oppf'. rww source_fidentity. rww source_fidentity. rww target_oppf'. rww target_fidentity. rww target_fidentity. ir. cp H2. rwi source_oppf' H3. cp H3. rwi mor_opp H4. rwi source_fidentity H4. rw fmor_oppf'. rw fmor_fidentity. rw fmor_fidentity. rww flip_flip. rw mor_opp. am. am. am. Qed. Lemma oppf'_constant_functor : forall a b x, Category.axioms a -> ob b x -> oppf' (constant_functor a b x) = constant_functor (opp a) (opp b) x. Proof. ir. assert (Category.axioms b). lu. ap constant_functor_criterion. rw source_oppf'. rw source_constant_functor. tv. rw target_oppf'. rw target_constant_functor. tv. ap oppf'_axioms. ap constant_functor_axioms. am. am. am. rww ob_opp. ir. rw fmor_oppf'. rw fmor_constant_functor. rw id_opp. tv. rw ob_opp. am. wr mor_opp. am. rw source_oppf'. rw source_constant_functor. am. Qed. Lemma oppf'_oppf' : forall f, Functor.axioms f -> oppf' (oppf' f) = f. Proof. ir. ap axioms_extensionality. app oppf'_axioms. app oppf'_axioms. am. rw source_oppf'. rw source_oppf'. rw opp_opp. tv. rw target_oppf'. rw target_oppf'. rw opp_opp. tv. ir. rwi source_oppf' H0. rwi source_oppf' H0. rwi opp_opp H0. rw fmor_oppf'. rw fmor_oppf'. rw flip_flip. rww flip_flip. rw source_oppf'. rw mor_opp. rw flip_flip. am. rw source_oppf'. rw source_oppf'. rw opp_opp. am. Qed. Definition oppf f := Y (Functor.axioms f) (oppf' f) f. Lemma unfold_oppf : forall f, Functor.axioms f -> oppf f = oppf' f. Proof. ir. uf oppf. ap (Y_if H). tv. Qed. Lemma oppf_axioms : forall f, Functor.axioms f -> Functor.axioms (oppf f). Proof. ir. rww unfold_oppf. app oppf'_axioms. Qed. Lemma oppf_oppf : forall f, oppf (oppf f) = f. Proof. ir. apply by_cases with (Functor.axioms f); ir. rw unfold_oppf. rw unfold_oppf. rww oppf'_oppf'. am. app oppf_axioms. assert (oppf f = f). uf oppf. ap (Y_if_not H). tv. rw H0. am. Qed. Lemma axioms_oppf : forall f, Functor.axioms (oppf f) = Functor.axioms f. Proof. ir. ap iff_eq; ir. wr oppf_oppf. app oppf_axioms. app oppf_axioms. Qed. Lemma source_oppf : forall f, Functor.axioms f -> source (oppf f) = opp (source f). Proof. ir. rww unfold_oppf. rww source_oppf'. Qed. Lemma target_oppf : forall f, Functor.axioms f -> target (oppf f) = opp (target f). Proof. ir. rww unfold_oppf. rww target_oppf'. Qed. Lemma fmor_oppf : forall f u, Functor.axioms f -> mor (source (oppf f)) u -> fmor (oppf f) u = flip (fmor f (flip u)). Proof. ir. rww unfold_oppf. rww fmor_oppf'. wrr unfold_oppf. Qed. Lemma fob_oppf : forall f x, Functor.axioms f -> ob (source (oppf f)) x -> fob (oppf f) x = fob f x. Proof. ir. rww unfold_oppf. rww fob_oppf'. wrr unfold_oppf. Qed. Lemma fcompose_oppf : forall f g, Functor.axioms f -> Functor.axioms g -> source f = target g -> fcompose (oppf f) (oppf g) = oppf (fcompose f g). Proof. ir. rww unfold_oppf. rww unfold_oppf. rw unfold_oppf. rww fcompose_oppf'. app fcompose_axioms. Qed. Lemma oppf_fidentity : forall a, Category.axioms a -> oppf (fidentity a) = fidentity (opp a). Proof. ir. rw unfold_oppf. app oppf'_fidentity. rww fidentity_axioms. Qed. Lemma oppf_constant_functor : forall a b x, Category.axioms a -> ob b x -> oppf (constant_functor a b x) = constant_functor (opp a) (opp b) x. Proof. ir. rw unfold_oppf. rww oppf'_constant_functor. ap constant_functor_axioms. am. uh H0; ee; am. am. Qed. Definition are_finverse f g := Functor.axioms f & Functor.axioms g & source f = target g & source g = target f & fcompose f g = fidentity (source g) & fcompose g f = fidentity (source f). Definition has_finverse f := exists g, are_finverse f g. Definition finverse f := choose (are_finverse f). Lemma finverse_pr : forall f, has_finverse f -> are_finverse f (finverse f). Proof. ir. exact (choose_pr H). Qed. Lemma are_finverse_symm : forall f g, are_finverse f g -> are_finverse g f. Proof. ir. uh H; ee. uhg; ee; am. Qed. Lemma are_finverse_umorphism_inverse : forall f g, Functor.axioms f -> Functor.axioms g -> are_finverse f g = Umorphism.are_inverse f g. Proof. ir. app iff_eq; ir. uh H1; ee. uhg; ee. uhg; ee. app functor_umorphism_axioms. app functor_umorphism_axioms. am. uhg; ee. app functor_umorphism_axioms. app functor_umorphism_axioms. am. exact H5. exact H6. uh H1; ee. uh H1; ee. uh H2; ee. uhg; ee. am. am. am. am. exact H3. exact H4. Qed. Lemma finverse_unique : forall f g h, are_finverse f g -> are_finverse f h -> g = h. Proof. ir. apply Umorphism.inverse_unique with f. cp H. uh H1; ee. uhg; ee. app functor_umorphism_axioms. uh H2; ee; am. uh H0; ee. uhg; ee. app functor_umorphism_axioms. uh H1; ee; am. wrr are_finverse_umorphism_inverse. uh H; ee; am. uh H; ee; am. wrr are_finverse_umorphism_inverse. uh H0; ee; am. uh H0; ee; am. Qed. End Functor. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Ltac nw := autorewrite with nw; try tv; try am. Ltac nr := autorewrite with nw. Ltac fr := autorewrite with fw. Ltac cr := autorewrite with cw. Module Nat_Trans. Export Functor. (*** we don't use the following first try because it turns out to be the same as a functor and this causes problems with rewriting: Definition create f g t := Arrow.create f g (L (objects (source f)) t). ************************************************) Open Local Scope string_scope. Definition Ntrans := R "Ntrans". Definition ntrans_arrow_create f t := denote Ntrans (L (objects (source f)) t) stop. Definition ntrans_arrow_ev n x := V x (V Ntrans n). Lemma ntrans_arrow_ev_create : forall f t x, inc x (objects (source f)) -> ntrans_arrow_ev (ntrans_arrow_create f t) x = t x. Proof. ir. uf ntrans_arrow_ev. uf ntrans_arrow_create. drw. aw. Qed. Definition create f g t := Arrow.create f g (ntrans_arrow_create f t). Definition ntrans n x := ntrans_arrow_ev (arrow n) x. Lemma source_create : forall f g t, source (create f g t) = f. Proof. ir. uf create. rww Arrow.source_create. Qed. Lemma target_create : forall f g t, target (create f g t) = g. Proof. ir. uf create. rww Arrow.target_create. Qed. Lemma ntrans_create : forall f g t x, inc x (objects (source f)) -> ntrans (create f g t) x = (t x). Proof. ir. uf create. uf ntrans. aw. rww ntrans_arrow_ev_create. Qed. Definition osource n := source (source n). Definition otarget n := target (target n). Lemma osource_create : forall f g t, osource (create f g t) = source f. Proof. ir. uf osource. rw source_create; tv. Qed. Lemma otarget_create : forall f g t, otarget (create f g t) = target g. Proof. ir. uf otarget. rw target_create; tv. Qed. Lemma create_extensionality : forall f g t f1 g1 t1, f = f1 -> g = g1 -> (forall x, inc x (objects (source f)) -> t x = t1 x) -> create f g t = create f1 g1 t1. Proof. ir. wr H; wr H0. uf create. ap uneq. uf ntrans_arrow_create. up. app Function.create_extensionality. ir. au. Qed. Definition like t := create (source t) (target t) (ntrans t) = t. Lemma create_like : forall f g t, like (create f g t). Proof. ir. uf like. ap create_extensionality. rww source_create. rww target_create. ir. rww ntrans_create. rwi source_create H. am. Qed. Definition axioms t := (like t) & (Category.axioms (osource t)) & (Category.axioms (otarget t)) & (Functor.axioms (source t)) & (Functor.axioms (target t)) & (source (target t)) = (osource t) & (target (source t)) = (otarget t) & (forall x, ob (osource t) x -> mor (otarget t) (ntrans t x)) & (forall x, ob (osource t) x -> source (ntrans t x) = fob (source t) x) & (forall x, ob (osource t) x -> target (ntrans t x) = fob (target t) x) & (forall u, mor (osource t) u -> comp (otarget t) (ntrans t (target u)) (fmor (source t) u) =comp (otarget t) (fmor (target t) u) (ntrans t (source u))). Definition property f g t := (Functor.axioms f) & (Functor.axioms g) & (source f) = (source g) & (target f) = (target g) & (forall x, ob (source f) x -> mor (target g) (t x)) & (forall x, ob (source f) x -> source (t x) = fob f x) & (forall x, ob (source f) x -> target (t x) = fob g x) & (forall u, mor (source f) u -> comp (target g) (t (target u)) (fmor f u) = comp (target g) (fmor g u) (t (source u))). Lemma create_axioms : forall f g t, property f g t -> axioms (create f g t). Proof. ir. uf axioms. ee; ir; try (ap create_like); do 3 (first [rw osource_create| rw otarget_create| rw source_create| rw target_create| idtac]). uh H; ee. uh H; ee; am. uh H; ee. uh H0; ee; am. lu. lu. uh H; ee; sy; am. uh H; ee; am. rw ntrans_create. uh H; ee. ap H4. rwi osource_create H0. am. change (is_ob (source f) x). rwi osource_create H0. lu. rwi osource_create H0. rw ntrans_create. uh H; ee. au. change (is_ob (source f) x); lu. rwi osource_create H0. rw ntrans_create. uh H; ee. au. change (is_ob (source f) x); lu. rwi osource_create H0. rw ntrans_create. rw ntrans_create. uh H; ee. au. change (is_ob (source f) (source u)). assert (ob (source f) (source u)). cw. lu. change (is_ob (source f) (target u)). assert (ob (source f) (target u)). cw. lu. Qed. Lemma axioms_like : forall t, axioms t -> like t = True. Proof. ir. app iff_eq; ir. lu. Qed. Lemma axioms_property : forall t, axioms t -> property (source t) (target t) (ntrans t). Proof. ir. uh H; uhg; xd. Qed. Lemma source_target : forall a, axioms a -> source (target a) = osource a. Proof. ir. lu. Qed. Lemma target_source : forall a, axioms a -> target (source a) = otarget a. Proof. ir. lu. Qed. Lemma mor_ntrans : forall a c x, axioms a -> ob (osource a) x -> c = otarget a -> mor c (ntrans a x). Proof. ir. uh H; ee. rw H1; au. Qed. Lemma mor_ntrans_rw : forall a c x, axioms a -> ob (osource a) x -> c = otarget a -> mor c (ntrans a x) = True. Proof. ir. app iff_eq; ir; app mor_ntrans. Qed. Lemma source_ntrans : forall a x, axioms a -> ob (osource a) x -> source (ntrans a x) = fob (source a) x. Proof. ir. uh H; xd. Qed. Lemma target_ntrans : forall a x, axioms a -> ob (osource a) x -> target (ntrans a x) = fob (target a) x. Proof. ir. uh H; xd. Qed. Hint Rewrite axioms_like source_ntrans target_ntrans mor_ntrans_rw : nw. Lemma carre : forall a u, axioms a -> mor (osource a) u -> comp (otarget a) (ntrans a (target u)) (fmor (source a) u)= comp (otarget a) (fmor (target a) u) (ntrans a (source u)). Proof. ir. uh H; xd. Qed. Lemma carre_verbose_rw : forall a c1 f u, axioms a -> mor (osource a) u -> c1 = otarget a -> f = source a -> comp c1 (ntrans a (target u)) (fmor f u)= comp (otarget a) (fmor (target a) u) (ntrans a (source u)). Proof. ir. rw H1; rw H2. ap carre; am. Qed. Lemma functor_axioms_source : forall a, axioms a -> Functor.axioms (source a) = True. Proof. ir. app iff_eq; ir. uh H; ee. am. Qed. Lemma functor_axioms_target : forall a, axioms a -> Functor.axioms (target a) = True. Proof. ir. app iff_eq; ir. uh H; ee. am. Qed. Lemma category_axioms_osource : forall a, axioms a -> Category.axioms (osource a) = True. Proof. ir. app iff_eq; ir. uh H; ee. am. Qed. Lemma category_axioms_otarget : forall a, axioms a -> Category.axioms (otarget a) = True. Proof. ir. app iff_eq; ir. uh H; ee. am. Qed. Lemma source_source : forall a, source (source a) = osource a. Proof. ir. tv. Qed. Lemma target_target : forall a, target (target a) = otarget a. Proof. ir. tv. Qed. Hint Rewrite functor_axioms_source functor_axioms_target category_axioms_osource category_axioms_otarget source_source target_target : nw. Definition vident f := create f f (fun x => id (target f) (fob f x)). Lemma source_vident : forall f, source (vident f) = f. Proof. ir. uf vident. rw source_create. tv. Qed. Lemma target_vident : forall f, target (vident f) = f. Proof. ir. uf vident. rww target_create. Qed. Lemma osource_vident : forall f, osource (vident f) = (source f). Proof. ir. uf osource. rww source_vident. Qed. Lemma otarget_vident : forall f, otarget (vident f) = (target f). Proof. ir. uf otarget. rww target_vident. Qed. Lemma ntrans_vident : forall f x, ob (source f) x -> ntrans (vident f) x = id (target f) (fob f x). Proof. ir. uf vident. rw ntrans_create. tv. lu. Qed. Definition vcompose a b := create (source b) (target a) (fun x => comp (otarget a) (ntrans a x) (ntrans b x)). Lemma source_vcompose : forall a b, source (vcompose a b) = (source b). Proof. ir. uf vcompose. rw source_create. tv. Qed. Lemma target_vcompose : forall a b, target (vcompose a b) = (target a). Proof. ir. uf vcompose. rww target_create. Qed. Lemma osource_vcompose : forall a b, osource (vcompose a b) = osource b. Proof. ir. uf osource. rww source_vcompose. Qed. Lemma otarget_vcompose : forall a b, otarget (vcompose a b) = otarget a. Proof. ir. uf otarget. rww target_vcompose. Qed. Lemma ntrans_vcompose : forall a b x, ob (osource b) x -> ntrans (vcompose a b) x = comp (otarget a) (ntrans a x) (ntrans b x). Proof. ir. uf vcompose. rw ntrans_create. tv. lu. Qed. Hint Rewrite osource_create otarget_create source_target target_source source_vident target_vident osource_vident otarget_vident ntrans_vident source_vcompose target_vcompose osource_vcompose otarget_vcompose ntrans_vcompose :nw. Lemma vcompose_axioms : forall a b, axioms a -> axioms b -> source a = target b -> axioms (vcompose a b) = True. Proof. ir. app iff_eq; ir. clear H2. assert (osource a = osource b). uf osource; rw H1; nw. assert (otarget a = otarget b). uf otarget; wr H1; nw. uhg; ee. uf vcompose; ap create_like. nw. nw. nw. nw. rw target_vcompose. rw source_target. rww osource_vcompose. am. rw source_vcompose. rw target_source. rww otarget_vcompose. sy; am. am. ir. rw ntrans_vcompose. rww mor_comp. ap mor_ntrans. am. rwi osource_vcompose H4. rww H2. rww otarget_vcompose. ap mor_ntrans. am. rwi osource_vcompose H4. am. rww otarget_vcompose. rww source_ntrans. rww target_ntrans. rww H1. rwi osource_vcompose H4. am. rwi osource_vcompose H4. rww H2. rww otarget_vcompose. rwi osource_vcompose H4. am. ir. rwi osource_vcompose H4. cp H4. wri H2 H4. rw ntrans_vcompose. rw source_vcompose. rw source_comp. rw source_ntrans. tv. am. am. ap mor_ntrans. am. am. tv. app mor_ntrans. rww source_ntrans. rww target_ntrans. rww H1. am. ir. rwi osource_vcompose H4. cp H4; wri H2 H4. rw ntrans_vcompose. rw target_vcompose. rw target_comp. rw target_ntrans. tv. am. am. ap mor_ntrans. am. am. tv. app mor_ntrans. rww target_ntrans. rww source_ntrans. rww H1. am. ir. rwi osource_vcompose H4. cp H4; wri H2 H4. nw. rw assoc. rw H3. rw carre. wr assoc. wr assoc. ap uncomp. reflexivity. wr H3. wr H1. rww carre. fw. nw. nw. wr H3. rww mor_fmorv. nw. nw. app mor_ntrans. rww ob_source. sy; am. nw. cw. rw source_fmor. rww target_ntrans. rww ob_source. nw. rww source_target. rww source_ntrans. rww target_ntrans. rww H1. rww ob_source. rww ob_source. tv. ap mor_ntrans. am. rww ob_target. sy; am. rww mor_fmorv. nw. rww source_target. app mor_ntrans. rww ob_source. rww source_ntrans. rww target_fmor. rww H1. nw. rww source_target. rww ob_target. rw source_fmor. rww target_ntrans. rww ob_source. nw. rww source_target. tv. am. am. app mor_ntrans. rww ob_target. app mor_ntrans. rww ob_target. rww mor_fmorv. nw. rww target_source. rw source_ntrans. rw target_ntrans. rww H1. am. rww ob_target. am. rww ob_target. rw source_ntrans. rw target_fmor. tv. nw. am. am. rww ob_target. tv. rww ob_source. rww ob_target. Qed. Lemma vident_axioms : forall f, Functor.axioms f -> axioms (vident f) = True. Proof. ir. app iff_eq; ir. clear H0. uf vident. ap create_axioms. uhg; dj. am. am. tv. tv. ap mor_id. ap ob_fob. am. am. rw source_id. tv. ap ob_fob; am. rw target_id; try tv; try (ap ob_fob; am). cp H7; rwi mor_facts_rw H7; uh H7; ee. rw left_id. rw right_id. tv. ap ob_fob; am. ap mor_fmor; am. rw source_fmor; try am. tv. tv. fw. fw. fw. tv. Qed. Lemma axioms_extensionality : forall a b, axioms a -> axioms b -> source a = source b -> target a = target b -> (forall x, ob (osource a) x -> ntrans a x = ntrans b x) -> a = b. Proof. ir. assert (like a). nw. assert (like b). nw. uh H4; uh H5. wr H4; wr H5. rw H1. rw H2. uf create. up. uf ntrans_arrow_create. up. app Function.create_extensionality. ir. wri H1 H7. ap H3. ap is_ob_ob. nw. am. Qed. Lemma left_vident : forall a, axioms a -> vcompose (vident (target a)) a = a. Proof. ir. ap axioms_extensionality. rww vcompose_axioms. nw. rww vident_axioms. nw. nw. am. nw. nw. ir. rwi osource_vcompose H0. nw. cw. fw. nw. nw. nw. nw. Qed. Lemma right_vident : forall a, axioms a -> vcompose a (vident (source a)) = a. Proof. ir. ap axioms_extensionality. rww vcompose_axioms. nw. nw. rww vident_axioms. nw. nw. am. nw. nw. ir. rwi osource_vcompose H0. rwi osource_vident H0. rwi source_source H0. nw. cw. fw. nw. nw. nw. nw. Qed. Lemma weak_left_vident : forall a f, axioms a -> f = target a -> vcompose (vident f) a = a. Proof. ir. rw H0. ap left_vident. am. Qed. Lemma weak_right_vident : forall a f, axioms a -> f = source a -> vcompose a (vident f) = a. Proof. ir. rw H0. ap right_vident. am. Qed. Hint Rewrite weak_left_vident weak_right_vident : nw. Lemma vcompose_assoc : forall a b c, axioms a -> axioms b -> axioms c -> source a = target b -> source b = target c -> vcompose (vcompose a b) c = vcompose a (vcompose b c). Proof. ir. ap axioms_extensionality; try am. rww vcompose_axioms. rww vcompose_axioms. nw. rww vcompose_axioms. rww vcompose_axioms. nw. rww source_vcompose. rww source_vcompose. rww source_vcompose. rw target_vcompose. rw target_vcompose. rw target_vcompose. tv. ir. rwi osource_vcompose H4. assert (otarget b = otarget a). uf otarget. wr H2. nw. assert (otarget c = otarget a). uf otarget. wr H3; nw. assert (osource b = osource a). uf osource. rw H2. nw. assert (osource c = osource a). uf osource. rw H2; nw. uf osource. rw H3. nw. rwi H8 H4. rww ntrans_vcompose. rww ntrans_vcompose. rw ntrans_vcompose. rw ntrans_vcompose. nw. rw assoc. rww H5. nw. nw. rww H7. sy; am. nw. rww H8. sy; am. nw. rww H2. rww H7. nw. rww H3. rww H7. rww H8. tv. rww H8. nw. rww H8. rww H7. rww H8. Qed. Definition htrans_left f a := create (fcompose f (source a)) (fcompose f (target a)) (fun x => (fmor f (ntrans a x))). Definition htrans_right a f := create (fcompose (source a) f) (fcompose (target a) f) (fun x=> (ntrans a (fob f x))). Lemma source_htrans_left : forall f a, source (htrans_left f a) = fcompose f (source a). Proof. ir. uf htrans_left. rww source_create. Qed. Lemma target_htrans_left : forall f a, target (htrans_left f a) = fcompose f (target a). Proof. ir. uf htrans_left. rww target_create. Qed. Lemma osource_htrans_left : forall f a, osource (htrans_left f a) = osource a. Proof. ir. uf osource. rww source_htrans_left. rww source_fcompose. Qed. Lemma otarget_htrans_left : forall f a, otarget (htrans_left f a) = target f. Proof. ir. uf otarget. rww target_htrans_left. rww target_fcompose. Qed. Lemma source_htrans_right : forall f a, source (htrans_right a f) = fcompose (source a) f. Proof. ir. uf htrans_right. rww source_create. Qed. Lemma target_htrans_right : forall f a, target (htrans_right a f) = fcompose (target a) f. Proof. ir. uf htrans_right. rww target_create. Qed. Lemma osource_htrans_right : forall f a, osource (htrans_right a f) = source f. Proof. ir. uf osource. rww source_htrans_right. rww source_fcompose. Qed. Lemma otarget_htrans_right : forall f a, otarget (htrans_right a f) = otarget a. Proof. ir. uf otarget. rw target_htrans_right. rww target_fcompose. Qed. Hint Rewrite source_htrans_left target_htrans_left osource_htrans_left otarget_htrans_left source_htrans_right target_htrans_right osource_htrans_right otarget_htrans_right : nw. Lemma ntrans_htrans_left : forall f a x, ob (osource a) x -> ntrans (htrans_left f a) x = fmor f (ntrans a x). Proof. ir. uf htrans_left. rw ntrans_create. tv. rw source_fcompose. lu. Qed. Lemma ntrans_htrans_right : forall f a x, ob (source f) x -> ntrans (htrans_right a f) x = ntrans a (fob f x). Proof. ir. uf htrans_right. rw ntrans_create. tv. rw source_fcompose. lu. Qed. Hint Rewrite ntrans_htrans_left ntrans_htrans_right : hw. Lemma htrans_left_axioms : forall f a, Functor.axioms f -> axioms a -> source f = otarget a -> axioms (htrans_left f a). Proof. ir. uhg; ee. uf htrans_left. ap create_like. rw osource_htrans_left. nw. rww otarget_htrans_left. fw. rww source_htrans_left. app fcompose_axioms. rww functor_axioms_source. rww target_source. rw target_htrans_left. ap fcompose_axioms. am. rww functor_axioms_target. am. rw target_htrans_left. rw osource_htrans_left. rw source_fcompose. rww source_target. rw source_htrans_left. rw target_fcompose. rww otarget_htrans_left. ir. rwi osource_htrans_left H2. rw otarget_htrans_left. rw ntrans_htrans_left. fw. nw. am. ir. rwi osource_htrans_left H2. rw ntrans_htrans_left. rw source_fmor. rw source_htrans_left. rw source_ntrans. rw fob_fcompose. tv. am. nw. nw. nw. am. am. am. nw. am. ir. rwi osource_htrans_left H2. rww ntrans_htrans_left. rww target_htrans_left. rww target_fmor. rww target_ntrans. rww fob_fcompose. nw. nw. nw. ir. rwi osource_htrans_left H2. rw otarget_htrans_left. rw ntrans_htrans_left. rw target_htrans_left. rw ntrans_htrans_left. rw fmor_fcompose. rw source_htrans_left. rw fmor_fcompose. rw comp_fmor. rw comp_fmor. ap uneq. rw H1. rww carre. am. fw. nw. nw. nw. cw. nw. fw. nw. nw. cw. am. nw. cw. fw. nw. nw. nw. fw. nw. cw. am. nw. nw. nw. am. nw. nw. nw. cw. cw. Qed. Lemma htrans_right_axioms : forall f a, Functor.axioms f -> axioms a -> osource a = target f -> axioms (htrans_right a f). Proof. ir. uhg; ee. uf htrans_right; ap create_like. rw osource_htrans_right. fw. rw otarget_htrans_right. nw. rw source_htrans_right. app fcompose_axioms. rww functor_axioms_source. rw target_htrans_right. app fcompose_axioms. rww functor_axioms_target. rww source_target. rw target_htrans_right. rw source_fcompose. rw osource_htrans_right. tv. rw source_htrans_right. rw target_fcompose. rw otarget_htrans_right. nw. ir. rwi osource_htrans_right H2. rw otarget_htrans_right. rw ntrans_htrans_right. nw. fw. am. ir. rwi osource_htrans_right H2. rw ntrans_htrans_right. rw source_ntrans. rw source_htrans_right. rww fob_fcompose. nw. am. fw. am. ir. rwi osource_htrans_right H2. rw ntrans_htrans_right. rw target_ntrans. rw target_htrans_right. rww fob_fcompose. nw. nw. am. fw. am. ir. rwi osource_htrans_right H2. rw otarget_htrans_right. rw ntrans_htrans_right. rw source_htrans_right. rw target_htrans_right. rw ntrans_htrans_right. rw fmor_fcompose. rw fmor_fcompose. wr target_fmor. wr source_fmor. rw carre. tv. am. fw. am. am. am. am. nw. am. nw. am. nw. am. nw. am. cw. cw. Qed. Definition hcomposable a b := axioms a & axioms b & osource a = otarget b. Definition hcompose a b := vcompose (htrans_right a (target b)) (htrans_left (source a) b). Lemma hcompose_axioms : forall a b, axioms a -> axioms b -> osource a = otarget b -> axioms (hcompose a b). Proof. ir. uf hcompose. rw vcompose_axioms. tv. ap htrans_right_axioms. nw. am. rw H1. tv. ap htrans_left_axioms. nw. am. am. rw source_htrans_right. rw target_htrans_left. tv. Qed. Lemma source_hcompose : forall a b, source (hcompose a b) = fcompose (source a) (source b). Proof. ir. uf hcompose. rw source_vcompose. rw source_htrans_left. tv. Qed. Lemma target_hcompose : forall a b, target (hcompose a b) = fcompose (target a) (target b). Proof. ir. uf hcompose. rw target_vcompose. rw target_htrans_right. tv. Qed. Lemma osource_hcompose : forall a b, osource (hcompose a b) = osource b. Proof. ir. uf osource. rww source_hcompose. rww source_fcompose. Qed. Lemma otarget_hcompose : forall a b, otarget (hcompose a b) = otarget a. Proof. ir. uf otarget. rww target_hcompose. rww target_fcompose. Qed. Lemma ntrans_hcompose : forall a b x, hcomposable a b -> ob (osource b) x -> ntrans (hcompose a b) x = comp (otarget a) (ntrans a (fob (target b) x)) (fmor (source a) (ntrans b x)). Proof. ir. uf hcompose. rw ntrans_vcompose. rw otarget_htrans_right. rw ntrans_htrans_right. rw ntrans_htrans_left. tv. am. uh H; ee. nw. rww osource_htrans_left. Qed. Definition hcompose1 a b := vcompose (htrans_left (target a) b) (htrans_right a (source b)). Lemma hcompose1_axioms : forall a b, hcomposable a b -> axioms (hcompose1 a b). Proof. ir. uh H; ee. uf hcompose1. rw vcompose_axioms. tv. ap htrans_left_axioms. nw. am. nw. ap htrans_right_axioms. nw. am. nw. rw source_htrans_left. rw target_htrans_right. tv. Qed. Lemma hcomposable_commutativity : forall a b x, hcomposable a b -> ob (osource b) x -> comp (otarget a) (ntrans a (fob (target b) x)) (fmor (source a) (ntrans b x)) = comp (otarget a) (fmor (target a) (ntrans b x)) (ntrans a (fob (source b) x)). Proof. ir. cp H. uh H; ee. assert (lem1 : fob (target b) x = target (ntrans b x)). rw target_ntrans. tv. am. am. assert (lem2 : fob (source b) x = source (ntrans b x)). rw source_ntrans. tv. am. am. rw lem1. rw carre. rw lem2. tv. am. ap mor_ntrans. am. am. am. Qed. Lemma hcompose_other : forall a b, hcomposable a b -> hcompose a b = hcompose1 a b. Proof. ir. cp H; uh H; ee. assert (lem1: axioms (hcompose a b)). ap hcompose_axioms; am. assert (lem2 : axioms (hcompose1 a b)). ap hcompose1_axioms; am. ap axioms_extensionality. app hcompose_axioms. app hcompose1_axioms. rw source_hcompose. uf hcompose1. rw source_vcompose. rw source_htrans_right. tv. rw target_hcompose. uf hcompose1. rw target_vcompose. rww target_htrans_left. ir. rwi osource_hcompose H3. rw ntrans_hcompose. uf hcompose1. rw ntrans_vcompose. rw otarget_htrans_left. rw ntrans_htrans_left. rw ntrans_htrans_right. assert (target (target a) = otarget a). tv. rw H4. ap hcomposable_commutativity. am. am. am. am. rw osource_htrans_right. am. am. am. Qed. Lemma hcompose_vident_left : forall f a, axioms a -> Functor.axioms f -> source f = otarget a -> hcompose (vident f) a = htrans_left f a. Proof. ir. ap axioms_extensionality. ap hcompose_axioms. rw vident_axioms. tv. am. am. nw. app htrans_left_axioms. rww source_hcompose. rw source_htrans_left. rw source_vident. tv. rw target_hcompose. rw target_vident. rw target_htrans_left. tv. ir. rwi osource_hcompose H2. rw ntrans_hcompose. rw ntrans_htrans_left. rw otarget_vident. rw ntrans_vident. rw left_id. rw source_vident. tv. ap ob_fob. am. rw H1. uf otarget. ap ob_fob. nw. nw. nw. fw. nw. nw. rw target_fmor. rw target_ntrans. tv. am. am. am. nw. tv. fw. nw. nw. am. uhg; ee. rww vident_axioms. am. nw. am. Qed. Lemma hcompose_vident_right : forall a f, axioms a -> Functor.axioms f -> target f = osource a -> hcompose a (vident f) = htrans_right a f. Proof. ir. ap axioms_extensionality. ap hcompose_axioms. uhg; ee. nw. nw. nw. nw. nw. nw. nw. ir. nw. ir. nw. ir. nw. ir. rw carre. tv. am. am. rww vident_axioms. nw. sy; am. ap htrans_right_axioms. am. am. sy; am. rw source_hcompose. rw source_htrans_right. rw source_vident. tv. rw target_hcompose. rw target_vident. rw target_htrans_right. tv. ir. rwi osource_hcompose H2. rwi osource_vident H2. rww ntrans_hcompose. rww ntrans_vident. rww ntrans_htrans_right. rww target_vident. rww fmor_id. rw target_source. rw right_id. tv. fw. nw. nw. wr H1. fw. nw. nw. wr H1; fw. nw. wr H1; fw. tv. am. nw. sy; am. fw. uhg; ee. am. rww vident_axioms. rw otarget_vident. sy; am. rww osource_vident. Qed. Lemma vident_hcomposable : forall f g, Functor.axioms f -> Functor.axioms g -> source f = target g -> hcomposable (vident f) (vident g). Proof. ir. uhg; ee. rww vident_axioms. rww vident_axioms. rw osource_vident. rww otarget_vident. Qed. Lemma hcompose_vident_vident : forall f g, Functor.axioms f -> Functor.axioms g -> source f = target g -> hcompose (vident f) (vident g) = vident (fcompose f g). Proof. ir. rw hcompose_vident_left. ap axioms_extensionality. ap htrans_left_axioms. am. rww vident_axioms. rww otarget_vident. rww vident_axioms. app fcompose_axioms. rw source_htrans_left. rw source_vident. rw source_vident. tv. rw target_htrans_left. rw target_vident. rw target_vident. tv. ir. rwi osource_htrans_left H2. rwi osource_vident H2. rw ntrans_htrans_left. rw ntrans_vident. rw ntrans_vident. rw target_fcompose. rw fmor_id. ap uneq. rww fob_fcompose. am. am. fw. rww source_fcompose. am. nw. rww vident_axioms. am. nw. Qed. Lemma htrans_right_vident : forall f g, Functor.axioms f -> Functor.axioms g -> source f = target g-> htrans_right (vident f) g = vident (fcompose f g). Proof. ir. wr hcompose_vident_right. rw hcompose_vident_vident. tv. am. am. am. rww vident_axioms. am. nw. sy; am. Qed. Lemma htrans_left_vident : forall f g, Functor.axioms f -> Functor.axioms g -> source f = target g-> htrans_left f (vident g) = vident (fcompose f g). Proof. ir. wr hcompose_vident_left. rw hcompose_vident_vident. tv. am. am. am. rww vident_axioms. am. nw. Qed. Lemma interchange : forall a b c d, target a = source c -> target b = source d -> osource b = otarget a -> axioms a -> axioms b -> axioms c -> axioms d -> vcompose (hcompose d c) (hcompose b a) = hcompose (vcompose d b) (vcompose c a). Proof. ir. assert (lema : osource d = otarget c). uf osource. wr target_source. wr H0. wr H. rw source_target. am. am. am. assert (lemb : osource d = osource b). rw lema. wr source_target. rw H0. sy; am. am. assert (lem1 : hcomposable d c). uhg; ee; try am. assert (lem2 : hcomposable b a). uhg; ee; try am. assert (lem5: otarget d = otarget b). uf otarget. rw H0. rw target_source. tv. am. assert (lem6 : osource c = osource a). uf osource. wr H. rw source_target. tv. am. assert (lem7 : otarget d = otarget b). uf otarget. rw H0. rw target_source. tv. am. assert (lem8 : osource b = otarget c). wr lema. sy; am. ap axioms_extensionality. rw vcompose_axioms. tv. ap hcompose_axioms; am. ap hcompose_axioms; am. rw source_hcompose. rw target_hcompose. rw H0. rw H. tv. ap hcompose_axioms. rww vcompose_axioms. sy; am. rww vcompose_axioms. sy; am. rw osource_vcompose. rww otarget_vcompose. rw source_vcompose. rw source_hcompose. rw source_hcompose. rw source_vcompose. rw source_vcompose. tv. rw target_vcompose. rw target_hcompose. rw target_hcompose. rw target_vcompose. rww target_vcompose. ir. rwi osource_vcompose H6. rwi osource_hcompose H6. cp H6. wri lem6 H7. rww ntrans_vcompose. rww ntrans_hcompose. rww ntrans_hcompose. rw ntrans_hcompose. rw ntrans_vcompose. rw otarget_hcompose. rw otarget_vcompose. rw target_vcompose. rw source_vcompose. rw ntrans_vcompose. rww assoc. rww assoc. app uncomp. wrr assoc. wr lema. assert (osource d = source (source b)). nw. rw H8. wr comp_fmor. wr assoc. ap uncomp. tv. rw target_source. wr H0. rw H. sy. ap hcomposable_commutativity. uhg; ee. am. am. am. (*** 33 rewriting obligations and other subsidiary goals ***) am. am. nw. nw. fw. nw. nw. fw. nw. nw. nw. fw. nw. nw. nw. nw. rw target_fmor. rw target_ntrans. tv. am. am. nw. nw. fw. nw. nw. rw source_fmor. rw source_ntrans. rw target_fmor. rw target_ntrans. rww H. am. am. nw. nw. am. am. nw. nw. nw. nw. nw. nw. nw. rww H. fw. nw. nw. nw. nw. fw. nw. nw. fw. nw. nw. nw. rw source_fmor. rw source_ntrans. rw target_ntrans. rw H0. rww H. am. fw. nw. nw. am. am. nw. nw. rw source_ntrans. rw target_fmor. rw target_ntrans. tv. am. am. nw. nw. am. fw. nw. nw. nw. fw. nw. nw. nw. fw. nw. nw. fw. nw. nw. rw mor_comp. tv. rw lem8. nw. rw H1. nw. nw. rww H. am. nw. rw source_ntrans. rw target_ntrans. wr H0. tv. am. fw. nw. nw. am. fw. nw. nw. rww source_ntrans. rw target_fmor. ap uneq. rw target_comp. rw target_ntrans. tv. am. am. nw. wr lem8. rw H1. nw. nw. rww H. nw. cw. nw. nw. nw. rww H. rw lem8. fw. nw. nw. nw. rw lemb. rw lem8. fw. nw. nw. fw. nw. nw. nw. cw. nw. fw. nw. nw. fw. nw. nw. nw. rw source_ntrans. rw target_fmor. rw target_ntrans. tv. am. am. nw. nw. am. fw. nw. nw. rw source_ntrans. rw target_fmor. rw target_ntrans. tv. am. am. nw. nw. am. fw. nw. nw. rw source_fmor. rw source_ntrans. rw target_comp. rw target_ntrans. wr H0. rww H. am. fw. nw. nw. nw. fw. nw. nw. fw. nw. nw. nw. rw source_ntrans. rw target_fmor. rw target_ntrans. tv. am. am. nw. nw. am. fw. nw. nw. am. am. nw. nw. am. rw target_vcompose. fw. nw. nw. uhg; ee. rww vcompose_axioms. sy; am. rww vcompose_axioms. sy; am. rw osource_vcompose. rww otarget_vcompose. rw osource_vcompose. am. rww osource_hcompose. Qed. Definition constant_nt a b u := create (constant_functor a b (source u)) (constant_functor a b (target u)) (fun x:E => u). Lemma osource_constant_nt : forall a b u, osource (constant_nt a b u) = a. Proof. ir. uf constant_nt. rw osource_create. rww source_constant_functor. Qed. Lemma otarget_constant_nt : forall a b u, otarget (constant_nt a b u) = b. Proof. ir. uf constant_nt. rw otarget_create. rww target_constant_functor. Qed. Lemma source_constant_nt : forall a b u, source (constant_nt a b u) = constant_functor a b (source u). Proof. ir. uf constant_nt. rww source_create. Qed. Lemma target_constant_nt : forall a b u, target (constant_nt a b u) = constant_functor a b (target u). Proof. ir. uf constant_nt. rww target_create. Qed. Lemma ntrans_constant_nt : forall a b u x, ob a x -> ntrans (constant_nt a b u) x = u. Proof. ir. uf constant_nt. rww ntrans_create. rw source_constant_functor. lu. Qed. Lemma constant_nt_axioms : forall a b u, Category.axioms a -> Category.axioms b -> mor b u -> axioms (constant_nt a b u). Proof. ir. uf constant_nt. ap create_axioms. cp H1. rwi mor_facts_rw H2. uh H2; ee. uhg; ee. app constant_functor_axioms. app constant_functor_axioms. rww source_constant_functor. rww source_constant_functor. rww target_constant_functor. rww target_constant_functor. ir. rww target_constant_functor. ir. rww fob_constant_functor. rwi source_constant_functor H8; am. ir. rwi source_constant_functor H8. rww fob_constant_functor. ir. rwi source_constant_functor H8. rww fmor_constant_functor. rww fmor_constant_functor. rw target_constant_functor. rww left_id. Qed. Lemma vcompose_htrans_right_htrans_right : forall u v f g, axioms u -> axioms v -> Functor.axioms f -> f = g -> source u = target v -> target f = osource u -> vcompose (htrans_right u f) (htrans_right v g) = htrans_right (vcompose u v) f. Proof. ir. assert (osource u = osource v). uf osource. rw H3. rw source_target. tv. am. cp hcompose_vident_right. wr H2. util (H6 u f). am. am. am. util (H6 v f). am. am. wr H5; am. util (H6 (vcompose u v) f). rww vcompose_axioms. am. rww osource_vcompose. wrr H5. wr H7. wr H8. assert (vident f = vcompose (vident f) (vident f)). rw weak_left_vident. reflexivity. rww vident_axioms. rww target_vident. rwi H10 H9. wr H9. apply interchange. rww target_vident. rww source_vident. sy; am. rww otarget_vident. sy; wrr H5. rww vident_axioms. am. rww vident_axioms. am. Qed. Lemma vcompose_htrans_left_htrans_left : forall u v f g, axioms u -> axioms v -> Functor.axioms f -> f = g -> source u = target v -> source f = otarget u -> vcompose (htrans_left f u) (htrans_left g v) = htrans_left f (vcompose u v). Proof. ir. assert (otarget u = otarget v). uf otarget. wr H3. rw target_source. tv. am. cp hcompose_vident_left. wr H2. util (H6 f u). am. am. am. util (H6 f v). am. am. wr H5; am. util (H6 f (vcompose u v)). rww vcompose_axioms. am. rww otarget_vcompose. wr H7. wr H8. assert (vident f = vcompose (vident f) (vident f)). rw weak_left_vident. reflexivity. rww vident_axioms. rww target_vident. rwi H10 H9. wr H9. apply interchange. sy; am. rww target_vident. rww source_vident. rww osource_vident. sy; wrr H5. sy; am. am. rww vident_axioms. am. rww vident_axioms. Qed. (**** oppnt stuff ****) Definition oppnt' u := Nat_Trans.create (oppf (target u)) (oppf (source u)) (fun x => flip (ntrans u x)). Lemma source_oppnt' : forall u, source (oppnt' u) = oppf (target u). Proof. ir. uf oppnt'. rw source_create. tv. Qed. Lemma target_oppnt' : forall u, target (oppnt' u) = oppf (source u). Proof. ir. uf oppnt'. rw target_create. tv. Qed. Lemma osource_oppnt' : forall u, axioms u -> osource (oppnt' u) = opp (osource u). Proof. ir. uf osource. rw source_oppnt'. rw source_oppf. rww source_target. rww functor_axioms_target. Qed. Lemma otarget_oppnt' : forall u, axioms u -> otarget (oppnt' u) = opp (otarget u). Proof. ir. uf otarget. rw target_oppnt'. rw target_oppf. rww target_source. rww functor_axioms_source. Qed. Lemma ntrans_oppnt' : forall u x, axioms u -> ob (osource u) x -> ntrans (oppnt' u) x = flip (ntrans u x). Proof. ir. uf oppnt'. rw ntrans_create. tv. rw source_oppf. ap ob_is_ob. rw ob_opp. rww source_target. rww functor_axioms_target. Qed. Lemma oppnt'_axioms : forall u, Nat_Trans.axioms u -> Nat_Trans.axioms (oppnt' u). Proof. ir. cp H. uh H0; ee. uhg; ee. uf oppnt'. ap create_like. rw osource_oppnt'. ap opp_axioms. am. am. rw otarget_oppnt'. ap opp_axioms. am. am. rw source_oppnt'. ap oppf_axioms. am. rw target_oppnt'. ap oppf_axioms. am. rw target_oppnt'. rw source_oppf. rw osource_oppnt'. tv. am. am. rw source_oppnt'. rw target_oppf. rw otarget_oppnt'. tv. am. ir. am. rw otarget_oppnt'. (* rw ntrans_oppnt'. rw mor_opp. rw flip_flip. ap H7. rwi osource_oppnt' H11. rwi ob_opp H11. am. am. am. am. am. rwi osource_oppnt' H11. rwi ob_opp H11. am. am. am. am. *) ir. rwi osource_oppnt' H11. rwi ob_opp H11. rw ntrans_oppnt'. rw mor_opp. rw flip_flip. app mor_ntrans. am. am. am. am. (*rw source_flip. rw fob_oppf. rw target_ntrans. tv. am. am. am. rw source_oppf. rw source_target. rw ob_opp. am. am. am. assert (mor (otarget u) (ntrans u x)). ap mor_ntrans. am. am. tv. apply mor_arrow_like with (otarget u). am. am. am. am. am. *) ir. rwi osource_oppnt' H11. rwi ob_opp H11. rw ntrans_oppnt'. rw source_flip. rw source_oppnt'. rw fob_oppf. rw target_ntrans. tv. am. am. am. rw source_oppf. rw source_target. rw ob_opp. am. am. am. assert (mor (otarget u) (ntrans u x)). ap mor_ntrans. am. am. tv. apply mor_arrow_like with (otarget u). am. am. am. am. ir. cp H11. rwi osource_oppnt' H12. rwi ob_opp H12. rw ntrans_oppnt'. rw target_flip. rw target_oppnt'. rw fob_oppf. rw source_ntrans. tv. am. am. am. rw source_oppf. rw ob_opp. am. rww functor_axioms_source. apply mor_arrow_like with (otarget u). ap mor_ntrans. am. am. tv. am. am. am. ir. cp H11. rwi osource_oppnt' H12. cp H12. rwi mor_opp H13. rw otarget_oppnt'. rw target_oppnt'. rw ntrans_oppnt'. rw ntrans_oppnt'. rw fmor_oppf. rw source_oppnt'. rw fmor_oppf. rw comp_opp. rw flip_flip. rw comp_opp. rw flip_flip. rw flip_flip. rw flip_flip. assert (source u0 = target (flip u0)). rww target_flip. apply mor_arrow_like with (osource (oppnt' u)). am. rw H14. ap uneq. rw H10. rw source_flip. tv. apply mor_arrow_like with (osource (oppnt' u)). am. am. rw mor_opp. rw flip_flip. wr target_source. ap mor_fmor. am. am. am. rw mor_opp. rw flip_flip. ap mor_ntrans. am. wr target_flip. rww ob_target. apply mor_arrow_like with (osource (oppnt' u)). am. tv. rw source_flip. rw target_flip. rw source_ntrans. rw target_fmor. ap uneq. rw target_flip. tv. apply mor_arrow_like with (opp (osource u)); am. am. am. am. wr target_flip. rww ob_target. apply mor_arrow_like with (opp (osource u)); am. apply mor_arrow_like with (otarget u). ap mor_ntrans. am. wr target_flip. rww ob_target. apply mor_arrow_like with (opp (osource u)); am. tv. apply mor_arrow_like with (target (source u)). ap mor_fmor. am. am. rw mor_opp. rw flip_flip. ap mor_ntrans. am. wr source_flip. rww ob_source. apply mor_arrow_like with (osource (oppnt' u)). am. tv. rw mor_opp. rw flip_flip. uf otarget. ap mor_fmor. am. rww source_target. rw source_flip. rw target_flip. rw target_ntrans. rw source_fmor. ap uneq. rw source_flip. tv. apply mor_arrow_like with (osource (oppnt' u)). am. am. rw source_target. am. am. am. wr source_flip. rww ob_source. apply mor_arrow_like with (osource (oppnt' u)). am. apply mor_arrow_like with (target (target u)). app mor_fmor. rw source_target. am. am. apply mor_arrow_like with (otarget u). app mor_ntrans. wr source_flip. rww ob_source. apply mor_arrow_like with (osource (oppnt' u)). am. rww functor_axioms_target. rw source_oppf. rww source_target. rww functor_axioms_target. rww functor_axioms_source. rw source_oppf. am. am. am. wr target_flip. rww ob_target. apply mor_arrow_like with (osource (oppnt' u)). am. am. wr source_flip. rww ob_source. apply mor_arrow_like with (osource (oppnt' u)). am. am. am. Qed. Lemma oppnt'_oppnt' : forall u, Nat_Trans.axioms u -> oppnt' (oppnt' u) = u. Proof. ir. ap axioms_extensionality. ap oppnt'_axioms. ap oppnt'_axioms. am. am. rw source_oppnt'. rw target_oppnt'. rw oppf_oppf. tv. uh H; ee. rw target_oppnt'. rw source_oppnt'. rw oppf_oppf. tv. ir. rw ntrans_oppnt'. rw ntrans_oppnt'. rw flip_flip. tv. am. rwi osource_oppnt' H0. rwi ob_opp H0. rwi osource_oppnt' H0. rwi ob_opp H0. am. am. app oppnt'_axioms. app oppnt'_axioms. rwi osource_oppnt' H0. rwi ob_opp H0. am. app oppnt'_axioms. Qed. Lemma vcompose_oppnt' : forall u v, Nat_Trans.axioms u -> Nat_Trans.axioms v -> source u = target v -> vcompose (oppnt' v) (oppnt' u) = oppnt' (vcompose u v). Proof. ir. assert (axioms (oppnt' u)). app oppnt'_axioms. assert (axioms (oppnt' v)). app oppnt'_axioms. assert (source (oppnt' v) = target (oppnt' u)). rw source_oppnt'. rw target_oppnt'. rww H1. assert (lem1 : otarget u = otarget v). uf otarget. wr H1. rww target_source. assert (lem2 : osource u = osource v). uf osource. rw H1. rww source_target. ap axioms_extensionality. rww vcompose_axioms. ap oppnt'_axioms. rww vcompose_axioms. rw source_vcompose. rw source_oppnt'. rw source_oppnt'. rw target_vcompose. tv. rw target_vcompose. rw target_oppnt'. rw target_oppnt'. rww source_vcompose. ir. rwi osource_vcompose H5. cp H5. rwi osource_oppnt' H6. rwi ob_opp H6. rw ntrans_vcompose. rw otarget_oppnt'. rw ntrans_oppnt'. rw ntrans_oppnt'. rw ntrans_oppnt'. rw comp_opp. ap uneq. rw flip_flip. rw flip_flip. rw ntrans_vcompose. rww lem1. wrr lem2. rww mor_opp. rw flip_flip. ap mor_ntrans. am. wrr lem2. tv. rww mor_opp. rw flip_flip. ap mor_ntrans. am. am. tv. sy; am. rw source_flip. rw target_flip. rw target_ntrans. rw source_ntrans. rww H1. am. am. am. wrr lem2. apply mor_arrow_like with (otarget u). app mor_ntrans. apply mor_arrow_like with (otarget u). app mor_ntrans. wrr lem2. rww vcompose_axioms. rw osource_vcompose. wrr lem2. am. am. am. wrr lem2. am. am. am. Qed. Lemma vident_oppf1 : forall f, Functor.axioms f -> vident (oppf f) = oppnt' (vident f). Proof. ir. ap axioms_extensionality. rw vident_axioms. tv. app oppf_axioms. app oppnt'_axioms. rww vident_axioms. rw source_vident. rw source_oppnt'. rw target_vident. tv. rw target_vident. rw target_oppnt'. rw source_vident. tv. ir. cp H0. rwi osource_vident H0. rwi source_oppf H0. rwi ob_opp H0. rw ntrans_vident. rw ntrans_oppnt'. rw ntrans_vident. rw target_oppf. rw fob_oppf. rw id_opp. tv. rw ob_opp. ap ob_fob. am. am. am. rw source_oppf. rw ob_opp. am. am. am. am. rww vident_axioms. rw osource_vident. am. rw source_oppf. rw ob_opp. am. am. am. Qed. Definition oppnt u := Y (Nat_Trans.axioms u) (oppnt' u) u. Lemma unfold_oppnt : forall u, Nat_Trans.axioms u -> oppnt u = oppnt' u. Proof. ir. uf oppnt. ap (Y_if H). tv. Qed. Lemma oppnt_axioms : forall u, Nat_Trans.axioms u -> Nat_Trans.axioms (oppnt u). Proof. ir. rww unfold_oppnt. app oppnt'_axioms. Qed. Lemma oppnt_oppnt : forall u, oppnt (oppnt u) = u. Proof. ir. apply by_cases with (Nat_Trans.axioms u); ir. rw unfold_oppnt. rw unfold_oppnt. rww oppnt'_oppnt'. am. app oppnt_axioms. assert (oppnt u = u). uf oppnt. ap (Y_if_not H). tv. rw H0. am. Qed. Lemma axioms_oppnt : forall u, Nat_Trans.axioms (oppnt u) = Nat_Trans.axioms u. Proof. ir. ap iff_eq; ir. wr oppnt_oppnt. app oppnt_axioms. app oppnt_axioms. Qed. Lemma source_oppnt : forall u, axioms u -> source (oppnt u) = oppf (target u). Proof. ir. rww unfold_oppnt. rww source_oppnt'. Qed. Lemma target_oppnt : forall u, axioms u -> target (oppnt u) = oppf (source u). Proof. ir. rww unfold_oppnt. rww target_oppnt'. Qed. Lemma osource_oppnt : forall u, axioms u -> osource (oppnt u) = opp (osource u). Proof. ir. uf osource. rw source_oppnt. rw source_oppf. rww source_target. rww functor_axioms_target. am. Qed. Lemma otarget_oppnt : forall u, axioms u -> otarget (oppnt u) = opp (otarget u). Proof. ir. uf otarget. rw target_oppnt. rw target_oppf. rww target_source. rww functor_axioms_source. am. Qed. Lemma ntrans_oppnt : forall u x, axioms u -> ob (osource u) x -> ntrans (oppnt u) x = flip (ntrans u x). Proof. ir. rww unfold_oppnt. rww ntrans_oppnt'. Qed. Lemma vcompose_oppnt : forall u v, Nat_Trans.axioms u -> Nat_Trans.axioms v -> source u = target v -> vcompose (oppnt v) (oppnt u) = oppnt (vcompose u v). Proof. ir. rww unfold_oppnt. rww unfold_oppnt. rww vcompose_oppnt'. rww unfold_oppnt. rww vcompose_axioms. Qed. Lemma vident_oppf : forall f, Functor.axioms f -> vident (oppf f) = oppnt (vident f). Proof. ir. sy; rw unfold_oppnt. sy; rw vident_oppf1. reflexivity. am. rww vident_axioms. Qed. (**** we should also do the following sometime ****** Lemma oppnt_htrans_left : forall f g u, Functor.axioms f -> Nat_Trans.axioms u -> source f = otarget u -> oppnt (htrans_left f u) = htrans_left (oppf f) (oppnt u). Proof. Qed. Lemma oppnt_htrans_right : forall f g u, Functor.axioms f -> Nat_Trans.axioms u -> target f = osource u -> oppnt (htrans_right u f) = htrans_right (oppnt u) (oppf f). Proof. Qed. Lemma oppnt_hcompose : forall u v, Nat_Trans.axioms u -> Nat_Trans.axioms v -> osource u = otarget v -> oppnt (hcompose u v) = hcompose (oppnt u) (oppnt v). Proof. Qed. ****************************************************) End Nat_Trans. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Ltac lw := autorewrite with lw; try tv; try am. Ltac lr := autorewrite with lw. Module Limit. Export Nat_Trans. Open Local Scope string_scope. Definition Vertex := R "Vertex". Definition Edge := R "Edge". Definition cone_create v e := denote Vertex v ( denote Edge e stop). Definition vertex c := V Vertex c. Definition edge_nt c := V Edge c. Definition edge c x := ntrans (edge_nt c) x. Definition socle c := target (edge_nt c). Definition cone_source c := source (socle c). Definition cone_target c := target (socle c). Definition cone_like c := cone_create (vertex c) (edge_nt c) = c. Lemma vertex_cone_create : forall v e, vertex (cone_create v e) = v. Proof. ir. uf cone_create. uf vertex. drw. Qed. Lemma edge_nt_cone_create : forall v e, edge_nt (cone_create v e) = e. Proof. ir. uf cone_create. uf edge_nt. drw. Qed. Lemma cone_like_cone_create : forall v e, cone_like (cone_create v e). Proof. ir. uf cone_like. rw vertex_cone_create. rww edge_nt_cone_create. Qed. Definition is_cone c := cone_like c & Nat_Trans.axioms (edge_nt c) & ob (cone_target c) (vertex c) & source (edge_nt c) = constant_functor (cone_source c) (cone_target c) (vertex c). Lemma cone_extensionality : forall c d, is_cone c -> is_cone d -> vertex c = vertex d -> socle c = socle d -> (forall x, ob (cone_source c) x -> edge c x = edge d x) -> c = d. Proof. ir. assert (cone_source c = cone_source d). uf cone_source. rww H2. assert (cone_target c = cone_target d). uf cone_target; rww H2. uh H; uh H0; ee. uh H; uh H0. wr H; wr H0. rw H1. ap uneq. app Nat_Trans.axioms_extensionality. rw H11. rw H8. rw H4; rw H5; rw H1. reflexivity. ir. util (H3 x). uf cone_source. uf socle. rw Nat_Trans.source_target. am. am. am. Qed. Definition cone_create2 f v e := cone_create v (Nat_Trans.create (constant_functor (source f) (target f) v) f e). Lemma is_cone_cone_create2 : forall f v e, Functor.axioms f-> ob (target f) v-> (forall x, ob (source f) x -> mor (target f) (e x)) -> (forall x, ob (source f) x -> source (e x) = v) -> (forall x, ob (source f) x -> target (e x) = (fob f x)) -> (forall u, mor (source f) u -> comp (target f) (fmor f u) (e (source u)) = e (target u)) -> is_cone (cone_create2 f v e). Proof. ir. uf cone_create2. uhg; ee. ap cone_like_cone_create. rw edge_nt_cone_create. app Nat_Trans.create_axioms. uhg; ee. app constant_functor_axioms. uh H; ee; am. uh H; ee; am. am. rww source_constant_functor. rww target_constant_functor. ir. rwi source_constant_functor H5. au. ir. rwi source_constant_functor H5. rw fob_constant_functor. au. am. am. ir. rwi source_constant_functor H5. au. ir. rwi source_constant_functor H5. rww fmor_constant_functor. rww H4. rww right_id. ap H1. rww ob_target. rw H2. tv. rww ob_target. rw vertex_cone_create. uf cone_target. uf socle. rw edge_nt_cone_create. rw target_create. am. rw edge_nt_cone_create. rw source_create. rw vertex_cone_create. uf cone_source; uf cone_target; uf socle; rw edge_nt_cone_create. rw target_create. tv. Qed. Lemma otarget_edge_nt : forall c, otarget (edge_nt c) = cone_target c. Proof. ir. tv. Qed. Lemma osource_edge_nt : forall c, is_cone c -> osource (edge_nt c) = cone_source c. Proof. ir. uf cone_source. uf socle. rw Nat_Trans.source_target. tv. lu. Qed. Definition cone_composable c u := is_cone c & mor (cone_target c) u & target u = vertex c. Lemma cone_composable_rw : forall c u, is_cone c -> mor (cone_target c) u -> target u = vertex c -> cone_composable c u = True. Proof. ir. uf cone_composable. app iff_eq; ir; try tv. xd. Qed. Definition cone_compose c u := cone_create (source u) (vcompose (edge_nt c) (constant_nt (cone_source c) (cone_target c) u)). Lemma vertex_cone_compose : forall c u , vertex (cone_compose c u) = source u. Proof. ir. uf cone_compose. rw vertex_cone_create. tv. Qed. Lemma edge_nt_cone_compose : forall c u, edge_nt (cone_compose c u) = (vcompose (edge_nt c) (constant_nt (cone_source c) (cone_target c) u)). Proof. ir. uf cone_compose. rw edge_nt_cone_create. tv. Qed. Lemma edge_cone_compose : forall c u x, ob (cone_source c) x -> cone_composable c u -> edge (cone_compose c u) x = comp (cone_target c) (edge c x) u. Proof. ir. uf edge. rw edge_nt_cone_compose. rw ntrans_vcompose. rw otarget_edge_nt. ap uneq. rw ntrans_constant_nt. tv. am. rw osource_constant_nt. am. Qed. Lemma socle_cone_compose : forall c u, socle (cone_compose c u) = socle c. Proof. ir. uf socle. rw edge_nt_cone_compose. rw target_vcompose. tv. Qed. Lemma cone_target_cone_compose : forall c u, cone_target (cone_compose c u) = cone_target c. Proof. ir. uf cone_target. rw socle_cone_compose. tv. Qed. Lemma cone_source_cone_compose : forall c u, cone_source (cone_compose c u) = cone_source c. Proof. ir. uf cone_source. rw socle_cone_compose. tv. Qed. Lemma mor_edge : forall c x, ob (cone_source c) x -> is_cone c -> mor (cone_target c) (edge c x). Proof. ir. uf edge. ap mor_ntrans. lu. rww osource_edge_nt. rww otarget_edge_nt. Qed. Lemma source_edge_nt : forall c, is_cone c -> source (edge_nt c) = constant_functor (cone_source c) (cone_target c) (vertex c). Proof. ir. uh H; ee. rw H2. tv. Qed. Lemma ob_vertex : forall c, is_cone c -> ob (cone_target c) (vertex c). Proof. ir. uh H; ee. am. Qed. Lemma source_edge : forall c x, ob (cone_source c) x -> is_cone c -> source (edge c x) = vertex c. Proof. ir. uf edge. rw source_ntrans. rw source_edge_nt. rw fob_constant_functor. tv. am. ap ob_vertex. am. am. lu. rww osource_edge_nt. Qed. Lemma target_edge_nt : forall c, target (edge_nt c) = socle c. Proof. ir. tv. Qed. Lemma target_edge : forall c x, ob (cone_source c) x -> is_cone c -> target (edge c x) = fob (socle c) x. Proof. ir. uf edge. rw target_ntrans. tv. uh H0; ee. am. ufi cone_source H. ufi socle H. rwi source_target H. am. uh H0; ee; am. Qed. Lemma commutativity : forall c u, mor (cone_source c) u -> is_cone c -> comp (cone_target c) (fmor (socle c) u) (edge c (source u)) = edge c (target u). Proof. ir. uh H0; ee. uf edge. assert (cone_target c = otarget (edge_nt c)). rww otarget_edge_nt. assert (socle c = target (edge_nt c)). rww target_edge_nt. assert (lem1: forall y, ntrans (edge_nt c) y = edge c y). ir. tv. rw H4; rw H5. wr carre. rw source_edge_nt. rw fmor_constant_functor. rw right_id. tv. wr H4; am. wr H4. change (mor (cone_target c) (edge c (target u))). app mor_edge. rww ob_target. uhg; ee; am. rw lem1. rww source_edge. rww ob_target. uhg; ee; am. rww otarget_edge_nt. am. uhg; ee; am. am. rww osource_edge_nt. uhg; ee; am. Qed. Lemma cone_source_axioms : forall c, is_cone c -> Category.axioms (cone_source c). Proof. ir. cp H. uh H; ee. uh H1; ee. rwi osource_edge_nt H4. exact H4. am. Qed. Lemma cone_target_axioms : forall c, is_cone c -> Category.axioms (cone_target c). Proof. ir. cp H. uh H; ee. uh H1; ee. rwi otarget_edge_nt H5. exact H5. Qed. Lemma socle_axioms : forall c, is_cone c -> Functor.axioms (socle c). Proof. ir. uh H; ee. uh H0; ee. exact H6. Qed. Hint Rewrite vertex_cone_compose edge_nt_cone_compose cone_composable_rw edge_cone_compose socle_cone_compose cone_target_cone_compose cone_source_cone_compose : lw. Lemma is_cone_cone_compose : forall c u, cone_composable c u -> is_cone (cone_compose c u) = True. Proof. ir. ap iff_eq; ir; try tv. uhg; ee. uf cone_like. uf cone_compose. rw vertex_cone_create. rw edge_nt_cone_create. tv. rw edge_nt_cone_compose. rww vcompose_axioms. lu. ap constant_nt_axioms. ap cone_source_axioms. lu. ap cone_target_axioms. lu. lu. rw target_constant_nt. uh H; ee. uh H; ee. rw H2; am. rw cone_target_cone_compose. rw vertex_cone_compose. uh H; ee. rww ob_source. rw edge_nt_cone_compose. rw source_vcompose. rw source_constant_nt. rw cone_source_cone_compose. rw cone_target_cone_compose. rw vertex_cone_compose. tv. Qed. Lemma cone_compose_cone_compose : forall a u v, cone_composable a u -> composable (cone_target a) u v -> cone_compose (cone_compose a u) v = cone_compose a (comp (cone_target a) u v). Proof. ir. rwi composable_facts_rw H0. apply cone_extensionality. rww is_cone_cone_compose. uf cone_composable; ee. rww is_cone_cone_compose. rw cone_target_cone_compose. lu. rw vertex_cone_compose. sy; lu. rww is_cone_cone_compose. uhg; ee. lu. rww mor_comp. lu. lu. lu. rw target_comp. lu. lu. lu. lu. rw vertex_cone_compose. rw vertex_cone_compose. rw source_comp. tv. lu. lu. lu. rw socle_cone_compose. rw socle_cone_compose. rw socle_cone_compose. tv. ir. rw edge_cone_compose. rw cone_target_cone_compose. rw edge_cone_compose. rw edge_cone_compose. rw assoc. tv. ap mor_edge. rwi cone_source_cone_compose H1. rwi cone_source_cone_compose H1. am. lu. uh H; ee. am. uh H0; ee; am. rw source_edge. sy; lu. rwi cone_source_cone_compose H1. rwi cone_source_cone_compose H1. am. lu. lu. tv. rwi cone_source_cone_compose H1. rwi cone_source_cone_compose H1. am. uhg; ee. lu. rww mor_comp. uh H0; ee; am. uh H0; ee; am. lu. rw target_comp. lu. uh H0; ee; am. uh H0; ee; am. lu. rwi cone_source_cone_compose H1. rwi cone_source_cone_compose H1. am. am. rw cone_source_cone_compose. rwi cone_source_cone_compose H1. rwi cone_source_cone_compose H1. am. uhg; ee. rww is_cone_cone_compose. rw cone_target_cone_compose. uh H0; ee; am. rw vertex_cone_compose. sy; lu. Qed. Definition is_uni a := is_cone a & (forall u v, cone_composable a u -> cone_composable a v -> cone_compose a u = cone_compose a v -> u = v). Definition is_versal a := is_cone a & (forall b, is_cone b -> socle b = socle a -> (exists u, (cone_composable a u & cone_compose a u = b))). Definition is_limit a := is_uni a & is_versal a. Lemma is_limit_is_versal : forall a, is_limit a -> is_versal a. Proof. ir. lu. Qed. Lemma is_limit_is_uni : forall a, is_limit a -> is_uni a. Proof. ir. lu. Qed. Lemma is_limit_is_cone : forall a, is_limit a -> is_cone a. Proof. ir. lu. Qed. Definition is_limit_of f a := is_limit a & socle a = f. Definition has_limit f := exists a, is_limit_of f a. Definition has_limits_over c b := (forall f, Functor.axioms f -> source f = c -> target f = b -> has_limit f). Definition limit f := choose (is_limit_of f). Lemma if_has_limit : forall f, has_limit f -> is_limit_of f (limit f). Proof. ir. uh H. exact (choose_pr H). Qed. Lemma is_limit_limit : forall f, has_limit f -> is_limit (limit f). Proof. ir. cp (if_has_limit H). lu. Qed. Lemma socle_limit : forall f, has_limit f -> socle (limit f) = f. Proof. ir. cp (if_has_limit H). lu. Qed. Definition cone_to_limit a b := choose (fun u => (cone_composable b u & cone_compose b u = a)). Lemma cone_to_limit_pr : forall a b, is_cone a -> is_limit b -> socle a = socle b -> (cone_composable b (cone_to_limit a b) & cone_compose b (cone_to_limit a b) = a). Proof. ir. uh H0; ee. uh H2; ee. util (H3 a). am. am. cp (choose_pr H4). cbv beta in H5. ee. am. uh H2; ee. util (H3 a). am. am. cp (choose_pr H4). cbv beta in H5. ee. am. Qed. Lemma mor_cone_to_limit : forall a b y, is_cone a -> is_limit b -> socle a = socle b -> y = cone_target b -> mor y (cone_to_limit a b). Proof. ir. cp (cone_to_limit_pr H H0 H1). ee. uh H3; ee. rw H2; am. Qed. Lemma source_cone_to_limit : forall a b, is_cone a -> is_limit b -> socle a = socle b -> source (cone_to_limit a b) = vertex a. Proof. ir. cp (cone_to_limit_pr H H0 H1). ee. transitivity (vertex (cone_compose b (cone_to_limit a b))). rw vertex_cone_compose. tv. rw H3. tv. Qed. Lemma target_cone_to_limit : forall a b, is_cone a -> is_limit b -> socle a = socle b -> target (cone_to_limit a b) = vertex b. Proof. ir. cp (cone_to_limit_pr H H0 H1). ee. uh H2; ee. am. Qed. Lemma cone_compose_cone_to_limit : forall a b, is_cone a -> is_limit b -> socle a = socle b -> cone_compose b (cone_to_limit a b) = a. Proof. ir. cp (cone_to_limit_pr H H0 H1). ee. am. Qed. Lemma cone_composable_cone_to_limit : forall a b, is_cone a -> is_limit b -> socle a = socle b -> cone_composable b (cone_to_limit a b) = True. Proof. ir. cp (cone_to_limit_pr H H0 H1). ee. app iff_eq; ir; try am. Qed. Lemma cone_to_limit_cone_compose1 : forall a u, is_limit a -> cone_composable a u -> cone_to_limit (cone_compose a u) a = u. Proof. ir. assert (lem1 : is_limit a). am. uh H; ee. uh H; ee. ap H2. uhg; ee. am. ap mor_cone_to_limit. rww is_cone_cone_compose. am. rw socle_cone_compose. tv. tv. rw target_cone_to_limit. tv. rww is_cone_cone_compose. am. rw socle_cone_compose. tv. am. rw cone_compose_cone_to_limit. tv. rww is_cone_cone_compose. am. rww socle_cone_compose. Qed. Lemma cone_to_limit_cone_compose : forall a b u, is_limit b -> cone_composable a u -> socle a = socle b -> cone_to_limit (cone_compose a u) b = comp (cone_target b) (cone_to_limit a b) u. Proof. ir. set (k:= comp (cone_target b) (cone_to_limit a b) u). assert (cone_target a = cone_target b). uf cone_target. rww H1. assert (lem1 : is_cone a). lu. transitivity (cone_to_limit (cone_compose b k) b). uf k. wr cone_compose_cone_compose. rw cone_compose_cone_to_limit. tv. lu. am. am. rww cone_composable_cone_to_limit. app show_composable. app mor_cone_to_limit. wr H2. lu. rww source_cone_to_limit. sy; lu. rww cone_to_limit_cone_compose1. uf k. uhg; ee. uh H; ee. uh H; ee; am. rww mor_comp. app mor_cone_to_limit. wr H2. lu. rww source_cone_to_limit. sy; lu. rw target_comp. rww target_cone_to_limit. app mor_cone_to_limit. wr H2; lu. rww source_cone_to_limit. sy; lu. Qed. Definition cone_transform u c := cone_create (vertex c) (vcompose u (edge_nt c)). Lemma vertex_cone_transform : forall u c, vertex (cone_transform u c) = vertex c. Proof. ir. uf cone_transform. rww vertex_cone_create. Qed. Lemma edge_nt_cone_transform : forall u c, edge_nt (cone_transform u c) = vcompose u (edge_nt c). Proof. ir. uf cone_transform. rww edge_nt_cone_create. Qed. Lemma socle_cone_transform : forall u c, socle (cone_transform u c) = target u. Proof. ir. uf socle. rww edge_nt_cone_transform. rww target_vcompose. Qed. Definition cone_transformable u c := is_cone c & Nat_Trans.axioms u & source u = socle c. Lemma cone_source_cone_transform : forall u c, cone_transformable u c -> cone_source (cone_transform u c) = cone_source c. Proof. ir. uf cone_source. rw socle_cone_transform. uh H; ee. rww source_target. uf osource; rww H1. Qed. Lemma cone_target_cone_transform : forall u c, cone_transformable u c -> cone_target (cone_transform u c) = cone_target c. Proof. ir. uf cone_target. rww socle_cone_transform. uh H; ee. wr H1. rww target_source. Qed. Lemma edge_cone_transform : forall u c x, ob (osource u) x -> cone_transformable u c -> edge (cone_transform u c) x = comp (cone_target c) (ntrans u x) (edge c x). Proof. ir. uf edge. rw edge_nt_cone_transform. rw ntrans_vcompose. uh H0; ee. wr target_source. rw H2. tv. am. uh H0. ee. rw osource_edge_nt. uf cone_source. wr H2. am. am. Qed. Lemma is_cone_cone_transform : forall u c, cone_transformable u c -> is_cone (cone_transform u c). Proof. ir. uhg; ee. uf cone_transform. app cone_like_cone_create. rw edge_nt_cone_transform. rww vcompose_axioms. lu. uh H; ee. uh H; ee. am. uh H; ee. am. rw vertex_cone_transform. rww cone_target_cone_transform. uh H; ee. uh H; ee. am. rw edge_nt_cone_transform. rw source_vcompose. rw source_edge_nt. rw cone_source_cone_transform. rw cone_target_cone_transform. rww vertex_cone_transform. am. am. lu. Qed. Definition cone_pushdown f c := cone_create (fob f (vertex c)) (htrans_left f (edge_nt c)). Lemma vertex_cone_pushdown : forall f c, vertex (cone_pushdown f c) = fob f (vertex c). Proof. ir. uf cone_pushdown. rww vertex_cone_create. Qed. Lemma edge_nt_cone_pushdown : forall f c, edge_nt (cone_pushdown f c) = htrans_left f (edge_nt c). Proof. ir. uf cone_pushdown. rww edge_nt_cone_create. Qed. Lemma socle_cone_pushdown : forall f c, socle (cone_pushdown f c) = fcompose f (socle c). Proof. ir. uf socle. rw edge_nt_cone_pushdown. rw target_htrans_left. tv. Qed. Lemma cone_source_cone_pushdown : forall f c, cone_source (cone_pushdown f c) = cone_source c. Proof. ir. uf cone_source. rw socle_cone_pushdown. rw source_fcompose. tv. Qed. Lemma cone_target_cone_pushdown : forall f c, cone_target (cone_pushdown f c) = target f. Proof. ir. uf cone_target. rw socle_cone_pushdown. rww target_fcompose. Qed. Lemma edge_cone_pushdown : forall f c x, ob (cone_source c) x -> is_cone c -> edge (cone_pushdown f c) x = fmor f (edge c x). Proof. ir. uf edge. rw edge_nt_cone_pushdown. rw ntrans_htrans_left. tv. rww osource_edge_nt. Qed. Lemma is_cone_cone_pushdown : forall f c, is_cone c -> Functor.axioms f -> source f = cone_target c -> is_cone (cone_pushdown f c). Proof. ir. uhg; ee. uf cone_pushdown. ap cone_like_cone_create. rw edge_nt_cone_pushdown. app htrans_left_axioms. uh H; ee. am. rw cone_target_cone_pushdown. rw vertex_cone_pushdown. app ob_fob. rw H1. uh H; ee; am. rw edge_nt_cone_pushdown. rw source_htrans_left. rw source_edge_nt. rw fcompose_right_constant_functor. rw cone_source_cone_pushdown. rw cone_target_cone_pushdown. rw vertex_cone_pushdown. tv. am. am. app cone_source_axioms. app ob_vertex. am. Qed. Lemma cone_pushdown_cone_pushdown : forall f g a, is_cone a -> Functor.axioms f -> Functor.axioms g -> source g = cone_target a -> source f = target g -> cone_pushdown f (cone_pushdown g a) = cone_pushdown (fcompose f g) a. Proof. ir. ap cone_extensionality. ap is_cone_cone_pushdown. ap is_cone_cone_pushdown. am. am. am. am. rw cone_target_cone_pushdown. am. ap is_cone_cone_pushdown. am. ap fcompose_axioms. am. am. am. rw source_fcompose. am. rw vertex_cone_pushdown. rw vertex_cone_pushdown. rw vertex_cone_pushdown. rw fob_fcompose. tv. am. am. am. rw H2. ap ob_vertex. am. rww socle_cone_pushdown. rww socle_cone_pushdown. sy; rw socle_cone_pushdown. rw fcompose_assoc. tv. am. am. app socle_axioms. am. am. ir. rwi cone_source_cone_pushdown H4. rwi cone_source_cone_pushdown H4. rw edge_cone_pushdown. rw edge_cone_pushdown. rw edge_cone_pushdown. rw fmor_fcompose. tv. am. am. am. rw H2. ap mor_edge. am. am. am. am. am. am. rw cone_source_cone_pushdown. am. app is_cone_cone_pushdown. Qed. Definition cone_pullback f c := cone_create (vertex c) (htrans_right (edge_nt c) f). Lemma vertex_cone_pullback : forall f c, vertex (cone_pullback f c) = vertex c. Proof. ir. uf cone_pullback. rww vertex_cone_create. Qed. Lemma edge_nt_cone_pullback : forall f c, edge_nt (cone_pullback f c) = htrans_right (edge_nt c) f. Proof. ir. uf cone_pullback. rww edge_nt_cone_create. Qed. Lemma socle_cone_pullback : forall f c, socle (cone_pullback f c) = fcompose (socle c) f. Proof. ir. uf socle. rw edge_nt_cone_pullback. rw target_htrans_right. tv. Qed. Lemma cone_source_cone_pullback : forall f c, cone_source (cone_pullback f c) = source f. Proof. ir. uf cone_source. rw socle_cone_pullback. rw source_fcompose. tv. Qed. Lemma cone_target_cone_pullback : forall f c, cone_target (cone_pullback f c) = cone_target c. Proof. ir. uf cone_target. rw socle_cone_pullback. rww target_fcompose. Qed. Lemma edge_cone_pullback : forall f c x, ob (source f) x -> edge (cone_pullback f c) x = edge c (fob f x). Proof. ir. uf edge. rw edge_nt_cone_pullback. rw ntrans_htrans_right. tv. am. Qed. Lemma is_cone_cone_pullback : forall f c, is_cone c -> Functor.axioms f -> cone_source c = target f -> is_cone (cone_pullback f c). Proof. ir. uhg; ee. uf cone_pullback. ap cone_like_cone_create. rw edge_nt_cone_pullback. app htrans_right_axioms. uh H; ee. am. rww osource_edge_nt. rw cone_target_cone_pullback. rw vertex_cone_pullback. app ob_vertex. rw edge_nt_cone_pullback. rw source_htrans_right. rw source_edge_nt. rw fcompose_left_constant_functor. rw cone_source_cone_pullback. rw cone_target_cone_pullback. rw vertex_cone_pullback. tv. am. sy; am. app cone_target_axioms. app ob_vertex. am. Qed. Lemma cone_compose_id : forall c, is_cone c -> cone_compose c (id (cone_target c) (vertex c)) = c. Proof. ir. ap cone_extensionality. rww is_cone_cone_compose. uhg; ee. am. ap mor_id. ap ob_vertex. am. rww target_id. app ob_vertex. am. rww vertex_cone_compose. rww source_id. app ob_vertex. rww socle_cone_compose. ir. rwi cone_source_cone_compose H0. rww edge_cone_compose. rww right_id. app ob_vertex. app mor_edge. rww source_edge. uhg; ee. am. app mor_id. app ob_vertex. rww target_id. app ob_vertex. Qed. Lemma cone_compose_cone_transform : forall f c u, is_cone c -> cone_composable c u -> cone_transformable f c -> cone_compose (cone_transform f c) u = cone_transform f (cone_compose c u). Proof. ir. ap cone_extensionality. rww is_cone_cone_compose. uhg; ee. app is_cone_cone_transform. rww cone_target_cone_transform. lu. rww vertex_cone_transform. lu. app is_cone_cone_transform. uhg; ee. rww is_cone_cone_compose. lu. rw socle_cone_compose. lu. rw vertex_cone_compose; rww vertex_cone_transform. rww vertex_cone_compose. rw socle_cone_compose. rww socle_cone_transform. rww socle_cone_transform. ir. rwi cone_source_cone_compose H2. rwi cone_source_cone_transform H2; try am. assert (osource f = cone_source c). uf cone_source. uf osource. ap uneq; lu. assert (otarget f = cone_target c). uf cone_target. wr target_source. ap uneq. uh H1; ee. am. lu. rw edge_cone_compose. rw edge_cone_transform. rw edge_cone_transform. rww cone_target_cone_transform. rww cone_target_cone_compose. rww edge_cone_compose. rww assoc. app mor_ntrans. lu. uh H1; ee. rww H3. sy; am. app mor_edge. uh H0; ee. am. rww source_ntrans. rww target_edge. uh H1; ee. rww H6. lu. rww H3. rww source_edge. sy; lu. rww H3. uhg; ee. rww is_cone_cone_compose. lu. rww socle_cone_compose. lu. rww H3. am. rww cone_source_cone_transform. uhg; ee. app is_cone_cone_transform. rww cone_target_cone_transform. uh H0; ee; am. rww vertex_cone_transform. lu. Qed. Lemma cone_to_limit_id : forall a b, is_limit a -> a = b -> cone_to_limit a b = id (cone_target b) (vertex b). Proof. ir. cp H. uh H1; ee. uh H1; ee. ap H3. uhg; ee. am. ap mor_cone_to_limit. am. wr H0; lu. rw H0; tv. rw H0; tv. rw target_cone_to_limit. rw H0; tv. am. wr H0; lu. rw H0; tv. uhg; ee. am. wr H0; ap mor_id. ap ob_vertex. am. rw target_id. rw H0; tv. ap ob_vertex. wr H0; am. wr H0; rw cone_compose_cone_to_limit. rw cone_compose_id. tv. am. am. am. tv. Qed. Lemma comp_edge_cone_to_limit : forall r s x b, is_limit s -> is_cone r -> socle r = socle s -> b = cone_target s -> ob (cone_source s) x -> comp b (edge s x) (cone_to_limit r s) = edge r x. Proof. ir. transitivity (edge (cone_compose s (cone_to_limit r s)) x). rw edge_cone_compose. rww H2. am. rww cone_composable_cone_to_limit. rw cone_compose_cone_to_limit. tv. am. am. am. Qed. Lemma edge_nt_axioms : forall c, is_cone c -> Nat_Trans.axioms (edge_nt c). Proof. ir. lu. Qed. Lemma cone_transform_vident : forall f c, f = socle c -> is_cone c -> cone_transform (vident f) c = c. Proof. ir. uf cone_transform. rw weak_left_vident. lu. app edge_nt_axioms. rww target_edge_nt. Qed. Lemma cone_transform_vcompose : forall u v c, is_cone c -> cone_transformable v c -> Nat_Trans.axioms u -> source u = target v -> cone_transform (vcompose u v) c = cone_transform u (cone_transform v c). Proof. ir. uh H0; ee. uf cone_transform. rw vertex_cone_create. ap uneq. rw edge_nt_cone_create. rww vcompose_assoc. app edge_nt_axioms. Qed. (**** stuff about limits and isomorphisms ****) Lemma comp_cone_to_limit_inversely : forall a b c, is_limit a -> is_limit b -> socle a = socle b -> cone_target a = c -> comp c (cone_to_limit a b) (cone_to_limit b a) = id c (vertex b). Proof. ir. assert (cone_target b = c). uf cone_target. wr H1. am. cp H; cp H0. uh H4; uh H5; ee. uh H4; uh H5. ee. assert (composable c (cone_to_limit a b) (cone_to_limit b a)). ap show_composable. app mor_cone_to_limit. sy; am. app mor_cone_to_limit. sy; am. sy; am. rww source_cone_to_limit. rww target_cone_to_limit. sy; am. ap H8. uhg; ee. am. rw H3. rww mor_comp. ap mor_cone_to_limit. am. am. am. sy; am. app mor_cone_to_limit. sy; am. sy; am. rw source_cone_to_limit. rww target_cone_to_limit. sy; am. am. am. am. rw target_comp. rww target_cone_to_limit. app mor_cone_to_limit. sy; am. app mor_cone_to_limit. sy; am. sy; am. rw source_cone_to_limit. rww target_cone_to_limit. sy; am. am. am. am. uhg; ee. am. rw H3. ap mor_id. wr H3. ap ob_vertex. am. rw target_id. tv. wr H3; app ob_vertex. wr H3. wr cone_compose_cone_compose. rw cone_compose_cone_to_limit. rw cone_compose_cone_to_limit. rw cone_compose_id. tv. am. am. am. sy; am. am. am. am. uhg; ee. am. app mor_cone_to_limit. rww target_cone_to_limit. rww H3. Qed. Lemma are_inverse_cone_to_limit : forall a b c, is_limit a -> is_limit b -> socle a = socle b -> cone_target a = c -> are_inverse c (cone_to_limit a b) (cone_to_limit b a). Proof. ir. assert (cone_target b = c). uf cone_target. wr H1. am. cp H; cp H0. uh H4; uh H5; ee. uh H4; uh H5. ee. uhg; ee; try am. app mor_cone_to_limit. sy; am. app mor_cone_to_limit. sy; am. sy; am. rww source_cone_to_limit. rww target_cone_to_limit. sy; am. rww target_cone_to_limit. rww source_cone_to_limit. sy; am. rw source_cone_to_limit. app comp_cone_to_limit_inversely. am. am. sy; am. rww comp_cone_to_limit_inversely. rww source_cone_to_limit. sy; am. Qed. Lemma invertible_cone_to_limit : forall a b c, is_limit a -> is_limit b -> socle a = socle b -> cone_target a = c -> invertible c (cone_to_limit a b). Proof. ir. uhg. sh (cone_to_limit b a). app are_inverse_cone_to_limit. Qed. Lemma inverse_cone_to_limit : forall a b c, is_limit a -> is_limit b -> socle a = socle b -> cone_target a = c -> inverse c (cone_to_limit a b) = cone_to_limit b a. Proof. ir. cp (are_inverse_cone_to_limit H H0 H1 H2). app inverse_eq. Qed. Lemma is_limit_cone_compose : forall a u, is_limit a -> cone_composable a u -> invertible (cone_target a) u -> is_limit (cone_compose a u). Proof. ir. assert (lem1: is_cone (cone_compose a u)). rww is_cone_cone_compose. uhg; ee. (**** uni proof ****) uhg; ee. am. ir. assert (mor (cone_target a) u0). uh H2; ee. rwi cone_target_cone_compose H5. am. assert (mor (cone_target a) v). uh H3; ee. rwi cone_target_cone_compose H6; am. assert (source u = target u0). sy. uh H2; ee. rwi vertex_cone_compose H8; am. assert (source u = target v). sy. uh H3; ee. rwi vertex_cone_compose H9; am. assert (mor (cone_target a) u). uh H0; ee. am. rwi cone_compose_cone_compose H4. rwi cone_compose_cone_compose H4. uh H; ee. uh H; ee. assert (comp (cone_target a) u u0 = comp (cone_target a) u v). ap H11. uhg; ee. am. rww mor_comp. rww target_comp. lu. uhg; ee. am. rww mor_comp. rw target_comp. lu. lu. lu. lu. am. transitivity (comp (cone_target a) (inverse (cone_target a) u) (comp (cone_target a) u u0)). wr assoc. rw left_inverse. rw left_id. tv. rww ob_source. am. sy; am. tv. am. ap mor_inverse. am. am. am. rw source_inverse. tv. am. am. tv. rw H12. wr assoc. rw left_inverse. rw left_id. tv. rww ob_source. am. sy; am. tv. am. app mor_inverse. am. am. rww source_inverse. am. tv. am. app show_composable. am. app show_composable. (*** versal proof ***) assert (lema: target u = vertex a). lu. uhg; ee. am. ir. assert (lem0 : socle b = socle a). rwi socle_cone_compose H3. am. assert (lem2: composable (cone_target a) (inverse (cone_target a) u) (cone_to_limit b a)). ap show_composable. app mor_inverse. app mor_cone_to_limit. rw source_inverse. rww target_cone_to_limit. lu. sh (comp (cone_target a) (inverse (cone_target a) u) (cone_to_limit b a)). ee. uhg; ee. am. rw cone_target_cone_compose. rww mor_comp. app mor_inverse. app mor_cone_to_limit. rww source_inverse. rww target_cone_to_limit. rww target_comp. rww target_inverse. assert (cone_target a = cone_target (cone_compose a u)). rww cone_target_cone_compose. rww vertex_cone_compose. app mor_inverse. app mor_cone_to_limit. rww source_inverse. rww target_cone_to_limit. assert (mor (cone_target a) u). uh H0; ee; am. rw cone_compose_cone_compose. wr assoc. rww right_inverse. rw left_id. rw cone_compose_cone_to_limit. tv. am. am. am. rww ob_target. app mor_cone_to_limit. rw target_cone_to_limit. sy; am. am. am. am. tv. am. app mor_inverse. app mor_cone_to_limit. rww target_inverse. rww source_inverse. rww target_cone_to_limit. tv. am. ap show_composable. am. rww mor_comp. app mor_inverse. app mor_cone_to_limit. rww source_inverse. rww target_cone_to_limit. rww target_comp. rww target_inverse. app mor_inverse. app mor_cone_to_limit. rww source_inverse. rww target_cone_to_limit. Qed. Lemma cone_to_limit_invertible_is_limit : forall a b, is_limit b -> is_cone a -> socle a = socle b -> invertible (cone_target b) (cone_to_limit a b) -> is_limit a. Proof. ir. assert (a = cone_compose b (cone_to_limit a b)). rw cone_compose_cone_to_limit. tv. am. am. am. rw H3. ap is_limit_cone_compose. am. uhg; ee. uh H; ee. uh H; ee; am. app mor_cone_to_limit. rww target_cone_to_limit. lu. Qed. (***** added in september: dotted *****) Definition dotted a := cone_to_limit a (limit (socle a)). Lemma source_dotted : forall a, is_cone a -> has_limit (socle a) -> source (dotted a) = vertex a. Proof. ir. uf dotted. rww source_cone_to_limit. app is_limit_limit. rww socle_limit. Qed. Lemma target_dotted : forall a, is_cone a -> has_limit (socle a) -> target (dotted a) = vertex (limit (socle a)). Proof. ir. uf dotted. rww target_cone_to_limit. app is_limit_limit. rww socle_limit. Qed. Lemma mor_dotted : forall a, is_cone a -> has_limit (socle a) -> mor (cone_target a) (dotted a). Proof. ir. uf dotted. app mor_cone_to_limit. app is_limit_limit. rww socle_limit. uf cone_target. rww socle_limit. Qed. Lemma cone_target_limit : forall f, has_limit f -> cone_target (limit f) = target f. Proof. ir. uf cone_target. rww socle_limit. Qed. Lemma cone_source_limit : forall f, has_limit f -> cone_source (limit f) = source f. Proof. ir. uf cone_source. rww socle_limit. Qed. Lemma target_socle : forall a, target (socle a) = cone_target a. Proof. ir. reflexivity. Qed. Lemma source_socle : forall a, source (socle a) = cone_source a. Proof. ir. reflexivity. Qed. Lemma cone_composable_dotted : forall a, is_cone a -> has_limit (socle a) -> cone_composable (limit (socle a)) (dotted a). Proof. ir. uf cone_composable. ee. ap is_limit_is_cone. app is_limit_limit. rww cone_target_limit. rw target_socle. app mor_dotted. rww target_dotted. Qed. Lemma cone_compose_dotted : forall a, is_cone a -> has_limit (socle a) -> cone_compose (limit (socle a)) (dotted a) = a. Proof. ir. uf dotted. rww cone_compose_cone_to_limit. app is_limit_limit. rww socle_limit. Qed. Lemma dotted_cone_compose : forall u a, cone_composable a u -> has_limit (socle a) -> dotted (cone_compose a u) = comp (cone_target a) (dotted a) u. Proof. ir. uf dotted. rw cone_to_limit_cone_compose. rw socle_cone_compose. rw cone_target_limit. rw target_socle. reflexivity. am. app is_limit_limit. rw socle_cone_compose. am. am. rw socle_limit. rw socle_cone_compose. tv. rww socle_cone_compose. Qed. Lemma cone_to_limit_refl : forall a, is_limit a -> cone_to_limit a a = id (cone_target a) (vertex a). Proof. ir. transitivity (comp (cone_target a) (cone_to_limit a a) (cone_to_limit a a)). wr cone_to_limit_cone_compose. rw cone_compose_cone_to_limit. tv. lu. am. tv. lu. rww cone_composable_cone_to_limit. lu. tv. rww comp_cone_to_limit_inversely. Qed. Lemma dotted_limit : forall f, Functor.axioms f -> has_limit f -> dotted (limit f) = id (target f) (vertex (limit f)). Proof. ir. uf dotted. rww socle_limit. rw cone_to_limit_refl. rw cone_target_limit. tv. am. app is_limit_limit. Qed. Lemma dotted_unique : forall f u, Functor.axioms f -> has_limit f -> cone_composable (limit f) u -> dotted (cone_compose (limit f) u) = u. Proof. ir. rw dotted_cone_compose. rw dotted_limit. rw cone_target_limit. rw left_id. tv. assert (target f = cone_target (limit f)). rww cone_target_limit. rw H2. app ob_vertex. ap is_limit_is_cone. app is_limit_limit. uh H1; ee. rwi cone_target_limit H2. am. am. uh H1; ee. am. tv. am. am. am. am. rww socle_limit. Qed. Lemma invertible_dotted_is_limit : forall a, is_cone a -> has_limit (socle a) -> invertible (cone_target a) (dotted a) -> is_limit a. Proof. ir. assert (a = cone_compose (limit (socle a)) (dotted a)). rww cone_compose_dotted. rw H2. app is_limit_cone_compose. app is_limit_limit. app cone_composable_dotted. rw cone_target_limit. rw target_socle. am. am. Qed. Lemma is_limit_invertible_dotted : forall a, is_limit a -> invertible (cone_target a) (dotted a). Proof. ir. uf dotted. assert (has_limit (socle a)). uhg. sh a. uhg; ee. am. tv. ap invertible_cone_to_limit. am. ap is_limit_limit. am. rww socle_limit. tv. Qed. (**** stuff about functors commuting with limits ***) Section Commutation_Def. Variable f a b: E. Hypothesis cone_a : is_cone a. Hypothesis limit_b : is_limit b. Hypothesis fsource_cone_target : source f = cone_target a. Hypothesis f_functor : Functor.axioms f. Hypothesis compose_ntarg : fcompose f (socle a) = socle b. Definition commutation := cone_to_limit (cone_pushdown f a) b. Lemma source_commutation : source commutation = fob f (vertex a). Proof. uf commutation. rw source_cone_to_limit. rww vertex_cone_pushdown. app is_cone_cone_pushdown. am. rww socle_cone_pushdown. Qed. Lemma target_commutation : target commutation = vertex b. Proof. ir. uf commutation. rw target_cone_to_limit. tv. app is_cone_cone_pushdown. am. rww socle_cone_pushdown. Qed. Lemma cone_target_b : cone_target b = target f. Proof. uf cone_target. wr compose_ntarg. rw target_fcompose. tv. Qed. Lemma mor_commutation : mor (target f) commutation. Proof. uf commutation. ap mor_cone_to_limit. app is_cone_cone_pushdown. am. rww socle_cone_pushdown. rww cone_target_b. Qed. Lemma cone_composable_commutation : cone_composable b commutation. Proof. uhg; ee. cp limit_b. uh H; ee. lu. rw cone_target_b. ap mor_commutation. rw target_commutation. tv. Qed. Lemma cone_compose_commutation : cone_compose b commutation = cone_pushdown f a. Proof. uf commutation. rw cone_compose_cone_to_limit. tv. app is_cone_cone_pushdown. am. rww socle_cone_pushdown. Qed. Lemma invertible_commutation_is_limit_cone_pushdown : forall c, target f = c -> invertible c commutation = is_limit (cone_pushdown f a). Proof. ir. wr H. ap iff_eq; ir. wr cone_compose_commutation. app is_limit_cone_compose. ap cone_composable_commutation. rww cone_target_b. uf commutation. ap invertible_cone_to_limit. am. am. rww socle_cone_pushdown. rww cone_target_cone_pushdown. Qed. End Commutation_Def. Section Cone_Pushdown_Cone_Compose. Variables u a f: E. Hypothesis K : is_cone a. Hypothesis K0 : Functor.axioms f. Hypothesis K1 : source f = cone_target a. Hypothesis K2 : mor (source f) u. Hypothesis K3 : target u = vertex a. Lemma cone_composable_a_u : cone_composable a u. Proof. uhg; ee. am. wr K1; am. am. Qed. Lemma cone_pushdown_cone_compose : cone_pushdown f (cone_compose a u) = cone_compose (cone_pushdown f a) (fmor f u). Proof. ap cone_extensionality. ap is_cone_cone_pushdown. rww is_cone_cone_compose. ap cone_composable_a_u. am. rww cone_target_cone_compose. rww is_cone_cone_compose. uhg; ee. app is_cone_cone_pushdown. rww cone_target_cone_pushdown. app mor_fmor. rww target_fmor. rww vertex_cone_pushdown. rww K3. rww vertex_cone_pushdown. rww vertex_cone_compose. rww vertex_cone_compose. rww source_fmor. rww socle_cone_pushdown. rww socle_cone_compose. rww socle_cone_compose. rww socle_cone_pushdown. ir. rwi cone_source_cone_pushdown H. rwi cone_source_cone_compose H. rw edge_cone_pushdown. rw edge_cone_compose. rw edge_cone_compose. rw cone_target_cone_pushdown. rw edge_cone_pushdown. wr K1. wr comp_fmor. tv. am. rw K1. app mor_edge. rww K1. wrr K1. rww source_edge. sy; am. am. am. rww cone_source_cone_pushdown. uhg; ee. app is_cone_cone_pushdown. rww cone_target_cone_pushdown. app mor_fmor. rww vertex_cone_pushdown. rww target_fmor. rww K3. am. ap cone_composable_a_u. rww cone_source_cone_compose. rww is_cone_cone_compose. ap cone_composable_a_u. Qed. End Cone_Pushdown_Cone_Compose. Section Cone_Pushdown_Cone_To_Limit. Variables a b f : E. Hypothesis K : Functor.axioms f. Hypothesis K0 : is_cone a. Hypothesis K1 : is_limit b. Hypothesis K2 : socle a = socle b. Hypothesis K3 : source f = cone_target b. Hypothesis K4 : is_limit (cone_pushdown f b). Lemma cone_compose_cone_pushdown_fmor_cone_to_limit : cone_compose (cone_pushdown f b) (fmor f (cone_to_limit a b)) = cone_pushdown f a. Proof. assert (lem0 : is_cone b). cp K1. uh H; ee. lu. assert (lem1 : a = cone_compose b (cone_to_limit a b)). rww cone_compose_cone_to_limit. transitivity (cone_pushdown f (cone_compose b (cone_to_limit a b))). assert (cone_pushdown f (cone_compose b (cone_to_limit a b)) = cone_compose (cone_pushdown f b) (fmor f (cone_to_limit a b))). rw cone_pushdown_cone_compose. reflexivity. am. am. am. app mor_cone_to_limit. rww target_cone_to_limit. rw H. reflexivity. assert (cone_compose b (cone_to_limit a b) = a). rw cone_compose_cone_to_limit. tv. am. am. am. rw H. reflexivity. Qed. Lemma fmor_cone_to_limit : fmor f (cone_to_limit a b) = cone_to_limit (cone_pushdown f a) (cone_pushdown f b). Proof. cp K4. uh H; ee. uh H; ee. assert (is_cone b). cp K1. uh H2; ee; lu. assert (is_versal b). cp K1; lu. ap H1. uhg; ee. app is_cone_cone_pushdown. rww cone_target_cone_pushdown. app mor_fmor. rw K3. app mor_cone_to_limit. rww target_fmor. rww vertex_cone_pushdown. rww target_cone_to_limit. rw K3; app mor_cone_to_limit. uhg; ee. app is_cone_cone_pushdown. rww cone_target_cone_pushdown. ap mor_cone_to_limit. ap is_cone_cone_pushdown. am. am. rw K3. uf cone_target. rww K2. am. rww socle_cone_pushdown. rw socle_cone_pushdown. rww K2. rww cone_target_cone_pushdown. rw target_cone_to_limit. tv. app is_cone_cone_pushdown. rw K3; uf cone_target; rww K2. am. rww socle_cone_pushdown. rw socle_cone_pushdown. rww K2. rw cone_compose_cone_pushdown_fmor_cone_to_limit. sy; rw cone_compose_cone_to_limit. tv. app is_cone_cone_pushdown. rw K3; uf cone_target; rww K2. am. rw socle_cone_pushdown. rw socle_cone_pushdown. rww K2. Qed. End Cone_Pushdown_Cone_To_Limit. Section Limit_Preservation_Invariance. Variables a b f : E. Hypothesis K : Functor.axioms f. Hypothesis K0 : is_limit a. Hypothesis K1 : is_limit b. Hypothesis K2 : socle a = socle b. Hypothesis K3 : source f = cone_target b. Hypothesis K4 : is_limit (cone_pushdown f b). Lemma invertible_cone_to_limit_a_b: invertible (source f) (cone_to_limit a b). Proof. app invertible_cone_to_limit. rw K3; uf cone_target; rw K2. tv. Qed. Lemma invertible_fmor_ctl : invertible (target f) (fmor f (cone_to_limit a b)). Proof. app invertible_fmor. app invertible_cone_to_limit. rw K3; uf cone_target; rww K2. Qed. Lemma limit_preservation_invariance : is_limit (cone_pushdown f a). Proof. ir. ap (cone_to_limit_invertible_is_limit (a:= (cone_pushdown f a)) (b:=(cone_pushdown f b))). am. app is_cone_cone_pushdown. cp K0; lu. rw K3; uf cone_target; rww K2. rw socle_cone_pushdown. rw socle_cone_pushdown. rww K2. wr fmor_cone_to_limit. rw cone_target_cone_pushdown. ap invertible_fmor_ctl. am. cp K0; lu. am. am. am. am. Qed. End Limit_Preservation_Invariance. Lemma cone_pushdown_are_inverse_invol : forall a f g, is_cone a -> are_finverse f g -> source f = cone_target a -> cone_pushdown g (cone_pushdown f a) = a. Proof. ir. ap cone_extensionality. ap is_cone_cone_pushdown. ap is_cone_cone_pushdown. am. uh H0; ee; am. am. uh H0; ee; am. rw cone_target_cone_pushdown. uh H0; ee; am. am. rw vertex_cone_pushdown. rw vertex_cone_pushdown. wr fob_fcompose. uh H0; ee. rw H6. rw fob_fidentity. tv. rw H1. ap ob_vertex. am. uh H0; ee; am. uh H0; ee; am. uh H0; ee; am. rw H1. ap ob_vertex. am. rw socle_cone_pushdown. rw socle_cone_pushdown. wr fcompose_assoc. uh H0; ee. rw H6. rw left_fidentity. tv. ap socle_axioms. am. am. uh H0; ee; am. uh H0; ee; am. ap socle_axioms. am. uh H0; ee; am. am. ir. rwi cone_source_cone_pushdown H2. rwi cone_source_cone_pushdown H2. uh H0; ee. rw edge_cone_pushdown. rw edge_cone_pushdown. wr fmor_fcompose. rw H7. rw fmor_fidentity. tv. rw H1. ap mor_edge. am. am. am. am. am. rw H1. ap mor_edge. am. am. am. am. rw cone_source_cone_pushdown. am. ap is_cone_cone_pushdown. am. am. am. Qed. Lemma are_finverse_preserves_limits : forall a f g, is_limit a -> are_finverse f g -> source f = cone_target a -> is_limit (cone_pushdown f a). Proof. ir. uh H0; ee. assert (is_cone a). uh H; ee. uh H; ee. am. assert (is_cone (cone_pushdown f a)). ap is_cone_cone_pushdown. am. am. am. assert (lem1 : forall x, ob (source f) x -> fob g (fob f x) = x). ir. wr fob_fcompose. rw H6. rw fob_fidentity. tv. am. am. am. am. am. assert (lem2 : forall x, ob (target f) x -> fob f (fob g x) = x). ir. wr fob_fcompose. rw H5. rw fob_fidentity. tv. rww H4. am. am. am. rww H4. assert (lem3 : forall u, mor (source f) u -> fmor g (fmor f u) = u). ir. wr fmor_fcompose. rw H6. rw fmor_fidentity. tv. am. am. am. am. am. assert (lem4 : forall u, mor (target f) u -> fmor f (fmor g u) = u). ir. wr fmor_fcompose. rw H5. rw fmor_fidentity. tv. rww H4. am. am. am. rww H4. uhg; ee. (**** uni proof *****) uhg; ee. am. ir. uh H9; ee. uh H10; ee. rwi cone_target_cone_pushdown H12. rwi cone_target_cone_pushdown H14. assert (cone_pushdown g (cone_pushdown f a) = a). rw cone_pushdown_are_inverse_invol. tv. am. uhg; ee; am. am. assert (cone_compose a (fmor g u) = cone_compose a (fmor g v)). wr H16. wr cone_pushdown_cone_compose. sy; wr cone_pushdown_cone_compose. rw H11. reflexivity. am. am. rw cone_target_cone_pushdown. am. rww H4. am. ap is_cone_cone_pushdown. am. am. am. am. rw cone_target_cone_pushdown. am. rw H4. am. am. uh H; ee. uh H; ee. assert (fmor g u = fmor g v). ap H19. uhg; ee. am. wr H1. rw H3. ap mor_fmor. am. rww H4. rw target_fmor. rw H13. rw vertex_cone_pushdown. rw lem1. tv. rw H1. ap ob_vertex. am. am. rww H4. uhg; ee. am. wr H1. rw H3. ap mor_fmor. am. rw H4. am. rw target_fmor. rw H15. rw vertex_cone_pushdown. rw lem1. tv. rw H1. ap ob_vertex. am. am. rww H4. am. wr lem4. wr H20. rw lem4. tv. am. am. (***** versal proof ****) uhg; ee. am. ir. cp H. uh H11. ee. uh H12. ee. util (H13 (cone_pushdown g b)). ap is_cone_cone_pushdown. am. am. uf cone_target. rw H10. rw socle_cone_pushdown. rw target_fcompose. am. rw socle_cone_pushdown. rw H10. rw socle_cone_pushdown. wr fcompose_assoc. rw H6. rw left_fidentity. tv. app socle_axioms. exact H1. am. am. app socle_axioms. am. exact H1. nin H14. ee. uh H14; ee. sh (fmor f x). ee. uhg; ee. ap is_cone_cone_pushdown. am. am. am. rw cone_target_cone_pushdown. ap mor_fmor. am. rw H1. am. rw vertex_cone_pushdown. rw target_fmor. rww H17. am. rww H1. wr cone_pushdown_cone_compose. rw H15. rw cone_pushdown_are_inverse_invol. tv. am. uhg; ee; am. uf cone_target. rw H10. rw socle_cone_pushdown. rw target_fcompose. am. am. am. am. rww H1. am. Qed. Lemma has_limits_over_finverse_invariance : forall a b c, Category.axioms a -> Category.axioms b -> Category.axioms c -> has_limits_over c a -> (exists f, (exists g, (are_finverse f g & source f = a & target f = b))) -> has_limits_over c b. Proof. ir. nin H3. nin H3. ee. uhg; ee. ir. uhg; ee. set (k:= fcompose x0 f). uh H3; ee. assert (Functor.axioms k). uf k. ap fcompose_axioms. am. am. rw H11. rw H5. sy; am. assert (source k = c). uf k. rw source_fcompose. am. assert (target k = a). uf k. rw target_fcompose. wr H10. am. assert (fcompose x k = f). uf k. wr fcompose_assoc. rw H12. rw left_fidentity. tv. am. rw H11. rw H5. sy; am. am. am. am. am. rw H11. rw H5. sy; am. uh H2; ee. util (H2 k). am. am. am. uh H18. nin H18. uh H18. ee. sh (cone_pushdown x x1). uhg; ee. apply are_finverse_preserves_limits with x0. am. uhg; ee; am. uf cone_target. rw H19. rw H16. am. rw socle_cone_pushdown. rw H19. am. Qed. End Limit. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Module Colimit. Export Limit. Definition cocone_create v e := cone_create v e. Definition coedge_nt := edge_nt. Definition coedge c x := ntrans (coedge_nt c) x. Definition cosocle c := source (coedge_nt c). Definition cocone_source c := source (cosocle c). Definition cocone_target c := target (cosocle c). Definition cocone_like c := cocone_create (vertex c) (coedge_nt c) = c. Lemma vertex_cocone_create : forall v e, vertex (cocone_create v e) = v. Proof. ir. uf cocone_create. uf cone_create. uf vertex. drw. Qed. Lemma coedge_nt_cocone_create : forall v e, coedge_nt (cocone_create v e) = e. Proof. ir. uf cocone_create. uf cone_create. uf coedge_nt. uf edge_nt. drw. Qed. Lemma cocone_like_cocone_create : forall v e, cocone_like (cocone_create v e). Proof. ir. uf cocone_like. rw vertex_cocone_create. rww coedge_nt_cocone_create. Qed. Definition is_cocone c := cocone_like c & Nat_Trans.axioms (coedge_nt c) & ob (cocone_target c) (vertex c) & target (coedge_nt c) = constant_functor (cocone_source c) (cocone_target c) (vertex c). Lemma cocone_extensionality : forall c d, is_cocone c -> is_cocone d -> vertex c = vertex d -> cosocle c = cosocle d -> (forall x, ob (cocone_source c) x -> coedge c x = coedge d x) -> c = d. Proof. ir. assert (cocone_source c = cocone_source d). uf cocone_source. rww H2. assert (cocone_target c = cocone_target d). uf cocone_target; rww H2. uh H; uh H0; ee. uh H; uh H0. wr H; wr H0. rw H1. ap uneq. app Nat_Trans.axioms_extensionality. rw H11. rw H8. rw H4; rw H5; rw H1. reflexivity. Qed. Definition cocone_create2 f v e := cocone_create v (Nat_Trans.create f (constant_functor (source f) (target f) v) e). Lemma is_cocone_cocone_create2 : forall f v e, Functor.axioms f-> ob (target f) v-> (forall x, ob (source f) x -> mor (target f) (e x)) -> (forall x, ob (source f) x -> target (e x) = v) -> (forall x, ob (source f) x -> source (e x) = (fob f x)) -> (forall u, mor (source f) u -> comp (target f) (e (target u)) (fmor f u) = e (source u)) -> is_cocone (cocone_create2 f v e). Proof. ir. uf cocone_create2. uhg; ee. ap cocone_like_cocone_create. rw coedge_nt_cocone_create. app Nat_Trans.create_axioms. uhg; ee. am. app constant_functor_axioms. uh H; ee; am. uh H; ee; am. rww source_constant_functor. rww target_constant_functor. ir. rw target_constant_functor. au. ir. au. ir. rw fob_constant_functor. au. am. am. ir. rw target_constant_functor. rww fmor_constant_functor. rww H4. rww left_id. ap H1. rww ob_source. rw H2. tv. rww ob_source. rw vertex_cocone_create. uf cocone_target. uf cosocle. rw coedge_nt_cocone_create. rw source_create. am. rw coedge_nt_cocone_create. rw target_create. rw vertex_cocone_create. uf cocone_source; uf cocone_target; uf cosocle; rw coedge_nt_cocone_create. rw source_create. tv. Qed. Lemma coedge_nt_axioms : forall c, is_cocone c -> Nat_Trans.axioms (coedge_nt c). Proof. ir. uh H; ee; am. Qed. Lemma otarget_coedge_nt : forall c, is_cocone c -> otarget (coedge_nt c) = cocone_target c. Proof. ir. tv. uf cocone_target. uf cosocle. rww target_source. app coedge_nt_axioms. Qed. Lemma osource_coedge_nt : forall c, osource (coedge_nt c) = cocone_source c. Proof. ir. uf cocone_source. uf cosocle. tv. Qed. Definition cocone_composable u c := is_cocone c & mor (cocone_target c) u & source u = vertex c. Lemma cocone_composable_rw : forall c u, is_cocone c -> mor (cocone_target c) u -> source u = vertex c -> cocone_composable u c = True. Proof. ir. uf cocone_composable. app iff_eq; ir; try tv. xd. Qed. Definition cocone_compose u c := cocone_create (target u) (vcompose (constant_nt (cocone_source c) (cocone_target c) u) (coedge_nt c)). Lemma vertex_cocone_compose : forall u c , vertex (cocone_compose u c) = target u. Proof. ir. uf cocone_compose. rw vertex_cocone_create. tv. Qed. Lemma coedge_nt_cocone_compose : forall u c, coedge_nt (cocone_compose u c) = (vcompose (constant_nt (cocone_source c) (cocone_target c) u) (coedge_nt c)). Proof. ir. uf cocone_compose. rw coedge_nt_cocone_create. tv. Qed. Lemma coedge_cocone_compose : forall c u x, ob (cocone_source c) x -> coedge (cocone_compose u c) x = comp (cocone_target c) u (coedge c x). Proof. ir. uf coedge. rw coedge_nt_cocone_compose. rw ntrans_vcompose. rw otarget_constant_nt. rw ntrans_constant_nt. tv. am. rw osource_coedge_nt. am. Qed. Lemma source_coedge_nt : forall c, source (coedge_nt c) = cosocle c. Proof. ir. tv. Qed. Lemma target_coedge_nt : forall c, is_cocone c -> target (coedge_nt c) = constant_functor (cocone_source c) (cocone_target c) (vertex c). Proof. ir. uh H. ee; am. Qed. Lemma cosocle_cocone_compose : forall c u, cosocle (cocone_compose u c) = cosocle c. Proof. ir. uf cosocle. rw coedge_nt_cocone_compose. rw source_vcompose. tv. Qed. Lemma cocone_target_cocone_compose : forall c u, cocone_target (cocone_compose u c) = cocone_target c. Proof. ir. uf cocone_target. rw cosocle_cocone_compose. tv. Qed. Lemma cocone_source_cocone_compose : forall c u, cocone_source (cocone_compose u c) = cocone_source c. Proof. ir. uf cocone_source. rw cosocle_cocone_compose. tv. Qed. Lemma mor_coedge : forall c x, ob (cocone_source c) x -> is_cocone c -> mor (cocone_target c) (coedge c x). Proof. ir. uf coedge. ap mor_ntrans. lu. rww osource_coedge_nt. rww otarget_coedge_nt. Qed. Lemma ob_vertex : forall c, is_cocone c -> ob (cocone_target c) (vertex c). Proof. ir. uh H; ee. am. Qed. Lemma target_coedge : forall c x, ob (cocone_source c) x -> is_cocone c -> target (coedge c x) = vertex c. Proof. ir. uf coedge. rw target_ntrans. rw target_coedge_nt. rw fob_constant_functor. tv. am. ap ob_vertex. am. am. lu. rww osource_coedge_nt. Qed. Lemma source_coedge : forall c x, ob (cocone_source c) x -> is_cocone c -> source (coedge c x) = fob (cosocle c) x. Proof. ir. uf coedge. rw source_ntrans. tv. uh H0; ee. am. ufi cocone_source H. ufi cosocle H. am. Qed. Lemma ntrans_coedge_nt : forall c x, ntrans (coedge_nt c) x = coedge c x. Proof. ir. tv. Qed. Lemma cocommutativity : forall c u, mor (cocone_source c) u -> is_cocone c -> comp (cocone_target c) (coedge c (target u)) (fmor (cosocle c) u) = coedge c (source u). Proof. ir. assert (K:is_cocone c). am. uh H0; ee. uf coedge. assert (cocone_target c = otarget (coedge_nt c)). rww otarget_coedge_nt. assert (cosocle c = source (coedge_nt c)). rww source_coedge_nt. assert (lem1: forall y, ntrans (coedge_nt c) y = coedge c y). ir. tv. rw H4; rw H5. rw carre. rw target_coedge_nt. rw fmor_constant_functor. rw left_id. tv. wr H4; am. wr H4. change (mor (cocone_target c) (coedge c (source u))). app mor_coedge. rww ob_source. rw ntrans_coedge_nt. rw target_coedge. tv. rww ob_source. am. rww otarget_coedge_nt. am. am. am. rww osource_coedge_nt. Qed. Lemma cocone_source_axioms : forall c, is_cocone c -> Category.axioms (cocone_source c). Proof. ir. cp H. uh H; ee. uh H1; ee. rwi osource_coedge_nt H4. exact H4. Qed. Lemma cocone_target_axioms : forall c, is_cocone c -> Category.axioms (cocone_target c). Proof. ir. cp H. uh H; ee. uh H1; ee. rwi otarget_coedge_nt H5. exact H5. am. Qed. Lemma cosocle_axioms : forall c, is_cocone c -> Functor.axioms (cosocle c). Proof. ir. uh H; ee. uh H0; ee. exact H5. Qed. Lemma is_cocone_cocone_compose : forall c u, cocone_composable u c -> is_cocone (cocone_compose u c). Proof. ir. assert (is_cocone c). lu. uhg; ee. uf cocone_like. uf cocone_compose. rw vertex_cocone_create. rw coedge_nt_cocone_create. tv. rw coedge_nt_cocone_compose. rww vcompose_axioms. ap constant_nt_axioms. app cocone_source_axioms. app cocone_target_axioms. uh H; ee; am. app coedge_nt_axioms. rww source_constant_nt. rw target_coedge_nt. uh H; ee. rww H2. am. rw cocone_target_cocone_compose. rw vertex_cocone_compose. rw ob_target. tv. uh H; ee; am. rw coedge_nt_cocone_compose. rw target_vcompose. rw target_constant_nt. rw cocone_source_cocone_compose. rw cocone_target_cocone_compose. rw vertex_cocone_compose. tv. Qed. Lemma cocone_compose_cocone_compose : forall a u v, cocone_composable u a -> composable (cocone_target a) v u -> cocone_compose v (cocone_compose u a) = cocone_compose (comp (cocone_target a) v u) a. Proof. ir. rwi composable_facts_rw H0. apply cocone_extensionality. app is_cocone_cocone_compose. uf cocone_composable; ee. app is_cocone_cocone_compose. rw cocone_target_cocone_compose. lu. rw vertex_cocone_compose. uh H0; ee; am. app is_cocone_cocone_compose. uhg; ee. lu. rww mor_comp. lu. lu. lu. rw source_comp. lu. lu. lu. lu. rw vertex_cocone_compose. rw vertex_cocone_compose. rw target_comp. tv. lu. lu. lu. rw cosocle_cocone_compose. rw cosocle_cocone_compose. rw cosocle_cocone_compose. tv. ir. rw coedge_cocone_compose. rw cocone_target_cocone_compose. rw coedge_cocone_compose. rw coedge_cocone_compose. rw assoc. tv. uh H0; ee; am. uh H0; ee; am. ap mor_coedge. rwi cocone_source_cocone_compose H1. rwi cocone_source_cocone_compose H1. am. lu. uh H; ee. uh H0; ee; am. rw target_coedge. uh H; ee; am. rwi cocone_source_cocone_compose H1. rwi cocone_source_cocone_compose H1. am. lu. tv. rwi cocone_source_cocone_compose H1. rwi cocone_source_cocone_compose H1. am. uhg; ee. ap cocone_source_axioms. lu. ap ob_is_ob. rwi cocone_source_cocone_compose H1. rwi cocone_source_cocone_compose H1. am. rwi cocone_source_cocone_compose H1. am. Qed. Definition is_couni a := is_cocone a & (forall u v, cocone_composable u a -> cocone_composable v a -> cocone_compose u a = cocone_compose v a -> u = v). Definition is_coversal a := is_cocone a & (forall b, is_cocone b -> cosocle b = cosocle a -> (exists u, (cocone_composable u a & cocone_compose u a = b))). Definition is_colimit a := is_couni a & is_coversal a. Lemma is_colimit_is_coversal : forall a, is_colimit a -> is_coversal a. Proof. ir. lu. Qed. Lemma is_colimit_is_couni : forall a, is_colimit a -> is_couni a. Proof. ir. lu. Qed. Lemma is_colimit_is_cocone : forall a, is_colimit a -> is_cocone a. Proof. ir. lu. Qed. Definition is_colimit_of f a := is_colimit a & cosocle a = f. Definition has_colimit f := exists a, is_colimit_of f a. Definition has_colimits_over c b := (forall f, Functor.axioms f -> source f = c -> target f = b -> has_colimit f). (************ at this point it is a good idea to start the comparison with limits **********************************************) Definition oppc c := (cocone_create (vertex c) (oppnt (edge_nt c))). Lemma oppc_co : forall c, oppc c = cone_create (vertex c) (oppnt (coedge_nt c)). Proof. ir. uf oppc. uf cocone_create. uf coedge_nt. tv. Qed. Lemma vertex_oppc : forall c, vertex (oppc c) = vertex c. Proof. ir. uf oppc. rw vertex_cocone_create. tv. Qed. Lemma coedge_nt_oppc : forall c, coedge_nt (oppc c) = oppnt (edge_nt c). Proof. ir. uf oppc. rww coedge_nt_cocone_create. Qed. Lemma edge_nt_oppc : forall c, edge_nt (oppc c) = oppnt (coedge_nt c). Proof. ir. uf oppc. rww edge_nt_cone_create. Qed. Lemma coedge_oppc : forall c x, ob (cone_source c) x -> is_cone c -> coedge (oppc c) x = flip (edge c x). Proof. ir. uf coedge. rw coedge_nt_oppc. rw ntrans_oppnt. tv. app edge_nt_axioms. rw osource_edge_nt. am. am. Qed. Lemma edge_oppc : forall c x, ob (cocone_source c) x -> is_cocone c -> edge (oppc c) x = flip (coedge c x). Proof. ir. uf edge. rw edge_nt_oppc. rw ntrans_oppnt. tv. app coedge_nt_axioms. rw osource_coedge_nt. am. Qed. Lemma oppc_oppc_cone : forall c, is_cone c -> oppc (oppc c) = c. Proof. ir. uf oppc. rw vertex_cocone_create. uf cocone_create. rw edge_nt_cone_create. rw oppnt_oppnt. uh H; ee. uh H; ee. am. Qed. Lemma oppc_oppc_cocone : forall c, is_cocone c -> oppc (oppc c) = c. Proof. ir. rw oppc_co. rw vertex_oppc. rw coedge_nt_oppc. rw oppnt_oppnt. uh H; ee. uh H; ee. am. Qed. Lemma cosocle_oppc : forall c, is_cone c -> cosocle (oppc c) = oppf (socle c). Proof. ir. uf cosocle. rw coedge_nt_oppc. rw source_oppnt. tv. app edge_nt_axioms. Qed. Lemma socle_oppc : forall c, is_cocone c -> socle (oppc c) = oppf (cosocle c). Proof. ir. uf socle. rw edge_nt_oppc. rw target_oppnt. tv. app coedge_nt_axioms. Qed. Lemma cocone_source_oppc : forall c, is_cone c -> cocone_source (oppc c) = opp (cone_source c). Proof. ir. uf cocone_source. rw cosocle_oppc. rw source_oppf. tv. ap socle_axioms. am. am. Qed. Lemma cocone_target_oppc : forall c, is_cone c -> cocone_target (oppc c) = opp (cone_target c). Proof. ir. uf cocone_target. rw cosocle_oppc. rw target_oppf. tv. app socle_axioms. am. Qed. Lemma cone_source_oppc : forall c, is_cocone c -> cone_source (oppc c) = opp (cocone_source c). Proof. ir. uf cone_source. rw socle_oppc. rw source_oppf. tv. app cosocle_axioms. am. Qed. Lemma cone_target_oppc : forall c, is_cocone c -> cone_target (oppc c) = opp (cocone_target c). Proof. ir. uf cone_target. rw socle_oppc. rw target_oppf. tv. app cosocle_axioms. am. Qed. Lemma is_cocone_oppc : forall c, is_cone c -> is_cocone (oppc c). Proof. ir. cp H; uh H; uhg; ee. uh H; uhg. rw vertex_oppc. rw coedge_nt_oppc. uf oppc. tv. rw coedge_nt_oppc. app oppnt_axioms. rw cocone_target_oppc. rw ob_opp. rw vertex_oppc. am. am. rw coedge_nt_oppc. rw target_oppnt. rw source_edge_nt. rw cocone_source_oppc. rw cocone_target_oppc. rw vertex_oppc. rw oppf_constant_functor. reflexivity. app cone_source_axioms. app Limit.ob_vertex. am. am. am. am. Qed. Lemma is_cone_oppc : forall c, is_cocone c -> is_cone (oppc c). Proof. ir. cp H; uh H; uhg; ee. uh H; uhg. rw vertex_oppc. rw coedge_nt_oppc. uf oppc. tv. rw coedge_nt_oppc. app oppnt_axioms. rw cone_target_oppc. rw ob_opp. rw vertex_oppc. am. am. rw edge_nt_oppc. rw source_oppnt. rw target_coedge_nt. rw cone_source_oppc. rw cone_target_oppc. rw vertex_oppc. rw oppf_constant_functor. reflexivity. app cocone_source_axioms. app ob_vertex. am. am. am. am. Qed. Lemma cocone_composable_oppc : forall c u, cone_composable c (flip u) -> cocone_composable u (oppc c). Proof. ir. uhg; ee. ap is_cocone_oppc. uh H; ee; am. rw cocone_target_oppc. rw mor_opp. uh H; ee; am. uh H; ee. am. rw vertex_oppc. uh H; ee. wr H1. rww target_flip. apply by_cases with (Arrow.like u). ir. am. ir. rwi flip_not_like H0. apply mor_arrow_like with (cone_target c); am. am. Qed. Lemma cone_composable_oppc : forall c u, cocone_composable (flip u) c-> cone_composable (oppc c) u. Proof. ir. uhg; ee. ap is_cone_oppc. uh H; ee; am. rw cone_target_oppc. rw mor_opp. uh H; ee; am. uh H; ee; am. rw vertex_oppc. uh H; ee. wr H1. rww source_flip. apply by_cases with (Arrow.like u). ir. am. ir. rwi flip_not_like H0. apply mor_arrow_like with (cocone_target c); am. am. Qed. Lemma oppc_cone_compose : forall c u, cone_composable c u -> oppc (cone_compose c u) = (cocone_compose (flip u) (oppc c)). Proof. ir. assert (cocone_composable (flip u) (oppc c)). ap cocone_composable_oppc. rw flip_flip. am. ap cocone_extensionality. app is_cocone_oppc. rww is_cone_cone_compose. app is_cocone_cocone_compose. rw vertex_oppc. rw vertex_cone_compose. rw vertex_cocone_compose. rw target_flip. tv. uh H; ee. ap (mor_arrow_like H1). rw cosocle_oppc. rw socle_cone_compose. rw cosocle_cocone_compose. rw cosocle_oppc. tv. uh H; ee; am. rww is_cone_cone_compose. ir. assert (is_cone c). uh H; ee; am. rwi cocone_source_oppc H1. rwi cone_source_cone_compose H1. cp H1. rwi ob_opp H1. rw coedge_oppc. sy. rw coedge_cocone_compose. rw edge_cone_compose. rw coedge_oppc. rw cocone_target_oppc. rw comp_opp. rw flip_flip. rw flip_flip. tv. wr cocone_target_oppc. rw cocone_target_oppc. rw mor_opp. rw flip_flip. uh H; ee; am. uh H; ee; am. uh H; ee; am. rw mor_opp. rw flip_flip. ap mor_edge. am. uh H; ee; am. rw source_flip. rw target_flip. rw source_edge. uh H; ee; am. am. am. apply mor_arrow_like with (cone_target c). app mor_edge. uh H; ee; alike. am. am. am. am. am. rw cocone_source_oppc. am. am. rww cone_source_cone_compose. rww is_cone_cone_compose. rww is_cone_cone_compose. Qed. Lemma oppc_cocone_compose : forall c u, cocone_composable u c -> oppc (cocone_compose u c) = (cone_compose (oppc c) (flip u)). Proof. ir. assert (cone_composable (oppc c) (flip u)). ap cone_composable_oppc. rw flip_flip. am. ap cone_extensionality. app is_cone_oppc. app is_cocone_cocone_compose. rww is_cone_cone_compose. rw vertex_oppc. rw vertex_cocone_compose. rw vertex_cone_compose. rw source_flip. tv. uh H; ee. ap (mor_arrow_like H1). rw socle_oppc. rw cosocle_cocone_compose. rw socle_cone_compose. rw socle_oppc. tv. uh H; ee; am. app is_cocone_cocone_compose. ir. rwi cone_source_oppc H1. rwi cocone_source_cocone_compose H1. cp H1. rwi ob_opp H1. wri cone_source_oppc H2. rw edge_oppc. sy. rw edge_cone_compose. rw coedge_cocone_compose. rw edge_oppc. rw cone_target_oppc. rw comp_opp. rw flip_flip. rw flip_flip. tv. rw mor_opp. rw flip_flip. ap mor_coedge. am. uh H; ee; am. rw mor_opp. rw flip_flip. uh H; ee; am. rw source_flip. rw target_flip. rw target_coedge. uh H; ee; sy; am. am. uh H; ee; am. uh H; ee; alike. apply mor_arrow_like with (cocone_target c). ap mor_coedge. am. uh H; ee; am. uh H; ee; am. am. uh H; ee; am. am. am. am. rww cocone_source_cocone_compose. app is_cocone_cocone_compose. uh H; ee; am. app is_cocone_cocone_compose. Qed. Lemma is_couni_oppc : forall c, is_uni c -> is_couni (oppc c). Proof. ir. cp H. uh H0; ee. uhg. ee. app is_cocone_oppc. ir. assert (c = oppc (oppc c)). rww oppc_oppc_cone. assert (cone_composable c (flip u)). rw H5. ap cone_composable_oppc. rw flip_flip. am. assert (cone_composable c (flip v)). rw H5. ap cone_composable_oppc. rw flip_flip. am. assert (flip u = flip v). ap H1. am. am. transitivity (oppc (oppc (cone_compose c (flip u)))). sy. rw oppc_oppc_cone. reflexivity. rww is_cone_cone_compose. rw oppc_cone_compose. rw flip_flip. rw H4. transitivity (oppc (oppc (cone_compose c (flip v)))). sy. rw oppc_cone_compose. rw flip_flip. reflexivity. am. rw oppc_oppc_cone. reflexivity. rww is_cone_cone_compose. am. transitivity (flip (flip u)). rww flip_flip. rw H8. rww flip_flip. Qed. Lemma is_uni_oppc : forall c, is_couni c -> is_uni (oppc c). Proof. ir. cp H. uh H0; ee. uhg. ee. app is_cone_oppc. ir. assert (c = oppc (oppc c)). rww oppc_oppc_cocone. assert (cocone_composable (flip u) c). rw H5. ap cocone_composable_oppc. rw flip_flip. am. assert (cocone_composable (flip v) c). rw H5. ap cocone_composable_oppc. rw flip_flip. am. assert (flip u = flip v). ap H1. am. am. transitivity (oppc (oppc (cocone_compose (flip u) c))). sy. rw oppc_oppc_cocone. reflexivity. app is_cocone_cocone_compose. rw oppc_cocone_compose. rw flip_flip. rw H4. transitivity (oppc (oppc (cocone_compose (flip v) c))). sy. rw oppc_cocone_compose. rw flip_flip. reflexivity. am. rw oppc_oppc_cocone. reflexivity. app is_cocone_cocone_compose. am. transitivity (flip (flip u)). rww flip_flip. rw H8. rww flip_flip. Qed. Lemma is_coversal_oppc : forall c, is_versal c -> is_coversal (oppc c). Proof. ir. uh H; uhg; ee. app is_cocone_oppc. ir. cp H2. rwi cosocle_oppc H3. util (H0 (oppc b)). app is_cone_oppc. rw socle_oppc. rw H3. rw oppf_oppf. tv. am. nin H4. ee. assert (cocone_composable (flip x) (oppc c)). app cocone_composable_oppc. rww flip_flip. sh (flip x). ee; try am. transitivity (oppc (oppc b)). wr H5. sy. rw oppc_cone_compose. reflexivity. am. rww oppc_oppc_cocone. am. Qed. Lemma is_versal_oppc : forall c, is_coversal c -> is_versal (oppc c). Proof. ir. uh H; uhg; ee. app is_cone_oppc. ir. cp H2. rwi socle_oppc H3. util (H0 (oppc b)). app is_cocone_oppc. rw cosocle_oppc. rw H3. rw oppf_oppf. tv. am. nin H4. ee. assert (cone_composable (oppc c) (flip x)). app cone_composable_oppc. rww flip_flip. sh (flip x). ee; try am. transitivity (oppc (oppc b)). wr H5. sy. rw oppc_cocone_compose. reflexivity. am. rww oppc_oppc_cone. am. Qed. Lemma is_limit_oppc : forall c, is_colimit c -> is_limit (oppc c). Proof. ir. uh H; uhg; ee. app is_uni_oppc. app is_versal_oppc. Qed. Lemma is_colimit_oppc : forall c, is_limit c -> is_colimit (oppc c). Proof. ir. uh H; uhg; ee. app is_couni_oppc. app is_coversal_oppc. Qed. Lemma is_colimit_of_oppf : forall f a, is_limit_of f a -> is_colimit_of (oppf f) (oppc a). Proof. ir. uhg; ee. ap is_colimit_oppc. uh H; ee; am. rw cosocle_oppc. uh H; ee. rww H0. uh H; ee. uh H; ee. uh H; ee. am. Qed. Lemma is_limit_of_oppf : forall f a, is_colimit_of f a -> is_limit_of (oppf f) (oppc a). Proof. ir. uhg; ee. ap is_limit_oppc. uh H; ee; am. rw socle_oppc. uh H; ee. rww H0. uh H; ee. uh H; ee. uh H; ee. am. Qed. Lemma has_colimit_oppf : forall f, has_limit f -> has_colimit (oppf f). Proof. ir. uhg. uh H; ee. nin H. sh (oppc x). app is_colimit_of_oppf. Qed. Lemma has_limit_oppf : forall f, has_colimit f -> has_limit (oppf f). Proof. ir. uhg. uh H; ee. nin H. sh (oppc x). app is_limit_of_oppf. Qed. Lemma has_colimits_over_opp : forall b c, Category.axioms b -> Category.axioms c -> has_limits_over c b -> has_colimits_over (opp c) (opp b). Proof. ir. uhg. ir. assert (f = oppf (oppf f)). rww oppf_oppf. rw H5. ap has_colimit_oppf. uh H1. ap H1. app oppf_axioms. rw source_oppf. rw H3. rww opp_opp. am. rw target_oppf. rw H4. rww opp_opp. am. Qed. Lemma has_limits_over_opp : forall b c, Category.axioms b -> Category.axioms c -> has_colimits_over c b -> has_limits_over (opp c) (opp b). Proof. ir. uhg. ir. assert (f = oppf (oppf f)). rww oppf_oppf. rw H5. ap has_limit_oppf. uh H1. ap H1. app oppf_axioms. rw source_oppf. rw H3. rww opp_opp. am. rw target_oppf. rw H4. rww opp_opp. am. Qed. (************************ now we get back to the definition of colimit; we use the above so that it is involutive with respect to oppc ************) (**** the definition obtained by copying limits.v would be: Definition colimit f := choose (is_colimit_of f). ************* however this doesn't seem to give oppc (colimit) = limit which would seem practical...********************) Definition colimit f := oppc (limit (oppf f)). Lemma has_colimit_functor_axioms : forall f, has_colimit f -> Functor.axioms f. Proof. ir. uh H. nin H. uh H. ee. wr H0. ap cosocle_axioms. app is_colimit_is_cocone. Qed. Lemma has_limit_functor_axioms : forall f, has_limit f -> Functor.axioms f. Proof. ir. uh H. nin H. uh H. ee. wr H0. ap socle_axioms. app is_limit_is_cone. Qed. Lemma if_has_colimit : forall f, has_colimit f -> is_colimit_of f (colimit f). Proof. ir. uhg. ee. uf colimit. ap is_colimit_oppc. ap is_limit_limit. ap has_limit_oppf. am. uf colimit. rw cosocle_oppc. rw socle_limit. rw oppf_oppf. tv. app has_limit_oppf. app is_limit_is_cone. app is_limit_limit. app has_limit_oppf. Qed. Lemma is_colimit_colimit : forall f, has_colimit f -> is_colimit (colimit f). Proof. ir. cp (if_has_colimit H). lu. Qed. Lemma cosocle_colimit : forall f, has_colimit f -> cosocle (colimit f) = f. Proof. ir. cp (if_has_colimit H). lu. Qed. Lemma colimit_oppf : forall f, has_limit f -> colimit (oppf f) = oppc (limit f). Proof. ir. uf colimit. rw oppf_oppf. tv. Qed. Lemma limit_oppf : forall f, has_colimit f -> limit (oppf f) = oppc (colimit f). Proof. ir. uf colimit. rw oppc_oppc_cone. tv. ap is_limit_is_cone. ap is_limit_limit. app has_limit_oppf. Qed. (****** we should also continue integrating results about cocommutation with oppc into the rest of the file below (later...) ************************) Definition colimit_to_cocone b a := choose (fun u => (cocone_composable u b & cocone_compose u b = a)). Lemma colimit_to_cocone_pr : forall a b, is_cocone a -> is_colimit b -> cosocle a = cosocle b -> (cocone_composable (colimit_to_cocone b a) b & cocone_compose (colimit_to_cocone b a) b = a). Proof. ir. uh H0; ee. uh H2; ee. util (H3 a). am. am. cp (choose_pr H4). cbv beta in H5. ee. am. uh H2; ee. util (H3 a). am. am. cp (choose_pr H4). cbv beta in H5. ee. am. Qed. Lemma mor_colimit_to_cocone : forall a b y, is_cocone a -> is_colimit b -> cosocle a = cosocle b -> y = cocone_target b -> mor y (colimit_to_cocone b a). Proof. ir. cp (colimit_to_cocone_pr H H0 H1). ee. uh H3; ee. rw H2; am. Qed. Lemma target_colimit_to_cocone : forall a b, is_cocone a -> is_colimit b -> cosocle a = cosocle b -> target (colimit_to_cocone b a) = vertex a. Proof. ir. cp (colimit_to_cocone_pr H H0 H1). ee. transitivity (vertex (cocone_compose (colimit_to_cocone b a) b)). rw vertex_cocone_compose. tv. rw H3. tv. Qed. Lemma source_colimit_to_cocone : forall a b, is_cocone a -> is_colimit b -> cosocle a = cosocle b -> source (colimit_to_cocone b a) = vertex b. Proof. ir. cp (colimit_to_cocone_pr H H0 H1). ee. uh H2; ee. am. Qed. Lemma cocone_compose_colimit_to_cocone : forall a b, is_cocone a -> is_colimit b -> cosocle a = cosocle b -> cocone_compose (colimit_to_cocone b a) b = a. Proof. ir. cp (colimit_to_cocone_pr H H0 H1). ee. am. Qed. Lemma cocone_composable_colimit_to_cocone : forall a b, is_cocone a -> is_colimit b -> cosocle a = cosocle b -> cocone_composable (colimit_to_cocone b a) b. Proof. ir. cp (colimit_to_cocone_pr H H0 H1). ee. am. Qed. Lemma colimit_to_cocone_cocone_compose1 : forall a u, is_colimit a -> cocone_composable u a -> colimit_to_cocone a (cocone_compose u a) = u. Proof. ir. assert (lem1 : is_colimit a). am. uh H; ee. uh H; ee. ap H2. uhg; ee. am. ap mor_colimit_to_cocone. app is_cocone_cocone_compose. am. rw cosocle_cocone_compose. tv. tv. rw source_colimit_to_cocone. tv. app is_cocone_cocone_compose. am. rw cosocle_cocone_compose. tv. am. rw cocone_compose_colimit_to_cocone. tv. app is_cocone_cocone_compose. am. rww cosocle_cocone_compose. Qed. Lemma colimit_to_cocone_cocone_compose : forall a b u, is_colimit b -> cocone_composable u a -> cosocle a = cosocle b -> colimit_to_cocone b (cocone_compose u a) = comp (cocone_target b) u (colimit_to_cocone b a). Proof. ir. set (k:= comp (cocone_target b) u (colimit_to_cocone b a)). assert (cocone_target a = cocone_target b). uf cocone_target. rww H1. assert (lem1 : is_cocone a). lu. transitivity (colimit_to_cocone b (cocone_compose k b)). uf k. wr cocone_compose_cocone_compose. rw cocone_compose_colimit_to_cocone. tv. lu. am. am. app cocone_composable_colimit_to_cocone. app show_composable. wr H2; uh H0; ee; am. app mor_colimit_to_cocone. rww target_colimit_to_cocone. uh H0; ee; am. rww colimit_to_cocone_cocone_compose1. uf k. uhg; ee. uh H; ee. uh H; ee; am. rww mor_comp. wr H2; uh H0; ee; am. app mor_colimit_to_cocone. rww target_colimit_to_cocone. uh H0; ee; am. rw source_comp. rww source_colimit_to_cocone. wr H2; uh H0; ee; am. app mor_colimit_to_cocone. rww target_colimit_to_cocone. uh H0; ee; am. Qed. Definition cocone_transform c u := cocone_create (vertex c) (vcompose (coedge_nt c) u). Lemma vertex_cocone_transform : forall u c, vertex (cocone_transform c u) = vertex c. Proof. ir. uf cocone_transform. rww vertex_cocone_create. Qed. Lemma coedge_nt_cocone_transform : forall u c, coedge_nt (cocone_transform c u) = vcompose (coedge_nt c) u. Proof. ir. uf cocone_transform. rww coedge_nt_cocone_create. Qed. Lemma cosocle_cocone_transform : forall u c, cosocle (cocone_transform c u) = source u. Proof. ir. uf cosocle. rww coedge_nt_cocone_transform. rww source_vcompose. Qed. Definition cocone_transformable c u := is_cocone c & Nat_Trans.axioms u & target u = cosocle c. Lemma source_cosocle : forall c, source (cosocle c) = cocone_source c. Proof. ir. tv. Qed. Lemma target_cosocle : forall c, target (cosocle c) = cocone_target c. Proof. ir. tv. Qed. Lemma coedge_cocone_transform : forall c u x, cocone_transformable c u -> ob (cocone_source c) x -> coedge (cocone_transform c u) x = comp (cocone_target c) (coedge c x) (ntrans u x). Proof. ir. uf coedge. rw coedge_nt_cocone_transform. rw ntrans_vcompose. rw otarget_coedge_nt. tv. uh H; ee; am. uh H; ee. wr source_target. rw H2. rw source_cosocle. am. am. Qed. Lemma cocone_source_cocone_transform : forall u c, cocone_transformable c u -> cocone_source (cocone_transform c u) = cocone_source c. Proof. ir. uf cocone_source. rw cosocle_cocone_transform. uh H; ee. rw source_source. wr source_target. rww H1. am. Qed. Lemma cocone_target_cocone_transform : forall u c, cocone_transformable c u -> cocone_target (cocone_transform c u) = cocone_target c. Proof. ir. uf cocone_target. rww cosocle_cocone_transform. uh H; ee. wr H1. rww target_source. Qed. Lemma is_cocone_cocone_transform : forall u c, cocone_transformable c u -> is_cocone (cocone_transform c u). Proof. ir. cp H; uh H; ee. uhg; ee. uf cocone_transform. app cocone_like_cocone_create. rw coedge_nt_cocone_transform. rww vcompose_axioms. app coedge_nt_axioms. rww source_coedge_nt. sy; am. rw vertex_cocone_transform. rww cocone_target_cocone_transform. uh H; ee. am. rw coedge_nt_cocone_transform. rw target_vcompose. rw target_coedge_nt. rw cocone_source_cocone_transform. rw cocone_target_cocone_transform. rww vertex_cocone_transform. am. am. am. Qed. Definition cocone_pushdown f c := cocone_create (fob f (vertex c)) (htrans_left f (coedge_nt c)). Lemma vertex_cocone_pushdown : forall f c, vertex (cocone_pushdown f c) = fob f (vertex c). Proof. ir. uf cocone_pushdown. rww vertex_cocone_create. Qed. Lemma coedge_nt_cocone_pushdown : forall f c, coedge_nt (cocone_pushdown f c) = htrans_left f (coedge_nt c). Proof. ir. uf cocone_pushdown. rww coedge_nt_cocone_create. Qed. Lemma cosocle_cocone_pushdown : forall f c, cosocle (cocone_pushdown f c) = fcompose f (cosocle c). Proof. ir. uf cosocle. rw coedge_nt_cocone_pushdown. rw source_htrans_left. tv. Qed. Lemma cocone_source_cocone_pushdown : forall f c, cocone_source (cocone_pushdown f c) = cocone_source c. Proof. ir. uf cocone_source. rw cosocle_cocone_pushdown. rw source_fcompose. tv. Qed. Lemma cocone_target_cocone_pushdown : forall f c, cocone_target (cocone_pushdown f c) = target f. Proof. ir. uf cocone_target. rw cosocle_cocone_pushdown. rww target_fcompose. Qed. Lemma coedge_cocone_pushdown : forall f c x, ob (cocone_source c) x -> is_cocone c -> coedge (cocone_pushdown f c) x = fmor f (coedge c x). Proof. ir. uf coedge. rw coedge_nt_cocone_pushdown. rw ntrans_htrans_left. tv. rww osource_coedge_nt. Qed. Lemma is_cocone_cocone_pushdown : forall f c, is_cocone c -> Functor.axioms f -> source f = cocone_target c -> is_cocone (cocone_pushdown f c). Proof. ir. uhg; ee. uf cocone_pushdown. ap cocone_like_cocone_create. rw coedge_nt_cocone_pushdown. app htrans_left_axioms. uh H; ee. am. rww otarget_coedge_nt. rw cocone_target_cocone_pushdown. rw vertex_cocone_pushdown. app ob_fob. rw H1. uh H; ee; am. rw coedge_nt_cocone_pushdown. rw target_htrans_left. rw target_coedge_nt. rw fcompose_right_constant_functor. rw cocone_source_cocone_pushdown. rw cocone_target_cocone_pushdown. rw vertex_cocone_pushdown. tv. am. am. app cocone_source_axioms. app ob_vertex. am. Qed. Lemma cocone_pushdown_cocone_pushdown : forall f g a, is_cocone a -> Functor.axioms f -> Functor.axioms g -> source g = cocone_target a -> source f = target g -> cocone_pushdown f (cocone_pushdown g a) = cocone_pushdown (fcompose f g) a. Proof. ir. ap cocone_extensionality. ap is_cocone_cocone_pushdown. ap is_cocone_cocone_pushdown. am. am. am. am. rw cocone_target_cocone_pushdown. am. ap is_cocone_cocone_pushdown. am. ap fcompose_axioms. am. am. am. rw source_fcompose. am. rw vertex_cocone_pushdown. rw vertex_cocone_pushdown. rw vertex_cocone_pushdown. rw fob_fcompose. tv. am. am. am. rw H2. ap ob_vertex. am. rww cosocle_cocone_pushdown. rww cosocle_cocone_pushdown. sy; rw cosocle_cocone_pushdown. rw fcompose_assoc. tv. am. am. app cosocle_axioms. am. am. ir. rwi cocone_source_cocone_pushdown H4. rwi cocone_source_cocone_pushdown H4. rw coedge_cocone_pushdown. rw coedge_cocone_pushdown. rw coedge_cocone_pushdown. rw fmor_fcompose. tv. am. am. am. rw H2. ap mor_coedge. am. am. am. am. am. am. rw cocone_source_cocone_pushdown. am. app is_cocone_cocone_pushdown. Qed. Definition cocone_pullback f c := cocone_create (vertex c) (htrans_right (coedge_nt c) f). Lemma vertex_cocone_pullback : forall f c, vertex (cocone_pullback f c) = vertex c. Proof. ir. uf cocone_pullback. rww vertex_cocone_create. Qed. Lemma coedge_nt_cocone_pullback : forall f c, coedge_nt (cocone_pullback f c) = htrans_right (coedge_nt c) f. Proof. ir. uf cocone_pullback. rww coedge_nt_cocone_create. Qed. Lemma cosocle_cocone_pullback : forall f c, cosocle (cocone_pullback f c) = fcompose (cosocle c) f. Proof. ir. uf cosocle. rw coedge_nt_cocone_pullback. rw source_htrans_right. tv. Qed. Lemma cocone_source_cocone_pullback : forall f c, cocone_source (cocone_pullback f c) = source f. Proof. ir. uf cocone_source. rw cosocle_cocone_pullback. rw source_fcompose. tv. Qed. Lemma cocone_target_cocone_pullback : forall f c, cocone_target (cocone_pullback f c) = cocone_target c. Proof. ir. uf cocone_target. rw cosocle_cocone_pullback. rww target_fcompose. Qed. Lemma coedge_cocone_pullback : forall f c x, ob (source f) x -> coedge (cocone_pullback f c) x = coedge c (fob f x). Proof. ir. uf coedge. rw coedge_nt_cocone_pullback. rw ntrans_htrans_right. tv. am. Qed. Lemma is_cocone_cocone_pullback : forall f c, is_cocone c -> Functor.axioms f -> cocone_source c = target f -> is_cocone (cocone_pullback f c). Proof. ir. uhg; ee. uf cocone_pullback. ap cocone_like_cocone_create. rw coedge_nt_cocone_pullback. app htrans_right_axioms. uh H; ee. am. rw cocone_target_cocone_pullback. rw vertex_cocone_pullback. app ob_vertex. rw coedge_nt_cocone_pullback. rw target_htrans_right. rw target_coedge_nt. rw fcompose_left_constant_functor. rw cocone_source_cocone_pullback. rw cocone_target_cocone_pullback. rw vertex_cocone_pullback. tv. am. sy; am. app cocone_target_axioms. app ob_vertex. am. Qed. Lemma cocone_compose_id : forall c, is_cocone c -> cocone_compose (id (cocone_target c) (vertex c)) c = c. Proof. ir. ap cocone_extensionality. app is_cocone_cocone_compose. uhg; ee. am. ap mor_id. ap ob_vertex. am. rww source_id. app ob_vertex. am. rww vertex_cocone_compose. rww target_id. app ob_vertex. rww cosocle_cocone_compose. ir. rwi cocone_source_cocone_compose H0. rww coedge_cocone_compose. rww left_id. app ob_vertex. app mor_coedge. rww target_coedge. Qed. Lemma cocone_compose_cocone_transform : forall f c u, is_cocone c -> cocone_composable u c -> cocone_transformable c f -> cocone_compose u (cocone_transform c f) = cocone_transform (cocone_compose u c) f. Proof. ir. ap cocone_extensionality. app is_cocone_cocone_compose. uhg; ee. app is_cocone_cocone_transform. rww cocone_target_cocone_transform. lu. rww vertex_cocone_transform. lu. app is_cocone_cocone_transform. uhg; ee. app is_cocone_cocone_compose. lu. rw cosocle_cocone_compose. lu. rw vertex_cocone_compose; rww vertex_cocone_transform. rww vertex_cocone_compose. rw cosocle_cocone_compose. rww cosocle_cocone_transform. rww cosocle_cocone_transform. ir. rwi cocone_source_cocone_compose H2. rwi cocone_source_cocone_transform H2; try am. assert (osource f = cocone_source c). uf cocone_source. wr source_target. ap uneq. uh H1; ee. am. uh H1; ee; am. assert (otarget f = cocone_target c). uf cocone_target. uf otarget. ap uneq. uh H1; ee; am. rw coedge_cocone_compose. rw coedge_cocone_transform. rw coedge_cocone_transform. rww cocone_target_cocone_transform. rww cocone_target_cocone_compose. rww coedge_cocone_compose. rww assoc. uh H0; ee; am. app mor_coedge. uh H0; ee. ap mor_ntrans. uh H1; ee; am. rww H3. sy; am. rww target_coedge. uh H0; ee; am. rw target_ntrans. rw source_coedge. uh H1; ee. rww H6. am. am. uh H1; ee; am. rww H3. uhg; ee. app is_cocone_cocone_compose. lu. rww cosocle_cocone_compose. lu. rw cocone_source_cocone_compose. am. am. am. rww cocone_source_cocone_transform. Qed. Lemma colimit_to_cocone_id : forall a b, is_colimit a -> a = b -> colimit_to_cocone a b = id (cocone_target b) (vertex b). Proof. ir. wr H0. cp H. uh H1; ee. uh H1; ee. ap H3. uhg; ee. am. ap mor_colimit_to_cocone. am. am. tv. tv. rww source_colimit_to_cocone. uhg; ee. am. ap mor_id. ap ob_vertex. am. rw source_id. tv. ap ob_vertex. am. rww cocone_compose_colimit_to_cocone. rww cocone_compose_id. Qed. Lemma comp_coedge_colimit_to_cocone : forall r s x b, is_colimit s -> is_cocone r -> cosocle r = cosocle s -> b = cocone_target s -> ob (cocone_source s) x -> comp b (colimit_to_cocone s r) (coedge s x) = coedge r x. Proof. ir. rw H2. transitivity (coedge (cocone_compose (colimit_to_cocone s r) s) x). rww coedge_cocone_compose. rw cocone_compose_colimit_to_cocone. tv. am. am. am. Qed. Lemma cocone_transform_vident : forall f c, f = cosocle c -> is_cocone c -> cocone_transform c (vident f) = c. Proof. ir. uf cocone_transform. rw weak_right_vident. lu. app coedge_nt_axioms. rww source_coedge_nt. Qed. Lemma cocone_transform_vcompose : forall u v c, is_cocone c -> cocone_transformable c v -> Nat_Trans.axioms u -> source v = target u -> cocone_transform c (vcompose v u) = cocone_transform (cocone_transform c v) u. Proof. ir. uh H0; ee. uf cocone_transform. rw vertex_cocone_create. ap uneq. rw coedge_nt_cocone_create. rww vcompose_assoc. app coedge_nt_axioms. rww source_coedge_nt. sy; am. Qed. (**** stuff about colimits and isomorphisms ****) Lemma comp_colimit_to_cocone_inversely : forall a b c, is_colimit a -> is_colimit b -> cosocle a = cosocle b -> cocone_target a = c -> comp c (colimit_to_cocone a b) (colimit_to_cocone b a) = id c (vertex b). Proof. ir. assert (cocone_target b = c). uf cocone_target. wr H1. am. cp H; cp H0. uh H4; uh H5; ee. uh H4; uh H5. ee. assert (composable c (colimit_to_cocone a b) (colimit_to_cocone b a)). ap show_composable. app mor_colimit_to_cocone. sy; am. sy; am. app mor_colimit_to_cocone. sy; am. rww source_colimit_to_cocone. rww target_colimit_to_cocone. sy; am. ap H8. uhg; ee. am. rw H3. rww mor_comp. ap mor_colimit_to_cocone. am. am. sy; am. sy; am. app mor_colimit_to_cocone. sy; am. rw source_colimit_to_cocone. rww target_colimit_to_cocone. am. am. sy; am. rw source_comp. rww source_colimit_to_cocone. app mor_colimit_to_cocone. sy; am. sy; am. app mor_colimit_to_cocone. sy; am. rw source_colimit_to_cocone. rww target_colimit_to_cocone. am. am. sy; am. uhg; ee. am. rw H3. ap mor_id. wr H3. ap ob_vertex. am. rw source_id. tv. wr H3; app ob_vertex. wr H3. wr cocone_compose_cocone_compose. rw cocone_compose_colimit_to_cocone. rw cocone_compose_colimit_to_cocone. rw cocone_compose_id. tv. am. am. am. sy; am. am. am. am. uhg; ee. am. app mor_colimit_to_cocone. rww source_colimit_to_cocone. rww H3. Qed. Lemma are_inverse_colimit_to_cocone : forall a b c, is_colimit a -> is_colimit b -> cosocle a = cosocle b -> cocone_target a = c -> are_inverse c (colimit_to_cocone a b) (colimit_to_cocone b a). Proof. ir. assert (cocone_target b = c). uf cocone_target. wr H1. am. cp H; cp H0. uh H4; uh H5; ee. uh H4; uh H5. ee. uhg; ee; try am. app mor_colimit_to_cocone. sy; am. sy; am. app mor_colimit_to_cocone. sy; am. rww source_colimit_to_cocone. rww target_colimit_to_cocone. sy; am. rww target_colimit_to_cocone. rww source_colimit_to_cocone. sy; am. rw source_colimit_to_cocone. app comp_colimit_to_cocone_inversely. am. am. am. rww comp_colimit_to_cocone_inversely. rww source_colimit_to_cocone. sy; am. sy; am. Qed. Lemma invertible_colimit_to_cocone : forall a b c, is_colimit a -> is_colimit b -> cosocle a = cosocle b -> cocone_target a = c -> invertible c (colimit_to_cocone a b). Proof. ir. uhg. sh (colimit_to_cocone b a). app are_inverse_colimit_to_cocone. Qed. Lemma inverse_colimit_to_cocone : forall a b c, is_colimit a -> is_colimit b -> cosocle a = cosocle b -> cocone_target a = c -> inverse c (colimit_to_cocone a b) = colimit_to_cocone b a. Proof. ir. cp (are_inverse_colimit_to_cocone H H0 H1 H2). app inverse_eq. Qed. Lemma is_colimit_cocone_compose : forall a u, is_colimit a -> cocone_composable u a -> invertible (cocone_target a) u -> is_colimit (cocone_compose u a). Proof. ir. assert (lem1: is_cocone (cocone_compose u a)). app is_cocone_cocone_compose. uhg; ee. (**** couni proof ****) uhg; ee. am. ir. assert (mor (cocone_target a) u0). uh H2; ee. rwi cocone_target_cocone_compose H5. am. assert (mor (cocone_target a) v). uh H3; ee. rwi cocone_target_cocone_compose H6; am. assert (target u = source u0). sy. uh H2; ee. rwi vertex_cocone_compose H8; am. assert (target u = source v). sy. uh H3; ee. rwi vertex_cocone_compose H9; am. assert (mor (cocone_target a) u). uh H0; ee. am. rwi cocone_compose_cocone_compose H4. rwi cocone_compose_cocone_compose H4. uh H; ee. uh H; ee. assert (comp (cocone_target a) u0 u = comp (cocone_target a) v u). ap H11. uhg; ee. am. rww mor_comp. wrr H7. rww source_comp. uh H0; ee; am. sy; am. uhg; ee. am. rww mor_comp. sy; am. rw source_comp. uh H0; ee; am. lu. lu. sy; am. am. transitivity (comp (cocone_target a) (comp (cocone_target a) u0 u) (inverse (cocone_target a) u)). rw assoc. rw right_inverse. rw right_id. tv. rww ob_target. am. sy; am. tv. am. am. am. ap mor_inverse. am. sy; am. rw target_inverse. tv. am. tv. rw H12. rw assoc. rw right_inverse. rw right_id. tv. rww ob_target. am. sy; am. tv. am. am. am. app mor_inverse. sy; am. rww target_inverse. tv. am. app show_composable. sy; am. am. app show_composable. sy; am. (*** coversal proof ***) assert (lema: source u = vertex a). lu. uhg; ee. am. ir. assert (lem0 : cosocle b = cosocle a). rwi cosocle_cocone_compose H3. am. assert (lem2: composable (cocone_target a) (colimit_to_cocone a b) (inverse (cocone_target a) u)). ap show_composable. app mor_colimit_to_cocone. app mor_inverse. rw target_inverse. rww source_colimit_to_cocone. sy; am. am. assert (is_cocone a). uh H; ee. uh H; ee; am. sh (comp (cocone_target a) (colimit_to_cocone a b) (inverse (cocone_target a) u)). ee. uhg; ee. am. rw cocone_target_cocone_compose. rww mor_comp. ap mor_colimit_to_cocone. am. am. am. tv. app mor_inverse. rww target_inverse. rww source_colimit_to_cocone. sy; am. rww source_comp. rww source_inverse. rww vertex_cocone_compose. app mor_colimit_to_cocone. app mor_inverse. rww source_colimit_to_cocone. rww target_inverse. sy; am. assert (cocone_target a = cocone_target (cocone_compose u a)). rww cocone_target_cocone_compose. assert (mor (cocone_target a) u). uh H0; ee; am. rw cocone_compose_cocone_compose. rw assoc. rww left_inverse. rw right_id. rw cocone_compose_colimit_to_cocone. tv. am. am. am. rww ob_source. app mor_colimit_to_cocone. rw source_colimit_to_cocone. sy; am. am. am. am. tv. app mor_colimit_to_cocone. app mor_inverse. am. rww target_inverse. rww source_colimit_to_cocone. sy; am. rww source_inverse. tv. am. ap show_composable. rww mor_comp. app mor_colimit_to_cocone. app mor_inverse. rww target_inverse. rww source_colimit_to_cocone. sy; am. am. rww source_comp. rww source_inverse. app mor_colimit_to_cocone. app mor_inverse. rww target_inverse. rww source_colimit_to_cocone. sy; am. Qed. Lemma colimit_to_cocone_invertible_is_colimit : forall a b, is_colimit b -> is_cocone a -> cosocle a = cosocle b -> invertible (cocone_target b) (colimit_to_cocone b a) -> is_colimit a. Proof. ir. assert (a = cocone_compose (colimit_to_cocone b a) b). rw cocone_compose_colimit_to_cocone. tv. am. am. am. rw H3. ap is_colimit_cocone_compose. am. uhg; ee. uh H; ee. uh H; ee; am. app mor_colimit_to_cocone. rww source_colimit_to_cocone. lu. Qed. (***** added in september: dotted *****) Definition codotted a := colimit_to_cocone (colimit (cosocle a)) a. Lemma target_codotted : forall a, is_cocone a -> has_colimit (cosocle a) -> target (codotted a) = vertex a. Proof. ir. uf codotted. rww target_colimit_to_cocone. app is_colimit_colimit. rww cosocle_colimit. Qed. Lemma source_codotted : forall a, is_cocone a -> has_colimit (cosocle a) -> source (codotted a) = vertex (colimit (cosocle a)). Proof. ir. uf codotted. rww source_colimit_to_cocone. app is_colimit_colimit. rww cosocle_colimit. Qed. Lemma mor_codotted : forall a, is_cocone a -> has_colimit (cosocle a) -> mor (cocone_target a) (codotted a). Proof. ir. uf codotted. app mor_colimit_to_cocone. app is_colimit_colimit. rww cosocle_colimit. uf cocone_target. rww cosocle_colimit. Qed. Lemma cocone_target_colimit : forall f, has_colimit f -> cocone_target (colimit f) = target f. Proof. ir. uf cocone_target. rww cosocle_colimit. Qed. Lemma cocone_source_colimit : forall f, has_colimit f -> cocone_source (colimit f) = source f. Proof. ir. uf cocone_source. rww cosocle_colimit. Qed. Lemma cocone_composable_codotted : forall a, is_cocone a -> has_colimit (cosocle a) -> cocone_composable (codotted a) (colimit (cosocle a)). Proof. ir. uf cocone_composable. ee. ap is_colimit_is_cocone. app is_colimit_colimit. rww cocone_target_colimit. rw target_cosocle. app mor_codotted. rww source_codotted. Qed. Lemma cocone_compose_codotted : forall a, is_cocone a -> has_colimit (cosocle a) -> cocone_compose (codotted a) (colimit (cosocle a)) = a. Proof. ir. uf codotted. rww cocone_compose_colimit_to_cocone. app is_colimit_colimit. rww cosocle_colimit. Qed. Lemma codotted_cocone_compose : forall u a, cocone_composable u a -> has_colimit (cosocle a) -> codotted (cocone_compose u a) = comp (cocone_target a) u (codotted a). Proof. ir. uf codotted. rw colimit_to_cocone_cocone_compose. rw cosocle_cocone_compose. rw cocone_target_colimit. rw target_cosocle. reflexivity. am. app is_colimit_colimit. rw cosocle_cocone_compose. am. am. rw cosocle_colimit. rw cosocle_cocone_compose. tv. rww cosocle_cocone_compose. Qed. Lemma colimit_to_cocone_refl : forall a, is_colimit a -> colimit_to_cocone a a = id (cocone_target a) (vertex a). Proof. ir. transitivity (comp (cocone_target a) (colimit_to_cocone a a) (colimit_to_cocone a a)). wr colimit_to_cocone_cocone_compose. rw cocone_compose_colimit_to_cocone. tv. lu. am. tv. lu. app cocone_composable_colimit_to_cocone. lu. tv. rww comp_colimit_to_cocone_inversely. Qed. Lemma codotted_colimit : forall f, Functor.axioms f -> has_colimit f -> codotted (colimit f) = id (target f) (vertex (colimit f)). Proof. ir. uf codotted. rww cosocle_colimit. rw colimit_to_cocone_refl. rw cocone_target_colimit. tv. am. app is_colimit_colimit. Qed. Lemma codotted_unique : forall f u, Functor.axioms f -> has_colimit f -> cocone_composable u (colimit f) -> codotted (cocone_compose u (colimit f)) = u. Proof. ir. rw codotted_cocone_compose. rw codotted_colimit. rw cocone_target_colimit. rw right_id. tv. assert (target f = cocone_target (colimit f)). rww cocone_target_colimit. rw H2. app ob_vertex. ap is_colimit_is_cocone. app is_colimit_colimit. uh H1; ee. rwi cocone_target_colimit H2. am. am. uh H1; ee. am. tv. am. am. am. am. rww cosocle_colimit. Qed. Lemma invertible_codotted_is_colimit : forall a, is_cocone a -> has_colimit (cosocle a) -> invertible (cocone_target a) (codotted a) -> is_colimit a. Proof. ir. assert (a = cocone_compose (codotted a) (colimit (cosocle a)) ). rww cocone_compose_codotted. rw H2. app is_colimit_cocone_compose. app is_colimit_colimit. app cocone_composable_codotted. rw cocone_target_colimit. rw target_cosocle. am. am. Qed. Lemma is_colimit_invertible_codotted : forall a, is_colimit a -> invertible (cocone_target a) (codotted a). Proof. ir. uf codotted. assert (has_colimit (cosocle a)). uhg. sh a. uhg; ee. am. tv. ap invertible_colimit_to_cocone. ap is_colimit_colimit. am. am. rww cosocle_colimit. rw cocone_target_colimit. rww target_cosocle. am. Qed. (**** stuff about functors commuting with colimits ***) Section Cocommutation_Def. Variable f a b: E. Hypothesis cocone_a : is_cocone a. Hypothesis colimit_b : is_colimit b. Hypothesis fsource_cocone_target : source f = cocone_target a. Hypothesis f_functor : Functor.axioms f. Hypothesis compose_ntarg : fcompose f (cosocle a) = cosocle b. Definition cocommutation := colimit_to_cocone b (cocone_pushdown f a). Lemma target_cocommutation : target cocommutation = fob f (vertex a). Proof. uf cocommutation. rw target_colimit_to_cocone. rww vertex_cocone_pushdown. app is_cocone_cocone_pushdown. am. rww cosocle_cocone_pushdown. Qed. Lemma source_cocommutation : source cocommutation = vertex b. Proof. ir. uf cocommutation. rw source_colimit_to_cocone. tv. app is_cocone_cocone_pushdown. am. rww cosocle_cocone_pushdown. Qed. Lemma cocone_target_b : cocone_target b = target f. Proof. uf cocone_target. wr compose_ntarg. rw target_fcompose. tv. Qed. Lemma mor_cocommutation : mor (target f) cocommutation. Proof. uf cocommutation. ap mor_colimit_to_cocone. app is_cocone_cocone_pushdown. am. rww cosocle_cocone_pushdown. rww cocone_target_b. Qed. Lemma cocone_composable_cocommutation : cocone_composable cocommutation b. Proof. uhg; ee. cp colimit_b. uh H; ee. lu. rw cocone_target_b. ap mor_cocommutation. rw source_cocommutation. tv. Qed. Lemma cocone_compose_cocommutation : cocone_compose cocommutation b = cocone_pushdown f a. Proof. uf cocommutation. rw cocone_compose_colimit_to_cocone. tv. app is_cocone_cocone_pushdown. am. rww cosocle_cocone_pushdown. Qed. Lemma invertible_cocommutation_is_colimit_cocone_pushdown : forall c, target f = c -> invertible c cocommutation = is_colimit (cocone_pushdown f a). Proof. ir. wr H. ap iff_eq; ir. wr cocone_compose_cocommutation. app is_colimit_cocone_compose. ap cocone_composable_cocommutation. rww cocone_target_b. uf cocommutation. ap invertible_colimit_to_cocone. am. am. rww cosocle_cocone_pushdown. sy; am. rww cocone_target_b. Qed. End Cocommutation_Def. Section cocone_Pushdown_cocone_Compose. Variables u a f: E. Hypothesis K : is_cocone a. Hypothesis K0 : Functor.axioms f. Hypothesis K1 : source f = cocone_target a. Hypothesis K2 : mor (source f) u. Hypothesis K3 : source u = vertex a. Lemma cocone_composable_u_a : cocone_composable u a. Proof. uhg; ee. am. wr K1; am. am. Qed. Lemma cocone_pushdown_cocone_compose : cocone_pushdown f (cocone_compose u a) = cocone_compose (fmor f u) (cocone_pushdown f a). Proof. ap cocone_extensionality. ap is_cocone_cocone_pushdown. app is_cocone_cocone_compose. ap cocone_composable_u_a. am. rww cocone_target_cocone_compose. app is_cocone_cocone_compose. uhg; ee. app is_cocone_cocone_pushdown. rww cocone_target_cocone_pushdown. app mor_fmor. rww source_fmor. rww vertex_cocone_pushdown. rww K3. rww vertex_cocone_pushdown. rww vertex_cocone_compose. rww vertex_cocone_compose. rww target_fmor. rww cosocle_cocone_pushdown. rww cosocle_cocone_compose. rww cosocle_cocone_compose. rww cosocle_cocone_pushdown. ir. rwi cocone_source_cocone_pushdown H. rwi cocone_source_cocone_compose H. rw coedge_cocone_pushdown. rw coedge_cocone_compose. rw coedge_cocone_compose. rw cocone_target_cocone_pushdown. rw coedge_cocone_pushdown. wr K1. wr comp_fmor. tv. am. am. rw K1. app mor_coedge. rww target_coedge. am. am. rww cocone_source_cocone_pushdown. uhg; ee. app cocone_source_axioms. app ob_is_ob. rww cocone_source_cocone_compose. app is_cocone_cocone_compose. uhg; ee; try am. wrr K1. Qed. End cocone_Pushdown_cocone_Compose. Section cocone_Pushdown_colimit_to_cocone. Variables a b f : E. Hypothesis K : Functor.axioms f. Hypothesis K0 : is_cocone a. Hypothesis K1 : is_colimit b. Hypothesis K2 : cosocle a = cosocle b. Hypothesis K3 : source f = cocone_target b. Hypothesis K4 : is_colimit (cocone_pushdown f b). Lemma cocone_compose_cocone_pushdown_fmor_colimit_to_cocone : cocone_compose (fmor f (colimit_to_cocone b a)) (cocone_pushdown f b) = cocone_pushdown f a. Proof. assert (lem0 : is_cocone b). cp K1. uh H; ee. lu. assert (lem1 : a = cocone_compose (colimit_to_cocone b a) b). rww cocone_compose_colimit_to_cocone. transitivity (cocone_pushdown f (cocone_compose (colimit_to_cocone b a) b)). assert (cocone_pushdown f (cocone_compose (colimit_to_cocone b a) b) = cocone_compose (fmor f (colimit_to_cocone b a)) (cocone_pushdown f b)). rw cocone_pushdown_cocone_compose. reflexivity. am. am. am. app mor_colimit_to_cocone. rww source_colimit_to_cocone. rw H. reflexivity. assert (cocone_compose (colimit_to_cocone b a) b = a). rw cocone_compose_colimit_to_cocone. tv. am. am. am. rw H. reflexivity. Qed. Lemma fmor_colimit_to_cocone : fmor f (colimit_to_cocone b a) = colimit_to_cocone (cocone_pushdown f b) (cocone_pushdown f a). Proof. cp K4. uh H; ee. uh H; ee. assert (is_cocone b). cp K1. uh H2; ee; lu. assert (is_coversal b). cp K1; lu. ap H1. uhg; ee. app is_cocone_cocone_pushdown. rww cocone_target_cocone_pushdown. app mor_fmor. rw K3. app mor_colimit_to_cocone. rww source_fmor. rww vertex_cocone_pushdown. rww source_colimit_to_cocone. rw K3; app mor_colimit_to_cocone. uhg; ee. app is_cocone_cocone_pushdown. rww cocone_target_cocone_pushdown. ap mor_colimit_to_cocone. ap is_cocone_cocone_pushdown. am. am. rw K3. uf cocone_target. rww K2. am. rww cosocle_cocone_pushdown. rw cosocle_cocone_pushdown. rww K2. rww cocone_target_cocone_pushdown. rw source_colimit_to_cocone. tv. app is_cocone_cocone_pushdown. rw K3; uf cocone_target; rww K2. am. rww cosocle_cocone_pushdown. rw cosocle_cocone_pushdown. rww K2. rw cocone_compose_cocone_pushdown_fmor_colimit_to_cocone. sy; rw cocone_compose_colimit_to_cocone. tv. app is_cocone_cocone_pushdown. rw K3; uf cocone_target; rww K2. am. rw cosocle_cocone_pushdown. rw cosocle_cocone_pushdown. rww K2. Qed. End cocone_Pushdown_colimit_to_cocone. Section colimit_Preservation_Invariance. Variables a b f : E. Hypothesis K : Functor.axioms f. Hypothesis K0 : is_colimit a. Hypothesis K1 : is_colimit b. Hypothesis K2 : cosocle a = cosocle b. Hypothesis K3 : source f = cocone_target b. Hypothesis K4 : is_colimit (cocone_pushdown f b). Lemma invertible_colimit_to_cocone_a_b: invertible (source f) (colimit_to_cocone a b). Proof. app invertible_colimit_to_cocone. rw K3; uf cocone_target; rw K2. tv. Qed. Lemma invertible_fmor_ctl : invertible (target f) (fmor f (colimit_to_cocone b a)). Proof. app invertible_fmor. app invertible_colimit_to_cocone. sy; am. sy; am. Qed. Lemma colimit_preservation_invariance : is_colimit (cocone_pushdown f a). Proof. ir. ap (colimit_to_cocone_invertible_is_colimit (a:= (cocone_pushdown f a)) (b:=(cocone_pushdown f b))). am. app is_cocone_cocone_pushdown. cp K0; lu. rw K3; uf cocone_target; rww K2. rw cosocle_cocone_pushdown. rw cosocle_cocone_pushdown. rww K2. wr fmor_colimit_to_cocone. rw cocone_target_cocone_pushdown. ap invertible_fmor_ctl. am. cp K0; lu. am. am. am. am. Qed. End colimit_Preservation_Invariance. Lemma cocone_pushdown_are_inverse_invol : forall a f g, is_cocone a -> are_finverse f g -> source f = cocone_target a -> cocone_pushdown g (cocone_pushdown f a) = a. Proof. ir. ap cocone_extensionality. ap is_cocone_cocone_pushdown. ap is_cocone_cocone_pushdown. am. uh H0; ee; am. am. uh H0; ee; am. rw cocone_target_cocone_pushdown. uh H0; ee; am. am. rw vertex_cocone_pushdown. rw vertex_cocone_pushdown. wr fob_fcompose. uh H0; ee. rw H6. rw fob_fidentity. tv. rw H1. ap ob_vertex. am. uh H0; ee; am. uh H0; ee; am. uh H0; ee; am. rw H1. ap ob_vertex. am. rw cosocle_cocone_pushdown. rw cosocle_cocone_pushdown. wr fcompose_assoc. uh H0; ee. rw H6. rw left_fidentity. tv. ap cosocle_axioms. am. am. uh H0; ee; am. uh H0; ee; am. ap cosocle_axioms. am. uh H0; ee; am. am. ir. rwi cocone_source_cocone_pushdown H2. rwi cocone_source_cocone_pushdown H2. uh H0; ee. rw coedge_cocone_pushdown. rw coedge_cocone_pushdown. wr fmor_fcompose. rw H7. rw fmor_fidentity. tv. rw H1. ap mor_coedge. am. am. am. am. am. rw H1. ap mor_coedge. am. am. am. am. rw cocone_source_cocone_pushdown. am. ap is_cocone_cocone_pushdown. am. am. am. Qed. Lemma are_finverse_preserves_colimits : forall a f g, is_colimit a -> are_finverse f g -> source f = cocone_target a -> is_colimit (cocone_pushdown f a). Proof. ir. uh H0; ee. assert (is_cocone a). uh H; ee. uh H; ee. am. assert (is_cocone (cocone_pushdown f a)). ap is_cocone_cocone_pushdown. am. am. am. assert (lem1 : forall x, ob (source f) x -> fob g (fob f x) = x). ir. wr fob_fcompose. rw H6. rw fob_fidentity. tv. am. am. am. am. am. assert (lem2 : forall x, ob (target f) x -> fob f (fob g x) = x). ir. wr fob_fcompose. rw H5. rw fob_fidentity. tv. rww H4. am. am. am. rww H4. assert (lem3 : forall u, mor (source f) u -> fmor g (fmor f u) = u). ir. wr fmor_fcompose. rw H6. rw fmor_fidentity. tv. am. am. am. am. am. assert (lem4 : forall u, mor (target f) u -> fmor f (fmor g u) = u). ir. wr fmor_fcompose. rw H5. rw fmor_fidentity. tv. rww H4. am. am. am. rww H4. uhg; ee. (**** couni proof *****) uhg; ee. am. ir. uh H9; ee. uh H10; ee. rwi cocone_target_cocone_pushdown H12. rwi cocone_target_cocone_pushdown H14. assert (cocone_pushdown g (cocone_pushdown f a) = a). rw cocone_pushdown_are_inverse_invol. tv. am. uhg; ee; am. am. assert (cocone_compose (fmor g u) a = cocone_compose (fmor g v) a). wr H16. wr cocone_pushdown_cocone_compose. sy; wr cocone_pushdown_cocone_compose. rw H11. reflexivity. am. am. rw cocone_target_cocone_pushdown. am. rww H4. am. ap is_cocone_cocone_pushdown. am. am. am. am. rw cocone_target_cocone_pushdown. am. rw H4. am. am. uh H; ee. uh H; ee. assert (fmor g u = fmor g v). ap H19. uhg; ee. am. wr H1. rw H3. ap mor_fmor. am. rww H4. rw source_fmor. rw H13. rw vertex_cocone_pushdown. rw lem1. tv. rw H1. ap ob_vertex. am. am. rww H4. uhg; ee. am. wr H1. rw H3. ap mor_fmor. am. rw H4. am. rw source_fmor. rw H15. rw vertex_cocone_pushdown. rw lem1. tv. rw H1. ap ob_vertex. am. am. rww H4. am. wr lem4. wr H20. rw lem4. tv. am. am. (***** coversal proof ****) uhg; ee. am. ir. cp H. uh H11. ee. uh H12. ee. util (H13 (cocone_pushdown g b)). ap is_cocone_cocone_pushdown. am. am. uf cocone_target. rw H10. rw cosocle_cocone_pushdown. rw target_fcompose. am. rw cosocle_cocone_pushdown. rw H10. rw cosocle_cocone_pushdown. wr fcompose_assoc. rw H6. rw left_fidentity. tv. app cosocle_axioms. exact H1. am. am. app cosocle_axioms. am. exact H1. nin H14. ee. uh H14; ee. sh (fmor f x). ee. uhg; ee. ap is_cocone_cocone_pushdown. am. am. am. rw cocone_target_cocone_pushdown. ap mor_fmor. am. rw H1. am. rw vertex_cocone_pushdown. rw source_fmor. rww H17. am. rww H1. wr cocone_pushdown_cocone_compose. rw H15. rw cocone_pushdown_are_inverse_invol. tv. am. uhg; ee; am. uf cocone_target. rw H10. rw cosocle_cocone_pushdown. rw target_fcompose. am. am. am. am. rww H1. am. Qed. Lemma has_colimits_over_finverse_invariance : forall a b c, Category.axioms a -> Category.axioms b -> Category.axioms c -> has_colimits_over c a -> (exists f, (exists g, (are_finverse f g & source f = a & target f = b))) -> has_colimits_over c b. Proof. ir. nin H3. nin H3. ee. uhg; ee. ir. uhg; ee. set (k:= fcompose x0 f). uh H3; ee. assert (Functor.axioms k). uf k. ap fcompose_axioms. am. am. rw H11. rw H5. sy; am. assert (source k = c). uf k. rw source_fcompose. am. assert (target k = a). uf k. rw target_fcompose. wr H10. am. assert (fcompose x k = f). uf k. wr fcompose_assoc. rw H12. rw left_fidentity. tv. am. rw H11. rw H5. sy; am. am. am. am. am. rw H11. rw H5. sy; am. uh H2; ee. util (H2 k). am. am. am. uh H18. nin H18. uh H18. ee. sh (cocone_pushdown x x1). uhg; ee. apply are_finverse_preserves_colimits with x0. am. uhg; ee; am. uf cocone_target. rw H19. rw H16. am. rw cosocle_cocone_pushdown. rw H19. am. Qed. End Colimit. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Module Subcategory. Export Nat_Trans. Definition subcategory a (obp morp:E->Prop) := Category.Notations.create (Z (objects a) obp) (Z (morphisms a) morp) (comp a) (id a) (structure a). Lemma is_ob_subcategory : forall a (obp morp:E->Prop) x, is_ob (subcategory a obp morp) x = (is_ob a x & obp x). Proof. ir. uf subcategory. rw is_ob_create. app iff_eq; ir. ee. Ztac. Ztac. ee. Ztac. Qed. Lemma is_mor_subcategory : forall a (obp morp:E->Prop) u, is_mor (subcategory a obp morp) u = (is_mor a u & morp u). Proof. ir. uf subcategory. rw is_mor_create. ap iff_eq; ir. ee. Ztac. Ztac. ee. Ztac. Qed. Lemma structure_subcategory : forall a obp morp, structure (subcategory a obp morp) = structure a. Proof. ir. uf subcategory. rw structure_create. tv. Qed. Definition subcategory_property a (obp morp:E->Prop) := (Category.axioms a) & (forall u v, mor a u -> mor a v -> source u = target v -> morp u -> morp v -> morp (comp a u v)) & (forall x, ob a x -> obp x -> morp (id a x)) & (forall u, mor a u -> morp u -> obp (source u)) & (forall u, mor a u -> morp u -> obp (target u)). Lemma subcategory_axioms : forall a obp morp, subcategory_property a obp morp -> Category.axioms (subcategory a obp morp). Proof. ir. cp H. uh H0; ee. uf subcategory. ap Category.create_axioms. uhg; ee; ir. ap iff_eq; ir. Ztac. assert (ob a x). app is_ob_ob. uhg; ee. Ztac. ap Z_inc. ap mor_is_mor. app mor_id. app H2. rww source_id. rww target_id. uh H5; ee. ap Z_inc. pose (Z_all H5). ee. am. pose (Z_all H5); ee. am. ap iff_eq; ir. Ztac. assert (mor a u). ap is_mor_mor. am. am. uhg; ee. app Z_inc. app Z_inc. ap ob_is_ob. rww ob_source. app H3. ap Z_inc. ap ob_is_ob. rww ob_target. app H4. rww right_id. rww ob_source. rww left_id. rww ob_target. apply mor_arrow_like with a. am. uh H5; ee. pose (Z_all H5). ee. Ztac. Ztac. clear H6. Ztac. clear H5. assert (mor a u). app is_mor_mor. assert (mor a v). app is_mor_mor. uhg; ee. Ztac. Ztac. am. Ztac. ap mor_is_mor. rww mor_comp. rww source_comp. rww target_comp. assert (mor a u). pose (Z_all H5); ee; app is_mor_mor. assert (mor a v). pose (Z_all H6); ee; app is_mor_mor. assert (mor a w). pose (Z_all H7); ee; app is_mor_mor. rww assoc. Qed. Lemma ob_subcategory : forall a obp morp x, subcategory_property a obp morp -> ob (subcategory a obp morp) x = (ob a x & obp x). Proof. ir. app iff_eq; ir. assert (is_ob (subcategory a obp morp) x). app ob_is_ob. rwi is_ob_subcategory H1. xd. app is_ob_ob. uh H; ee; am. ap is_ob_ob. app subcategory_axioms. rw is_ob_subcategory. xd. app ob_is_ob. Qed. Lemma mor_subcategory : forall a obp morp u, subcategory_property a obp morp -> mor (subcategory a obp morp) u = (mor a u & morp u). Proof. ir. app iff_eq; ir. assert (is_mor (subcategory a obp morp) u). app mor_is_mor. rwi is_mor_subcategory H1. xd. app is_mor_mor. uh H; ee; am. ap is_mor_mor. app subcategory_axioms. rw is_mor_subcategory. xd. app mor_is_mor. Qed. Definition is_subcategory a b := Category.axioms a & Category.axioms b & structure a = structure b & (forall x, ob a x -> ob b x) & (forall u, mor a u -> mor b u) & (forall u v, mor a u -> mor a v -> source u = target v -> comp a u v = comp b u v) & (forall x, ob a x -> id a x = id b x). (**** remark (2 sep 04): it is necessary to include the condition about identity elements. To see this (we give the informal proof rather than a construction in coq) look at the example of a category with one object and two morphisms, one of which is an idempotent and the other is the identity. For example, the identity and an orthogonal projection matrix. The sub-semicategory consisting of the same object and just the idempotent is itself a category and satisfies the other conditions but the identities are not the same so it isn't a subcategory (and the inclusion isn't a functor). ****) Lemma is_subcategory_mor : forall b u, (exists a, is_subcategory a b & mor a u) -> mor b u. Proof. ir. nin H. ee. uh H; ee. au. Qed. Lemma is_subcategory_ob: forall b x, (exists a, is_subcategory a b & ob a x) -> ob b x. Proof. ir. nin H. ee. uh H; ee. au. Qed. Lemma is_subcategory_same_id : forall a b, is_subcategory a b -> (forall x, ob a x -> id a x = id b x). Proof. ir. uh H; ee. au. Qed. Lemma is_subcategory_same_comp : forall a b, is_subcategory a b -> (forall u v, mor a u -> mor a v -> source u = target v -> comp a u v = comp b u v). Proof. ir. uh H; ee. au. Qed. Lemma id_subcategory : forall a obp morp x, subcategory_property a obp morp -> ob a x -> obp x -> id (subcategory a obp morp) x = id a x. Proof. ir. uf subcategory. rw id_create. tv. Ztac. ap ob_is_ob. am. Qed. Lemma comp_subcategory : forall a obp morp u v, subcategory_property a obp morp -> mor a u -> mor a v -> source u = target v -> morp u -> morp v -> comp (subcategory a obp morp) u v = comp a u v. Proof. ir. uf subcategory. rw comp_create. tv. Ztac. app mor_is_mor. Ztac. app mor_is_mor. am. Qed. Lemma is_subcategory_property : forall a b, is_subcategory a b -> subcategory_property b (ob a) (mor a). Proof. ir. cp H. uh H; ee. uhg; ee. am. ir. wr H5. rww mor_comp. am. am. am. ir. wr (is_subcategory_same_id H0). app mor_id. am. ir. rww ob_source. ir. rww ob_target. Qed. Lemma subcategory_is_subcategory : forall a obp morp, subcategory_property a obp morp -> is_subcategory (subcategory a obp morp) a. Proof. ir. cp H. uh H0; ee. uhg; ee. app subcategory_axioms. am. rww structure_subcategory. ir. rwi ob_subcategory H5. ee; am. am. ir. rwi mor_subcategory H5. ee; am. am. ir. rwi mor_subcategory H5. rwi mor_subcategory H6. ee. rww comp_subcategory. am. am. ir. rwi ob_subcategory H5. ee. rww id_subcategory. am. Qed. Lemma is_subcategory_refl : forall a, Category.axioms a -> is_subcategory a a. Proof. ir. uhg; ee. am. am. tv. ir; am. ir; am. ir; tv. ir; tv. Qed. Lemma is_subcategory_trans : forall a b c, is_subcategory a b -> is_subcategory b c -> is_subcategory a c. Proof. ir. uh H; uh H0; ee. uhg; ee; try am; try tv. transitivity (structure b); try am; try (sy; am). ir. au. ir. au. ir. rww H11. rww H5. au. au. ir. rww H12. rww H6. au. Qed. Lemma is_subcategory_extensionality : forall a b, is_subcategory a b -> is_subcategory b a -> a = b. Proof. ir. cp H. cp H0. uh H; uh H0; ee. uh H; uh H9; ee. rw H22. sy. rw H18. ap Notations.create_extensionality. ap extensionality; uhg; ir. ap ob_is_ob. ap H5. app is_ob_ob. ap ob_is_ob. ap H11. app is_ob_ob. ap extensionality; uhg; ir. ap mor_is_mor. ap H6. app is_mor_mor. ap mor_is_mor. ap H12. app is_mor_mor. ir. app H7. app is_mor_mor. app is_mor_mor. ir. app H8. app is_ob_ob. am. Qed. Lemma is_subcategory_eq : forall a b, is_subcategory a b -> subcategory b (ob a) (mor a) = a. Proof. ir. assert (lem1 : subcategory_property b (ob a) (mor a)). app is_subcategory_property. cp H. uh H0; ee. ap is_subcategory_extensionality. uhg; ee. app subcategory_axioms. am. rww structure_subcategory. sy; am. ir. rwi ob_subcategory H7; ee. am. am. ir. rwi mor_subcategory H7; ee; am. ir. rwi mor_subcategory H7; rwi mor_subcategory H8; ee. rw comp_subcategory. sy; app H5. am. am. am. am. am. am. am. am. am. ir. rwi ob_subcategory H7; ee. rww id_subcategory. sy; app H6. am. uhg; ee. am. app subcategory_axioms. rww structure_subcategory. ir. rww ob_subcategory; ee; try am. au. ir. rww mor_subcategory; ee; au. ir. rww comp_subcategory. au. au. au. ir. rww id_subcategory. au. au. Qed. Lemma source_inclusion : forall a b, source (inclusion a b) = a. Proof. ir. uf inclusion. rww Umorphism.source_create. Qed. Lemma target_inclusion : forall a b, target (inclusion a b) = b. Proof. ir. uf inclusion. rww Umorphism.target_create. Qed. Lemma fmor_inclusion : forall a b u, mor a u -> fmor (inclusion a b) u = u. Proof. ir. uf inclusion. uf fmor. rww Umorphism.ev_create. change (is_mor a u). app mor_is_mor. Qed. Lemma fob_inclusion : forall a b x, ob a x -> fob (inclusion a b) x = x. Proof. ir. uf fob. rw source_inclusion. rww fmor_inclusion. rww source_id. app mor_id. Qed. Lemma subcategory_inclusion_axioms : forall a b, is_subcategory a b -> Functor.axioms (Umorphism.inclusion a b). Proof. ir. uh H; ee. uhg; ee. uf inclusion. app Umorphism.create_like. rww source_inclusion. rww target_inclusion. ir. rw target_inclusion. rwi source_inclusion H6. rww fob_inclusion. au. ir. rwi source_inclusion H6. rw target_inclusion. rww fob_inclusion. rw source_inclusion. rww fmor_inclusion. sy; au. app mor_id. ir. rwi source_inclusion H6. rw target_inclusion. rww fmor_inclusion. au. ir. rwi source_inclusion H6. rww fmor_inclusion. rww fob_inclusion. rww ob_source. ir. rwi source_inclusion H6. rww fmor_inclusion. rww fob_inclusion. rww ob_target. ir. rwi source_inclusion H6. rwi source_inclusion H7. rw target_inclusion. rww fmor_inclusion. rww fmor_inclusion. rww source_inclusion. rww fmor_inclusion. sy; au. rww mor_comp. Qed. Lemma subcategory_inclusion_refl : forall a, Category.axioms a -> Umorphism.inclusion a a = fidentity a. Proof. ir. reflexivity. Qed. Lemma umorphism_create_extensionality : forall a b f a1 b1 f1, a = a1 -> b = b1 -> (forall x, inc x (U a) -> inc (f x) (U b)) -> (forall x, inc x (U a) -> f x = f1 x) -> Umorphism.create a b f = Umorphism.create a1 b1 f1. Proof. ir. assert (Umorphism.property a b f). uhg; ee. uhg; ee. am. assert (Umorphism.property a1 b1 f1). wr H. wr H0. uhg. uhg. ir. wr H2. au. am. ap Umorphism.extens. ap create_strong_axioms. am. ap create_strong_axioms. am. rw Umorphism.source_create. rww Umorphism.source_create. rww Umorphism.target_create. rww Umorphism.target_create. ir. rwi Umorphism.source_create H5. rwi Umorphism.source_create H6. rww ev_create. rww ev_create. au. Qed. Lemma subcategory_inclusion_trans : forall a b c, is_subcategory a b -> is_subcategory b c -> fcompose (Umorphism.inclusion b c) (Umorphism.inclusion a b) = Umorphism.inclusion a c. Proof. ir. uf fcompose. uf compose. rw source_inclusion. rw target_inclusion. uf inclusion. assert (sub (U a) (U b)). uhg; ir. uh H; ee. change (is_mor b x). app mor_is_mor. ap H5. app is_mor_mor. assert (sub (U b) (U c)). uhg; ir. uh H0; ee. change (is_mor c x). app mor_is_mor. ap H6. app is_mor_mor. assert (sub (U a) (U c)). apply sub_trans with (U b); try am. app umorphism_create_extensionality. ir. cp (H1 _ H4). cp (H3 _ H4). rww ev_create. rww ev_create. rww ev_create. ir. cp (H1 _ H4). cp (H3 _ H4). rww ev_create. rww ev_create. rww ev_create. Qed. Lemma subcategory_all_criterion : forall a b, is_subcategory a b -> (forall u, mor b u -> mor a u) -> a = b. Proof. ir. ap is_subcategory_extensionality. am. uhg; dj. uh H; ee; am. uh H; ee; am. uh H; ee; sy; am. ir. assert (x = source (id b x)). rww source_id. rw H5. rw ob_source. tv. ap H0. app mor_id. ap H0; am. sy. ap is_subcategory_same_comp. am. app H5. app H5. am. sy. ap is_subcategory_same_id. am. au. Qed. End Subcategory. Export Subcategory. Module From_Arrows. Export Nat_Trans. Section Construction. Variable obs : E. Variable homs : E -> E -> E. Variable comps : E -> E -> E. Variable ids : E -> E. Definition morphism_set_pool := Image.create (Cartesian.product obs obs) (fun q => homs (pr1 q) (pr2 q)). Lemma inc_morphism_set_pool : forall r, inc r morphism_set_pool = exists a, exists b, (inc a obs & inc b obs & r = (homs a b)). Proof. ir. uf morphism_set_pool. rw Image.inc_rw. app iff_eq; ir. nin H; ee. sh (pr1 x). sh (pr2 x). ee; try (sy; am). cp (Cartesian.product_pr H). ee. am. cp (Cartesian.product_pr H). ee. am. nin H. nin H. sh (pair x x0). ee. ap Cartesian.product_pair_inc. am. am. rw pr1_pair. rw pr2_pair. sy; am. Qed. Definition morphism_set := union morphism_set_pool. Lemma inc_morphism_set1 : forall r, inc r morphism_set = exists a, exists b, (inc a obs & inc b obs & inc r (homs a b)). Proof. ir. ap iff_eq; ir. ufi morphism_set H. nin (union_exists H). ee. rwi inc_morphism_set_pool H1. nin H1. nin H1. ee. sh x0. sh x1. ee; try am. wrr H3. nin H. nin H. ee. uf morphism_set. apply union_inc with (homs x x0). am. rw inc_morphism_set_pool. sh x. sh x0. ee; try am; try tv. Qed. Definition property := (forall a b u, inc u (homs a b) -> source u = a) & (forall a b u, inc u (homs a b) -> target u = b) & (forall a b u, inc u (homs a b) -> Arrow.like u) & (forall a b c u v, inc a obs -> inc b obs -> inc c obs -> inc u (homs b c) -> inc v (homs a b) -> inc (comps u v) (homs a c)) & (forall a, inc a obs -> inc (ids a) (homs a a)) & (forall a b u, inc a obs -> inc b obs -> inc u (homs a b) -> comps u (ids a) = u) & (forall a b u, inc a obs -> inc b obs -> inc u (homs a b) -> comps (ids b) u = u) & (forall a b c d u v w, inc a obs -> inc b obs -> inc c obs -> inc d obs -> inc u (homs c d) -> inc v (homs b c) -> inc w (homs a b) -> comps u (comps v w) = comps (comps u v) w). Hypothesis property_hyp : property. Lemma inc_morphism_set : forall r, inc r morphism_set = (inc (source r) obs & inc (target r) obs & inc r (homs (source r) (target r))). Proof. ir. cp property_hyp. uh H; ee. ap iff_eq; ir. rwi inc_morphism_set1 H7. nin H7. nin H7. ee. rww (H _ _ _ H9). rww (H0 _ _ _ H9). rww (H _ _ _ H9). rww (H0 _ _ _ H9). ee. rw inc_morphism_set1. sh (source r). sh (target r). ee; try am. Qed. Definition from_arrows := Category.Notations.create obs morphism_set comps ids emptyset. Lemma structure_from_arrows : structure from_arrows = emptyset. Proof. uf from_arrows. rww structure_create. Qed. Lemma is_ob_from_arrows : forall x, is_ob from_arrows x = inc x obs. Proof. ir. ap iff_eq; ir. ufi from_arrows H. rwi is_ob_create H. am. uf from_arrows. rww is_ob_create. Qed. Lemma is_mor_from_arrows : forall u, is_mor from_arrows u = (is_ob from_arrows (source u) & is_ob from_arrows (target u) & inc u (homs (source u) (target u))). Proof. ir. ap iff_eq; ir. ufi from_arrows H. rwi is_mor_create H. rwi inc_morphism_set H. xd. rww is_ob_from_arrows. rww is_ob_from_arrows. uf from_arrows; rw is_mor_create. rw inc_morphism_set. xd. rwi is_ob_from_arrows H; am. rwi is_ob_from_arrows H0; am. Qed. Lemma is_mor_from_arrows2 : forall u, is_mor from_arrows u = inc u morphism_set. Proof. ir. ap iff_eq; ir. ufi from_arrows H. rwi is_mor_create H. am. uf from_arrows; rww is_mor_create. Qed. Lemma comp_from_arrows : forall u v, is_mor from_arrows u -> is_mor from_arrows v -> source u = target v -> comp from_arrows u v = comps u v. Proof. ir. uf from_arrows. rw comp_create. tv. rwi is_mor_from_arrows2 H; am. rwi is_mor_from_arrows2 H0; am. am. Qed. Lemma id_from_arrows : forall x, is_ob from_arrows x -> id from_arrows x = ids x. Proof. ir. uf from_arrows. rww id_create. rwi is_ob_from_arrows H; am. Qed. Lemma inc_homs_is_mor : forall u, (exists a, exists b, (inc a obs & inc b obs & inc u (homs a b)))-> is_mor from_arrows u. Proof. ir. nin H. nin H. ee. rw is_mor_from_arrows2. rw inc_morphism_set1. sh x. sh x0. ee; am. Qed. Lemma inc_homs_source : forall a u, is_ob from_arrows a -> (exists b, (is_ob from_arrows b & inc u (homs a b))) -> source u = a. Proof. ir. nin H0. ee. rwi is_ob_from_arrows H. rwi is_ob_from_arrows H0. cp property_hyp. uh H2; ee. exact (H2 _ _ _ H1). Qed. Lemma inc_homs_target : forall a u, is_ob from_arrows a -> (exists b, (is_ob from_arrows b & inc u (homs b a))) -> target u = a. Proof. ir. nin H0. ee. rwi is_ob_from_arrows H. rwi is_ob_from_arrows H0. cp property_hyp. uh H2; ee. exact (H3 _ _ _ H1). Qed. Lemma source_ids : forall x, inc x obs -> source (ids x) = x. Proof. ir. cp property_hyp. uh H0; ee. cp (H4 _ H). exact (H0 _ _ _ H8). Qed. Lemma target_ids : forall x, inc x obs -> target (ids x) = x. Proof. ir. cp property_hyp. uh H0; ee. cp (H4 _ H). exact (H1 _ _ _ H8). Qed. Lemma is_mor_id_from_arrows : forall x, is_ob from_arrows x -> is_mor from_arrows (id from_arrows x). Proof. ir. cp H. cp property_hyp. rwi is_ob_from_arrows H0. uh H1; ee. rw is_mor_from_arrows. rww id_from_arrows. rww source_ids. rww target_ids. ee; try am. app H5. Qed. Lemma source_id_from_arrows : forall x, is_ob from_arrows x -> source (id from_arrows x) = x. Proof. ir. rww id_from_arrows. rww source_ids. wrr is_ob_from_arrows. Qed. Lemma target_id_from_arrows : forall x, is_ob from_arrows x -> target (id from_arrows x) = x. Proof. ir. rww id_from_arrows. rww target_ids. wrr is_ob_from_arrows. Qed. Lemma left_id_from_arrows : forall u, is_mor from_arrows u -> comp from_arrows (id from_arrows (target u)) u = u. Proof. ir. cp property_hyp. cp H. rwi is_mor_from_arrows H1. ee. cp H1; cp H2. rwi is_ob_from_arrows H4; rwi is_ob_from_arrows H5. rww comp_from_arrows. rww id_from_arrows. uh H0; ee. apply H11 with (source u). am. am. am. app is_mor_id_from_arrows. rww source_id_from_arrows. Qed. Lemma right_id_from_arrows : forall u, is_mor from_arrows u -> comp from_arrows u (id from_arrows (source u)) = u. Proof. ir. cp property_hyp. cp H. rwi is_mor_from_arrows H1. ee. cp H1; cp H2. rwi is_ob_from_arrows H4; rwi is_ob_from_arrows H5. rww comp_from_arrows. rww id_from_arrows. uh H0; ee. apply H10 with (target u). am. am. am. app is_mor_id_from_arrows. rww target_id_from_arrows. Qed. Lemma from_arrows_axioms : Category.axioms from_arrows. Proof. uhg; ee; ir. ap iff_eq; ir. uhg; ee. am. app is_mor_id_from_arrows. rww source_id_from_arrows. rww target_id_from_arrows. ir. wr H1. rww right_id_from_arrows. ir. wr H1. rww left_id_from_arrows. uh H; ee; am. ap iff_eq; ir. uhg; ee. am. rwi is_mor_from_arrows H. ee; am. rwi is_mor_from_arrows H. ee; am. rww left_id_from_arrows. rww right_id_from_arrows. rwi is_mor_from_arrows H; ee. cp property_hyp. uh H2; ee. exact (H4 _ _ _ H1). uh H; ee; am. ap iff_eq; ir. assert (lema : are_composable from_arrows u v). am. uh H; ee. rwi is_mor_from_arrows H. rwi is_mor_from_arrows H0. ee. cp property_hyp. uh H6; ee. util (H9 (source v) (source u) (target u) u v). wrr is_ob_from_arrows. wrr is_ob_from_arrows. wrr is_ob_from_arrows. am. rww H1. util (inc_homs_source (a:= (source v)) (u:= (comps u v))). am. sh (target u). ee; am. util (inc_homs_target (a:= (target u)) (u:= (comps u v))). am. sh (source v). ee; am. assert (is_mor from_arrows u). rw is_mor_from_arrows; ee; am. assert (is_mor from_arrows v). rw is_mor_from_arrows; ee; am. uhg; ee. am. rw is_mor_from_arrows; ee. rw is_ob_from_arrows. rww comp_from_arrows. rw H15. wrr is_ob_from_arrows. rww comp_from_arrows. rw H16. am. rww comp_from_arrows. rw H15. rw H16. am. rww comp_from_arrows. rww comp_from_arrows. uh H; ee; am. uh H; uh H0; ee. cp H; cp H3; cp H1. rwi is_mor_from_arrows H5; rwi is_mor_from_arrows H6; rwi is_mor_from_arrows H7; ee. cp property_hyp. uh H14; ee. util (H17 (source v) (source u) (target u) u v). wrr is_ob_from_arrows. wrr is_ob_from_arrows. wrr is_ob_from_arrows. am. rww H4. util (H17 (source w) (source v) (source u) v w). wrr is_ob_from_arrows. wrr is_ob_from_arrows. wrr is_ob_from_arrows. rww H4. rww H2. sy. rww comp_from_arrows. rww comp_from_arrows. rww comp_from_arrows. rww comp_from_arrows. apply H21 with (source w) (source v) (source u) (target u). wrr is_ob_from_arrows. wrr is_ob_from_arrows. wrr is_ob_from_arrows. wrr is_ob_from_arrows. am. rww H4. rww H2. rww comp_from_arrows. ap inc_homs_is_mor. sh (source v). sh (target u). ee. wrr is_ob_from_arrows. wrr is_ob_from_arrows. am. ap inc_homs_source. am. sh (target u). ee; try am. wrr H2. rww comp_from_arrows. rww comp_from_arrows. ap inc_homs_is_mor. sh (source w); sh (source u). ee. wrr is_ob_from_arrows. wrr is_ob_from_arrows. am. sy; ap inc_homs_target. am. sh (source w). ee; try am. rww comp_from_arrows. uf from_arrows. ap Notations.create_like. Qed. Lemma ob_from_arrows : forall x, ob from_arrows x = inc x obs. Proof. ir. ap iff_eq; ir. wrr is_ob_from_arrows. app ob_is_ob. wri is_ob_from_arrows H. app is_ob_ob. ap from_arrows_axioms. Qed. Lemma mor_from_arrows : forall u, mor from_arrows u = (ob from_arrows (source u) & ob from_arrows (target u) & inc u (homs (source u) (target u))). Proof. ir. cp from_arrows_axioms. ap iff_eq; ir. assert (is_mor from_arrows u). app mor_is_mor. rwi is_mor_from_arrows H1. ee; try am. app is_ob_ob. app is_ob_ob. ap is_mor_mor. ap from_arrows_axioms. rww is_mor_from_arrows. ee; try am. app ob_is_ob. app ob_is_ob. Qed. End Construction. End From_Arrows. Export From_Arrows. Module Function_Cat. Export Function_Set. Export Nat_Trans. Definition function_arrow_set a b := Image.create (function_set a (fun x:E => b)) (fun u => Arrow.create a b u). Lemma inc_function_arrow_set : forall a b u, inc u (function_arrow_set a b) = (Arrow.like u & source u = a & target u = b & Function.axioms (arrow u) & Function.domain (arrow u) = a & sub (Function.range (arrow u)) b & Map.axioms a b (arrow u)). Proof. ir. ap iff_eq; ir. ufi function_arrow_set H. rwi Image.inc_rw H. nin H. dj; ee; cp (function_set_pr H); ee. wr H0. rww Arrow.create_like. wr H1. rww Arrow.source_create. wr H2. rww Arrow.target_create. wr H3. rw Arrow.arrow_create. am. wr H4. rw Arrow.arrow_create. am. wr H5. rw Arrow.arrow_create. uhg; ir. nin (range_ex H7 H10). ee. wr H12. ap H9. wrr H8. uhg; ee. am. am. am. ee. uf function_arrow_set. rw Image.inc_rw. sh (arrow u). ee. ap function_set_inc. am. am. ir. ap H4. ap range_inc. am. sh y. ee; try tv; try am. rww H3. uh H. wr H0. wr H1. sy; am. Qed. Definition fa_comp u v := Arrow.create (source v) (target u) (Function.compose (arrow u) (arrow v)). Definition fa_id x := Arrow.create x x (Function.identity x). Lemma source_fa_comp : forall u v, source (fa_comp u v) = source v. Proof. ir. uf fa_comp. rww Arrow.source_create. Qed. Lemma target_fa_comp : forall u v, target (fa_comp u v) = target u. Proof. ir. uf fa_comp. rww Arrow.target_create. Qed. Lemma arrow_fa_comp : forall u v, arrow (fa_comp u v) = Function.compose (arrow u) (arrow v). Proof. ir. uf fa_comp. rww Arrow.arrow_create. Qed. Lemma arrow_fa_id : forall x, arrow (fa_id x) = Function.identity x. Proof. ir. uf fa_id. rww Arrow.arrow_create. Qed. Lemma source_fa_id : forall x, source (fa_id x) = x. Proof. ir. uf fa_id. rww Arrow.source_create. Qed. Lemma target_fa_id : forall x, target (fa_id x) = x. Proof. ir. uf fa_id. rww Arrow.target_create. Qed. Lemma inc_fas_fa_id : forall x, inc (fa_id x) (function_arrow_set x x). Proof. ir. rw inc_function_arrow_set. dj. uf fa_id. rww Arrow.create_like. rww source_fa_id. rww target_fa_id. rw arrow_fa_id. ap Function.identity_axioms. rw arrow_fa_id. rww Function.identity_domain. rw arrow_fa_id. uhg; ir. util (range_ex (f:= Function.identity x) (y:= x0)). ap Function.identity_axioms. am. nin H5. ee. ufi Function.identity H6. rwi create_V_rewrite H6. wrr H6. rwi Function.identity_domain H5. am. rwi Function.identity_domain H5. am. uhg; ee; am. Qed. Lemma inc_fas_fa_comp : forall a b u v, inc u (function_arrow_set (source u) (target u)) -> inc v (function_arrow_set (source v) (target v)) -> source u = target v -> a = source v -> b = target u -> inc (fa_comp u v) (function_arrow_set a b). Proof. ir. rw H2; rw H3. clear H2; clear H3. rwi inc_function_arrow_set H. rwi inc_function_arrow_set H0. ee. assert (Map.axioms (source v) (target u) (arrow (fa_comp u v))). rw arrow_fa_comp. apply Map.compose_axioms with (source u). am. rww H1. rw inc_function_arrow_set. ee. uf fa_comp. rww Arrow.create_like. rww source_fa_comp. rww target_fa_comp. uh H14; ee; am. uh H14; ee; am. uh H14; ee; am. am. Qed. Lemma fa_extensionality : forall u v, inc u (function_arrow_set (source u) (target u)) -> inc v (function_arrow_set (source v) (target v)) -> source u = source v -> target u = target v -> (forall x, inc x (source u) -> V x (arrow u) = V x (arrow v)) -> u = v. Proof. ir. rwi inc_function_arrow_set H; rwi inc_function_arrow_set H0; ee. uh H; uh H0. rw H. rw H0. rw H1. rw H2. ap uneq. ap function_extensionality. am. am. ir. ufi defined H16. ee. uhg; ee. am. rwi H13 H17. rw H7. wrr H1. ir. ufi defined H16. ee. uhg; ee. am. rwi H7 H17. rw H13. rww H1. ir. ap H3. uh H16; ee. wrr H13. Qed. Lemma map_V_inc : forall f x b, (exists a, (Map.axioms a b f & inc x a)) -> inc (V x f) b. Proof. ir. nin H. ee. uh H; ee. ap H2. ap range_inc. am. sh x. ee. rww H1. tv. Qed. Lemma V_fa_comp : forall u v x, inc u (function_arrow_set (source u) (target u)) -> inc v (function_arrow_set (source v) (target v)) -> source u = target v -> inc x (source v) -> V x (arrow (fa_comp u v)) = V (V x (arrow v)) (arrow u). Proof. ir. rw arrow_fa_comp. rw compose_ev. tv. assert (inc (fa_comp u v) (function_arrow_set (source v) (target u))). ap inc_fas_fa_comp. am. am. am. tv. tv. rwi inc_function_arrow_set H3. ee. wr arrow_fa_comp. rw H7. am. Qed. Lemma V_fa_id : forall x y, inc x y -> V x (arrow (fa_id y)) = x. Proof. ir. rw arrow_fa_id. uf Function.identity. rw create_V_rewrite. tv. am. Qed. Lemma function_cat_property : forall z, From_Arrows.property z function_arrow_set fa_comp fa_id. Proof. ir. uhg; ee; ir. rwi inc_function_arrow_set H. ee; am. rwi inc_function_arrow_set H. ee; am. rwi inc_function_arrow_set H. ee; am. rwi inc_function_arrow_set H2. rwi inc_function_arrow_set H3. ee. rw inc_function_arrow_set. ee. uf fa_comp. rww Arrow.create_like. rww source_fa_comp. rww target_fa_comp. rw arrow_fa_comp. ap Function.compose_axioms. assert (Map.axioms a c (arrow (fa_comp u v))). rw arrow_fa_comp. apply Map.compose_axioms with b. am. am. uh H16; ee. am. assert (Map.axioms a c (arrow (fa_comp u v))). rw arrow_fa_comp. apply Map.compose_axioms with b. am. am. uh H16; ee. am. rw arrow_fa_comp. apply Map.compose_axioms with b. am. am. assert (Map.axioms a a (arrow (fa_id a))). rw arrow_fa_id. ap Map.identity_axioms. rw inc_function_arrow_set. ee. uf fa_id. rww Arrow.create_like. rww source_fa_id. rww target_fa_id. uh H0; ee. am. uh H0; ee; am. uh H0; ee; am. am. cp H1. rwi inc_function_arrow_set H2; ee. ap fa_extensionality. ap inc_fas_fa_comp. rw H3; rww H4. rw source_fa_id. rw target_fa_id. ap inc_fas_fa_id. rww target_fa_id. rww source_fa_comp. rww target_fa_comp. rw H3; rww H4. rw source_fa_comp. rww source_fa_id. sy; am. rww target_fa_comp. assert (inc (fa_comp u (fa_id a)) (function_arrow_set (source u) (target u))). ap inc_fas_fa_comp. rw H3; rww H4. rw source_fa_id. rw target_fa_id. ap inc_fas_fa_id. rww target_fa_id. rww source_fa_id. tv. cp H9. rwi inc_function_arrow_set H10; ee. ir. rw arrow_fa_comp. rw arrow_fa_id. rw compose_ev. uf Function.identity. rw create_V_rewrite. tv. rwi source_fa_comp H17. rwi source_fa_id H17. am. rwi source_fa_comp H17. rwi source_fa_id H17. rwi arrow_fa_comp H14. rwi arrow_fa_id H14. rw H14. rww H3. cp H1. rwi inc_function_arrow_set H2. ee. assert (inc (fa_comp (fa_id b) u) (function_arrow_set (source u) (target u))). ap inc_fas_fa_comp. rw source_fa_id. rw target_fa_id. ap inc_fas_fa_id. rw H3; rww H4. rw source_fa_id. sy; am. tv. rw target_fa_id. am. cp H9. rwi inc_function_arrow_set H10; ee. ap fa_extensionality. rw source_fa_comp. rw target_fa_comp. rw target_fa_id. ap inc_fas_fa_comp. rw source_fa_id. rw target_fa_id. ap inc_fas_fa_id. rw H3; rww H4. rww source_fa_id. sy; am. tv. sy; rww target_fa_id. rw H3; rww H4. rww source_fa_comp. rw target_fa_comp. rw target_fa_id. sy; am. ir. rw arrow_fa_comp. rw arrow_fa_id. rw compose_ev. uf Function.identity. rw create_V_rewrite. tv. rwi source_fa_comp H17. wr H4. ap map_V_inc. sh a. ee. rww H4. wrr H3. wr arrow_fa_id. wr arrow_fa_comp. rw H14. rwi source_fa_comp H17. am. cp H3; cp H4; cp H5. rwi inc_function_arrow_set H6. rwi inc_function_arrow_set H7. rwi inc_function_arrow_set H8. ee. wri H21 H3; wri H22 H3. wri H15 H4; wri H16 H4. wri H9 H5; wri H10 H5. assert (source u = target v). rw H21; rww H16. assert (source v = target w). rw H15; rww H10. assert (inc (fa_comp v w) (function_arrow_set a c)). app inc_fas_fa_comp. sy; am. sy; am. assert (inc (fa_comp u v) (function_arrow_set b d)). app inc_fas_fa_comp. sy; am. sy; am. ap fa_extensionality. ap inc_fas_fa_comp. am. app inc_fas_fa_comp. rww source_fa_comp. rww target_fa_comp. rww target_fa_comp. rw source_fa_comp. tv. rw target_fa_comp. tv. ap inc_fas_fa_comp. ap inc_fas_fa_comp. am. am. am. rww source_fa_comp. rww target_fa_comp. am. rww source_fa_comp. rww source_fa_comp. rww target_fa_comp. rw source_fa_comp. rw source_fa_comp. rw source_fa_comp. tv. rw target_fa_comp. rw target_fa_comp. rw target_fa_comp. tv. ir. rw V_fa_comp. rw V_fa_comp. rw V_fa_comp. rw V_fa_comp. tv. am. am. am. uh H14; ee. rw H15. ap H33. ap range_inc. am. sh x. ee. rwi source_fa_comp H31. rwi source_fa_comp H31. rw H12. wrr H9. tv. rw source_fa_comp. rw target_fa_comp. rw H15. rww H22. am. rww source_fa_comp. rwi source_fa_comp H31. rwi source_fa_comp H31. am. am. am. am. rwi source_fa_comp H31. rwi source_fa_comp H31. am. am. rw source_fa_comp. rw target_fa_comp. rw H9; rww H16. rww target_fa_comp. rwi source_fa_comp H31. am. Qed. Definition function_cat z := From_Arrows.from_arrows z function_arrow_set fa_comp fa_id. Lemma function_cat_axioms : forall z, Category.axioms (function_cat z). Proof. ir. uf function_cat. ap From_Arrows.from_arrows_axioms. ap function_cat_property. Qed. Lemma ob_function_cat : forall z x, ob (function_cat z) x = inc x z. Proof. ir. uf function_cat. rww ob_from_arrows. ap function_cat_property. Qed. Lemma mor_function_cat1 : forall z u, mor (function_cat z) u = (Arrow.like u & inc (source u) z & inc (target u) z & inc u (function_arrow_set (source u) (target u))). Proof. ir. ap iff_eq. ir. ufi function_cat H. rwi mor_from_arrows H. ee. rwi inc_function_arrow_set H1. ee; am. rwi ob_from_arrows H. am. ap function_cat_property. rwi ob_from_arrows H0. am. ap function_cat_property. am. ap function_cat_property. ir. ee. uf function_cat. rw mor_from_arrows. ee. rw ob_from_arrows. am. ap function_cat_property. rw ob_from_arrows. am. ap function_cat_property. am. ap function_cat_property. Qed. Lemma mor_function_cat2 : forall z u, mor (function_cat z) u = (Arrow.like u & inc (source u) z & inc (target u) z & Map.axioms (source u) (target u) (arrow u)). Proof. ir. rw mor_function_cat1. ap iff_eq; ir; xd. rwi inc_function_arrow_set H2; ee; am. rw inc_function_arrow_set. ee; try am. tv. tv. uh H2; ee; am. uh H2; ee; am. uh H2; ee; am. Qed. Lemma mor_function_cat3 : forall z u, mor (function_cat z) u = (Arrow.like u & inc (source u) z & inc (target u) z & inc u (function_arrow_set (source u) (target u)) & Map.axioms (source u) (target u) (arrow u)). Proof. ir. ap iff_eq; ir. cp H. rwi mor_function_cat1 H. rwi mor_function_cat2 H0. xd. rw mor_function_cat1; xd. Qed. Lemma comp_function_cat : forall z u v, mor (function_cat z) u -> mor (function_cat z) v -> source u = target v -> comp (function_cat z) u v = fa_comp u v. Proof. ir. uf function_cat. rw comp_from_arrows. tv. app mor_is_mor. app mor_is_mor. am. Qed. Lemma id_function_cat : forall z x, inc x z -> id (function_cat z) x = fa_id x. Proof. ir. uf function_cat. rw id_from_arrows. tv. rw is_ob_from_arrows. am. Qed. Lemma inc_V_arrow : forall u a x, (exists z, mor (function_cat z) u) -> inc x (source u) -> a = target u -> inc (V x (arrow u)) a. Proof. ir. nin H. rwi mor_function_cat3 H; ee. ap map_V_inc. sh (source u). ee; try am. rww H1. Qed. Lemma inc_V_arrow2 : forall u a x, inc u (function_arrow_set (source u) (target u)) -> inc x (source u) -> a = target u -> inc (V x (arrow u)) a. Proof. ir. ap map_V_inc. sh (source u). ee; try am. rwi inc_function_arrow_set H. rw H1; ee; am. Qed. Lemma fa_comp_assoc : forall u v w, inc u (function_arrow_set (source u) (target u)) -> inc v (function_arrow_set (source v) (target v)) -> inc w (function_arrow_set (source w) (target w)) -> source u = target v -> source v = target w -> fa_comp (fa_comp u v) w = fa_comp u (fa_comp v w). Proof. ir. ap fa_extensionality. ap inc_fas_fa_comp. ap inc_fas_fa_comp. am. am. am. rww source_fa_comp. rww target_fa_comp. am. rww source_fa_comp. rww source_fa_comp. rww target_fa_comp. ap inc_fas_fa_comp. am. ap inc_fas_fa_comp. am. am. am. rw source_fa_comp. tv. rww target_fa_comp. rww target_fa_comp. rww source_fa_comp. rww target_fa_comp. rww source_fa_comp. rww source_fa_comp. rww source_fa_comp. rw target_fa_comp. rww target_fa_comp. rww target_fa_comp. ir. rw V_fa_comp. rw V_fa_comp. rw V_fa_comp. rw V_fa_comp. tv. am. am. am. rwi source_fa_comp H4. am. am. ap inc_fas_fa_comp. am. am. am. rww source_fa_comp. rww target_fa_comp. rww target_fa_comp. rwi source_fa_comp H4. rww source_fa_comp. am. am. am. rwi source_fa_comp H4. ap inc_V_arrow2. am. am. am. ap inc_fas_fa_comp. am. am. am. rww source_fa_comp. rww target_fa_comp. am. rww source_fa_comp. rwi source_fa_comp H4. am. Qed. Lemma left_fa_id : forall u x, inc u (function_arrow_set (source u) (target u)) -> x = target u -> fa_comp (fa_id x) u = u. Proof. ir. cp H. rwi inc_function_arrow_set H1. ee. ap fa_extensionality. ap inc_fas_fa_comp. rw source_fa_id. rw target_fa_id. ap inc_fas_fa_id. am. rww source_fa_id. rww source_fa_comp. rww target_fa_comp. am. rww source_fa_comp. rww target_fa_comp. rww target_fa_id. ir. rw V_fa_comp. rw V_fa_id. tv. ap inc_V_arrow2. am. rwi source_fa_comp H8. am. am. rw source_fa_id; rw target_fa_id. ap inc_fas_fa_id. am. rww source_fa_id. rwi source_fa_comp H8. am. Qed. Lemma right_fa_id : forall u x, inc u (function_arrow_set (source u) (target u)) -> x = source u -> fa_comp u (fa_id x) = u. Proof. ir. cp H. rwi inc_function_arrow_set H1. ee. ap fa_extensionality. ap inc_fas_fa_comp. am. rw source_fa_id. rw target_fa_id. ap inc_fas_fa_id. rww target_fa_id. sy; am. rww source_fa_comp. rww target_fa_comp. am. rww source_fa_comp. rww source_fa_id. rww target_fa_comp. ir. rw V_fa_comp. rw V_fa_id. tv. rwi source_fa_comp H8. rwi source_fa_id H8. am. am. rw source_fa_id; rw target_fa_id. ap inc_fas_fa_id. rww target_fa_id. sy; am. rwi source_fa_comp H8. am. Qed. Definition fa_create a b f := Arrow.create a b (Function.create a f). Lemma source_fa_create : forall a b f, source (fa_create a b f) = a. Proof. ir. uf fa_create. rww Arrow.source_create. Qed. Lemma target_fa_create : forall a b f, target (fa_create a b f) = b. Proof. ir. uf fa_create. rww Arrow.target_create. Qed. Lemma arrow_fa_create : forall a b f, arrow (fa_create a b f) = Function.create a f. Proof. ir. uf fa_create. rww Arrow.arrow_create. Qed. Lemma V_arrow_fa_create : forall a b f x, inc x a -> V x (arrow (fa_create a b f)) = f x. Proof. ir. rw arrow_fa_create. rw create_V_rewrite. tv. am. Qed. Lemma inc_fa_create_fas : forall a b f, Transformation.axioms a b f -> inc (fa_create a b f) (function_arrow_set a b). Proof. ir. rw inc_function_arrow_set. dj. uf fa_create. rww Arrow.create_like. rww source_fa_create. rww target_fa_create. rw arrow_fa_create. ap Function.create_axioms. rw arrow_fa_create. rww Function.create_domain. uhg; ir. rwi range_inc_rw H5. nin H5. ee. rwi arrow_fa_create H5. rwi Function.create_domain H5. uh H. rwi arrow_fa_create H6. rwi create_V_rewrite H6. rw H6. ap H. am. am. rw arrow_fa_create. ap Function.create_axioms. uhg; ee; am. Qed. Lemma eq_fa_create1 : forall a b f u, inc u (function_arrow_set a b) -> (forall x, inc x a -> f x = V x (arrow u)) -> u = fa_create a b f. Proof. ir. cp H. rwi inc_function_arrow_set H1. ee. ap fa_extensionality. rw H2; rww H3. rw source_fa_create. rw target_fa_create. ap inc_fa_create_fas. uh H7; ee. uhg. ir. rw H0. ap H6. ap range_inc. am. sh x. ee. rww H5. tv. am. rww source_fa_create. rww target_fa_create. ir. rw arrow_fa_create. rw create_V_rewrite. sy; ap H0. wrr H2. wrr H2. Qed. Lemma mor_function_cat_fa_create : forall z a b f, inc a z -> inc b z -> (forall x, inc x a -> inc (f x) b) -> mor (function_cat z) (fa_create a b f). Proof. ir. rw mor_function_cat1. ee. uf fa_create; rww Arrow.create_like. rww source_fa_create. rww target_fa_create. rw source_fa_create. rw target_fa_create. app inc_fa_create_fas. Qed. Lemma eq_fa_create2 : forall a b f u, (exists z, mor (function_cat z) u) -> source u = a -> target u = b -> (forall x, inc x a -> f x = V x (arrow u)) -> u = fa_create a b f. Proof. ir. nin H. rwi mor_function_cat3 H; ee. ap eq_fa_create1. wr H0; wrr H1. am. Qed. Lemma all_fa_create : forall z u, mor (function_cat z) u -> u = fa_create (source u) (target u) (fun x => V x (arrow u)). Proof. ir. ap eq_fa_create2. sh z; am. tv. tv. tv. Qed. Lemma mor_fc_extensionality : forall u v, (exists z, ( mor (function_cat z) u & mor (function_cat z) v & source u = source v & target u = target v & (forall x, inc x (source u) -> V x (arrow u) = V x (arrow v))))-> u = v. Proof. ir. nin H. ee. rwi mor_function_cat3 H. rwi mor_function_cat3 H0; ee. ap fa_extensionality. am. am. am. am. am. Qed. End Function_Cat. Module Umorphism_Cat. Export Function_Set. Export Nat_Trans. Definition umorphism_set a b := Image.create (function_set (U a) (fun x:E => (U b))) (fun u => Umorphism.create a b (fun x => V x u)). Lemma inc_umorphism_set : forall a b u, inc u (umorphism_set a b) = (Umorphism.strong_axioms u & source u = a & target u = b). Proof. ir. ap iff_eq; ir. ufi umorphism_set H. rwi Image.inc_rw H. nin H. ee. wr H0. ap Umorphism.create_strong_axioms. uhg; ee. uhg. ir. cp (function_set_pr H). ee. ap H5. am. wr H0. rww Umorphism.source_create. wr H0. rww Umorphism.target_create. ee. uf umorphism_set. rw Image.inc_rw. sh (arrow u). ee. uh H; ee. ap function_set_inc. uh H2; ee. wr H2. uf Umorphism.create. rw Arrow.arrow_create. ap Function.create_axioms. uh H2. wr H2. uf Umorphism.create. rw Arrow.arrow_create. rw Function.create_domain. rww H0. ir. change (inc (ev u y) (U b)). uh H. uh H; ee. uh H. wr H1. ap H. rww H0. uh H; ee. uh H2. transitivity (Umorphism.create (source u) (target u) (ev u)). ap Umorphism.create_extens. sy; am. sy; am. ir. tv. am. Qed. Lemma V_arrow : forall x u, V x (arrow u) = ev u x. Proof. ir. reflexivity. Qed. Lemma umorphism_cat_property : forall z, From_Arrows.property z umorphism_set Umorphism.compose Umorphism.identity. Proof. ir. uhg; ee; ir. rwi inc_umorphism_set H; ee. am. rwi inc_umorphism_set H; ee. am. rwi inc_umorphism_set H; ee. uh H; ee. uh H2. wr H2. uf Umorphism.create. rww Arrow.create_like. rwi inc_umorphism_set H2; rwi inc_umorphism_set H3; ee. rw inc_umorphism_set. ee. ap Umorphism.compose_strong_axioms. uhg; ee. uh H2; ee; am. uh H3; ee; am. rw H6. rww H5. rw Umorphism.source_compose. am. rww Umorphism.target_compose. rw inc_umorphism_set. ee. ap Umorphism.identity_strong_axioms. rww Umorphism.source_identity. rww Umorphism.target_identity. assert (a = source u). rwi inc_umorphism_set H1. ee; sy; am. rw H2. rww Umorphism.right_identity. rwi inc_umorphism_set H1. ee; am. assert (b = target u). rwi inc_umorphism_set H1. ee; sy; am. rw H2. rww Umorphism.left_identity. rwi inc_umorphism_set H1. ee; am. rwi inc_umorphism_set H3; rwi inc_umorphism_set H4; rwi inc_umorphism_set H5; ee. rww Umorphism.associativity. uhg; ee. lu. lu. rw H10; rww H9. uhg; ee. lu. lu. rw H8; rww H7. Qed. Definition umorphism_cat z := From_Arrows.from_arrows z umorphism_set Umorphism.compose Umorphism.identity. Lemma umorphism_cat_axioms : forall z, Category.axioms (umorphism_cat z). Proof. ir. uf umorphism_cat. ap from_arrows_axioms. ap umorphism_cat_property. Qed. Lemma ob_umorphism_cat : forall z x, ob (umorphism_cat z) x = inc x z. Proof. ir. uf umorphism_cat. rww ob_from_arrows. ap umorphism_cat_property. Qed. Lemma mor_umorphism_cat : forall z u, mor (umorphism_cat z) u = (Umorphism.strong_axioms u & inc (source u) z & inc (target u) z). Proof. ir. cp (umorphism_cat_property z). uf umorphism_cat. rww mor_from_arrows. ap iff_eq; ir. ee. rwi inc_umorphism_set H2; ee; am. rwi ob_from_arrows H0. am. am. rwi ob_from_arrows H1; am. ee. rww ob_from_arrows. rww ob_from_arrows. rww inc_umorphism_set. ee; try am. tv. tv. Qed. Lemma comp_umorphism_cat : forall z u v, mor (umorphism_cat z) u -> mor (umorphism_cat z) v -> source u = target v -> comp (umorphism_cat z) u v = Umorphism.compose u v. Proof. ir. uf umorphism_cat. rw comp_from_arrows. tv. app mor_is_mor. app mor_is_mor. am. Qed. Lemma id_umorphism_cat : forall z x, inc x z -> id (umorphism_cat z) x = Umorphism.identity x. Proof. ir. uf umorphism_cat. rw id_from_arrows. tv. rw is_ob_from_arrows. am. Qed. End Umorphism_Cat. Module Empty_Cat. Export Nat_Trans. Definition empty_cat := Category.Notations.create emptyset emptyset (fun u v=> u) (fun x => x) emptyset. Lemma is_ob_empty_cat : forall x, is_ob empty_cat x = False. Proof. ir. ap iff_eq; ir. uh H. ufi empty_cat H. rwi Notations.objects_create H. nin H. elim x0. elim H. Qed. Lemma is_mor_empty_cat : forall x, is_mor empty_cat x = False. Proof. ir. ap iff_eq; ir. ufi empty_cat H. rwi Category.is_mor_create H. nin H. elim x0. elim H. Qed. Lemma structure_empty_cat : structure empty_cat = emptyset. Proof. uf empty_cat. rw Notations.structure_create. tv. Qed. Lemma empty_cat_axioms : Category.axioms empty_cat. Proof. uf empty_cat. ap Category.create_axioms. uhg; ee. ir. ap iff_eq; ir. nin H. elim x0. uh H; ee; am. ir. ap iff_eq; ir. nin H. elim x. uh H; ee; am. ir. nin H. elim x. ir. nin H. elim x. Qed. Lemma ob_empty_cat : forall x, ob empty_cat x = False. Proof. ir. ap iff_eq; ir. uh H; ee. rwi is_ob_empty_cat H0. am. elim H. Qed. Lemma mor_empty_cat : forall x, mor empty_cat x = False. Proof. ir. ap iff_eq; ir. uh H; ee. rwi is_mor_empty_cat H0. am. elim H. Qed. Lemma show_empty_subcategory : forall a b, Category.axioms a -> Category.axioms b -> (forall x, ob a x -> False) -> structure a = structure b -> is_subcategory a b. Proof. ir. assert (forall u, mor a u -> False). ir. apply H1 with (source u). rww ob_source. uhg; ee; try am. ir. elim (H1 _ H4). ir. elim (H3 _ H4). ir. elim (H3 _ H4). ir. elim (H1 _ H4). Qed. Lemma eq_empty_cat : forall a, Category.axioms a -> structure a = emptyset -> (forall x, ob a x -> False) -> a = empty_cat. Proof. ir. ap is_subcategory_extensionality. ap show_empty_subcategory. am. ap empty_cat_axioms. am. rww structure_empty_cat. ap show_empty_subcategory. ap empty_cat_axioms. am. ir. rwi ob_empty_cat H2. am. sy; rww structure_empty_cat. Qed. Definition empty_functor a := Functor.create empty_cat a (fun u => u). Lemma source_empty_functor : forall a, source (empty_functor a) = empty_cat. Proof. ir. uf empty_functor. rww Functor.source_create. Qed. Lemma target_empty_functor : forall a, target (empty_functor a) = a. Proof. ir. uf empty_functor. rww Functor.target_create. Qed. Lemma empty_functor_axioms : forall a, Category.axioms a -> Functor.axioms (empty_functor a). Proof. ir. uf empty_functor. ap Functor.create_axioms. sh (fun (x:E) => x). uhg; ee. ap empty_cat_axioms. am. ir. rwi ob_empty_cat H0; nin H0. ir. rwi ob_empty_cat H0; elim H0. ir. rwi mor_empty_cat H0; elim H0. ir. rwi mor_empty_cat H0; elim H0. ir. rwi mor_empty_cat H0; elim H0. ir. rwi mor_empty_cat H0; elim H0. Qed. Lemma eq_empty_functor : forall a f, Functor.axioms f -> source f = empty_cat -> target f = a -> f = empty_functor a. Proof. ir. ap Functor.axioms_extensionality. am. ap empty_functor_axioms. wr H1. rww category_axioms_target. rww source_empty_functor. rww target_empty_functor. ir. rwi H0 H2. rwi mor_empty_cat H2. elim H2. Qed. Definition empty_nt a := Nat_Trans.create (empty_functor a) (empty_functor a) (fun (x : E) => x). Lemma source_empty_nt : forall a, source (empty_nt a) = empty_functor a. Proof. ir. uf empty_nt. rww Nat_Trans.source_create. Qed. Lemma target_empty_nt : forall a, target (empty_nt a) = empty_functor a. Proof. ir. uf empty_nt. rww Nat_Trans.target_create. Qed. Lemma osource_empty_nt : forall a, osource (empty_nt a) = empty_cat. Proof. ir. uf osource. rw source_empty_nt. rww source_empty_functor. Qed. Lemma otarget_empty_nt : forall a, otarget (empty_nt a) = a. Proof. ir. uf otarget. rw target_empty_nt. rww target_empty_functor. Qed. Lemma empty_nt_axioms : forall a, Category.axioms a -> Nat_Trans.axioms (empty_nt a). Proof. ir. uf empty_nt. ap Nat_Trans.create_axioms. uhg; ee. app empty_functor_axioms. app empty_functor_axioms. tv. tv. ir. rwi source_empty_functor H0. rwi ob_empty_cat H0. elim H0. ir. rwi source_empty_functor H0. rwi ob_empty_cat H0. elim H0. ir. rwi source_empty_functor H0. rwi ob_empty_cat H0. elim H0. ir. rwi source_empty_functor H0. rwi mor_empty_cat H0. elim H0. Qed. Lemma eq_empty_nt : forall a u, Nat_Trans.axioms u -> osource u = empty_cat -> otarget u = a -> u = empty_nt a. Proof. ir. assert (Category.axioms a). wr H1. rww category_axioms_otarget. ap Nat_Trans.axioms_extensionality. am. app empty_nt_axioms. rww source_empty_nt. ap eq_empty_functor. rww functor_axioms_source. am. rww target_source. rw target_empty_nt. ap eq_empty_functor. rww functor_axioms_target. rww source_target. am. ir. rwi H0 H3. rwi ob_empty_cat H3. elim H3. Qed. End Empty_Cat. Module Discrete_Cat. Export Function_Cat. (*** discrete_cat z is the category of elements of z with only identity morphisms ***) Definition is_id_fun_arrow u := u = fa_id (source u). Definition discrete_cat z := subcategory (function_cat z) (fun x => True) is_id_fun_arrow. Lemma is_id_fun_arrow_id_fc : forall z x, inc x z -> is_id_fun_arrow (id (function_cat z) x). Proof. ir. uhg; ee. rw id_function_cat. uf fa_id. rw Arrow.source_create. tv. am. Qed. Lemma is_id_fun_arrow_rw : forall u, is_id_fun_arrow u = (source u = target u & (forall z, inc (source u) z -> (u = (id (function_cat z) (source u))))). Proof. ir. ap iff_eq; ir. ee. ufi is_id_fun_arrow H. rw H. rw source_fa_id. rww target_fa_id. ir. uh H; ee. rw H. rw source_fa_id. rw id_function_cat. tv. am. uhg; ee. util (H0 (singleton (source u))). ap singleton_inc. rwi id_function_cat H1. am. ap singleton_inc. Qed. Lemma discrete_cat_property : forall z, subcategory_property (function_cat z) (fun x => True) is_id_fun_arrow. Proof. ir. uhg; ee. ap function_cat_axioms. ir. uhg; ee. rw source_comp. cp H2; cp H3. rwi is_id_fun_arrow_rw H2. rwi is_id_fun_arrow_rw H3. ee. cp H. rwi mor_function_cat3 H8. ee. cp (H7 z H9). rw H13. rw left_id. uh H5. am. rww ob_function_cat. am. sy; am. tv. am. am. am. ir. clear H0. cp H. rwi ob_function_cat H0. rww id_function_cat. uhg. rww source_fa_id. ir. tv. ir. tv. Qed. Lemma discrete_cat_axioms : forall z, Category.axioms (discrete_cat z). Proof. ir. uf discrete_cat. ap subcategory_axioms. ap discrete_cat_property. Qed. Lemma ob_discrete_cat : forall z x, ob (discrete_cat z) x = inc x z. Proof. ir. ap iff_eq; ir. ufi discrete_cat H. rwi ob_subcategory H. ee. rwi ob_function_cat H. am. ap discrete_cat_property. uf discrete_cat. rw ob_subcategory. ee; try tv. rww ob_function_cat. ap discrete_cat_property. Qed. Lemma id_discrete_cat : forall z x, inc x z -> id (discrete_cat z) x = id (function_cat z) x. Proof. ir. cp H. wri ob_discrete_cat H. uf discrete_cat. rw id_subcategory. tv. ap discrete_cat_property. rww ob_function_cat. tv. Qed. Lemma mor_discrete_cat : forall z u, mor (discrete_cat z) u = (inc (source u) z & is_id_fun_arrow u). Proof. ir. uf discrete_cat. rw mor_subcategory. ap iff_eq; ir. xd. rwi mor_function_cat3 H. ee; am. xd. uh H0; ee. assert (u = id (function_cat z) (source u)). rw id_function_cat. am. am. rw H1. ap mor_id. rww ob_function_cat. ap discrete_cat_property. Qed. Lemma mor_discrete_cat3 : forall z u, mor (discrete_cat z) u = (inc (source u) z & inc (target u) z & source u = target u & is_id_fun_arrow u & u = id (discrete_cat z) (source u) & u = id (function_cat z) (source u)). Proof. ir. rw mor_discrete_cat; ap iff_eq; ir; xd. uh H0. rw H0. rw target_fa_id. am. uh H0. rw H0. rw source_fa_id. rww target_fa_id. rw id_discrete_cat. rw id_function_cat. am. am. am. rw id_function_cat. am. am. Qed. Lemma comp_discrete_cat : forall z u v, mor (discrete_cat z) u -> mor (discrete_cat z) v -> source u = target v -> comp (discrete_cat z) u v = u. Proof. ir. rwi mor_discrete_cat3 H; rwi mor_discrete_cat3 H0. ee. rw H10. rw H1. rw left_id. wr H3. am. rw ob_discrete_cat. am. rw mor_discrete_cat. ee; am. tv. tv. Qed. Lemma discrete_cat_mor_extens : forall u v, source u = source v -> (exists z, (mor (discrete_cat z) u & mor (discrete_cat z) v)) -> u = v. Proof. ir. nin H0. ee. rwi mor_discrete_cat3 H0. rwi mor_discrete_cat3 H1. ee. rw H10. rw H5. rw H. reflexivity. Qed. (*** functors and natural transformations on discrete_cat ***) Definition discrete_functor z a f := Functor.create (discrete_cat z) a (fun u => id a (f (source u))). Lemma source_discrete_functor : forall z a f, source (discrete_functor z a f) = (discrete_cat z). Proof. ir. uf discrete_functor. rww Functor.source_create. Qed. Lemma target_discrete_functor : forall z a f, target (discrete_functor z a f) = a. Proof. ir. uf discrete_functor. rww Functor.target_create. Qed. Lemma fmor_discrete_functor : forall z a f u, mor (discrete_cat z) u -> fmor (discrete_functor z a f) u = id a (f (source u)). Proof. ir. uf discrete_functor. rww fmor_create. Qed. Definition discrete_functor_property z a f := Category.axioms a & (forall x, inc x z -> ob a (f x)). Lemma fob_discrete_functor : forall z a f x, discrete_functor_property z a f -> inc x z -> fob (discrete_functor z a f) x = f x. Proof. ir. uf fob. rw fmor_discrete_functor. rw source_discrete_functor. rw source_id. rw source_id. tv. rww ob_discrete_cat. rw source_id. uh H; ee. au. rww ob_discrete_cat. rw source_discrete_functor. app mor_id. rww ob_discrete_cat. Qed. Lemma discrete_functor_axioms : forall z a f, discrete_functor_property z a f -> Functor.axioms (discrete_functor z a f). Proof. ir. uf discrete_functor. ap Functor.create_axioms. sh (fob (discrete_functor z a f)). cp H. uh H0; ee. uhg; ee. ap discrete_cat_axioms. am. ir. cp H2. rwi ob_discrete_cat H3. rww fob_discrete_functor. au. ir. cp H2. rwi ob_discrete_cat H3. rww fob_discrete_functor. rww source_id. ir. cp H2. rwi mor_discrete_cat3 H3. ee. ap mor_id. ap H1. am. ir. cp H2. rwi mor_discrete_cat3 H3. ee. rww source_id. rww fob_discrete_functor. app H1. ir. cp H2. rwi mor_discrete_cat3 H3. ee. rww target_id. rww fob_discrete_functor. rww H5. au. ir. cp H2; cp H3. rwi mor_discrete_cat3 H5; rwi mor_discrete_cat3 H6. ee. rw left_id. rww source_comp. au. app mor_id. au. rww target_id. rww H4. rww H8. au. tv. Qed. Lemma eq_discrete_functor : forall z a f g, Functor.axioms g -> discrete_functor_property z a f -> source g = discrete_cat z -> target g = a -> (forall x, inc x z -> fob g x = f x) -> g = discrete_functor z a f. Proof. ir. assert (forall x, inc x z -> fmor g (id (discrete_cat z) x) = id a (f x)). ir. rw fmor_id. rww H3. rww H2. am. am. rww ob_discrete_cat. ap Functor.axioms_extensionality. am. ap discrete_functor_axioms. am. rww source_discrete_functor. rww target_discrete_functor. ir. rww fmor_discrete_functor. rwi H1 H5. rwi mor_discrete_cat3 H5. ee. rw H9. rw H4. rw source_id. tv. rww ob_source. rw mor_discrete_cat; ee; am. am. wrr H1. Qed. Lemma discrete_functor_property_fob : forall z a g, Functor.axioms g -> source g = discrete_cat z -> a = target g -> discrete_functor_property z a (fob g). Proof. ir. uhg; ee. uh H; ee. rww H1. ir. rw H1. ap ob_fob. am. rw H0. rw ob_discrete_cat. am. Qed. Lemma all_functors_discrete : forall z g, Functor.axioms g -> source g = discrete_cat z -> g = discrete_functor z (target g) (fob g). Proof. ir. app eq_discrete_functor. app discrete_functor_property_fob. Qed. Definition discrete_nt z a t := Nat_Trans.create (discrete_functor z a (fun x => source (t x))) (discrete_functor z a (fun x => target (t x))) t. Lemma source_discrete_nt : forall z a t, source (discrete_nt z a t) = discrete_functor z a (fun x => source (t x)). Proof. ir. uf discrete_nt. rw Nat_Trans.source_create. tv. Qed. Lemma target_discrete_nt : forall z a t, target (discrete_nt z a t) = discrete_functor z a (fun x => target (t x)). Proof. ir. uf discrete_nt. rw Nat_Trans.target_create. tv. Qed. Lemma osource_discrete_nt : forall z a t, osource (discrete_nt z a t) = discrete_cat z. Proof. ir. uf osource. rw source_discrete_nt. rw source_discrete_functor. tv. Qed. Lemma otarget_discrete_nt : forall z a t, otarget (discrete_nt z a t) = a. Proof. ir. uf otarget. rw target_discrete_nt. rw target_discrete_functor. tv. Qed. Lemma ntrans_discrete_nt : forall z a t x, inc x z -> ntrans (discrete_nt z a t) x = (t x). Proof. ir. uf discrete_nt. rw Nat_Trans.ntrans_create. tv. rw source_discrete_functor. change (is_ob (discrete_cat z) x). ap ob_is_ob. rww ob_discrete_cat. Qed. Definition discrete_nt_property z a t := Category.axioms a & (forall x, inc x z -> mor a (t x)). Lemma discrete_nt_axioms : forall z a t, discrete_nt_property z a t -> Nat_Trans.axioms (discrete_nt z a t). Proof. ir. uh H; ee. uf discrete_nt. ap Nat_Trans.create_axioms. uhg; ee. ap discrete_functor_axioms. uhg; ee. am. ir. rw ob_source. tv. au. ap discrete_functor_axioms. uhg; ee. am. ir. rw ob_target. tv. au. rw source_discrete_functor. rww source_discrete_functor. rw target_discrete_functor. rww target_discrete_functor. ir. rwi source_discrete_functor H1. rw target_discrete_functor. ap H0. wrr ob_discrete_cat. ir. rwi source_discrete_functor H1. rw fob_discrete_functor. tv. uhg; ee. am. ir. rww ob_source. ap H0. am. wrr ob_discrete_cat. ir. rwi source_discrete_functor H1. rw fob_discrete_functor. tv. uhg; ee. am. ir. rww ob_target. ap H0. am. wrr ob_discrete_cat. ir. rw target_discrete_functor. rwi source_discrete_functor H1. cp H1. rwi mor_discrete_cat3 H2. ee. rww fmor_discrete_functor. rww fmor_discrete_functor. wr H4. rw left_id. rw right_id. tv. rww ob_source. ap H0. am. app H0. tv. tv. rww ob_target. app H0. app H0. tv. tv. Qed. Lemma discrete_nt_property_ntrans : forall z u, Nat_Trans.axioms u -> osource u = discrete_cat z -> discrete_nt_property z (otarget u) (ntrans u). Proof. ir. uhg; ee. rww category_axioms_otarget. ir. ap mor_ntrans. am. rw H0. rww ob_discrete_cat. tv. Qed. Lemma eq_discrete_nt : forall z a t u, discrete_nt_property z a t -> Nat_Trans.axioms u -> osource u = discrete_cat z -> otarget u = a -> (forall x, inc x z -> ntrans u x = t x) -> u = discrete_nt z a t. Proof. ir. ap Nat_Trans.axioms_extensionality. am. app discrete_nt_axioms. rww source_discrete_nt. ap eq_discrete_functor. rww functor_axioms_source. uhg; ee. wr H2. rww category_axioms_otarget. ir. uh H; ee. rww ob_source. au. am. rww target_source. ir. wrr H3. rww source_ntrans. rw H1. rww ob_discrete_cat. rw target_discrete_nt. ap eq_discrete_functor. rww functor_axioms_target. uhg; ee. wr H2. rww category_axioms_otarget. ir. uh H; ee. rww ob_target. au. rww source_target. am. ir. wrr H3. rww target_ntrans. rw H1. rww ob_discrete_cat. ir. rw ntrans_discrete_nt. ap H3. rwi H1 H4. rwi ob_discrete_cat H4; am. rwi H1 H4. rwi ob_discrete_cat H4; am. Qed. Lemma all_nt_discrete : forall z u, Nat_Trans.axioms u -> osource u = discrete_cat z -> u = discrete_nt z (otarget u) (ntrans u). Proof. ir. ap eq_discrete_nt. ap discrete_nt_property_ntrans. am. am. am. am. tv. ir. tv. Qed. End Discrete_Cat. Module Inclusion_Cat. Export Function_Cat. (*** inclusion_cat z is the category of elements of z with only inclusions as morphisms ***) Definition fa_inclusion a b := Arrow.create a b (Function.create a (fun (x:E) => x)). Lemma source_fa_inclusion : forall a b, source (fa_inclusion a b) = a. Proof. ir. uf fa_inclusion. rww Arrow.source_create. Qed. Lemma target_fa_inclusion : forall a b, target (fa_inclusion a b) = b. Proof. ir. uf fa_inclusion. rww Arrow.target_create. Qed. Lemma arrow_fa_inclusion : forall a b, arrow (fa_inclusion a b) = (Function.create a (fun (x:E) => x)). Proof. ir. uf fa_inclusion. rww Arrow.arrow_create. Qed. Lemma inc_fa_inclusion_fas : forall a b, sub a b -> inc (fa_inclusion a b) (function_arrow_set a b). Proof. ir. assert (Map.axioms a b (arrow (fa_inclusion a b))). uhg; ee. rw arrow_fa_inclusion. ap Function.create_axioms. rw arrow_fa_inclusion. rww Function.create_domain. rw arrow_fa_inclusion. uhg; ir. rwi range_inc_rw H0. nin H0. ee. rwi Function.create_domain H0. rwi create_V_rewrite H1. rw H1. ap H. am. am. ap Function.create_axioms. cp H0. uh H1; ee. rw inc_function_arrow_set; xd. uf fa_inclusion. rww Arrow.create_like. rww source_fa_inclusion. rww target_fa_inclusion. Qed. Definition is_fa_inclusion u := (sub (source u) (target u) & u = fa_inclusion (source u) (target u)). Lemma is_fa_inclusion_fa_id : forall x, is_fa_inclusion (fa_id x). Proof. ir. uhg; ee. rw source_fa_id. rw target_fa_id. uhg; ir; am. rw source_fa_id. rw target_fa_id. tv. Qed. Lemma fa_inclusion_fa_id : forall x y, x = y -> fa_inclusion x y = fa_id x. Proof. ir. rw H. tv. Qed. Lemma fa_id_fa_inclusion : forall x, fa_id x = fa_inclusion x x. Proof. ir. tv. Qed. Lemma is_fa_inclusion_fa_comp : forall u v, is_fa_inclusion u -> is_fa_inclusion v -> source u = target v -> is_fa_inclusion (fa_comp u v). Proof. ir. assert (inc (fa_comp u v) (function_arrow_set (source v) (target u))). ap inc_fas_fa_comp. uh H. ee. rw H2. rw source_fa_inclusion. rw target_fa_inclusion. ap inc_fa_inclusion_fas. am. uh H0. ee. rw H2. rw source_fa_inclusion. rw target_fa_inclusion. ap inc_fa_inclusion_fas. am. am. tv. tv. cp H2. rwi inc_function_arrow_set H3. ee. uhg; ee. rw source_fa_comp. rw target_fa_comp. uh H; uh H0; ee. apply sub_trans with (source u). rww H1. am. rw source_fa_comp. rw target_fa_comp. ap fa_extensionality. ap inc_fas_fa_comp. uh H; ee. rw H10. rw source_fa_inclusion; rw target_fa_inclusion. ap inc_fa_inclusion_fas. am. uh H0; ee. rw H10. rw source_fa_inclusion; rw target_fa_inclusion. ap inc_fa_inclusion_fas. am. am. rww source_fa_comp. rww target_fa_comp. rw source_fa_inclusion. rw target_fa_inclusion. ap inc_fa_inclusion_fas. apply sub_trans with (source u). rww H1. uh H0; ee; am. uh H; ee; am. rw source_fa_comp. rww source_fa_inclusion. rw target_fa_comp. rww target_fa_inclusion. ir. rw V_fa_comp. rw arrow_fa_inclusion. rw create_V_rewrite. uh H; uh H0; ee. rw H12; rw H11. rw arrow_fa_inclusion. rw arrow_fa_inclusion. rw create_V_rewrite. rw create_V_rewrite. tv. rwi source_fa_comp H10. tv. rw create_V_rewrite. rwi source_fa_comp H10. rw H1. ap H0; am. rwi source_fa_comp H10. am. rwi source_fa_comp H10. am. uh H; ee. rw H11. rw source_fa_inclusion; rw target_fa_inclusion. ap inc_fa_inclusion_fas. am. uh H0; ee. rw H11. rw source_fa_inclusion; rw target_fa_inclusion. ap inc_fa_inclusion_fas. am. am. rwi source_fa_comp H10. am. Qed. Lemma inclusion_cat_property : forall z, subcategory_property (function_cat z) (fun x => True) is_fa_inclusion. Proof. ir. uhg; ee. ap function_cat_axioms. ir. rw comp_function_cat. ap is_fa_inclusion_fa_comp. am. am. am. am. am. am. ir. rw id_function_cat. ap is_fa_inclusion_fa_id. rwi ob_function_cat H; am. ir; tv. ir; tv. Qed. Definition inclusion_cat z := subcategory (function_cat z) (fun x => True) is_fa_inclusion. Lemma inclusion_cat_axioms : forall z, Category.axioms (inclusion_cat z). Proof. ir. uf inclusion_cat. ap subcategory_axioms. ap inclusion_cat_property. Qed. Lemma ob_inclusion_cat : forall z x, ob (inclusion_cat z) x = inc x z. Proof. ir. uf inclusion_cat. rw ob_subcategory. ap iff_eq; ir; ee. rwi ob_function_cat H; am. rww ob_function_cat. tv. ap inclusion_cat_property. Qed. Lemma mor_inclusion_cat : forall z u, mor (inclusion_cat z) u = (inc (source u) z & inc (target u) z & is_fa_inclusion u). Proof. ir. uf inclusion_cat. rw mor_subcategory. ap iff_eq; ir; xd. wr ob_function_cat. rww ob_source. wr ob_function_cat. rww ob_target. uh H1; ee. rw H2. rw mor_function_cat1. ee. uf fa_inclusion. rww Arrow.create_like. rw source_fa_inclusion. am. rww target_fa_inclusion. rw source_fa_inclusion. rw target_fa_inclusion. ap inc_fa_inclusion_fas. am. ap inclusion_cat_property. Qed. Lemma id_inclusion_cat : forall z x, inc x z -> id (inclusion_cat z) x = fa_id x. Proof. ir. uf inclusion_cat. rw id_subcategory. rww id_function_cat. ap inclusion_cat_property. rww ob_function_cat. tv. Qed. Lemma inclusion_cat_mor_extens : forall u v, source u = source v -> target u = target v -> (exists z, (mor (inclusion_cat z) u & mor (inclusion_cat z) v)) -> u = v. Proof. ir. nin H1. ee. rwi mor_inclusion_cat H1. rwi mor_inclusion_cat H2. ee. uh H6; uh H4; ee. rw H8. rw H7. rw H; rw H0. reflexivity. Qed. Lemma inclusion_cat_sub_trans : forall u v, source u = target v -> (exists z, (mor (inclusion_cat z) u & mor (inclusion_cat z) v)) -> sub (source v) (target u). Proof. ir. nin H0; ee. rwi mor_inclusion_cat H0. rwi mor_inclusion_cat H1. ee. uh H5; uh H3; ee. apply sub_trans with (source u). rww H. am. Qed. Lemma comp_inclusion_cat : forall z u v, mor (inclusion_cat z) u -> mor (inclusion_cat z) v -> source u = target v -> comp (inclusion_cat z) u v = fa_inclusion (source v) (target u). Proof. ir. ap inclusion_cat_mor_extens. rww source_comp. rww source_fa_inclusion. rww target_comp. rww target_fa_inclusion. sh z. ee. rww mor_comp. rw mor_inclusion_cat. ee. rw source_fa_inclusion. wr ob_inclusion_cat. rww ob_source. rw target_fa_inclusion. wr ob_inclusion_cat. rww ob_target. uhg. ee. rw source_fa_inclusion. rw target_fa_inclusion. app inclusion_cat_sub_trans. sh z; ee; try am. rw source_fa_inclusion. rww target_fa_inclusion. Qed. End Inclusion_Cat. Module Small_Integer_Sets. Export Function_Cat. Export Naturals. Definition arrow_zero_to x := fa_create (R 0) x (fun (x:E) => x). Lemma source_arrow_zero_to : forall x, source (arrow_zero_to x) = (R 0). Proof. ir. uf arrow_zero_to. rww source_fa_create. Qed. Lemma target_arrow_zero_to : forall x, target (arrow_zero_to x) = x. Proof. ir. uf arrow_zero_to. rww target_fa_create. Qed. Lemma mor_fc_arrow_zero_to : forall z x, inc (R 0) z -> inc x z -> mor (function_cat z) (arrow_zero_to x). Proof. ir. rw mor_function_cat1. ee. uf arrow_zero_to. uf fa_create. rww Arrow.create_like. rww source_arrow_zero_to. rww target_arrow_zero_to. uf arrow_zero_to. rw source_fa_create. rw target_fa_create. ap inc_fa_create_fas. uhg. ir. rwi zero_emptyset H1. nin H1. nin x1. Qed. Lemma all_arrow_zero_to : forall z u, mor (function_cat z) u -> source u = (R 0) -> u = arrow_zero_to (target u). Proof. ir. ap mor_fc_extensionality. sh z. ee; try am. ap mor_fc_arrow_zero_to. wr H0. wr ob_function_cat. rww ob_source. wr ob_function_cat. rww ob_target. rww source_arrow_zero_to. rww target_arrow_zero_to. ir. rwi H0 H1. rwi zero_emptyset H1. nin H1. nin x0. Qed. Definition arrow_one_at x y := fa_create (R 1) y (fun (t:E) => x). Lemma source_arrow_one_at : forall x y, source (arrow_one_at x y) = R 1. Proof. ir. uf arrow_one_at. rww source_fa_create. Qed. Lemma target_arrow_one_at : forall x y, target (arrow_one_at x y) = y. Proof. ir. uf arrow_one_at. rww target_fa_create. Qed. Lemma mor_arrow_one_at : forall x y z, inc (R 1) z -> inc y z -> inc x y -> mor (function_cat z) (arrow_one_at x y). Proof. ir. uf arrow_one_at. ap mor_function_cat_fa_create. am. am. ir. am. Qed. Lemma V_arrow_arrow_one_at : forall x y a, inc y a -> inc x (R 1) -> V x (arrow (arrow_one_at y a)) = y. Proof. ir. uf arrow_one_at. rw V_arrow_fa_create. tv. am. Qed. Lemma all_arrow_one_at : forall z u, mor (function_cat z) u -> source u = (R 1) -> (exists x, (inc x (target u) & u = arrow_one_at x (target u))). Proof. ir. assert (inc (V (R 0) (arrow u)) (target u)). ap inc_V_arrow. sh z; am. rw H0. ap inc_zero_one. tv. assert (inc (R 1) z). wr H0. wr ob_function_cat. rww ob_source. assert (inc (target u) z). wr ob_function_cat. rww ob_target. sh (V (R 0) (arrow u)). ee. am. ap mor_fc_extensionality. sh z; ee. am. ap mor_arrow_one_at. am. am. am. rww source_arrow_one_at. rww target_arrow_one_at. ir. rw V_arrow_arrow_one_at. rwi H0 H4. rwi inc_one H4. rww H4. ap inc_V_arrow. sh z; am. rw H0. ap inc_zero_one. tv. wrr H0. Qed. End Small_Integer_Sets. Export Small_Integer_Sets. Module Ordinals_Cat. Export Function_Cat. Export Ordinal. (*** ordinals_cat a is the category of elements of a which are ordinals, with morphisms being the order-preserving maps ***) (*** not done yet (or even started...) ***********************) End Ordinals_Cat. (***** the following provides a good example of how not to proceed: trying to define things concretely gives a big mess; this suggests that it is better to use Coq's inductive objects which we subsequently try in the next file ***************** Module Twoarrow_Cat. Export Function_Cat. Definition twoarrow_objects := doubleton (R 1) (R 2). Lemma inc_doubleton : forall x y z, inc x (doubleton y z) = ((x = y) \/ (x = z)). Proof. ir. ap iff_eq; ir. cp (doubleton_or H). am. nin H. rw H; ap doubleton_first. rw H; ap doubleton_second. Qed. Lemma inc_twoarrow_objects : forall x, inc x twoarrow_objects = ((x = R 1) \/ (x = R 2)). Proof. ir. uf twoarrow_objects. rw inc_doubleton. tv. Qed. Definition twoarrow_morp u := (u = fa_id (R 1)) \/ (u = fa_id (R 2)) \/ (u = arrow_one_at (R 0) (R 2)) \/ (u = arrow_one_at (R 1) (R 2)). Lemma twoarrow_morp_rw : forall u, twoarrow_morp u = (mor (function_cat twoarrow_objects) u & (source u = R 2 -> u = (fa_id (R 2)))). Proof. ir. ap iff_eq; ir. ee. uh H. nin H. assert (fa_id (R 1) = id (function_cat twoarrow_objects) (R 1)). rww id_function_cat. rw inc_twoarrow_objects. ap or_introl; tv. rwi H0 H. rw H. ap mor_id. rw ob_function_cat. rw inc_twoarrow_objects. ap or_introl; tv. nin H. assert (fa_id (R 2) = id (function_cat twoarrow_objects) (R 2)). rww id_function_cat. rw inc_twoarrow_objects. ap or_intror; tv. rwi H0 H. rw H. ap mor_id. rw ob_function_cat. rw inc_twoarrow_objects. ap or_intror; tv. nin H. rw H. ap mor_arrow_one_at. rw inc_twoarrow_objects. ap or_introl; tv. rw inc_twoarrow_objects. ap or_intror; tv. ap inc_zero_two. rw H. ap mor_arrow_one_at. rw inc_twoarrow_objects. ap or_introl; tv. rw inc_twoarrow_objects. ap or_intror; tv. ap inc_one_two. ir. nin H. rwi H H0. rwi source_fa_id H0. cp (R_inj H0). discriminate H1. nin H. tv. nin H. rwi H H0. rwi source_arrow_one_at H0. cp (R_inj H0). discriminate H1. rwi H H0. rwi source_arrow_one_at H0. cp (R_inj H0). discriminate H1. ee. cp H. rwi mor_function_cat3 H. ee. cp H2. rwi inc_twoarrow_objects H6. nin H6. cp (all_arrow_one_at H1 H6). nin H7. ee. rwi inc_twoarrow_objects H3. nin H3. rwi H3 H8. rwi H3 H7. rwi inc_one H7. rwi H7 H8. uhg. ap or_introl. util (all_arrow_one_at (z:= twoarrow_objects) (u := fa_id (R 1))). rewrite <- id_function_cat with (z:=twoarrow_objects). ap mor_id. rw ob_function_cat. rw inc_twoarrow_objects. ap or_introl; tv. rw inc_twoarrow_objects. ap or_introl; tv. rww source_fa_id. nin H9. ee. rw H10. rw H8. rwi target_fa_id H9. rwi inc_one H9. rw H9. rw target_fa_id. reflexivity. rwi H3 H7; rwi H3 H8. rwi inc_two H7. nin H7. rwi H7 H8. rw H8. uhg; ee. ap or_intror. ap or_intror. ap or_introl; reflexivity. rwi H7 H8. rw H8. uhg. ap or_intror. ap or_intror. ap or_intror. reflexivity. cp (H0 H6). rw H7. uhg. ap or_intror. ap or_introl; reflexivity. Qed. Definition twoarrow_cat := subcategory (function_cat twoarrow_objects) (fun x => True) twoarrow_morp. Lemma case_source_two : forall u, twoarrow_morp u -> source u = (R 2) -> u = fa_id (R 2). Proof. ir. rwi twoarrow_morp_rw H. ee. au. Qed. Lemma case_target_one : forall u, twoarrow_morp u -> target u = (R 1) -> u = fa_id (R 1). Proof. ir. uh H. nin H. am. nin H. rwi H H0. rwi target_fa_id H0. cp (R_inj H0). discriminate H1. nin H. rwi H H0. rwi target_arrow_one_at H0. cp (R_inj H0). discriminate H1. rwi H H0. rwi target_arrow_one_at H0. cp (R_inj H0). discriminate H1. Qed. Lemma case_source_one_target_two : forall u, twoarrow_morp u -> source u = (R 1) -> target u = (R 2) -> ((u = arrow_one_at (R 0) (R 2)) \/ (u = arrow_one_at (R 1) (R 2))). Proof. ir. uh H. nin H. rwi H H1. rwi target_fa_id H1. cp (R_inj H1). discriminate H2. nin H. rwi H H0. rwi source_fa_id H0. cp (R_inj H0). discriminate H2. exact H. Qed. Lemma twoarrow_property : subcategory_property (function_cat twoarrow_objects) (fun x => True) twoarrow_morp. Proof. ir. uhg; ee. ap function_cat_axioms. ir. rww comp_function_cat. assert (inc (source u) twoarrow_objects). rewrite <- ob_function_cat with (z:=twoarrow_objects). rww ob_source. assert (inc (target u) twoarrow_objects). rewrite <- ob_function_cat with (z:=twoarrow_objects). rww ob_target. rwi inc_twoarrow_objects H4. nin H4. rwi H1 H4. cp (case_target_one H3 H4). rw H6. rw right_fa_id. am. rwi mor_function_cat1 H; ee; am. rw H1. sy; am. cp (case_source_two H2 H4). rw H6. rw left_fa_id. am. rwi mor_function_cat1 H0; ee; am. wr H1. sy; am. ir. rw id_function_cat. rwi ob_function_cat H. rwi inc_twoarrow_objects H. nin H. rw H. uhg. ap or_introl; reflexivity. rw H. uhg. ap or_intror. ap or_introl. reflexivity. rwi ob_function_cat H. am. ir. tv. ir. tv. Qed. Lemma twoarrow_cat_axioms : Category.axioms twoarrow_cat. Proof. uf twoarrow_cat. ap subcategory_axioms. ap twoarrow_property. Qed. Lemma ob_twoarrow_cat : forall x, ob twoarrow_cat x = (x = R 1 \/ x = R 2). Proof. ir. uf twoarrow_cat. rw ob_subcategory. ap iff_eq. ir. ee. rwi ob_function_cat H. rwi inc_twoarrow_objects H. am. ir. rw ob_function_cat. ee. rw inc_twoarrow_objects. am. tv. ap twoarrow_property. Qed. Lemma id_twoarrow_cat : forall x, ob twoarrow_cat x -> id twoarrow_cat x = fa_id x. Proof. ir. uf twoarrow_cat. rw id_subcategory. rww id_function_cat. rw inc_twoarrow_objects. rwi ob_twoarrow_cat H. am. ap twoarrow_property. rw ob_function_cat. rw inc_twoarrow_objects. rwi ob_twoarrow_cat H. am. tv. Qed. Lemma mor_twoarrow_cat1 : forall u, mor twoarrow_cat u = ((ob twoarrow_cat (source u) & u = id twoarrow_cat (source u)) \/ (u = arrow_one_at (R 0) (R 2) \/ u = arrow_one_at (R 1) (R 2))). Proof. ir. assert (lem1 : inc (R 1) twoarrow_objects). rw inc_twoarrow_objects. ap or_introl; tv. assert (lem1a : ob twoarrow_cat (R 1)). rw ob_twoarrow_cat. ap or_introl; tv. assert (lem2 : inc (R 2) twoarrow_objects). rw inc_twoarrow_objects. ap or_intror; tv. assert (lem2a : ob twoarrow_cat (R 2)). rw ob_twoarrow_cat. ap or_intror; tv. ap iff_eq; ir. ufi twoarrow_cat H. rwi mor_subcategory H. ee. uh H0. nin H0. ap or_introl. ee. rw H0. rww source_fa_id. rw H0. rw source_fa_id. uf twoarrow_cat. rw id_subcategory. rww id_function_cat. ap twoarrow_property. rww ob_function_cat. tv. nin H0. rw H0. rw source_fa_id. ap or_introl. ee. am. uf twoarrow_cat. rw id_subcategory. rww id_function_cat. ap twoarrow_property. rww ob_function_cat. tv. nin H0. ap or_intror. app or_introl. ap or_intror. app or_intror. ap twoarrow_property. assert (twoarrow_morp u). nin H. ee. rwi ob_twoarrow_cat H. nin H. rwi H H0. rwi id_twoarrow_cat H0. uhg; app or_introl. am. rwi id_twoarrow_cat H0. rwi H H0. uhg; ap or_intror; app or_introl. rww H. uhg; ap or_intror; app or_intror. uf twoarrow_cat. rw mor_subcategory. ee. rwi twoarrow_morp_rw H0. ee; am. am. ap twoarrow_property. Qed. Lemma mor_twoarrow_cat2 : forall u, mor twoarrow_cat u = (twoarrow_morp u & mor (function_cat twoarrow_objects) u & ((ob twoarrow_cat (source u) & u = id twoarrow_cat (source u)) \/ (source u = R 1 & target u = R 2 & (u = arrow_one_at (R 0) (R 2) \/ u = arrow_one_at (R 1) (R 2))))). Proof. ir. ap iff_eq; ir. ee. ufi twoarrow_cat H. rwi mor_subcategory H. ee; am. ap twoarrow_property. ufi twoarrow_cat H. rwi mor_subcategory H. ee; am. ap twoarrow_property. rwi mor_twoarrow_cat1 H. nin H. app or_introl. ap or_intror. ee. nin H. rw H. rww source_arrow_one_at. rw H. rww source_arrow_one_at. nin H. rw H. rww target_arrow_one_at. rw H. rww target_arrow_one_at. am. rw mor_twoarrow_cat1. ee. nin H1. app or_introl. ee. app or_intror. Qed. Lemma comp_twoarrow_cat : forall u v, mor twoarrow_cat u -> mor twoarrow_cat v -> source u = target v -> comp twoarrow_cat u v = fa_comp u v. Proof. ir. uf twoarrow_cat. rw comp_subcategory. rw comp_function_cat. tv. rwi mor_twoarrow_cat2 H. ee; am. rwi mor_twoarrow_cat2 H0; ee; am. am. ap twoarrow_property. rwi mor_twoarrow_cat2 H. ee; am. rwi mor_twoarrow_cat2 H0; ee; am. am. rwi mor_twoarrow_cat2 H. ee; am. rwi mor_twoarrow_cat2 H0; ee; am. Qed. Lemma composable_twoarrow_cat : forall u v, mor twoarrow_cat u -> mor twoarrow_cat v -> source u = target v -> ((source u = R 2 & u = id twoarrow_cat (source u) & source u = target u & comp twoarrow_cat u v = v) \/ (source u = R 1 & v = id twoarrow_cat (target v) & source v = target v & comp twoarrow_cat u v = u)). Proof. ir. assert (ob twoarrow_cat (source u)). rww ob_source. rwi ob_twoarrow_cat H2. nin H2. ap or_intror. dj. am. rwi mor_twoarrow_cat2 H0. ee. rwi H1 H2. cp (case_target_one H0 H2). rw H2. rw id_twoarrow_cat. am. wr H2. wr H1. rww ob_source. rw H4. rw source_id. rw target_id. tv. rww ob_target. rww ob_target. rw H4. wr H5. rw right_id. tv. rww ob_source. am. rww H5. tv. ap or_introl. dj. am. rwi mor_twoarrow_cat2 H. ee. cp (case_source_two H H2). rw H2. rw id_twoarrow_cat. am. wr H2. rw H1. rww ob_target. rw H4. rw source_id. rww target_id. rww ob_source. rww ob_source. rw H4. rw left_id. tv. rww ob_source. am. sy; am. tv. Qed. Lemma ob_ta_1 : ob twoarrow_cat (R 1). Proof. ir. rw ob_twoarrow_cat. app or_introl. Qed. Lemma ob_ta_2 : ob twoarrow_cat (R 2). Proof. ir. rw ob_twoarrow_cat. app or_intror. Qed. Lemma mor_ta_i1 : mor twoarrow_cat (fa_id (R 1)). Proof. Qed. Lemma mor_ta_i2 : mor twoarrow_cat (fa_id (R 2)). Proof. Qed. Lemma mor_ta_a0 : mor twoarrow_cat (arrow_one_at (R 0) (R 2)). Proof. Qed. Lemma mor_ta_a1 : mor twoarrow_cat (arrow_one_at (R 1) (R 2)). Proof. Qed. Definition twoarrow_functor u v a := Functor.create twoarrow_cat a (fun w => Y (w = fa_id (R 1)) (id a (source u)) (Y (w = fa_id (R 2)) (id a (target u)) (Y (w = arrow_one_at (R 0) (R 2)) u v))). Lemma source_twoarrow_functor : forall u v a, source (twoarrow_functor u v a) = twoarrow_cat. Proof. ir. uf twoarrow_functor. rww Functor.source_create. Qed. Lemma target_twoarrow_functor : forall u v a, target (twoarrow_functor u v a) = a. Proof. ir. uf twoarrow_functor. rww Functor.target_create. Qed. Lemma fmor_taf_i1 : forall u v a, fmor (twoarrow_functor u v a) (fa_id (R 1)) = id a (source u). Proof. ir. uf twoarrow_functor. rw fmor_create. rw Y_if_rw. tv. tv. Qed. Lemma fmor_taf_i2 : forall u v a, fmor (twoarrow_functor u v a) (fa_id (R 2)) = id a (target u). Proof. Qed. Lemma fmor_taf_a0 : forall u v a, fmor (twoarrow_functor u v a) (arrow_one_at (R 0) (R 2)) = u. Proof. Qed. Lemma fmor_taf_a1 : forall u v a, fmor (twoarrow_functor u v a) (arrow_one_at (R 1) (R 2)) = v. Proof. Qed. Lemma fob_taf_1 : forall u v a, fob (twoarrow_functor u v a) (R 1) = source u. Proof. Qed. Lemma fob_taf_2 : forall u v a, fob (twoarrow_functor u v a) (R 2) = target u. Proof. Qed. Lemma twoarrow_functor_axioms : forall u v a, mor a u -> mor a v -> source u = source v -> target u = target v -> Functor.axioms (twoarrow_functor u v a). Proof. ir. uhg; ee; try (rw source_twoarrow_functor); try (rw target_twoarrow_functor). uf twoarrow_functor. uf Functor.create. ap Umorphism.create_like. ap twoarrow_cat_axioms. uh H; ee. am. Qed. End Twoarrow_Cat. *******************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Module Functor_Cat. Export Nat_Trans. Definition fhom a b f := Functor.axioms f & source f = a & target f = b. Definition nthom f g u := Nat_Trans.axioms u & source u = f & target u = g. Definition nt2hom a b u := Nat_Trans.axioms u & osource u = a & otarget u = b. Lemma fhom_bounded : forall a b, Bounded.axioms (fhom a b). Proof. ir. cp (Bounded.trans_criterion (p:=fhom a b) (f:=fun g => Arrow.create a b g) (x:=Function_Set.function_set (morphisms a) (fun z =>morphisms b))). apply H. ir. sh (L (morphisms a) (fmor y)). ee. apply Function_Set.in_function_set_inc. apply Function_Set.in_fs_for_L. ir. change (is_mor b (fmor y y0)). ap mor_is_mor. uh H0; ee. wr H3. app mor_fmor. rw H2. ap is_mor_mor. wr H2. lu. am. uh H0; ee. uh H0; ee. uh H0; ee. ufi Umorphism.create H0. set (k:= fmor y). wr H0. uf k. wr H1. wr H2. ap uneq. ap Function.create_extensionality. tv. ir. tv. Qed. Lemma nthom_bounded : forall f g, Bounded.axioms (nthom f g). Proof. ir. cp (Bounded.trans_criterion (p:=nthom f g) (f:= fun u => Arrow.create f g (ntrans_arrow_create f (fun y => V y u))) (x:= Function_Set.function_set (objects (source f)) (fun z => morphisms (target g)))). ap H. ir. sh (L (objects (source f)) (ntrans y)). ee. apply Function_Set.in_function_set_inc. apply Function_Set.in_fs_for_L. ir. assert (ob (source f) y0). ap is_ob_ob. uh H0; ee. wr H2. uh H0; ee. exact H4. am. change (is_mor (target g) (ntrans y y0)). ap mor_is_mor. ap mor_ntrans. lu. uh H0; ee. uf osource. rw H3. am. uf otarget. uh H0; ee. rw H4. tv. uh H0; ee. assert (Nat_Trans.like y). lu. uh H3; ee. ufi create H3. set (k:=ntrans y). wr H3. uf k. wr H1. wr H2. ap uneq. uf ntrans_arrow_create. assert (Function.create (objects (source (source y))) (fun y0 : E => V y0 (Function.create (objects (source (source y))) (ntrans y))) = Function.create (objects (source (source y))) (ntrans y)). ap Function.create_extensionality. tv. ir. rw create_V_rewrite. tv. am. rww H4. Qed. Definition functor_set a b:= (Bounded.create (fhom a b)). Lemma inc_functor_set : forall a b u, inc u (functor_set a b) = fhom a b u. Proof. ir. uf functor_set. rw Bounded.inc_create. tv. ap fhom_bounded. Qed. Definition nt_set f g:= (Bounded.create (nthom f g)). Lemma inc_nt_set : forall f g u, inc u (nt_set f g) = nthom f g u. Proof. ir. uf nt_set. rw Bounded.inc_create. tv. ap nthom_bounded. Qed. Lemma nt2hom_bounded : forall a b, Bounded.axioms (nt2hom a b). Proof. ir. ap Bounded.criterion. sh (union (Image.create (Cartesian.product (functor_set a b) (functor_set a b)) (fun z => (nt_set (pr1 z) (pr2 z))))). ir. apply union_inc with (nt_set (source y) (target y)). rw inc_nt_set. uh H; ee. uhg; ee. am. tv. tv. rw Image.inc_rw. uh H; ee. sh (pair (source y) (target y)). ee. ap product_pair_inc. rw inc_functor_set. uhg; ee. uh H; ee. am. am. rww target_source. rw inc_functor_set. uhg; ee. uh H; ee; am. rww source_target. am. rw pr1_pair. rw pr2_pair. tv. Qed. Definition nt2_set a b := (Bounded.create (nt2hom a b)). Lemma inc_nt2_set : forall a b u, inc u (nt2_set a b) = nt2hom a b u. Proof. ir. uf nt2_set. rw Bounded.inc_create. tv. ap nt2hom_bounded. Qed. Definition functor_cat a b := Category.Notations.create (functor_set a b) (nt2_set a b) vcompose vident emptyset. Lemma objects_functor_cat : forall a b, objects (functor_cat a b) = functor_set a b. Proof. ir. uf functor_cat. rww objects_create. Qed. Lemma morphisms_functor_cat : forall a b, morphisms (functor_cat a b) = nt2_set a b. Proof. ir. uf functor_cat. rww morphisms_create. Qed. Lemma is_ob_functor_cat : forall a b x, is_ob (functor_cat a b) x = fhom a b x. Proof. ir. uf is_ob. rw objects_functor_cat. rww inc_functor_set. Qed. Lemma is_mor_functor_cat : forall a b u, is_mor (functor_cat a b) u = nt2hom a b u. Proof. ir. uf is_mor. rw morphisms_functor_cat. rww inc_nt2_set. Qed. Lemma functor_cat_axioms : forall a b, Category.axioms a -> Category.axioms b -> Category.axioms (functor_cat a b). Proof. ir. uf functor_cat. ap Category.create_axioms. uhg; ee; ir. rw inc_functor_set; app iff_eq; ir. uh H1; ee. uhg; ee. rw inc_functor_set. uhg; xd. rw inc_nt2_set. uhg; ee. rww vident_axioms. rww osource_vident. rww otarget_vident. rww source_vident. rww target_vident. uh H1; ee. rwi inc_functor_set H1. am. app iff_eq; ir. cp H1. rwi inc_nt2_set H2. uh H2; ee. uhg; ee. am. rw inc_functor_set. uhg; ee. uh H2; ee. am. am. rww target_source. rw inc_functor_set. uhg; ee. uh H2; ee; am. rww source_target. am. rww right_vident. rww left_vident. uh H2; ee. uh H2. ufi create H2. wr H2. rww Arrow.create_like. uh H1; ee. am. cp H1; cp H2. rwi inc_nt2_set H4. rwi inc_nt2_set H5. uh H4; uh H5; ee. uhg; ee. am. am. am. rw inc_nt2_set. uhg; ee. rww vcompose_axioms. rww osource_vcompose. rww otarget_vcompose. rww source_vcompose. rww target_vcompose. rww vcompose_assoc. rwi inc_nt2_set H1. lu. rwi inc_nt2_set H2. lu. rwi inc_nt2_set H3. lu. Qed. Lemma ob_functor_cat : forall a b x, Category.axioms a -> Category.axioms b -> ob (functor_cat a b) x = fhom a b x. Proof. ir. app iff_eq; ir. wr is_ob_functor_cat. lu. uhg; ee. app functor_cat_axioms. rww is_ob_functor_cat. Qed. Lemma mor_functor_cat : forall a b u, Category.axioms a -> Category.axioms b -> mor (functor_cat a b) u = nt2hom a b u. Proof. ir. app iff_eq; ir. wr is_mor_functor_cat. lu. uhg; ee. app functor_cat_axioms. rww is_mor_functor_cat. Qed. Lemma comp_functor_cat : forall a b u v, Category.axioms a -> Category.axioms b -> mor (functor_cat a b) u -> mor (functor_cat a b) v -> source u = target v -> comp (functor_cat a b) u v = vcompose u v. Proof. ir. uf functor_cat. rw comp_create. tv. rw inc_nt2_set. wrr mor_functor_cat. rw inc_nt2_set. wrr mor_functor_cat. am. Qed. Lemma id_functor_cat : forall a b x, Category.axioms a -> Category.axioms b -> ob (functor_cat a b) x -> id (functor_cat a b) x = vident x. Proof. ir. uf functor_cat; rw id_create. tv. rw inc_functor_set. wrr ob_functor_cat. Qed. (**** we need point functors, point transfos etc. ***) Definition point_functor a b x := Functor.create (functor_cat a b) b (fun u => ntrans u x). Lemma source_point_functor : forall a b x, source (point_functor a b x) = functor_cat a b. Proof. ir. uf point_functor. rww Functor.source_create. Qed. Lemma target_point_functor : forall a b x, target (point_functor a b x) = b. Proof. ir. uf point_functor. rww Functor.target_create. Qed. Lemma fob_point_functor : forall a b x y, Category.axioms a -> Category.axioms b -> ob (functor_cat a b) y -> ob a x -> fob (point_functor a b x) y = fob y x. Proof. ir. uf point_functor. rw Functor.fob_create. rw source_ntrans. rw source_id. tv. am. rw id_functor_cat. rww vident_axioms. rwi ob_functor_cat H1. lu. am. am. am. am. am. rw id_functor_cat. rw osource_vident. rwi ob_functor_cat H1. uh H1; ee. rww H3. am. am. am. am. am. am. Qed. Lemma fmor_point_functor : forall a b x u, mor (functor_cat a b) u -> fmor (point_functor a b x) u = ntrans u x. Proof. ir. uf point_functor. rww fmor_create. Qed. Lemma point_functor_axioms : forall a b x, ob a x -> Category.axioms b -> Functor.axioms (point_functor a b x). Proof. ir. assert (Category.axioms a). uh H; ee; am. uf point_functor. ap Functor.create_axioms. sh (fun y => fob y x). uhg; dj. ap functor_cat_axioms. lu. am. am. rwi ob_functor_cat H4. uh H4; ee. wr H6. ap ob_fob. am. rww H5. am. am. rw id_functor_cat. rw ntrans_vident. rwi ob_functor_cat H5. uh H5; ee. rww H7. am. am. rwi ob_functor_cat H5. uh H5; ee. rww H6. am. am. am. am. am. rwi mor_functor_cat H6; ee. uh H6; ee. app mor_ntrans. rww H7. sy; am. am. am. rww source_ntrans. rwi mor_functor_cat H7; uh H7; ee. am. am. am. rwi mor_functor_cat H7; uh H7; ee. rww H8. am. am. rww target_ntrans. rwi mor_functor_cat H8; uh H8; ee. am. am. am. rwi mor_functor_cat H8; uh H8; ee. rww H9. am. am. rw comp_functor_cat. rw ntrans_vcompose. rwi mor_functor_cat H9; uh H9; ee. rww H13. am. am. rwi mor_functor_cat H10; uh H10; ee. rww H12. am. am. am. am. am. am. am. Qed. Definition point_trans a b u := Nat_Trans.create (point_functor a b (source u)) (point_functor a b (target u)) (fun y => fmor y u). Lemma source_point_trans: forall a b u, source (point_trans a b u) = point_functor a b (source u). Proof. ir. uf point_trans. rww Nat_Trans.source_create. Qed. Lemma target_point_trans : forall a b u, target (point_trans a b u) = point_functor a b (target u). Proof. ir. uf point_trans. rww Nat_Trans.target_create. Qed. Lemma osource_point_trans : forall a b u, osource (point_trans a b u) = functor_cat a b. Proof. ir. uf osource. rw source_point_trans. rww source_point_functor. Qed. Lemma otarget_point_trans : forall a b u, otarget (point_trans a b u) = b. Proof. ir. uf otarget. rw target_point_trans. rww target_point_functor. Qed. Lemma ntrans_point_trans : forall a b u y, mor a u -> ob (functor_cat a b) y -> ntrans (point_trans a b u) y = fmor y u. Proof. ir. uf point_trans. rww ntrans_create. rw source_point_functor. change (is_ob (functor_cat a b) y). lu. Qed. Lemma point_trans_axioms : forall a b u, mor a u -> Category.axioms b -> Nat_Trans.axioms (point_trans a b u). Proof. ir. assert (lem1 : Category.axioms a). uh H; ee; am. uf point_trans. ap Nat_Trans.create_axioms. uhg; dj. ap point_functor_axioms. rwi mor_facts_rw H; lu. am. ap point_functor_axioms. rwi mor_facts_rw H; lu. am. rw source_point_functor. rw source_point_functor. tv. rw target_point_functor. rw target_point_functor. tv. rw target_point_functor. rwi source_point_functor H5. rwi ob_functor_cat H5. uh H5; ee. wr H7. ap mor_fmor. am. rww H6. am. am. rwi source_point_functor H6. cp H6. rwi ob_functor_cat H7. uh H7; ee. rww fob_point_functor. rww source_fmor. rww H8. rww ob_source. am. am. rwi source_point_functor H7. cp H7. rwi ob_functor_cat H7. uh H7; ee. rww fob_point_functor. rww target_fmor. rww H9. rww ob_target. am. am. rwi source_point_functor H8. cp H8. rwi mor_functor_cat H8. uh H8; ee. rww target_point_functor. rww fmor_point_functor. rww fmor_point_functor. wr H11. rw carre. tv. am. rww H10. am. am. Qed. Lemma vcompose_point_trans : forall a b u v, composable a u v -> Category.axioms b -> vcompose (point_trans a b u) (point_trans a b v) = point_trans a b (comp a u v). Proof. ir. rwi composable_facts_rw H; uh H; ee. ap Nat_Trans.axioms_extensionality. rw vcompose_axioms. tv. ap point_trans_axioms. am. am. ap point_trans_axioms; am. rw source_point_trans. rw target_point_trans. rw H5; tv. ap point_trans_axioms. am. am. rw source_vcompose. rw source_point_trans. rw source_point_trans. rw source_comp. tv. am. am. am. rw target_vcompose. rw target_point_trans. rw target_point_trans. rw target_comp. tv. am. am. am. ir. rwi osource_vcompose H8. rwi osource_point_trans H8. rwi ob_functor_cat H8. rw ntrans_vcompose. rw otarget_point_trans. rw ntrans_point_trans. rw ntrans_point_trans. rw ntrans_point_trans. uh H8; ee. wr H10. rw comp_fmor. rww H9. am. rww H9. rww H9. am. am. rww ob_functor_cat. am. rww ob_functor_cat. am. rww ob_functor_cat. rww osource_point_trans. rww ob_functor_cat. am. am. Qed. Lemma vident_point_functor : forall a b x, ob a x -> Category.axioms b -> vident (point_functor a b x) = point_trans a b (id a x). Proof. ir. assert (lem1: Category.axioms a). uh H; ee; am. rwi ob_facts_rw H; uh H; ee. ap Nat_Trans.axioms_extensionality. rw vident_axioms. tv. ap point_functor_axioms. am. am. ap point_trans_axioms. am. am. rw source_vident. rw source_point_trans. rw H3. tv. rw target_vident. rw target_point_trans. rw H4; tv. ir. rwi osource_vident H8. rwi source_point_functor H8. cp H8. rwi ob_functor_cat H8. uh H8; ee. rw ntrans_vident. rw target_point_functor. rw fob_point_functor. rw ntrans_point_trans. wr H11. rw id_fob. rww H10. am. rww H10. am. rw ob_functor_cat. uhg; ee; am. am. am. tv. am. am. am. rw source_point_functor. am. am. am. Qed. Definition fc_opp a b := Functor.create (functor_cat (opp a) (opp b)) (opp (functor_cat a b)) (fun u => flip (oppnt u)). Lemma source_fc_opp : forall a b, source (fc_opp a b) = (functor_cat (opp a) (opp b)). Proof. ir. uf fc_opp. rw Functor.source_create. tv. Qed. Lemma target_fc_opp : forall a b, target (fc_opp a b) = (opp (functor_cat a b)). Proof. ir. uf fc_opp. rw Functor.target_create. tv. Qed. Lemma fmor_fc_opp : forall a b u, mor (functor_cat (opp a) (opp b)) u -> fmor (fc_opp a b) u = flip (oppnt u). Proof. ir. uf fc_opp. rw fmor_create. tv. am. Qed. Lemma fob_fc_opp : forall a b f, Category.axioms a -> Category.axioms b -> ob (functor_cat (opp a) (opp b)) f -> fob (fc_opp a b) f = oppf f. Proof. ir. uf fob. rw fmor_fc_opp. rw source_flip. rw target_oppnt. rw source_id. tv. rw source_fc_opp. am. uf oppnt. uf create. rw source_fc_opp. rw id_functor_cat. rwi ob_functor_cat H1. uh H1; ee. rww vident_axioms. app opp_axioms. app opp_axioms. app opp_axioms. app opp_axioms. am. rw unfold_oppnt. uf oppnt'. uf create. rww Arrow.create_like. rw source_fc_opp. rw id_functor_cat. rwi ob_functor_cat H1. uh H1; ee. rww vident_axioms. app opp_axioms. app opp_axioms. app opp_axioms. app opp_axioms. am. rw source_fc_opp. ap mor_id. am. Qed. Lemma fc_opp_axioms : forall a b, Category.axioms a -> Category.axioms b -> Functor.axioms (fc_opp a b). Proof. ir. assert (oax : Category.axioms (opp a)). app opp_axioms. assert (obx : Category.axioms (opp b)). app opp_axioms. uhg; ee. uf fc_opp. uf Functor.create. app Umorphism.create_like. rw source_fc_opp. ap functor_cat_axioms. app opp_axioms. app opp_axioms. rw target_fc_opp. ap opp_axioms. ap functor_cat_axioms. am. am. ir. rwi source_fc_opp H1. cp H1. rwi ob_functor_cat H2. uh H2; ee. rw target_fc_opp. rw ob_opp. rw fob_fc_opp. rw ob_functor_cat. uhg; ee. ap oppf_axioms. am. rww source_oppf. rw H3. rww opp_opp. rw target_oppf. rw H4. rww opp_opp. am. am. am. am. am. rw ob_functor_cat. uhg; ee. am. am. am. app opp_axioms. app opp_axioms. am. am. ir. rwi source_fc_opp H1. cp H1. rwi ob_functor_cat H2. uh H2; ee. assert (ob (functor_cat a b) (oppf x)). rw ob_functor_cat. uhg; ee. app oppf_axioms. rw source_oppf. rw H3. rww opp_opp. am. rw target_oppf. rw H4. rww opp_opp. am. am. am. rw target_fc_opp. rw fob_fc_opp. rw fmor_fc_opp. rw source_fc_opp. rw id_opp. ap uneq. rw id_functor_cat. rw id_functor_cat. rw vident_oppf. tv. am. am. am. rw ob_functor_cat. uhg; ee; try am. am. am. am. am. am. rw ob_opp. am. rw source_fc_opp. app mor_id. am. am. am. am. am. ir. cp H1. rwi source_fc_opp H2. cp H2. rwi mor_functor_cat H3. uh H3. ee. assert (mor (functor_cat a b) (oppnt u)). rw mor_functor_cat. uhg; ee. app oppnt_axioms. rw osource_oppnt. rw H4. rww opp_opp. am. rw otarget_oppnt. rw H5. rww opp_opp. am. am. am. rw target_fc_opp. rw mor_opp. rw mor_functor_cat. uhg; ee. rw fmor_fc_opp. rw flip_flip. app oppnt_axioms. am. rw fmor_fc_opp. rw flip_flip. rw osource_oppnt. rw H4. rww opp_opp. am. am. rw fmor_fc_opp. rw flip_flip. rw otarget_oppnt. rw H5. rww opp_opp. am. am. am. am. am. am. ir. cp H1. rwi source_fc_opp H2. cp H2. rwi mor_functor_cat H3. uh H3. ee. assert (mor (functor_cat a b) (oppnt u)). rw mor_functor_cat. uhg; ee. app oppnt_axioms. rw osource_oppnt. rw H4. rww opp_opp. am. rw otarget_oppnt. rw H5. rww opp_opp. am. am. am. rw fmor_fc_opp. rw source_flip. rw fob_fc_opp. rw target_oppnt. tv. am. am. am. rww ob_source. rw unfold_oppnt. uf oppnt'. uf create. rww Arrow.create_like. am. am. am. am. ir. cp H1. rwi source_fc_opp H2. cp H2. rwi mor_functor_cat H3. uh H3. ee. assert (mor (functor_cat a b) (oppnt u)). rw mor_functor_cat. uhg; ee. app oppnt_axioms. rw osource_oppnt. rw H4. rww opp_opp. am. rw otarget_oppnt. rw H5. rww opp_opp. am. am. am. rw fmor_fc_opp. rw target_flip. rw fob_fc_opp. rw source_oppnt. tv. am. am. am. rw ob_target. tv. am. rw unfold_oppnt. uf oppnt'. uf create. rww Arrow.create_like. am. am. am. am. ir. cp H1. rwi source_fc_opp H4. cp H4. rwi mor_functor_cat H5. uh H5. ee. assert (mor (functor_cat a b) (oppnt u)). rw mor_functor_cat. uhg; ee. app oppnt_axioms. rw osource_oppnt. rw H6. rww opp_opp. am. rw otarget_oppnt. rw H7. rww opp_opp. am. am. am. cp H2. rwi source_fc_opp H9. cp H9. rwi mor_functor_cat H10. uh H10. ee. assert (mor (functor_cat a b) (oppnt v)). rw mor_functor_cat. uhg; ee. app oppnt_axioms. rw osource_oppnt. rw H11. rww opp_opp. am. rw otarget_oppnt. rw H12. rww opp_opp. am. am. am. rw target_fc_opp. rw fmor_fc_opp. rw fmor_fc_opp. rw comp_opp. rw fmor_fc_opp. ap uneq. rw source_fc_opp. rw flip_flip. rw flip_flip. rw comp_functor_cat. rw comp_functor_cat. rw vcompose_oppnt. tv. am. am. am. am. am. am. am. am. am. am. am. am. rw source_oppnt. rw target_oppnt. rw H3. tv. am. am. rw source_fc_opp. rw mor_comp. tv. am. am. am. reflexivity. rw mor_opp. rw flip_flip. am. rw mor_opp. rw flip_flip. am. rw source_flip. rw target_flip. rw target_oppnt. rw source_oppnt. rww H3. am. am. apply mor_arrow_like with (functor_cat a b). am. apply mor_arrow_like with (functor_cat a b). am. am. am. am. am. am. am. Qed. Definition opp_fc a b := Functor.create (opp (functor_cat a b)) (functor_cat (opp a) (opp b)) (fun u => oppnt (flip u)). Lemma source_opp_fc : forall a b, source (opp_fc a b) = opp (functor_cat a b). Proof. ir. uf opp_fc. rww Functor.source_create. Qed. Lemma target_opp_fc : forall a b, target (opp_fc a b) = functor_cat (opp a) (opp b). Proof. ir. uf opp_fc. rww Functor.target_create. Qed. Lemma fmor_opp_fc : forall a b u, mor (opp (functor_cat a b)) u -> fmor (opp_fc a b) u = oppnt (flip u). Proof. ir. uf opp_fc. rw fmor_create. tv. am. Qed. Lemma fob_opp_fc : forall a b x, Category.axioms a -> Category.axioms b -> ob (opp (functor_cat a b)) x -> fob (opp_fc a b) x = oppf x. Proof. ir. uf fob. rw fmor_opp_fc. rw source_opp_fc. rw source_oppnt. rw target_flip. rw source_id. tv. am. apply mor_arrow_like with (opp (functor_cat a b)). ap mor_id. am. rw id_opp. rw flip_flip. rw id_functor_cat. rww vident_axioms. rwi ob_opp H1. rwi ob_functor_cat H1. uh H1; ee; am. am. am. am. am. rwi ob_opp H1. am. am. rw source_opp_fc. ap mor_id. am. Qed. Lemma opp_fc_axioms : forall a b, Category.axioms a -> Category.axioms b -> Functor.axioms (opp_fc a b). Proof. ir. assert (oax : Category.axioms (opp a)). app opp_axioms. assert (obx :Category.axioms (opp b)). app opp_axioms. assert (fcox : Category.axioms (functor_cat (opp a) (opp b))). ap functor_cat_axioms. am. am. assert (ofcx : Category.axioms (opp (functor_cat a b))). ap opp_axioms. ap functor_cat_axioms. am. am. assert (sfcx : Category.axioms (source (opp_fc a b))). rw source_opp_fc. am. assert (tfcx : Category.axioms (target (opp_fc a b))). rw target_opp_fc. am. assert (fcx : Category.axioms (functor_cat a b)). ap functor_cat_axioms. am. am. uhg; ee. uf opp_fc. uf Functor.create. ap Umorphism.create_like. am. am. ir. cp H1. rwi source_opp_fc H2. cp H2. rwi ob_opp H3. cp H3. rwi ob_functor_cat H4. uh H4; ee. assert (ob (functor_cat (opp a) (opp b)) (oppf x)). rw ob_functor_cat. uhg; ee. ap oppf_axioms. am. rw source_oppf. rww H5. am. rw target_oppf. rww H6. am. am. am. rw target_opp_fc. rw fob_opp_fc. am. am. am. am. am. am. ir. cp H1. rwi source_opp_fc H2. cp H2. rwi ob_opp H3. cp H3. rwi ob_functor_cat H4. uh H4; ee. assert (ob (functor_cat (opp a) (opp b)) (oppf x)). rw ob_functor_cat. uhg; ee. ap oppf_axioms. am. rw source_oppf. rww H5. am. rw target_oppf. rw H6. tv. am. am. am. rw target_opp_fc. rw fob_opp_fc. rw fmor_opp_fc. rw source_opp_fc. rw id_functor_cat. rw id_opp. rw flip_flip. rw id_functor_cat. rw vident_oppf. tv. am. am. am. am. rw ob_opp. am. am. am. am. rw source_opp_fc. ap mor_id. am. am. am. am. am. am. ir. cp H1. rwi source_opp_fc H2. cp H2. rwi mor_opp H3. cp H3. rwi mor_functor_cat H4. uh H4; ee. assert (axioms (oppnt (flip u))). ap oppnt_axioms. am. rw target_opp_fc. rw fmor_opp_fc. rw mor_functor_cat. uhg; ee. am. rw osource_oppnt. rww H5. am. rw otarget_oppnt. rww H6. am. am. am. am. am. am. ir. cp H1. rwi source_opp_fc H2. cp H2. rwi mor_opp H3. cp H3. rwi mor_functor_cat H4. uh H4; ee. assert (axioms (oppnt (flip u))). ap oppnt_axioms. am. assert (Arrow.like u). apply mor_arrow_like with (source (opp_fc a b)). am. rw fmor_opp_fc. rw fob_opp_fc. rw source_oppnt. rww target_flip. rwi axioms_oppnt H7. am. am. am. rww ob_source. am. am. am. ir. cp H1. rwi source_opp_fc H2. cp H2. rwi mor_opp H3. cp H3. rwi mor_functor_cat H4. uh H4; ee. assert (axioms (oppnt (flip u))). ap oppnt_axioms. am. assert (Arrow.like u). apply mor_arrow_like with (source (opp_fc a b)). am. rw fmor_opp_fc. rw fob_opp_fc. rw target_oppnt. rww source_flip. am. am. am. rww ob_target. am. am. am. ir. cp H1. rwi source_opp_fc H4. cp H4. rwi mor_opp H5. cp H5. rwi mor_functor_cat H6. uh H6; ee. assert (axioms (oppnt (flip u))). ap oppnt_axioms. am. assert (Arrow.like u). apply mor_arrow_like with (source (opp_fc a b)). am. cp H2. rwi source_opp_fc H11. cp H11. rwi mor_opp H12. cp H12. rwi mor_functor_cat H13. uh H13; ee. assert (axioms (oppnt (flip v))). ap oppnt_axioms. am. assert (Arrow.like v). apply mor_arrow_like with (source (opp_fc a b)). am. assert (source (flip v) = target (flip u)). rw source_flip. rw target_flip. sy; am. am. am. assert (mor (functor_cat (opp a) (opp b)) (oppnt (flip u))). rw mor_functor_cat. uhg; ee. am. rw osource_oppnt. rww H7. am. rw otarget_oppnt. ap uneq; am. am. am. am. assert (mor (functor_cat (opp a) (opp b)) (oppnt (flip v))). rw mor_functor_cat. uhg; ee. am. rw osource_oppnt. ap uneq; am. am. rw otarget_oppnt. ap uneq; am. am. am. am. rw target_opp_fc. rw fmor_opp_fc. rw fmor_opp_fc. rw fmor_opp_fc. rw source_opp_fc. rw comp_functor_cat. rw comp_opp. rw flip_flip. rw comp_functor_cat. rw vcompose_oppnt. reflexivity. am. am. am. am. am. am. am. am. am. am. am. am. am. am. am. rw source_oppnt. rw target_oppnt. ap uneq. sy; am. am. am. rw source_opp_fc. rw mor_comp. tv. am. am. am. tv. am. am. am. am. am. am. Qed. Lemma are_finverse_opp_fc_fc_opp : forall a b, Category.axioms a -> Category.axioms b -> are_finverse (opp_fc a b) (fc_opp a b). Proof. ir. assert (Functor.axioms (opp_fc a b)). app opp_fc_axioms. assert (Functor.axioms (fc_opp a b)). app fc_opp_axioms. assert (source (fc_opp a b) = target (opp_fc a b)). rw source_fc_opp. rww target_opp_fc. assert (source (opp_fc a b) = target (fc_opp a b)). rw target_fc_opp. rww source_opp_fc. uhg; ee. am. am. am. am. ap Functor.axioms_extensionality. ap fcompose_axioms. am. am. am. rw fidentity_axioms. tv. rw source_fc_opp. ap functor_cat_axioms. app opp_axioms. app opp_axioms. rw source_fcompose. rw source_fidentity. reflexivity. rw target_fcompose. rw target_fidentity. sy; am. ir. rwi source_fcompose H5. cp H5. rwi source_fc_opp H6. cp H6. rwi mor_functor_cat H7. uh H7; ee. rw fmor_fcompose. rw fmor_fidentity. rw fmor_opp_fc. rw fmor_fc_opp. rw flip_flip. rw oppnt_oppnt. tv. am. wr target_fc_opp. ap mor_fmor. ap fc_opp_axioms. am. am. am. am. app opp_fc_axioms. app fc_opp_axioms. am. am. app opp_axioms. app opp_axioms. ap Functor.axioms_extensionality. ap fcompose_axioms. am. am. am. rw fidentity_axioms. tv. rw source_opp_fc. ap opp_axioms. app functor_cat_axioms. rw source_fcompose. rw source_fidentity. reflexivity. rw target_fcompose. rw target_fidentity. sy; am. ir. rwi source_fcompose H5. cp H5. rwi source_opp_fc H6. cp H6. rwi mor_opp H7. cp H7. rwi mor_functor_cat H8. uh H8; ee. rw fmor_fcompose. rw fmor_fidentity. rw fmor_fc_opp. rw fmor_opp_fc. rw oppnt_oppnt. rw flip_flip. tv. am. wr target_opp_fc. ap mor_fmor. ap opp_fc_axioms. am. am. am. am. app fc_opp_axioms. app opp_fc_axioms. am. am. am. am. Qed. End Functor_Cat. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Module Functor_Cat_Limit. Export Functor_Cat. Export Colimit. Module MainResultMod. Section MainResult. Variables a b f: E. Hypothesis Xa : Category.axioms a. Hypothesis Xb : Category.axioms b. Hypothesis Ff : Functor.axioms f. Hypothesis F2 : target f = functor_cat a b. Definition pointf x := fcompose (point_functor a b x) f. Definition c:= source f. Definition F1 : source f = c. Proof. tv. Qed. Definition Xc : Category.axioms c. Proof. uf c. cp Ff; lu. Qed. Lemma source_pointf : forall x, source (pointf x) = c. Proof. ir. uf pointf. rw source_fcompose. tv. Qed. Lemma target_pointf : forall x, target (pointf x) = b. Proof. ir. uf pointf. rww target_fcompose. rww target_point_functor. Qed. Lemma pointf_axioms : forall x, ob a x -> Functor.axioms (pointf x). Proof. ir. uf pointf. ap fcompose_axioms. app point_functor_axioms. am. rww source_point_functor. sy; am. Qed. Definition pointl x := limit (pointf x). Hypothesis FL : forall x, ob a x -> has_limit (pointf x). Lemma is_limit_pointl : forall x, ob a x -> is_limit (pointl x). Proof. ir. uf pointl. ap is_limit_limit. au. Qed. Lemma is_cone_pointl : forall x, ob a x -> is_cone (pointl x). Proof. ir. cp (is_limit_pointl H). lu. Qed. Lemma socle_pointl : forall x, ob a x -> socle (pointl x) = pointf x. Proof. ir. uf pointl. rw socle_limit. tv. au. Qed. Lemma cone_target_pointl : forall x, ob a x -> cone_target (pointl x) = b. Proof. ir. uf cone_target. rw socle_pointl. tv. rww target_pointf. am. Qed. Lemma cone_source_pointl : forall x, ob a x -> cone_source (pointl x) = c. Proof. ir. uf cone_source. rw socle_pointl. rww source_pointf. am. Qed. Definition pointv x := vertex (pointl x). Lemma vertex_pointl : forall x, vertex (pointl x) = pointv x. Proof. ir. tv. Qed. Lemma ob_pointv : forall x, ob a x -> ob b (pointv x). Proof. ir. uf pointv. assert (b = cone_target (pointl x)). uf cone_target. rw socle_pointl. rww target_pointf. am. rw H0. ap Limit.ob_vertex. cp (is_limit_pointl H). lu. Qed. Definition newcone u := cone_transform (htrans_right (point_trans a b u) f) (pointl (source u)). Lemma is_cone_newcone : forall u, mor a u -> is_cone (newcone u). Proof. ir. uf newcone. ap is_cone_cone_transform. uhg; ee. ap is_cone_pointl. rww ob_source. ap htrans_right_axioms. am. ap point_trans_axioms. am. am. rw osource_point_trans. sy; am. rw socle_pointl. rw source_htrans_right. rw source_point_trans. uf pointf. tv. rww ob_source; am. Qed. Lemma socle_newcone : forall u, mor a u -> socle (newcone u) = pointf (target u). Proof. ir. uf newcone. rw socle_cone_transform. rw target_htrans_right. rw target_point_trans. tv. Qed. Lemma vertex_newcone : forall u, mor a u -> vertex (newcone u) = pointv (source u). Proof. ir. uf newcone. rw vertex_cone_transform. tv. Qed. Definition restr u := cone_to_limit (newcone u) (pointl (target u)). Lemma mor_restr : forall u, mor a u -> mor b (restr u). Proof. ir. uf restr. ap mor_cone_to_limit. ap is_cone_newcone. am. ap is_limit_pointl. rww ob_target. rw socle_newcone. rw socle_pointl. tv. rww ob_target; am. am. uf otarget. rww cone_target_pointl. rww ob_target. Qed. Lemma source_restr : forall u, mor a u -> source (restr u) = pointv (source u). Proof. ir. uf restr. rw source_cone_to_limit. rw vertex_newcone. tv. am. ap is_cone_newcone. am. ap is_limit_pointl. rww ob_target. rw socle_newcone. rw socle_pointl. tv. rww ob_target. am. Qed. Lemma target_restr : forall u, mor a u -> target (restr u) = pointv (target u). Proof. ir. uf restr. rw target_cone_to_limit. tv. ap is_cone_newcone. am. ap is_limit_pointl. rww ob_target. rw socle_newcone. rw socle_pointl. tv. rww ob_target. am. Qed. Lemma restr_id : forall x, ob a x -> restr (id a x) = id b (pointv x). Proof. ir. uf restr. rw cone_to_limit_id. rw cone_target_pointl. rw vertex_pointl. rw target_id. tv. am. rw target_id. am. am. uf newcone. wr vident_point_functor. rw htrans_right_vident. rw cone_transform_vident. ap is_limit_pointl. rw source_id. am. am. assert (is_limit (pointl (source (id a x)))). ap is_limit_pointl. rww source_id. rw socle_pointl. rw source_id. tv. am. rww source_id. app is_cone_pointl. rww source_id. ap point_functor_axioms. am. am. am. rw source_point_functor. sy; am. am. am. uf newcone. rww source_id. rww target_id. wr vident_point_functor. rw htrans_right_vident. rw cone_transform_vident. tv. rw socle_pointl. tv. am. app is_cone_pointl. app point_functor_axioms. am. rww source_point_functor. sy; am. am. am. Qed. Lemma restr_comp : forall u v, composable a u v -> restr (comp a u v) = comp b (restr u) (restr v). Proof. ir. assert (mu : mor a u). rwi composable_facts_rw H; lu. assert (mv : mor a v). rwi composable_facts_rw H; lu. assert (sutv : source u = target v). rwi composable_facts_rw H; lu. uf restr. assert (osu : ob a (source u)). rww ob_source. assert (otu : ob a (target u)). rww ob_target. assert (osv : ob a (source v)). rww ob_source. assert (otv : ob a (target v)). rww ob_target. transitivity (comp (cone_target (pointl (target u))) (cone_to_limit (newcone u) (pointl (target u))) (cone_to_limit (newcone v) (pointl (target v)))). wr cone_to_limit_cone_compose. rw target_comp. assert (lem1 : (newcone (comp a u v)) = (cone_compose (newcone u) (cone_to_limit (newcone v) (pointl (target v))))). uf newcone. set (uu := htrans_right (point_trans a b u) f). set (vv := htrans_right (point_trans a b v) f). set (uv := htrans_right (point_trans a b (comp a u v)) f). assert (uuax : Nat_Trans.axioms uu). uf uu. ap htrans_right_axioms. am. app point_trans_axioms. rw osource_point_trans. sy; am. assert (vvax : Nat_Trans.axioms vv). uf vv. ap htrans_right_axioms. am. app point_trans_axioms. rw osource_point_trans. sy; am. assert (suu : source uu = pointf (source u)). uf uu; rw source_htrans_right. rw source_point_trans. reflexivity. assert (tuu : target uu = pointf (target u)). uf uu; rw target_htrans_right. rw target_point_trans. reflexivity. assert (svv : source vv = pointf (source v)). uf vv; rw source_htrans_right. rw source_point_trans. reflexivity. assert (tvv : target vv = pointf (target v)). uf vv; rw target_htrans_right. rw target_point_trans. reflexivity. rw source_comp. rw sutv. set (k:= (cone_to_limit (cone_transform vv (pointl (source v))) (pointl (target v)))). assert (cone_compose (cone_transform uu (pointl (target v))) k = cone_transform uu (cone_compose (pointl (target v)) k)). ap cone_compose_cone_transform. app is_cone_pointl. uhg; ee. app is_cone_pointl. rww cone_target_pointl. uf k. ap mor_cone_to_limit. ap is_cone_cone_transform. uhg; ee. app is_cone_pointl. am. rww socle_pointl. app is_limit_pointl. rww socle_cone_transform. rww socle_pointl. rww cone_target_pointl. uf k. rww target_cone_to_limit. app is_cone_cone_transform. uhg; ee. app is_cone_pointl. am. rww socle_pointl. app is_limit_pointl. rww socle_cone_transform. rww socle_pointl. uhg; ee. app is_cone_pointl. am. rw socle_pointl. wr sutv. am. am. rw H0. uf k. assert (cone_compose (pointl (target v)) (cone_to_limit (cone_transform vv (pointl (source v))) (pointl (target v))) = (cone_transform vv (pointl (source v)))). rw cone_compose_cone_to_limit. reflexivity. app is_cone_cone_transform. uhg; ee. app is_cone_pointl. am. rww socle_pointl. app is_limit_pointl. rww socle_cone_transform. rww socle_pointl. rw H1. assert (uv = vcompose uu vv). uf uu; uf vv. rw vcompose_htrans_right_htrans_right. assert (vcompose (point_trans a b u) (point_trans a b v) = point_trans a b (comp a u v)). app vcompose_point_trans. rw H2. reflexivity. app point_trans_axioms. app point_trans_axioms. am. reflexivity. rww source_point_trans. rw target_point_trans. rw sutv. reflexivity. rw osource_point_trans. am. rw H2. rw cone_transform_vcompose. reflexivity. app is_cone_pointl. uhg; ee. app is_cone_pointl. am. rww socle_pointl. am. rw suu. rw tvv. rw sutv. reflexivity. am. am. am. (**** end of proof of lem1 ! ***) rw lem1. tv. am. am. am. ap is_limit_pointl. am. uhg; ee. app is_cone_newcone. ap mor_cone_to_limit. ap is_cone_newcone. am. ap is_limit_pointl. am. rw socle_newcone. rw socle_pointl. tv. am. am. uf cone_target. rw socle_newcone. rw socle_pointl. rw target_pointf. rw target_pointf. tv. am. am. rw target_cone_to_limit. rw vertex_newcone. rw vertex_pointl. rwi composable_facts_rw H. uh H; ee. rw H4; tv. am. ap is_cone_newcone. am. app is_limit_pointl. rw socle_newcone. rw socle_pointl. tv. am. am. rw socle_newcone. rw socle_pointl. tv. am. am. rw cone_target_pointl. tv. am. Qed. (*** plv = presheaf_limit_vertex ***) Definition plv := Functor.create a b restr. Lemma source_plv : source plv = a. Proof. ir. uf plv. rww Functor.source_create. Qed. Lemma target_plv : target plv = b. Proof. ir. uf plv. rww Functor.target_create. Qed. Lemma fmor_plv : forall u, mor a u -> fmor plv u = restr u. Proof. ir. uf plv. rww Functor.fmor_create. Qed. Lemma fob_plv : forall x, ob a x -> fob plv x = pointv x. Proof. ir. uf fob. rww fmor_plv. rw source_plv. rww restr_id. rww source_id. app ob_pointv. rw source_plv. app mor_id. Qed. Lemma plv_axioms : Functor.axioms plv. Proof. uf plv. ap Functor.create_axioms. sh pointv. uhg; ee; try am; ir. app ob_pointv. rww restr_id. app mor_restr. rww source_restr. rww target_restr. rww restr_comp. app show_composable. Qed. Definition ple x := Nat_Trans.create plv (fob f x) (fun y => edge (pointl y) x). Lemma source_ple : forall x, source (ple x) = plv. Proof. ir. uf ple. rww Nat_Trans.source_create. Qed. Lemma target_ple : forall x, target (ple x) = fob f x. Proof. ir. uf ple. rww Nat_Trans.target_create. Qed. Lemma osource_ple : forall x, osource (ple x) = a. Proof. ir. uf osource. rw source_ple. rw source_plv. tv. Qed. Lemma otarget_ple : forall x, ob c x -> otarget (ple x) = b. Proof. ir. uf otarget. rw target_ple. assert (ob (functor_cat a b) (fob f x)). wr F2. app ob_fob. rwi ob_functor_cat H0. uh H0; ee. am. am. am. Qed. Lemma ntrans_ple : forall y x, ob c x -> ob a y -> ntrans (ple x) y = edge (pointl y) x. Proof. ir. uf ple. rww ntrans_create. change (is_ob (source plv) y). rw source_plv. lu. Qed. Lemma fmor_edge_edge_restr : forall x u, ob c x -> mor a u -> comp b (fmor (fob f x) u) (edge (pointl (source u)) x) = comp b (edge (pointl (target u)) x) (restr u). Proof. ir. uf restr. transitivity (edge (cone_compose (pointl (target u)) (cone_to_limit (newcone u) (pointl (target u)))) x). rw cone_compose_cone_to_limit. uf newcone. rw edge_cone_transform. rw ntrans_htrans_right. rw ntrans_point_trans. rw cone_target_pointl. tv. rww ob_source. am. wr F2. app ob_fob. rww F1. rw osource_htrans_right. rww F1. uhg; ee. app is_cone_pointl. rww ob_source. app htrans_right_axioms. app point_trans_axioms. rww osource_point_trans. sy; am. rw source_htrans_right. rw source_point_trans. rw socle_pointl. tv. rww ob_source. app is_cone_newcone. app is_limit_pointl. rww ob_target. rw socle_newcone. rww socle_pointl. rww ob_target. am. rw edge_cone_compose. rw cone_target_pointl. tv. rww ob_target. rw cone_source_pointl. am. rww ob_target. uhg; ee. app is_cone_pointl. rww ob_target. rw cone_target_pointl. app mor_cone_to_limit. app is_cone_newcone. app is_limit_pointl. rww ob_target. rww socle_newcone. rww socle_pointl. rww ob_target. rww cone_target_pointl. rww ob_target. rww ob_target. rww target_cone_to_limit. app is_cone_newcone. app is_limit_pointl. rww ob_target. rww socle_newcone. rww socle_pointl. rww ob_target. Qed. Lemma nat_trans_axioms_ple : forall x, ob c x -> Nat_Trans.axioms (ple x). Proof. ir. assert (ob (functor_cat a b) (fob f x)). wr F2. app ob_fob. cp H0. rwi ob_functor_cat H1; try am. uh H1; ee. uhg; ee. uf ple. ap create_like. rww osource_ple. rww otarget_ple. rww source_ple. app plv_axioms. rw target_ple. am. rw target_ple. rw H2. rww osource_ple. rw source_ple. rw target_plv. rww otarget_ple. ir. rwi osource_ple H4. rww otarget_ple. rww ntrans_ple. assert (b = cone_target (pointl x0)). rww cone_target_pointl. rw H5. app mor_edge. rww cone_source_pointl. app is_cone_pointl. ir. rwi osource_ple H4. rww source_ple. rww ntrans_ple. rww source_edge. rww vertex_pointl. rww fob_plv. rww cone_source_pointl. app is_cone_pointl. ir. rwi osource_ple H4. rww target_ple. rww ntrans_ple. rww target_edge. rww socle_pointl. uf pointf. rw fob_fcompose. rw fob_point_functor. tv. am. am. am. am. app point_functor_axioms. am. rww source_point_functor. sy; am. am. rww cone_source_pointl. app is_cone_pointl. ir. rwi osource_ple H4. rww otarget_ple. rww target_ple. rw source_ple. rw ntrans_ple. rw ntrans_ple. rw fmor_plv. sy; ap fmor_edge_edge_restr. am. am. am. am. rww ob_source. am. rww ob_target. Qed. Lemma axioms_fob_f : forall x, ob c x -> Functor.axioms (fob f x). Proof. ir. assert (fhom a b (fob f x)). wr ob_functor_cat. wr F2. app ob_fob. am. am. lu. Qed. Lemma source_fob_f : forall x, ob c x -> source (fob f x) = a. Proof. ir. assert (fhom a b (fob f x)). wr ob_functor_cat. wr F2. app ob_fob. am. am. lu. Qed. Lemma target_fob_f : forall x, ob c x -> target (fob f x) = b. Proof. ir. assert (fhom a b (fob f x)). wr ob_functor_cat. wr F2. app ob_fob. am. am. lu. Qed. Lemma axioms_fmor_f : forall u, mor c u -> Nat_Trans.axioms (fmor f u). Proof. ir. assert (nt2hom a b (fmor f u)). wr mor_functor_cat. wr F2; app mor_fmor. am. am. lu. Qed. Lemma osource_fmor_f : forall u, mor c u -> osource (fmor f u) = a. Proof. ir. assert (nt2hom a b (fmor f u)). wr mor_functor_cat. wr F2; app mor_fmor. am. am. lu. Qed. Lemma otarget_fmor_f : forall u, mor c u -> otarget (fmor f u) = b. Proof. ir. assert (nt2hom a b (fmor f u)). wr mor_functor_cat. wr F2; app mor_fmor. am. am. lu. Qed. Lemma ple_commutation : forall u, mor c u -> vcompose (fmor f u) (ple (source u)) = ple (target u). Proof. ir. assert (ob c (source u)). rww ob_source. assert (ob c (target u)). rww ob_target. ap Nat_Trans.axioms_extensionality. rww vcompose_axioms. app axioms_fmor_f. app nat_trans_axioms_ple. rww target_ple. rww source_fmor. app nat_trans_axioms_ple. rw source_vcompose. rw source_ple. rw source_ple. tv. rw target_vcompose. rw target_ple. rw target_fmor. tv. am. am. ir. rwi osource_vcompose H2. rwi osource_ple H2. rww ntrans_vcompose. rww otarget_fmor_f. rww ntrans_ple. rww ntrans_ple. assert (b = cone_target (pointl x)). rww cone_target_pointl. assert (ntrans (fmor f u) x = fmor (socle (pointl x)) u). rw socle_pointl. uf pointf. rw fmor_fcompose. rw fmor_point_functor. tv. wr F2; app mor_fmor. app point_functor_axioms. am. rww source_point_functor. sy; am. am. am. rw H3. rw H4. rw Limit.commutativity. tv. rww cone_source_pointl. app is_cone_pointl. rww osource_ple. Qed. (*** plc = presheaf limit cone ***) Definition plc := cone_create2 f plv ple. Lemma vertex_plc : vertex plc = plv. Proof. ir. uf plc. uf cone_create2. rww vertex_cone_create. Qed. Lemma socle_plc : socle plc = f. Proof. ir. uf plc; uf cone_create2. uf socle. rw edge_nt_cone_create. rw target_create. tv. Qed. Lemma cone_source_plc : cone_source plc = c. Proof. uf cone_source. rw socle_plc. tv. Qed. Lemma cone_target_plc : cone_target plc = (functor_cat a b). Proof. ir. uf cone_target. rw socle_plc. am. Qed. Lemma edge_plc : forall x, ob c x -> edge plc x = ple x. Proof. ir. uf plc; uf cone_create2. uf edge. rw edge_nt_cone_create. rw ntrans_create. tv. rw source_constant_functor. change (is_ob c x). lu. Qed. Lemma is_cone_plc : is_cone plc. Proof. uf plc. ap is_cone_cone_create2. am. rw F2. rw ob_functor_cat. uhg; ee. app plv_axioms. rww source_plv. rww target_plv. am. am. ir. rw F2; rw mor_functor_cat. uhg; ee. app nat_trans_axioms_ple. rww osource_ple. rww otarget_ple. am. am. ir. rww source_ple. ir. rww target_ple. ir. rw F2. rw comp_functor_cat. ap ple_commutation. am. am. am. wr F2; app mor_fmor. rww mor_functor_cat. uhg; ee. app nat_trans_axioms_ple. rww ob_source. rww osource_ple. rww otarget_ple. rww ob_source. rww source_fmor. rww target_ple. Qed. Section Limit_Pr. Variable other : E. Hypothesis oth_cone : is_cone other. Hypothesis socle_other : socle other = f. Definition otherv := vertex other. Lemma cone_source_other : cone_source other = c. Proof. uf cone_source. rw socle_other. tv. Qed. Lemma cone_target_other : cone_target other = functor_cat a b. Proof. ir. uf cone_target. rww socle_other. Qed. Lemma source_otherv : source otherv = a. Proof. uf otherv. assert (ob (functor_cat a b) otherv). wr cone_target_other. uf otherv. app Limit.ob_vertex. rwi ob_functor_cat H. lu. am. am. Qed. Lemma target_otherv : target otherv = b. Proof. uf otherv. assert (ob (functor_cat a b) otherv). wr cone_target_other. uf otherv. app Limit.ob_vertex. rwi ob_functor_cat H. lu. am. am. Qed. Lemma axioms_otherv : Functor.axioms otherv. Proof. uf otherv. assert (ob (functor_cat a b) otherv). wr cone_target_other. uf otherv. app Limit.ob_vertex. rwi ob_functor_cat H. lu. am. am. Qed. (*** we want to construct a presh morph from otherv to plv and show that any other such is equal to it ***) Definition other_pt y:= cone_pushdown (point_functor a b y) other. Lemma is_cone_other_pt : forall y, ob a y -> is_cone (other_pt y). Proof. ir. uf other_pt. ap is_cone_cone_pushdown. am. app point_functor_axioms. rww source_point_functor. rww cone_target_other. Qed. Lemma socle_other_pt : forall y, ob a y -> socle (other_pt y) = pointf y. Proof. ir. uf other_pt. rw socle_cone_pushdown. rw socle_other. tv. Qed. Lemma cone_source_other_pt : forall y, ob a y -> cone_source (other_pt y) = c. Proof. ir. uf cone_source. rww socle_other_pt. rww source_pointf. Qed. Lemma cone_target_other_pt : forall y, ob a y -> cone_target (other_pt y) = b. Proof. ir. uf cone_target. rww socle_other_pt. rww target_pointf. Qed. Lemma vertex_other_pt : forall y, ob a y -> vertex (other_pt y) = fob otherv y. Proof. ir. uf other_pt. rw vertex_cone_pushdown. rw fob_point_functor. tv. am. am. wr cone_target_other. app Limit.ob_vertex. am. Qed. Lemma edge_other_pt : forall x y, ob a y -> ob c x -> edge (other_pt y) x = ntrans (edge other x) y. Proof. ir. uf other_pt. rw edge_cone_pushdown. rw fmor_point_functor. tv. wr cone_target_other. ap mor_edge. rww cone_source_other. am. rww cone_source_other. am. Qed. Definition our_mval y := cone_to_limit (other_pt y) (pointl y). Lemma source_our_mval : forall y, ob a y -> source (our_mval y) = fob otherv y. Proof. ir. uf our_mval. rw source_cone_to_limit. rw vertex_other_pt. tv. am. app is_cone_other_pt. ap is_limit_pointl. am. rw socle_other_pt. rw socle_pointl. tv. am. am. Qed. Lemma target_our_mval : forall y, ob a y-> target (our_mval y) = pointv y. Proof. ir. uf our_mval. rw target_cone_to_limit. tv. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. Qed. Lemma target_our_mval2 : forall y, ob a y-> target (our_mval y) = fob plv y. Proof. ir. rw target_our_mval. rw fob_plv. tv. am. am. Qed. Lemma comp_ntrans_pointl_our_mval : forall x y, ob c x -> ob a y -> comp b (edge (pointl y) x) (our_mval y) = edge (other_pt y) x. Proof. ir. uf our_mval. rw comp_edge_cone_to_limit. tv. app is_limit_pointl. app is_cone_other_pt. rw socle_other_pt. rw socle_pointl. tv. am. am. rww cone_target_pointl. rww cone_source_pointl. Qed. Lemma weak_mor_fmor : forall bb ff uu, Functor.axioms ff -> bb = target ff -> mor (source ff) uu -> mor bb (fmor ff uu). Proof. ir. rw H0. app mor_fmor. Qed. Lemma our_mval_carre : forall u, mor a u -> comp b (fmor plv u) (our_mval (source u)) = comp b (our_mval (target u)) (fmor otherv u). Proof. ir. uf our_mval. rw fmor_plv. assert (ob_src : ob a (source u)). rww ob_source. assert (ob_trg : ob a (target u)). rww ob_target. assert (mor_restr_u : mor b (restr u)). ap mor_restr. am. assert (mor_fmor_otherv : mor b (fmor otherv u)). app weak_mor_fmor. ap axioms_otherv. rww target_otherv. rww source_otherv. assert (lem1: is_limit (pointl (target u))). ap is_limit_pointl. am. cp lem1. uh H0; ee. uh H0; ee. ap H2. uhg; ee. app is_cone_pointl. rww cone_target_pointl. rw mor_comp. tv. am. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. rww source_restr. rw target_cone_to_limit. rw vertex_pointl. tv. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. tv. rw target_comp. rww target_restr. am. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. rww source_restr. rw target_cone_to_limit. rww vertex_pointl. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. uhg; ee. app is_cone_pointl. rww cone_target_pointl. rw mor_comp. tv. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. assert (b = (target otherv)). rww target_otherv. rw H3. app mor_fmor. app axioms_otherv. rw source_otherv. am. rw source_cone_to_limit. rw vertex_other_pt. rw target_fmor. tv. ap axioms_otherv. rww source_otherv. am. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. tv. rw target_comp. rw target_cone_to_limit. tv. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. ap mor_cone_to_limit. app is_cone_other_pt. am. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. app weak_mor_fmor. app axioms_otherv. rww target_otherv. rww source_otherv. rw source_cone_to_limit. rww vertex_other_pt. rw target_fmor. tv. ap axioms_otherv. rww source_otherv. app is_cone_other_pt. am. rww socle_other_pt. rww socle_pointl. assert (lem2 : b = cone_target (pointl (target u))). rw cone_target_pointl. tv. am. rw lem2. wr cone_compose_cone_compose. wr cone_compose_cone_compose. rw cone_compose_cone_to_limit. uf restr. rw cone_compose_cone_to_limit. uf newcone. rw cone_compose_cone_transform. assert (cone_compose (pointl (source u)) (cone_to_limit (other_pt (source u)) (pointl (source u))) = other_pt (source u)). rw cone_compose_cone_to_limit. tv. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rw H3. uf other_pt. ap cone_extensionality. ap is_cone_cone_transform. uhg; ee. ap is_cone_cone_pushdown. am. app point_functor_axioms. rww source_point_functor. rww cone_target_other. ap htrans_right_axioms. am. app point_trans_axioms. rww osource_point_trans. sy; am. rw source_htrans_right. rw source_point_trans. rw socle_cone_pushdown. rww socle_other. rww is_cone_cone_compose. uhg; ee. app is_cone_cone_pushdown. app point_functor_axioms. rww source_point_functor. sy; rww cone_target_other. rww cone_target_cone_pushdown. rww target_point_functor. rw vertex_cone_pushdown. rw fob_point_functor. rw target_fmor. tv. ap axioms_otherv. rww source_otherv. am. am. rw ob_functor_cat. uhg; ee. ap axioms_otherv. ap source_otherv. ap target_otherv. am. am. am. rw vertex_cone_transform. rw vertex_cone_pushdown. rw vertex_cone_compose. rw fob_point_functor. rw source_fmor. tv. ap axioms_otherv. rww source_otherv. am. am. rw ob_functor_cat. uhg; ee. ap axioms_otherv. ap source_otherv. ap target_otherv. am. am. am. rw socle_cone_transform. rw target_htrans_right. rw socle_cone_compose. rw socle_cone_pushdown. rw target_point_trans. rww socle_other. ir. rwi cone_source_cone_transform H4. rwi cone_source_cone_pushdown H4. rwi cone_source_other H4. assert (lem3 : source (edge other x) = otherv). rw source_edge. tv. rw cone_source_other. am. am. assert (lem4 : target (edge other x) = fob f x). rww target_edge. rw socle_other. tv. rww cone_source_other. assert (lem5 : otarget (edge other x) = b). uf otarget. rw lem4. rw target_fob_f. tv. am. assert (lem6 : osource (edge other x) = a). uf osource. rw lem3. rw source_otherv. tv. assert (lem7 : Nat_Trans.axioms (edge other x)). assert (nt2hom a b (edge other x)). wr mor_functor_cat. wr F2. wr socle_other. change (mor (cone_target other) (edge other x)). ap mor_edge. rww cone_source_other. am. am. am. lu. assert (lem8 : mor (functor_cat a b) (edge other x)). rw mor_functor_cat. uhg; ee. am. am. am. am. am. assert (lem9 : ob (functor_cat a b) (fob f x)). rw ob_functor_cat. uhg; ee. app axioms_fob_f. rww source_fob_f. rww target_fob_f. am. am. rw edge_cone_transform. rw cone_target_cone_pushdown. rw target_point_functor. rw ntrans_htrans_right. rw ntrans_point_trans. rw edge_cone_pushdown. rw fmor_point_functor. rw edge_cone_compose. rw cone_target_cone_pushdown. rw target_point_functor. rw edge_cone_pushdown. rw fmor_point_functor. wr lem5; wr lem4; wr lem3; sy. ap carre. am. rww lem6. wr F2. wr socle_other. change (mor (cone_target other) (edge other x)). ap mor_edge. rww cone_source_other. am. rww cone_source_other. am. rw cone_source_cone_pushdown. rww cone_source_other. uhg; ee. app is_cone_cone_pushdown. app point_functor_axioms. rww source_point_functor. rww cone_target_other. rww cone_target_cone_pushdown. rww target_point_functor. rww vertex_cone_pushdown. rww fob_point_functor. rww target_fmor. ap axioms_otherv. rww source_otherv. rw ob_functor_cat. uhg; ee. ap axioms_otherv. ap source_otherv. ap target_otherv. am. am. am. rww cone_source_other. am. am. am. am. rw osource_htrans_right. am. uhg; ee. app is_cone_cone_pushdown. app point_functor_axioms. rww source_point_functor. rww cone_target_other. app htrans_right_axioms. app point_trans_axioms. rww osource_point_trans. sy; am. rw source_htrans_right. rw source_point_trans. rw socle_cone_pushdown. rww socle_other. uhg; ee. app is_cone_cone_pushdown. app point_functor_axioms. rww source_point_functor. rww cone_target_other. app htrans_right_axioms. app point_trans_axioms. rww osource_point_trans. sy; am. rw source_htrans_right. rw source_point_trans. rw socle_cone_pushdown. rww socle_other. app is_cone_pointl. uhg; ee. app is_cone_pointl. rw cone_target_pointl. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. am. rw target_cone_to_limit. tv. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. uhg; ee. app is_cone_pointl. app htrans_right_axioms. app point_trans_axioms. rww osource_point_trans. sy; am. rw source_htrans_right. rw source_point_trans. rw socle_pointl. tv. am. app is_cone_newcone. app is_limit_pointl. rw socle_newcone. rww socle_pointl. am. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. uhg; ee. app is_cone_pointl. rw cone_target_pointl. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. am. rw target_cone_to_limit. tv. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. ap show_composable. rw cone_target_pointl. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. am. rw cone_target_pointl. am. am. rw source_cone_to_limit. rw vertex_other_pt. rw target_fmor. tv. ap axioms_otherv. rww source_otherv. am. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. uhg; ee. app is_cone_pointl. rww cone_target_pointl. rww vertex_pointl. rww target_restr. ap show_composable. rww cone_target_pointl. rw cone_target_pointl. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. rww cone_target_pointl. am. rw target_cone_to_limit. rw vertex_pointl. rww source_restr. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt. rww socle_pointl. am. Qed. Definition our_map := Nat_Trans.create otherv plv our_mval. Lemma source_our_map : source our_map = otherv. Proof. uf our_map. rww Nat_Trans.source_create. Qed. Lemma target_our_map : target our_map = plv. Proof. uf our_map. rww Nat_Trans.target_create. Qed. Lemma ntrans_our_map : forall y, ob a y -> ntrans our_map y = our_mval y. Proof. ir. uf our_map. rw ntrans_create. tv. rw source_otherv. lu. Qed. Lemma mor_our_map : mor (functor_cat a b) our_map. Proof. rw mor_functor_cat. uf our_map. uhg; ee. ap create_axioms. uhg; ee. ap axioms_otherv. ap plv_axioms. ir. uf our_mval. rww source_otherv. rww source_plv. rw target_otherv; rww target_plv. ir. rwi source_otherv H. uf our_mval. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rww socle_other_pt; rww socle_pointl. rww cone_target_pointl. rww target_plv. ir. rwi source_otherv H. rww source_our_mval. ir. rwi source_otherv H. rww target_our_mval. rww fob_plv. ir. rwi source_otherv H. rw target_plv. sy; app our_mval_carre. rw osource_create. rww source_otherv. rw otarget_create. rww target_plv. am. am. Qed. Lemma cone_compose_our_map : cone_compose plc our_map = other. Proof. ap cone_extensionality. rww is_cone_cone_compose. uhg; ee. ap is_cone_plc. rww cone_target_plc. ap mor_our_map. rww target_our_map. rww vertex_plc. am. rww vertex_cone_compose. rww source_our_map. rww socle_cone_compose. rww socle_other. rww socle_plc. ir. rwi cone_source_cone_compose H. rwi cone_source_plc H. rw edge_cone_compose. rw cone_target_plc. rw comp_functor_cat. ap Nat_Trans.axioms_extensionality. rww vcompose_axioms. rw edge_plc. ap nat_trans_axioms_ple. am. am. cp mor_our_map. rwi mor_functor_cat H0. lu. am. am. rw edge_plc. rw source_ple. rww target_our_map. am. assert (mor (cone_target other) (edge other x)). ap mor_edge. rww cone_source_other. am. rwi cone_target_other H0. rwi mor_functor_cat H0. lu. am. am. rw source_vcompose. rw source_edge. rw source_our_map. tv. rww cone_source_other. am. rw target_vcompose. rw edge_plc. rw target_edge. rw socle_other. rw target_ple. tv. rww cone_source_other. am. am. ir. rwi osource_vcompose H0. ufi osource H0. rwi source_our_map H0. rwi source_otherv H0. rw ntrans_vcompose. rw edge_plc. rw otarget_ple. assert (ntrans our_map x0 = our_mval x0). rww ntrans_our_map. rw H1. rw ntrans_ple. uf our_mval. rw comp_edge_cone_to_limit. rw edge_other_pt. tv. am. am. app is_limit_pointl. app is_cone_other_pt. rw socle_other_pt. rww socle_pointl. am. rww cone_target_pointl. rww cone_source_pointl. am. am. am. am. uf osource. rw source_our_map. rww source_otherv. am. am. rw mor_functor_cat. uhg; ee. rw edge_plc. ap nat_trans_axioms_ple. am. am. rw edge_plc. rww osource_ple. am. rw edge_plc. rww otarget_ple. am. am. am. ap mor_our_map. rw edge_plc. rw target_our_map. rww source_ple. am. rww cone_source_plc. uhg; ee. ap is_cone_plc. rw cone_target_plc. ap mor_our_map. rw target_our_map. rww vertex_plc. Qed. Lemma versal_summary : source our_map = otherv & target our_map = plv & mor (functor_cat a b) our_map & cone_compose plc our_map = other. Proof. ee. ap source_our_map. ap target_our_map. ap mor_our_map. ap cone_compose_our_map. Qed. Variable another_map : E. Hypothesis mor_another : mor (functor_cat a b) another_map. Hypothesis source_another : source another_map = otherv. Hypothesis target_another : target another_map = plv. Hypothesis cone_compose_another : cone_compose plc another_map = other. Lemma osource_another : osource another_map = a. Proof. uf osource. rw source_another. rww source_otherv. Qed. Lemma otarget_another : otarget another_map = b. Proof. uf otarget. rw target_another. rww target_plv. Qed. Lemma presheaf_mor_axioms_another : Nat_Trans.axioms another_map. Proof. ir. cp mor_another. rwi mor_functor_cat H. lu. am. am. Qed. Lemma ntrans_edge_other : forall x y, ob c x -> ob a y -> ntrans (edge other x) y = edge (cone_compose (pointl y) (ntrans another_map y)) x. Proof. ir. assert (lem1: Nat_Trans.axioms another_map). cp mor_another. rwi mor_functor_cat H1. lu. am. am. wr cone_compose_another. rw edge_cone_compose. rw edge_cone_compose. rw cone_target_plc. rw comp_functor_cat. rw cone_target_pointl. rw ntrans_vcompose. rw edge_plc. rw ntrans_ple. rw otarget_ple. tv. am. am. am. am. rww osource_another. am. am. am. rw edge_plc. rw mor_functor_cat. uhg; ee. ap nat_trans_axioms_ple. am. rww osource_ple. rww otarget_ple. am. am. am. am. rw target_another. rw edge_plc. rww source_ple. am. rww cone_source_pointl. uhg; ee. app is_cone_pointl. rw cone_target_pointl. ap mor_ntrans. am. rww osource_another. rww otarget_another. am. rw target_ntrans. rw target_another. rw vertex_pointl. rw fob_plv. tv. am. am. rw osource_another. am. rww cone_source_plc. uhg; ee. app is_cone_plc. rww cone_target_plc. rww target_another. rww vertex_plc. Qed. Lemma pointwise_same : forall y, ob a y -> ntrans another_map y = our_mval y. Proof. ir. assert (lem0: Nat_Trans.axioms another_map). cp mor_another. rwi mor_functor_cat H0. lu. am. am. assert (lem1: is_uni (pointl y)). cp (is_limit_pointl H). lu. uh lem1. ee. ap H1. uhg; ee. app is_cone_pointl. rw cone_target_pointl. ap mor_ntrans. am. rw osource_another. am. rww otarget_another. am. rw target_ntrans. rw target_another. rw fob_plv. rww vertex_pointl. am. am. rww osource_another. uhg; ee. app is_cone_pointl. rww cone_target_pointl. uf our_mval. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rw socle_other_pt. rw socle_pointl. reflexivity. am. am. rww cone_target_pointl. rw target_our_mval. rw vertex_pointl. tv. am. ap cone_extensionality. rww is_cone_cone_compose. uhg; ee. app is_cone_pointl. rww cone_target_pointl. uf our_mval. ap mor_ntrans. am. rww osource_another. rww otarget_another. rww target_ntrans. rww target_another. rw fob_plv. rww vertex_pointl. am. rww osource_another. rww is_cone_cone_compose. uhg; ee. app is_cone_pointl. rww cone_target_pointl. uf our_mval. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rw socle_other_pt. rw socle_pointl. reflexivity. am. am. rww cone_target_pointl. rww target_our_mval. rw vertex_cone_compose. rw vertex_cone_compose. rw source_ntrans. rw source_another. rw source_our_mval. reflexivity. am. am. rww osource_another. rw socle_cone_compose. rw socle_cone_compose. reflexivity. ir. rwi cone_source_cone_compose H2. rwi cone_source_pointl H2. wrr ntrans_edge_other. rw edge_cone_compose. rw cone_target_pointl. uf our_mval. rw comp_edge_cone_to_limit. rw edge_other_pt. tv. am. am. app is_limit_pointl. app is_cone_other_pt. rww socle_other_pt; rww socle_pointl. rww cone_target_pointl. rww cone_source_pointl. am. rww cone_source_pointl. uhg; ee. app is_cone_pointl. rww cone_target_pointl. uf our_mval. ap mor_cone_to_limit. app is_cone_other_pt. app is_limit_pointl. rw socle_other_pt. rw socle_pointl. reflexivity. am. am. rww cone_target_pointl. rww target_our_mval. am. Qed. Lemma another_same : another_map = our_map. Proof. assert (lem0: Nat_Trans.axioms another_map). cp mor_another. rwi mor_functor_cat H. lu. am. am. ap Nat_Trans.axioms_extensionality. am. cp mor_our_map. rwi mor_functor_cat H. lu. am. am. rw source_another. rw source_our_map. tv. rw target_another. rww target_our_map. ir. rwi osource_another H. rw ntrans_our_map. ap pointwise_same. am. am. Qed. End Limit_Pr. Lemma for_uni_plc : forall u, cone_composable plc u -> u = our_map (cone_compose plc u). Proof. ir. assert (is_cone (cone_compose plc u)). rww is_cone_cone_compose. assert (socle (cone_compose plc u) = f). rw socle_cone_compose. rw socle_plc. tv. ap (another_same H0 H1). uh H; ee. rwi cone_target_plc H2. am. uf otherv. rw vertex_cone_compose. tv. uh H; ee. rw H3. rw vertex_plc. tv. tv. Qed. Lemma is_limit_plc : is_limit plc. Proof. uhg; ee. uhg; ee; ir. ap is_cone_plc. rw (for_uni_plc H). rw H1. wr for_uni_plc. tv. am. uhg; ee. ap is_cone_plc. ir. sh (our_map b0). rwi socle_plc H0. cp (versal_summary H H0). ee. uhg; ee. ap is_cone_plc. rww cone_target_plc. rww vertex_plc. am. Qed. Lemma cone_pushdown_point_functor_plc : forall y, ob a y -> cone_pushdown (point_functor a b y) plc = pointl y. Proof. ir. ap cone_extensionality. ap is_cone_cone_pushdown. ap is_cone_plc. app point_functor_axioms. rw source_point_functor. rww cone_target_plc. app is_cone_pointl. rw vertex_cone_pushdown. rw fob_point_functor. rw vertex_pointl. rw vertex_plc. rw fob_plv. tv. am. am. am. rw vertex_plc. rw ob_functor_cat. uhg; ee. ap plv_axioms. rww source_plv. rww target_plv. am. am. am. rw socle_cone_pushdown. rw socle_pointl. rw socle_plc. tv. am. ir. rwi cone_source_cone_pushdown H0. rwi cone_source_plc H0. rw edge_cone_pushdown. rw edge_plc. rw fmor_point_functor. rw ntrans_ple. tv. am. am. rw mor_functor_cat. uhg; ee. app nat_trans_axioms_ple. rww osource_ple. rww otarget_ple. am. am. am. rww cone_source_plc. app is_cone_plc. Qed. Lemma presheaf_limit_criterion: has_limit f. Proof. uhg. sh plc. uhg; ee. ap is_limit_plc. rww socle_plc. Qed. Lemma invertible_commutation_plc : forall y, ob a y -> invertible b (commutation (point_functor a b y) plc (pointl y)). Proof. ir. assert (b = target (point_functor a b y)). rww target_point_functor. set (k:=point_functor a b y). rw H0. uf k. rw invertible_commutation_is_limit_cone_pushdown. rw cone_pushdown_point_functor_plc. app is_limit_pointl. am. ap is_cone_plc. app is_limit_pointl. rww source_point_functor. rww cone_target_plc. app point_functor_axioms. rw socle_plc. rww socle_pointl. tv. Qed. Lemma invertible_cone_to_limit_plc : invertible (functor_cat a b) (cone_to_limit plc (limit f)). Proof. ir. ap invertible_cone_to_limit. ap is_limit_plc. ap is_limit_limit. ap presheaf_limit_criterion. rww socle_plc. rww socle_limit. ap presheaf_limit_criterion. rww cone_target_plc. Qed. Lemma is_limit_cone_pushdown_point_functor : forall y, ob a y -> is_limit (cone_pushdown (point_functor a b y) (limit f)). Proof. ir. assert (has_limit f). ap presheaf_limit_criterion. apply limit_preservation_invariance with plc. app point_functor_axioms. app is_limit_limit. ap is_limit_plc. rww socle_limit. rww socle_plc. rww source_point_functor. rww cone_target_plc. rww cone_pushdown_point_functor_plc. app is_limit_pointl. Qed. Lemma invertible_commutation_point_functor_limit : forall y, ob a y -> invertible b (commutation (point_functor a b y) (limit f) (pointl y)). Proof. ir. rw invertible_commutation_is_limit_cone_pushdown. ap is_limit_cone_pushdown_point_functor. am. assert (is_limit (limit f)). app is_limit_limit. ap presheaf_limit_criterion. lu. app is_limit_pointl. rww source_point_functor. uf cone_target. rww socle_limit. sy; am. ap presheaf_limit_criterion. app point_functor_axioms. rww socle_limit. rww socle_pointl. ap presheaf_limit_criterion. rww target_point_functor. Qed. End MainResult. End MainResultMod. Import MainResultMod. Lemma has_limits_functor_cat : forall a b z, Category.axioms a -> Category.axioms b -> Category.axioms z -> has_limits_over z b -> has_limits_over z (functor_cat a b). Proof. ir. uhg; ee. ir. apply presheaf_limit_criterion with a b. am. am. am. am. ir. uh H2; ee. ap H2. app pointf_axioms. rww source_pointf. rww target_pointf. Qed. (**** now by dualizing we get the theorem saying that functor cats have colimits. *******) Lemma has_colimits_functor_cat : forall a b z, Category.axioms a -> Category.axioms b -> Category.axioms z -> has_colimits_over z b -> has_colimits_over z (functor_cat a b). Proof. ir. assert (Category.axioms (opp a)). app opp_axioms. assert (Category.axioms (opp b)). app opp_axioms. assert (Category.axioms (opp z)). app opp_axioms. assert (has_limits_over (opp z) (opp (functor_cat a b))). apply has_limits_over_finverse_invariance with (functor_cat (opp a) (opp b)). app functor_cat_axioms. ap opp_axioms. app functor_cat_axioms. am. app has_limits_functor_cat. app has_limits_over_opp. sh (fc_opp a b). sh (opp_fc a b). ee. app are_finverse_symm. app are_finverse_opp_fc_fc_opp. rw source_fc_opp. reflexivity. rw target_fc_opp. reflexivity. assert (z = opp (opp z)). rww opp_opp. assert (functor_cat a b = opp (opp (functor_cat a b))). sy; rw opp_opp. reflexivity. rw H7; rw H8. ap has_colimits_over_opp. ap opp_axioms. app functor_cat_axioms. am. am. Qed. End Functor_Cat_Limit. Export Functor_Cat_Limit. (************ todo: natural isos, (iso)equiv of cats (do adjoints first because the essential inverse is the adjoint too) nat isos = isos in fc products in functor_cat, switch etc *******************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Module From_Types. Export Nat_Trans. Record cat_type_data : Type := { obsy : Type; morsy : Type; srcy : morsy -> obsy; trgy : morsy -> obsy; idy : obsy -> morsy; compy : morsy -> morsy -> morsy }. Definition catyd_arrow d (u:morsy d) := Arrow.create (R (srcy u)) (R (trgy u)) (R u). Definition catyd_arrow_set d := IM (catyd_arrow (d:=d)). Lemma inc_catyd_arrow_set : forall d u, inc u (catyd_arrow_set d) = exists v:morsy d, u = catyd_arrow v. Proof. ir. ap iff_eq; ir. ufi catyd_arrow_set H. cp (IM_exists H). nin H0. sh x; sy; am. uf catyd_arrow_set. ap IM_inc. nin H. sh x; sy; am. Qed. Lemma inc_catyd_arrow : forall d (u:morsy d), inc (catyd_arrow u) (catyd_arrow_set d). Proof. ir. rw inc_catyd_arrow_set. sh u. tv. Qed. Lemma arrow_catyd_arrow : forall d (u:morsy d), arrow (catyd_arrow u) = (R u). Proof. ir. uf catyd_arrow. rw Arrow.arrow_create. tv. Qed. Definition catyd_id d x := X (fun x0 => catyd_arrow (d:=d) (idy x0)) x. Lemma catyd_id_R : forall d (x:obsy d), catyd_id d (R x) = catyd_arrow (idy x). Proof. ir. uf catyd_id. rw X_rewrite. tv. Qed. Definition catyd_comp d u v := X (fun v0 => (X (fun u0 => catyd_arrow (d:=d) (compy u0 v0)) (arrow u))) (arrow v). Lemma catyd_comp_catyd_arrow : forall d (u v:morsy d), catyd_comp d (catyd_arrow u) (catyd_arrow v) = catyd_arrow (compy u v). Proof. ir. uf catyd_comp. rw arrow_catyd_arrow. rw arrow_catyd_arrow. rw X_rewrite. rw X_rewrite. tv. Qed. Lemma source_catyd_arrow : forall d (u:morsy d), source (catyd_arrow u) = R (srcy u). Proof. ir. uf catyd_arrow. rw Arrow.source_create. tv. Qed. Lemma target_catyd_arrow : forall d (u:morsy d), target (catyd_arrow u) = R (trgy u). Proof. ir. uf catyd_arrow. rw Arrow.target_create. tv. Qed. Definition catyd_property d := (forall (x:obsy d), srcy (idy x) = x) & (forall (x:obsy d), trgy (idy x) = x) & (forall (u v:morsy d), srcy u = trgy v -> srcy (compy u v) = srcy v) & (forall (u v:morsy d), srcy u = trgy v -> trgy (compy u v) = trgy u) & (forall (u:morsy d), compy (idy (trgy u)) u = u) & (forall (u:morsy d), compy u (idy (srcy u)) = u) & (forall u v w : morsy d, srcy u = trgy v -> srcy v = trgy w -> compy (compy u v) w = compy u (compy v w)). Definition catyd d := Category.Notations.create (obsy d) (catyd_arrow_set d) (catyd_comp d) (catyd_id d) emptyset. Lemma catyd_axioms : forall d, catyd_property d -> Category.axioms (catyd d). Proof. ir. uf catyd. ap Category.create_axioms. uhg; ee. ir. ap iff_eq; ir. uhg. ee. am. nin H0. wr H0. rw catyd_id_R. ap inc_catyd_arrow. nin H0. wr H0. rw catyd_id_R. rww source_catyd_arrow. uh H; ee. rw H. tv. nin H0. wr H0. rw catyd_id_R. rww target_catyd_arrow. uh H; ee. rw H1. tv. uh H0; ee. am. ir. ap iff_eq; ir. rwi inc_catyd_arrow_set H0. nin H0. rw H0. uhg; ee; try (rw source_catyd_arrow); try (rw target_catyd_arrow). rw inc_catyd_arrow_set. sh x. tv. ap R_inc. ap R_inc. rw catyd_id_R. rw catyd_comp_catyd_arrow. uh H; ee. rw H5. tv. rw catyd_id_R. rw catyd_comp_catyd_arrow. uh H; ee. rw H4. tv. uf catyd_arrow. rww Arrow.create_like. uh H0; ee; am. ir. rwi inc_catyd_arrow_set H0. rwi inc_catyd_arrow_set H1. nin H0; nin H1. rw H0; rw H1. uhg; ee. ap inc_catyd_arrow. ap inc_catyd_arrow. rw source_catyd_arrow. rw target_catyd_arrow. rwi H0 H2; rwi H1 H2. rwi source_catyd_arrow H2; rwi target_catyd_arrow H2. am. rw catyd_comp_catyd_arrow. ap inc_catyd_arrow. rw catyd_comp_catyd_arrow. rw source_catyd_arrow. rw source_catyd_arrow. uh H; ee. util (H4 x x0). ap R_inj. rwi H0 H2; rwi H1 H2. rwi source_catyd_arrow H2; rwi target_catyd_arrow H2. am. rww H9. uh H; ee. util (H5 x x0). ap R_inj. rwi H0 H2; rwi H1 H2. rwi source_catyd_arrow H2; rwi target_catyd_arrow H2. am. rw catyd_comp_catyd_arrow. rw target_catyd_arrow. rw target_catyd_arrow. rww H9. ir. rwi inc_catyd_arrow_set H0. rwi inc_catyd_arrow_set H1. rwi inc_catyd_arrow_set H2. nin H0; nin H1; nin H2. rwi H0 H3. rwi H1 H3. rwi H1 H4. rwi H2 H4. rwi source_catyd_arrow H3. rwi source_catyd_arrow H4. rwi target_catyd_arrow H3. rwi target_catyd_arrow H4. cp (R_inj H3). cp (R_inj H4). rw H0; rw H1; rw H2. rw catyd_comp_catyd_arrow. rw catyd_comp_catyd_arrow. rw catyd_comp_catyd_arrow. rw catyd_comp_catyd_arrow. uh H; ee. rw H12. reflexivity. am. am. Qed. Lemma ob_catyd : forall d x, catyd_property d -> ob (catyd d) x = (exists y:obsy d, x = R y). Proof. ir. ap iff_eq; ir. uh H0; ee. ufi catyd H1. rwi Category.is_ob_create H1. nin H1. sh x0. sy; am. nin H0. uf ob. ee. app catyd_axioms. uf catyd. rw Category.is_ob_create. rw H0. ap R_inc. Qed. Lemma mor_catyd : forall d u, catyd_property d -> mor (catyd d) u = (exists v : morsy d, u = catyd_arrow v). Proof. ir. ap iff_eq; ir. uh H0; ee. ufi catyd H1. rwi Category.is_mor_create H1. rwi inc_catyd_arrow_set H1. am. uhg; ee. app catyd_axioms. uf catyd. rw Category.is_mor_create. rw inc_catyd_arrow_set. am. Qed. Lemma ob_catyd_R : forall d (x:obsy d), catyd_property d -> ob (catyd d) (R x). Proof. ir. rw ob_catyd. sh x; tv. am. Qed. Lemma mor_catyd_catyd_arrow : forall d (u:morsy d), catyd_property d -> mor (catyd d) (catyd_arrow u). Proof. ir. rw mor_catyd. sh u; tv. am. Qed. Definition ob_lift d x (H:ob (catyd d) x) : obsy d. ir. assert (inc x (obsy d)). uh H; ee. ufi catyd H0. rwi Category.is_ob_create H0. am. exact (B H0). Defined. Lemma B_irrelevant : forall a x y (Hx : inc x a) (Hy : inc y a), x=y -> B Hx = B Hy. Proof. ir. ap R_inj. rw B_eq. rw B_eq. am. Qed. Lemma R_ob_lift : forall d x (H:ob (catyd d) x), R (ob_lift H) = x. Proof. ir. assert (ob (catyd d) x). am. uh H0; ee. ufi catyd H1. rwi Category.is_ob_create H1. assert (ob_lift H = B H1). uf ob_lift. ap B_irrelevant. tv. rw H2. rw B_eq. tv. Qed. Lemma eq_ob_lift : forall d x (H:ob (catyd d) x) (y:(obsy d)), x = R y -> y = ob_lift H. Proof. ir. ap R_inj. rw R_ob_lift. sy; am. Qed. Definition mor_lift d u (H:mor (catyd d) u) : morsy d. ir. assert (is_mor (catyd d) u). uh H; ee. am. ufi catyd H0. rwi Category.is_mor_create H0. ufi catyd_arrow_set H0. exact (IM_lift (B H0)). Defined. Lemma unIM_lift : forall a (f:a->E) (x y:IM f), x = y -> IM_lift x = IM_lift y. Proof. ir. rw H. tv. Qed. Lemma catyd_arrow_mor_lift : forall d u (H: mor (catyd d) u), catyd_arrow (mor_lift H) = u. Proof. ir. assert (mor (catyd d) u). am. uh H0; ee. ufi catyd H1. rwi is_mor_create H1. ufi catyd_arrow_set H1. assert (mor_lift H = IM_lift (B H1)). uf mor_lift. apply unIM_lift. ap B_irrelevant. tv. rw H2. rw IM_lift_pr. rw B_eq. tv. Qed. Lemma R_srcy_mor_lift : forall d u (H:mor (catyd d) u), R (srcy (mor_lift H)) = source u. Proof. ir. cp (catyd_arrow_mor_lift H). assert (source u = source (catyd_arrow (d:=d) (mor_lift H))). rww H0. rw H1. rw source_catyd_arrow. tv. Qed. Lemma R_trgy_mor_lift : forall d u (H:mor (catyd d) u), R (trgy (mor_lift H)) = target u. Proof. ir. cp (catyd_arrow_mor_lift H). assert (target u = target (catyd_arrow (d:=d) (mor_lift H))). rww H0. rw H1. rw target_catyd_arrow. tv. Qed. Lemma inc_obsy : forall d x, ob (catyd d) x -> inc x (obsy d). Proof. ir. uh H; ee. ufi catyd H0. rwi is_ob_create H0. am. Qed. Lemma show_inc_catyd_arrow_set : forall d u, mor (catyd d) u -> inc u (catyd_arrow_set d). Proof. ir. uh H; ee. ufi catyd H0. rwi is_mor_create H0. am. Qed. Lemma comp_catyd : forall d u v, mor (catyd d) u -> mor (catyd d) v -> source u = target v -> comp (catyd d) u v = catyd_comp d u v. Proof. ir. uf catyd. rw comp_create. tv. app show_inc_catyd_arrow_set. app show_inc_catyd_arrow_set. am. Qed. Lemma id_catyd : forall d x, ob (catyd d) x -> id (catyd d) x = catyd_id d x. Proof. ir. uf catyd. rw id_create. tv. app inc_obsy. Qed. Lemma id_catyd_R : forall d (x:obsy d), catyd_property d -> id (catyd d) (R x) = catyd_arrow (idy x). Proof. ir. rw id_catyd. rw catyd_id_R. tv. ap ob_catyd_R. am. Qed. Lemma catyd_arrow_idy_ob_lift : forall d x (H:ob (catyd d) x), catyd_arrow (idy (ob_lift H)) = id (catyd d) x. Proof. ir. cp (R_ob_lift H). assert (id (catyd d) x = id (catyd d) (R (ob_lift H))). rww H0. rw H1. uf catyd. rw Category.id_create. rw catyd_id_R. tv. rw H0. cp H. app inc_obsy. Qed. Lemma catyd_arrow_compy_mor_lift : forall d u v (Hu : mor (catyd d) u) (Hv : mor (catyd d) v), source u = target v -> catyd_arrow (compy (mor_lift Hu) (mor_lift Hv)) = comp (catyd d) u v. Proof. ir. cp (catyd_arrow_mor_lift Hu). cp (catyd_arrow_mor_lift Hv). assert (comp (catyd d) u v = comp (catyd d) (catyd_arrow (d:=d) (mor_lift Hu)) (catyd_arrow (d:=d) (mor_lift Hv))). rw H0; rww H1. rw H2. rw comp_catyd. rw catyd_comp_catyd_arrow. tv. rww H0. rww H1. rw catyd_arrow_mor_lift. rww catyd_arrow_mor_lift. Qed. Lemma comp_catyd_catyd_arrow : forall d (u v:morsy d), catyd_property d -> srcy u = trgy v -> comp (catyd d) (catyd_arrow u) (catyd_arrow v) = catyd_arrow (compy u v). Proof. ir. rw comp_catyd. rw catyd_comp_catyd_arrow. tv. rw mor_catyd. sh u; tv. am. rw mor_catyd. sh v; tv. am. rw source_catyd_arrow. rw target_catyd_arrow. rww H0. Qed. Record fun_type_data (d:cat_type_data): Type := { ft : E; fo : obsy d -> E; fm : morsy d -> E }. Definition funtyd_fmor d (f:fun_type_data d) u := X (fm f) (arrow u). Definition funtyd_property d (f:fun_type_data d):= Category.axioms (ft f) & catyd_property d & (forall (x:obsy d), ob (ft f) (fo f x) )& (forall (u:morsy d), mor (ft f) (fm f u) )& (forall (u:morsy d), source (fm f u) = fo f (srcy u) )& (forall (u:morsy d), target (fm f u) = fo f (trgy u)) & (forall (x:obsy d), id (ft f) (fo f x) = fm f (idy x)) & (forall (u v:morsy d), srcy u = trgy v -> comp (ft f) (fm f u) (fm f v) = fm f (compy u v)). Definition funtyd d (f:fun_type_data d):= Functor.create (catyd d) (ft f) (funtyd_fmor f). Lemma source_funtyd : forall d (f:fun_type_data d), source (funtyd f) = catyd d. Proof. ir. uf funtyd. rww Functor.source_create. Qed. Lemma target_funtyd : forall d (f:fun_type_data d), target (funtyd f) = (ft f). Proof. ir. uf funtyd. rww Functor.target_create. Qed. Lemma fmor_funtyd : forall d (f:fun_type_data d) u, mor (source (funtyd f)) u -> fmor (funtyd f) u = funtyd_fmor f u. Proof. ir. uf funtyd. rww fmor_create. rwi source_funtyd H. am. Qed. Lemma fob_funtyd : forall d (f:fun_type_data d) x, funtyd_property f -> ob (source (funtyd f)) x -> fob (funtyd f) x = X (fo f) x. Proof. ir. uf fob. rww fmor_funtyd. rw source_funtyd. rwi source_funtyd H0. cp (R_ob_lift H0). wr H1. rw X_rewrite. uh H; ee. rw id_catyd. rw catyd_id_R. uf funtyd_fmor. rw arrow_catyd_arrow. rw X_rewrite. wr H7. rw source_id. tv. ap H3. rw R_ob_lift. am. rw source_funtyd. ap mor_id. rwi source_funtyd H0; am. Qed. Lemma fob_funtyd_R : forall d (f:fun_type_data d) (x:obsy d), funtyd_property f -> fob (funtyd f) (R x) = fo f x. Proof. ir. rewrite fob_funtyd. ap X_rewrite. am. rw source_funtyd. ap ob_catyd_R. uh H; ee; am. Qed. Lemma fmor_funtyd_catyd_arrow : forall d (f:fun_type_data d) (u:morsy d), funtyd_property f -> fmor (funtyd f) (catyd_arrow u) = fm f u. Proof. ir. rw fmor_funtyd. uf funtyd_fmor. rw arrow_catyd_arrow. rw X_rewrite. tv. rw source_funtyd. ap mor_catyd_catyd_arrow. uh H; ee; am. Qed. Lemma funtyd_axioms : forall d (f:fun_type_data d), funtyd_property f -> Functor.axioms (funtyd f). Proof. ir. uhg; ee. uf funtyd. uf Functor.create. ap Umorphism.create_like. rw source_funtyd. ap catyd_axioms. uh H; ee; am. rw target_funtyd. uh H; ee; am. ir. rwi source_funtyd H0. rw target_funtyd. cp (R_ob_lift H0). wr H1. rw fob_funtyd_R. uh H; ee. ap H3. am. ir. rwi source_funtyd H0. rw target_funtyd. rw source_funtyd. cp (R_ob_lift H0). wr H1. rw fob_funtyd_R. rw id_catyd_R. rw fmor_funtyd_catyd_arrow. uh H; ee. ap H7. am. uh H; ee; am. am. ir. rwi source_funtyd H0. rw target_funtyd. cp (catyd_arrow_mor_lift H0). wr H1. rw fmor_funtyd_catyd_arrow. uh H; ee. ap H4. am. ir. rwi source_funtyd H0. cp (catyd_arrow_mor_lift H0). wr H1. rw fmor_funtyd_catyd_arrow. rw source_catyd_arrow. rw fob_funtyd_R. uh H; ee. ap H5. am. am. ir. rwi source_funtyd H0. cp (catyd_arrow_mor_lift H0). wr H1. rw fmor_funtyd_catyd_arrow. rw target_catyd_arrow. rw fob_funtyd_R. uh H; ee. ap H6. am. am. rw source_funtyd. rw target_funtyd. ir. cp (catyd_arrow_mor_lift H0). cp (catyd_arrow_mor_lift H1). wr H3; wr H4. rw fmor_funtyd_catyd_arrow. rw fmor_funtyd_catyd_arrow. rw comp_catyd_catyd_arrow. rw fmor_funtyd_catyd_arrow. uh H; ee. ap H11. ap R_inj. rw R_srcy_mor_lift. rw R_trgy_mor_lift. am. am. uh H; ee; am. ap R_inj. rw R_srcy_mor_lift. rw R_trgy_mor_lift. am. am. am. Qed. Definition funtyd_lift d g := Build_fun_type_data (target g) (fun (x:obsy d) => fob g (R x)) (fun (u:morsy d) => fmor g (catyd_arrow u)). Lemma ft_funtyd_lift : forall d g, ft (funtyd_lift d g) = (target g). Proof. ir. tv. Qed. Lemma fo_funtyd_lift : forall d g (x:obsy d), fo (funtyd_lift d g) x = fob g (R x). Proof. ir. tv. Qed. Lemma fm_funtyd_lift : forall d g (u:morsy d), fm (funtyd_lift d g) u = fmor g (catyd_arrow u). Proof. ir. tv. Qed. Lemma funtyd_fmor_funtyd_lift : forall d g u, Functor.axioms g -> catyd_property d -> source g = catyd d -> mor (source g) u -> funtyd_fmor (funtyd_lift d g) u = fmor g u. Proof. ir. uf funtyd_fmor. cp H2. rwi H1 H3. rwi mor_catyd H3. nin H3. rw H3. rw arrow_catyd_arrow. rw X_rewrite. rw fm_funtyd_lift. tv. am. Qed. Lemma funtyd_lift_property : forall d g, Functor.axioms g -> catyd_property d -> source g = catyd d -> funtyd_property (funtyd_lift d g). Proof. ir. uhg; ee; ir. rw ft_funtyd_lift. uh H; ee; am. am. rw ft_funtyd_lift; rw fo_funtyd_lift. ap ob_fob. am. rw H1. ap ob_catyd_R. am. rw ft_funtyd_lift; rw fm_funtyd_lift. ap mor_fmor. am. rw H1. ap mor_catyd_catyd_arrow. am. rw fm_funtyd_lift; rw fo_funtyd_lift. rw source_fmor. ap uneq. rw source_catyd_arrow. tv. am. rw H1. ap mor_catyd_catyd_arrow. am. rw fm_funtyd_lift. rw fo_funtyd_lift. rw target_fmor. rw target_catyd_arrow. tv. am. rw H1. ap mor_catyd_catyd_arrow. am. rw ft_funtyd_lift. rw fo_funtyd_lift. rw fm_funtyd_lift. rw id_fob. rw H1. rw id_catyd_R. reflexivity. am. am. rw H1. ap ob_catyd_R. am. rw ft_funtyd_lift. rw fm_funtyd_lift. rw fm_funtyd_lift. rw comp_fmor. rw fm_funtyd_lift. rw H1. rw comp_catyd_catyd_arrow. tv. am. am. am. rw H1. app mor_catyd_catyd_arrow. rw H1. app mor_catyd_catyd_arrow. rw source_catyd_arrow. rw target_catyd_arrow. rww H2. Qed. Lemma funtyd_funtyd_lift : forall d g, Functor.axioms g -> catyd_property d -> source g = catyd d -> funtyd (funtyd_lift d g) = g. Proof. ir. ap Functor.axioms_extensionality. ap funtyd_axioms. app funtyd_lift_property. am. rww source_funtyd. sy; am. rw target_funtyd. rw ft_funtyd_lift. tv. ir. cp H2. rwi source_funtyd H2. rw fmor_funtyd. rww funtyd_fmor_funtyd_lift. rww H1. am. Qed. Definition nttyd d (f g : fun_type_data d) (n : obsy d -> E) := Nat_Trans.create (funtyd f) (funtyd g) (X n). Lemma source_nttyd : forall d f g (n : obsy d -> E), source (nttyd f g n) = (funtyd f). Proof. ir. uf nttyd. rw Nat_Trans.source_create. tv. Qed. Lemma target_nttyd : forall d f g (n : obsy d -> E), target (nttyd f g n) = (funtyd g). Proof. ir. uf nttyd. rw Nat_Trans.target_create. tv. Qed. Lemma osource_nttyd : forall d f g (n : obsy d -> E), osource (nttyd f g n) = catyd d. Proof. ir. uf osource. rw source_nttyd. rww source_funtyd. Qed. Lemma otarget_nttyd : forall d f g (n : obsy d -> E), otarget (nttyd f g n) = ft g. Proof. ir. uf otarget. rw target_nttyd. rww target_funtyd. Qed. Lemma ntrans_nttyd : forall d f g (n : obsy d -> E) x, ob (catyd d) x -> ntrans (nttyd f g n) x = X n x. Proof. ir. uf nttyd. rw ntrans_create. tv. rw source_funtyd. uh H; ee. am. Qed. Lemma ntrans_nttyd_R : forall d f g (n : obsy d -> E) (x:obsy d), catyd_property d -> ntrans (nttyd f g n) (R x) = n x. Proof. ir. rw ntrans_nttyd. rww X_rewrite. app ob_catyd_R. Qed. Definition nttyd_property d (f g:fun_type_data d) (n : obsy d -> E) := catyd_property d & funtyd_property f & funtyd_property g & ft f = ft g & (forall (x:obsy d), mor (ft f) (n x)) & (forall (x:obsy d), source (n x) = fo f x) & (forall (x:obsy d), target (n x) = fo g x) & (forall (u:morsy d), comp (ft f) (n (trgy u)) (fm f u) = comp (ft f) (fm g u) (n (srcy u))). Lemma nttyd_axioms : forall d f g (n:obsy d -> E), nttyd_property f g n -> Nat_Trans.axioms (nttyd f g n). Proof. ir. assert (lem1: catyd_property d). uh H; ee. uh H0; ee; am. assert (lem2: Category.axioms (catyd d)). app catyd_axioms. assert (lem3 : funtyd_property f). uh H; ee; am. assert (lem4 : funtyd_property g). uh H; ee; am. assert (lem5 : Functor.axioms (funtyd f)). app funtyd_axioms. assert (lem6 : Functor.axioms (funtyd g)). app funtyd_axioms. uhg; ee. uf nttyd. ap create_like. rww osource_nttyd. rw otarget_nttyd. uh H; ee. uh H1; ee. am. rww source_nttyd. rww target_nttyd. rww target_nttyd. rww osource_nttyd. rww source_funtyd. rww source_nttyd. rww otarget_nttyd. rww target_funtyd. uh H; ee; am. ir. rw otarget_nttyd. rwi osource_nttyd H0. cp H0. rw ntrans_nttyd. rwi ob_catyd H1. nin H1. rw H1. rw X_rewrite. uh H; ee. wr H4; au. am. am. ir. rwi osource_nttyd H0. cp H0. rwi ob_catyd H0. nin H0. rww ntrans_nttyd. rww source_nttyd. rw H0. rw X_rewrite. rw fob_funtyd_R. uh H; ee. ap H6. am. am. ir. rwi osource_nttyd H0. cp H0. rwi ob_catyd H0. nin H0. rw H0. rw ntrans_nttyd_R. rw target_nttyd. rw fob_funtyd_R. uh H; ee; au. am. am. am. ir. rwi osource_nttyd H0. cp H0. rwi mor_catyd H1. nin H1. rw H1. rw target_catyd_arrow. rw ntrans_nttyd_R. rw otarget_nttyd. rw source_nttyd. rw fmor_funtyd_catyd_arrow. rw target_nttyd. rw fmor_funtyd_catyd_arrow. rw source_catyd_arrow. rw ntrans_nttyd_R. uh H; ee. wr H4. ap H8. am. am. am. am. am. Qed. Lemma nttyd_property_ntrans_R : forall d (f g:fun_type_data d) u, Nat_Trans.axioms u -> funtyd_property f -> funtyd_property g -> source u = funtyd f -> target u = funtyd g -> nttyd_property f g (fun (x:obsy d) => ntrans u (R x)). Proof. ir. assert (lem1 : ft f = otarget u). wr target_source. rw H2. rww target_funtyd. am. assert (lem2 : ft g = otarget u). uf otarget. rw H3. rww target_funtyd. assert (lem3 : osource u = catyd d). uf osource. rw H2. rww source_funtyd. uhg; dj. uh H0; ee; am. am. am. rw lem1; rww lem2. rw lem1. ap mor_ntrans. am. rw lem3. ap ob_catyd_R. am. tv. rw source_ntrans. rw H2. rww fob_funtyd_R. am. rw lem3. ap ob_catyd_R. am. rw target_ntrans. rw H3. rww fob_funtyd_R. am. rw lem3. app ob_catyd_R. rw lem1. wr fmor_funtyd_catyd_arrow. wr fmor_funtyd_catyd_arrow. wr H2; wr H3. wr target_catyd_arrow. wr source_catyd_arrow. app carre. rw lem3. ap mor_catyd_catyd_arrow. am. am. am. Qed. Lemma nttyd_ntrans_R : forall d (f g:fun_type_data d) u, Nat_Trans.axioms u -> funtyd_property f -> funtyd_property g -> source u = funtyd f -> target u = funtyd g -> nttyd f g (fun (x:obsy d) => ntrans u (R x)) = u. Proof. ir. assert (lem0:catyd_property d). uh H0; ee; am. assert (lem1 : ft f = otarget u). wr target_source. rw H2. rww target_funtyd. am. assert (lem2 : ft g = otarget u). uf otarget. rw H3. rww target_funtyd. assert (lem3 : osource u = catyd d). uf osource. rw H2. rww source_funtyd. ap Nat_Trans.axioms_extensionality. ap nttyd_axioms. app nttyd_property_ntrans_R. am. rw source_nttyd. sy; am. rw target_nttyd. sy; am. ir. rwi osource_nttyd H4. cp H4. rwi ob_catyd H5. nin H5. rw H5. rw ntrans_nttyd_R. tv. am. am. Qed. (***** we now write a tactic which will verify by direct computation that d satisfies catyd_property, for objects d:cat_type_data where obsy d and morsy d are finite inductive objects, and where the maps srcy d, trgy d, idsy d and compy d are defined by a match construction. ******************************) Ltac show_catyd_property := match goal with |- (catyd_property _) => uf catyd_property; ee; first [ solve [(intros fty_u fty_v fty_w fty_h1 fty_h2); nin fty_u; nin fty_v; nin fty_w; try reflexivity; try (discriminate fty_h1); try (discriminate fty_h2)] | solve [intros fty_u fty_v fty_h1; nin fty_u; nin fty_v; try reflexivity; try (discriminate fty_h1)] | solve [intro fty_x; nin fty_x; reflexivity] ] | |- _ => fail end. Lemma ft_Build_fun_type_data : forall d a o m, ft (Build_fun_type_data (d:=d) a o m) = a. Proof. ir. reflexivity. Qed. Lemma fo_Build_fun_type_data : forall d a o m, fo (Build_fun_type_data (d:=d) a o m) = o. Proof. ir. reflexivity. Qed. Lemma fm_Build_fun_type_data : forall d a o m, fm (Build_fun_type_data (d:=d) a o m) = m. Proof. ir. reflexivity. Qed. (***** here is a tactic to start the proof of funtyd_property f where f is an explicitly defined fun_type_data; it generates a lot of subgoals which then have to be treated by piping to other try tactics according to the context *************************) Ltac start_funtyd_proof := match goal with |- (funtyd_property _) => (uhg; ee; try (rw ft_Build_fun_type_data); try (rw fo_Build_fun_type_data); try (rw fm_Build_fun_type_data); try show_catyd_property; try (intros fu_x fu_y hyp1; nin fu_x; nin fu_y; try (discriminate hyp1)); try (intros fu_x; nin fu_x)) | _ => fail end. (*** now here is a tactic to follow up start_funtyd_proof, where we try to dispatch as many goals as possible; for simple examples it should be sufficient (see below) ****) Ltac funtyd_dispatch := try am; try (sy; am); try reflexivity; match goal with |- (Category.axioms _) => lu | |- (ob _ (source _)) => rww ob_source | |- (ob _ (target _)) => rww ob_target | |- (mor _ (id _ _)) => app mor_id; funtyd_dispatch | |- (source (id _ _) = _) => rww source_id; funtyd_dispatch | |- (target (id _ _) = _) => rww target_id; funtyd_dispatch | |- (comp _ (id _ _) _ = _) => rww left_id; funtyd_dispatch | |- (comp _ _ (id _ _) = _) => rww right_id; funtyd_dispatch | _ => idtac end. End From_Types. Module Finite_Cat. Export Map. Export From_Types. Export Cardinal. Export Functor_Cat. Definition is_finite_cat a := Category.axioms a & is_finite (objects a) & is_finite (morphisms a). Lemma objects_catyd : forall (d:cat_type_data), objects (catyd d) = obsy d. Proof. ir. uf catyd. rw Notations.objects_create. tv. Qed. Lemma tcreate_axioms : forall x (f:x->E), Function.axioms (tcreate f). Proof. ir. uf tcreate. ap Function.create_axioms. Qed. Lemma are_isomorphic_morphisms_catyd : forall (d:cat_type_data), catyd_property d -> are_isomorphic (morsy d) (morphisms (catyd d)). Proof. ir. uhg. sh (Function.tcreate (fun y :morsy d => catyd_arrow y)). uhg; dj. uhg; ee. ap tcreate_axioms. rww domain_tcreate. uhg; ir. rwi range_inc_rw H0. nin H0. ee. rwi domain_tcreate H0. assert (x0 = R (B H0)). rww B_eq. rwi H2 H1. rwi tcreate_value_type H1. rw H1. change (is_mor (catyd d) (catyd_arrow (B H0))). ap mor_is_mor. ap mor_catyd_catyd_arrow. am. ap tcreate_axioms. uhg; ee. am. uhg. ir. sh (arrow x). ee. assert (mor (catyd d) x). ap is_mor_mor. app catyd_axioms. am. rwi mor_catyd H2. nin H2. rw H2. rw arrow_catyd_arrow. ap R_inc. am. assert (mor (catyd d) x). ap is_mor_mor. app catyd_axioms. am. rwi mor_catyd H2. nin H2. rw H2. rw arrow_catyd_arrow. rw tcreate_value_type. tv. am. uhg. ee; try am. uhg. ir. cp (B_eq H2). cp (B_eq H3). wri H5 H4. wri H6 H4. rwi tcreate_value_type H4. rwi tcreate_value_type H4. transitivity (arrow (catyd_arrow (B H2))). rww arrow_catyd_arrow. sy; am. rw H4. rw arrow_catyd_arrow. am. Qed. Lemma is_finite_catyd : forall (d:cat_type_data), catyd_property d -> is_finite (obsy d) -> is_finite (morsy d) -> is_finite_cat (catyd d). Proof. ir. uhg. ee. app catyd_axioms. rww objects_catyd. ap finite_invariant. sh (morsy d). ee. ap are_isomorphic_morphisms_catyd. am. am. Qed. Definition has_finite_limits b := Category.axioms b & (forall c, is_finite_cat c -> has_limits_over c b). Lemma has_finite_limits_functor_cat : forall a b, Category.axioms a -> has_finite_limits b -> has_finite_limits (functor_cat a b). Proof. ir. uh H0; uhg; ee. app functor_cat_axioms. ir. ap has_limits_functor_cat. am. am. uh H2; ee; am. ap H1; am. Qed. Lemma opp_morphisms_isomorphic : forall a, Category.axioms a -> are_isomorphic (morphisms a) (morphisms (opp a)). Proof. ir. rw iso_trans_ex_rw. sh flip. uhg; dj. uhg. ir. assert (mor a x). app is_mor_mor. change (is_mor (opp a) (flip x)). ap mor_is_mor. rw mor_opp. rww flip_flip. uhg; ee. am. uhg. ir. assert (mor (opp a) x). ap is_mor_mor. app opp_axioms. am. sh (flip x). ee. change (is_mor a (flip x)). ap mor_is_mor. wr mor_opp. am. rww flip_flip. uhg; ee. am. uhg. ir. transitivity (flip (flip x)). rww flip_flip. rw H4. rww flip_flip. Qed. Lemma is_finite_cat_opp : forall a, is_finite_cat a -> is_finite_cat (opp a). Proof. ir. uhg; dj. ap opp_axioms. uh H; ee; am. assert (objects (opp a) = objects a). ap extensionality; uhg; ir. assert (ob (opp a) x). app is_ob_ob. ap ob_is_ob. wr ob_opp. am. assert (ob a x). ap is_ob_ob. wrr axioms_opp. am. ap ob_is_ob. rww ob_opp. rw H1. uh H; ee; am. ap finite_invariant. sh (morphisms a). ee. ap opp_morphisms_isomorphic. wrr axioms_opp. uh H; ee. am. Qed. Definition has_finite_colimits b := Category.axioms b & (forall c, is_finite_cat c -> has_colimits_over c b). Lemma finite_colimits_finite_limits_opp : forall b, has_finite_colimits b = has_finite_limits (opp b). Proof. ir. ap iff_eq; ir. uh H; uhg; ee. app opp_axioms. ir. assert (c = opp (opp c)). rww opp_opp. rw H2. ap has_limits_over_opp. am. ap opp_axioms. uh H1; ee; am. ap H0. ap is_finite_cat_opp. am. uh H; uhg; ee. wrr axioms_opp. ir. assert (c = opp (opp c)). rww opp_opp. assert (b = opp (opp b)). rww opp_opp. rw H2; rw H3. ap has_colimits_over_opp. am. ap opp_axioms. uh H1; ee; am. ap H0. app is_finite_cat_opp. Qed. Lemma has_finite_colimits_functor_cat : forall a b, Category.axioms a -> has_finite_colimits b -> has_finite_colimits (functor_cat a b). Proof. ir. uh H0; uhg; ee. app functor_cat_axioms. ir. ap has_colimits_functor_cat. am. am. uh H2; ee; am. app H1. Qed. End Finite_Cat. Module Twoarrow_Cat. Export From_Types. Export Finite_Cat. Inductive ta_obs : Set := o1 : ta_obs | o2 : ta_obs. Inductive ta_maps : Set := i1 : ta_maps | i2 : ta_maps | a0 : ta_maps | a1 : ta_maps. Definition ta_src u := match u with i1 => o1 | i2 => o2 | a0 => o1 | a1 => o1 end. Definition ta_trg u := match u with i1 => o1 | i2 => o2 | a0 => o2 | a1 => o2 end. Definition ta_id x := match x with o1 => i1 | o2 => i2 end. Definition ta_comp u v := match (u, v) with (i1, v') => v' | (i2, v') => v' | (u', i1) => u' | (u', i2) => u' | _ => i1 end. Definition twoarrow_data := Build_cat_type_data ta_src ta_trg ta_id ta_comp. Lemma twoarrow_data_property : catyd_property twoarrow_data. Proof. show_catyd_property. Qed. Definition twoarrow_cat := catyd twoarrow_data. Lemma twoarrow_cat_axioms : Category.axioms twoarrow_cat. Proof. uf twoarrow_cat. ap catyd_axioms. ap twoarrow_data_property. Qed. (*** the constructions (R o1) and (R o2) dont work well with the implicit arguments mechanism because they don't introduce the type (obsy _); it is better to redefine the objects ***) Definition o1' : obsy twoarrow_data := o1. Definition o2' : obsy twoarrow_data := o2. Definition i1' : morsy twoarrow_data := i1. Definition i2' : morsy twoarrow_data := i2. Definition a0' : morsy twoarrow_data := a0. Definition a1' : morsy twoarrow_data := a1. Lemma ob_twoarrow_cat_or : forall x, ob twoarrow_cat x = (x = (R o1') \/ x = (R o2')). Proof. ir. ap iff_eq; ir. ufi twoarrow_cat H. rwi ob_catyd H. nin H. nin x0. ap or_introl; am. ap or_intror; am. ap twoarrow_data_property. cp twoarrow_data_property. uf twoarrow_cat. nin H. rw H. app ob_catyd_R. rw H. app ob_catyd_R. Qed. Lemma ob_twoarrow_cat : forall (x:obsy twoarrow_data), ob twoarrow_cat (R x). Proof. ir. uf twoarrow_cat. app ob_catyd_R. ap twoarrow_data_property. Qed. Ltac or_first := match goal with |- (_ \/ _) => ap or_introl | _ => idtac end. Ltac or_show i := match i with O => or_first | (S ?id1) => ap or_intror; or_show id1 end. Lemma mor_twoarrow_cat_or : forall u, mor twoarrow_cat u = (u = (catyd_arrow i1') \/ u = (catyd_arrow i2') \/ u = (catyd_arrow a0') \/ u = (catyd_arrow a1')). Proof. ir. ap iff_eq; ir. ufi twoarrow_cat H; rwi mor_catyd H; nin H. nin x. or_show 0; am. or_show 1; am. or_show 2; am. or_show 3; am. ap twoarrow_data_property. cp twoarrow_data_property. nin H. rw H. uf twoarrow_cat. app mor_catyd_catyd_arrow. nin H. rw H. uf twoarrow_cat. app mor_catyd_catyd_arrow. nin H. rw H. uf twoarrow_cat. app mor_catyd_catyd_arrow. rw H. uf twoarrow_cat. app mor_catyd_catyd_arrow. Qed. Lemma mor_twoarrow_cat : forall (y:morsy twoarrow_data), mor twoarrow_cat (catyd_arrow y). Proof. ir. uf twoarrow_cat. app mor_catyd_catyd_arrow. ap twoarrow_data_property. Qed. Lemma mor_twoarrow_cat_ex : forall u, mor twoarrow_cat u = (exists y:morsy twoarrow_data, u = catyd_arrow y). Proof. ir. ap iff_eq; ir. ufi twoarrow_cat H; rwi mor_catyd H. am. ap twoarrow_data_property. nin H. rw H. ap mor_twoarrow_cat. Qed. Lemma id_twoarrow_cat_R : forall (x:obsy twoarrow_data), id twoarrow_cat (R x) = match x with o1 => (catyd_arrow i1') | o2 => (catyd_arrow i2') end. Proof. ir. nin x; uf twoarrow_cat; rww id_catyd_R; ap twoarrow_data_property. Qed. Definition twoarrow_hypothesis a u v := mor a u & mor a v & source u = source v & target u = target v. Definition twoarrow_fun_data a u v := Build_fun_type_data (d:= twoarrow_data) a (fun x => match x with o1 => (source u) | o2 => (target u) end) (fun y => match y with i1 => id a (source u) | i2 => id a (target u) | a0 => u | a1 => v end). Lemma ft_twoarrow_fun_data : forall a u v, ft (twoarrow_fun_data a u v) = a. Proof. ir. uf twoarrow_fun_data. rww ft_Build_fun_type_data. Qed. Lemma twoarrow_fun_data_property : forall a u v, twoarrow_hypothesis a u v -> funtyd_property (twoarrow_fun_data a u v). Proof. ir. uh H; ee. uf twoarrow_fun_data. start_funtyd_proof; funtyd_dispatch. Qed. Definition twoarrow_functor a u v := funtyd (twoarrow_fun_data a u v). Lemma twoarrow_functor_axioms : forall a u v, twoarrow_hypothesis a u v -> Functor.axioms (twoarrow_functor a u v). Proof. ir. uh H; ee. uf twoarrow_functor. ap funtyd_axioms. app twoarrow_fun_data_property. uhg; ee; am. Qed. Lemma source_twoarrow_functor : forall a u v, source (twoarrow_functor a u v) = twoarrow_cat. Proof. ir. uf twoarrow_functor. rww source_funtyd. Qed. Lemma target_twoarrow_functor : forall a u v, target (twoarrow_functor a u v) = a. Proof. ir. uf twoarrow_functor. rww target_funtyd. Qed. Lemma fob_twoarrow_functor_R : forall a u v (x:obsy twoarrow_data), twoarrow_hypothesis a u v -> fob (twoarrow_functor a u v) (R x) = match x with o1 => (source u) | o2 => (target u) end. Proof. ir. cp (twoarrow_fun_data_property H). uf twoarrow_functor. nin x; rww fob_funtyd_R. Qed. Lemma fmor_twoarrow_functor_catyd_arrow :forall a u v (y:morsy twoarrow_data), twoarrow_hypothesis a u v -> fmor (twoarrow_functor a u v) (catyd_arrow y) = match y with i1 => id a (source u) | i2 => id a (target u) | a0 => u | a1 => v end. Proof. ir. cp (twoarrow_fun_data_property H). uf twoarrow_functor. nin y; rww fmor_funtyd_catyd_arrow. Qed. (**** every functor from twoarrow_cat is of the form twoarrow_functor _ _ _ **********************) Lemma functor_twoarrow_hypothesis : forall f, Functor.axioms f -> source f = twoarrow_cat -> twoarrow_hypothesis (target f) (fmor f (catyd_arrow a0')) (fmor f (catyd_arrow a1')). Proof. ir. uhg; ee. app mor_fmor. rw H0. ap mor_twoarrow_cat. app mor_fmor. rw H0. ap mor_twoarrow_cat. rww source_fmor. rw source_catyd_arrow. rww source_fmor. rww source_catyd_arrow. rw H0. ap mor_twoarrow_cat. rw H0. ap mor_twoarrow_cat. rww target_fmor. rw target_catyd_arrow. rww target_fmor. rww target_catyd_arrow. rw H0. ap mor_twoarrow_cat. rw H0. ap mor_twoarrow_cat. Qed. Lemma functor_twoarrow_eq : forall f, Functor.axioms f -> source f = twoarrow_cat -> f = twoarrow_functor (target f) (fmor f (catyd_arrow a0')) (fmor f (catyd_arrow a1')). Proof. ir. ap Functor.axioms_extensionality. am. ap twoarrow_functor_axioms. app functor_twoarrow_hypothesis. rww source_twoarrow_functor. rww target_twoarrow_functor. ir. rwi H0 H1. set (p:= (fmor f (catyd_arrow (d:=twoarrow_data) a0'))). set (q:= (fmor f (catyd_arrow (d:=twoarrow_data) a1'))). rwi mor_twoarrow_cat_ex H1. nin H1. rw H1. rw fmor_twoarrow_functor_catyd_arrow. assert (catyd_arrow (d:= twoarrow_data) i1 = id twoarrow_cat (R o1')). rw id_twoarrow_cat_R. reflexivity. assert (catyd_arrow (d:= twoarrow_data) i2 = id twoarrow_cat (R o2')). rw id_twoarrow_cat_R. reflexivity. nin x. rw H2. wr H0. rw fmor_id. uf p. rw source_fmor. rw source_catyd_arrow. tv. am. rw H0. ap mor_twoarrow_cat. am. tv. rw H0; ap ob_twoarrow_cat. rw H3. wr H0. rw fmor_id. uf p. rw target_fmor. rw target_catyd_arrow. reflexivity. am. rw H0; ap mor_twoarrow_cat. am. tv. rw H0; ap ob_twoarrow_cat. reflexivity. reflexivity. uf p. uf q. app functor_twoarrow_hypothesis. Qed. Lemma functor_twoarrow_eq2 : forall a u v f, Functor.axioms f -> source f = twoarrow_cat -> a = target f -> u = (fmor f (catyd_arrow a0')) -> v = (fmor f (catyd_arrow a1')) -> f = twoarrow_functor a u v. Proof. ir. rw H1; rw H2; rw H3; app functor_twoarrow_eq. Qed. Lemma constant_functor_twoarrow_functor : forall a b x, a = twoarrow_cat -> ob b x -> constant_functor a b x = twoarrow_functor b (id b x) (id b x). Proof. ir. ap functor_twoarrow_eq2. ap constant_functor_axioms. rw H; ap twoarrow_cat_axioms. uh H0; ee; am. am. rww source_constant_functor. rww target_constant_functor. rw fmor_constant_functor. tv. rw H. ap mor_twoarrow_cat. rw fmor_constant_functor. tv. rw H. ap mor_twoarrow_cat. Qed. Lemma fidentity_twoarrow_cat : fidentity twoarrow_cat = twoarrow_functor twoarrow_cat (catyd_arrow a0') (catyd_arrow a1'). Proof. cp twoarrow_cat_axioms. app functor_twoarrow_eq2. rww fidentity_axioms. rww source_fidentity. rww target_fidentity. rww fmor_fidentity. ap mor_twoarrow_cat. rww fmor_fidentity; ap mor_twoarrow_cat. Qed. Lemma fcompose_twoarrow_functor : forall a u v f, twoarrow_hypothesis a u v -> Functor.axioms f -> source f = a -> fcompose f (twoarrow_functor a u v) = twoarrow_functor (target f) (fmor f u) (fmor f v). Proof. ir. ap functor_twoarrow_eq2. app fcompose_axioms. app twoarrow_functor_axioms. rww target_twoarrow_functor. rww source_fcompose. rww source_twoarrow_functor. rww target_fcompose. rww fmor_fcompose. rww fmor_twoarrow_functor_catyd_arrow. app twoarrow_functor_axioms. rww target_twoarrow_functor. rww source_twoarrow_functor. ap mor_twoarrow_cat. rww fmor_fcompose. rww fmor_twoarrow_functor_catyd_arrow. app twoarrow_functor_axioms. rww target_twoarrow_functor. rww source_twoarrow_functor. ap mor_twoarrow_cat. Qed. Definition twoarrow_nt a u1 v1 u2 v2 r s := nttyd (twoarrow_fun_data a u1 v1) (twoarrow_fun_data a u2 v2) (fun x : (obsy twoarrow_data) => match x with o1 => r | o2 => s end). Definition twoarrow_nt_hypothesis a u1 v1 u2 v2 r s:= Category.axioms a & mor a u1 & mor a v1 & mor a u2 & mor a v2 & mor a r & mor a s & source r = source u1 & target r = source u2 & source s = target u1 & target s = target u2 & source u1 = source v1 & target u1 = target v1 & source u2 = source v2 & target u2 = target v2 & comp a s u1 = comp a u2 r & comp a s v1 = comp a v2 r. Lemma twoarrow_nttyd_property : forall a u1 v1 u2 v2 r s, twoarrow_nt_hypothesis a u1 v1 u2 v2 r s -> nttyd_property (twoarrow_fun_data a u1 v1) (twoarrow_fun_data a u2 v2) (fun x : (obsy twoarrow_data) => match x with o1 => r | o2 => s end). Proof. ir. uh H; ee. assert (lem1: twoarrow_hypothesis a u1 v1). uhg; ee; am. assert (lem2: twoarrow_hypothesis a u2 v2). uhg; ee; am. uhg; ee. ap twoarrow_data_property. app twoarrow_fun_data_property. app twoarrow_fun_data_property. rw ft_twoarrow_fun_data; rww ft_twoarrow_fun_data. ir. rw ft_twoarrow_fun_data. nin x. am. am. ir. nin x. rww H6. rww H8. ir. nin x. rww H7. rww H9. ir. rw ft_twoarrow_fun_data. nin u. change (comp a r (id a (source u1)) = comp a (id a (source u2)) r). rww right_id. rww left_id. rww ob_source. rww ob_source. change (comp a s (id a (target u1)) = comp a (id a (target u2)) s). rww left_id. rww right_id. rww ob_target. rww ob_target. am. am. Qed. Lemma twoarrow_nt_axioms : forall a u1 v1 u2 v2 r s, twoarrow_nt_hypothesis a u1 v1 u2 v2 r s -> Nat_Trans.axioms (twoarrow_nt a u1 v1 u2 v2 r s). Proof. ir. uf twoarrow_nt. ap nttyd_axioms. ap twoarrow_nttyd_property. am. Qed. Lemma source_twoarrow_nt : forall a u1 v1 u2 v2 r s, source (twoarrow_nt a u1 v1 u2 v2 r s) = twoarrow_functor a u1 v1. Proof. ir. uf twoarrow_nt. rww source_nttyd. Qed. Lemma target_twoarrow_nt : forall a u1 v1 u2 v2 r s, target (twoarrow_nt a u1 v1 u2 v2 r s) = twoarrow_functor a u2 v2. Proof. ir. uf twoarrow_nt. rww target_nttyd. Qed. Lemma osource_twoarrow_nt : forall a u1 v1 u2 v2 r s, osource (twoarrow_nt a u1 v1 u2 v2 r s) = twoarrow_cat. Proof. ir. uf osource. rw source_twoarrow_nt. rww source_twoarrow_functor. Qed. Lemma otarget_twoarrow_nt : forall a u1 v1 u2 v2 r s, otarget (twoarrow_nt a u1 v1 u2 v2 r s) = a. Proof. ir. uf otarget. rw target_twoarrow_nt. rww target_twoarrow_functor. Qed. Lemma ntrans_twoarrow_nt_R : forall a u1 v1 u2 v2 r s (x:obsy twoarrow_data), ntrans (twoarrow_nt a u1 v1 u2 v2 r s) (R x) = match x with o1 => r | o2 => s end. Proof. ir. uf twoarrow_nt. rw ntrans_nttyd. rw X_rewrite. tv. rw ob_catyd. sh x; tv. ap twoarrow_data_property. Qed. Lemma twoarrow_nt_hypothesis_ntrans : forall u, Nat_Trans.axioms u -> osource u = twoarrow_cat -> twoarrow_nt_hypothesis (otarget u) (fmor (source u) (catyd_arrow a0')) (fmor (source u) (catyd_arrow a1')) (fmor (target u) (catyd_arrow a0')) (fmor (target u) (catyd_arrow a1')) (ntrans u (R o1')) (ntrans u (R o2')). Proof. ir. assert (Category.axioms (otarget u)). rww category_axioms_otarget. assert (Functor.axioms (source u)). rww functor_axioms_source. assert (Functor.axioms (target u)). rww functor_axioms_target. uhg; ee. am. wrr target_source. app mor_fmor. rw source_source. rw H0. ap mor_twoarrow_cat. wr target_source. app mor_fmor. rw source_source. rw H0. ap mor_twoarrow_cat. am. uf otarget. app mor_fmor. rw source_target. rw H0. ap mor_twoarrow_cat. am. uf otarget. app mor_fmor. rw source_target. rw H0. ap mor_twoarrow_cat. am. app mor_ntrans. rw H0. ap ob_twoarrow_cat. app mor_ntrans. rw H0. ap ob_twoarrow_cat. rww source_fmor. rww source_catyd_arrow. rww source_ntrans. rw H0. ap ob_twoarrow_cat. rw source_source; rw H0; ap mor_twoarrow_cat. rww target_ntrans. rww source_fmor. rww source_catyd_arrow. rww source_target. rw H0. ap mor_twoarrow_cat. rw H0. ap ob_twoarrow_cat. rww source_ntrans. rww target_fmor. rww target_catyd_arrow. rw source_source; rw H0; ap mor_twoarrow_cat. rw H0. ap ob_twoarrow_cat. rww target_ntrans. rww target_fmor. rww target_catyd_arrow. rww source_target. rw H0. ap mor_twoarrow_cat. rw H0. ap ob_twoarrow_cat. rw source_fmor. rw source_catyd_arrow. rw source_fmor. rw source_catyd_arrow. reflexivity. am. rw source_source; rw H0; ap mor_twoarrow_cat. am. rw source_source; rw H0; ap mor_twoarrow_cat. rw target_fmor. rw target_catyd_arrow. rw target_fmor. rw target_catyd_arrow. reflexivity. am. rw source_source; rw H0; ap mor_twoarrow_cat. am. rw source_source; rw H0; ap mor_twoarrow_cat. rw source_fmor. rw source_catyd_arrow. rw source_fmor. rw source_catyd_arrow. reflexivity. am. rw source_target. rw H0; ap mor_twoarrow_cat. am. am. rww source_target; rw H0; ap mor_twoarrow_cat. rw target_fmor. rw target_catyd_arrow. rw target_fmor. rw target_catyd_arrow. reflexivity. am. rww source_target; rw H0; ap mor_twoarrow_cat. am. rww source_target; rw H0; ap mor_twoarrow_cat. assert (R o2' = target (catyd_arrow a0')). rww target_catyd_arrow. rw H4. rw carre. rw source_catyd_arrow. reflexivity. am. rw H0. ap mor_twoarrow_cat. assert (R o2' = target (catyd_arrow a1')). rww target_catyd_arrow. rw H4. rw carre. rw source_catyd_arrow. reflexivity. am. rw H0. ap mor_twoarrow_cat. Qed. Lemma twoarrow_nt_ntrans : forall u, Nat_Trans.axioms u -> osource u = twoarrow_cat -> twoarrow_nt (otarget u) (fmor (source u) (catyd_arrow a0')) (fmor (source u) (catyd_arrow a1')) (fmor (target u) (catyd_arrow a0')) (fmor (target u) (catyd_arrow a1')) (ntrans u (R o1')) (ntrans u (R o2')) = u. Proof. ir. ap Nat_Trans.axioms_extensionality. ap twoarrow_nt_axioms. app twoarrow_nt_hypothesis_ntrans. am. rw source_twoarrow_nt. wr target_source. sy; ap functor_twoarrow_eq. uh H; ee. am. am. am. rw target_twoarrow_nt. uf otarget. sy; ap functor_twoarrow_eq. uh H; ee; am. rww source_target. ir. ufi osource H1. rwi source_twoarrow_nt H1. rwi source_twoarrow_functor H1. rwi ob_twoarrow_cat_or H1. nin H1. rw H1. rw ntrans_twoarrow_nt_R. reflexivity. rw H1. rw ntrans_twoarrow_nt_R. reflexivity. Qed. Lemma eq_twoarrow_nt : forall u a u1 v1 u2 v2 r s, Nat_Trans.axioms u -> osource u = twoarrow_cat -> a = (otarget u) -> u1 = (fmor (source u) (catyd_arrow a0')) -> v1 =(fmor (source u) (catyd_arrow a1')) -> u2 =(fmor (target u) (catyd_arrow a0')) -> v2 =(fmor (target u) (catyd_arrow a1')) -> r =(ntrans u (R o1')) -> s =(ntrans u (R o2')) -> u = twoarrow_nt a u1 v1 u2 v2 r s. Proof. ir. rw H1; rw H2; rw H3; rw H4; rw H5; rw H6; rw H7; rww twoarrow_nt_ntrans. Qed. Lemma constant_nt_twoarrow_nt : forall a b u, a = twoarrow_cat -> mor b u -> constant_nt a b u = twoarrow_nt b (id b (source u)) (id b (source u)) (id b (target u)) (id b (target u)) u u. Proof. ir. rw H. ap eq_twoarrow_nt. app constant_nt_axioms. ap twoarrow_cat_axioms. uh H0; ee; am. rww osource_constant_nt. rww otarget_constant_nt. rw source_constant_nt. rw fmor_constant_functor. tv. ap mor_twoarrow_cat. rw source_constant_nt. rw fmor_constant_functor. tv. ap mor_twoarrow_cat. rw target_constant_nt. rw fmor_constant_functor. tv. ap mor_twoarrow_cat. rw target_constant_nt. rw fmor_constant_functor. tv. ap mor_twoarrow_cat. rww ntrans_constant_nt. ap ob_twoarrow_cat. rww ntrans_constant_nt. ap ob_twoarrow_cat. Qed. Lemma vident_twoarrow_functor : forall a u v, twoarrow_hypothesis a u v -> vident (twoarrow_functor a u v) = twoarrow_nt a u v u v (id a (source u)) (id a (target u)). Proof. ir. cp twoarrow_cat_axioms. cp (twoarrow_functor_axioms H). cp H; uh H; ee. assert (ob a (source u)). rww ob_source. assert (ob a (target u)). rww ob_target. assert (twoarrow_nt_hypothesis a u v u v (id a (source u)) (id a (target u))). uhg; ee. uh H; ee; am. am. am. am. am. app mor_id. app mor_id. rww source_id. rww target_id. rww source_id. rww target_id. am. am. am. am. rww left_id. rww right_id. rww left_id. rww right_id. sy; am. sy; am. ap Nat_Trans.axioms_extensionality. rww vident_axioms. ap twoarrow_nt_axioms. am. rww source_vident. rww source_twoarrow_nt. rww target_vident. rww target_twoarrow_nt. ir. rwi osource_vident H9. rwi source_twoarrow_functor H9. rw ntrans_vident. rww target_twoarrow_functor. rwi ob_twoarrow_cat_or H9. nin H9. rw H9. rw fob_twoarrow_functor_R. rw ntrans_twoarrow_nt_R. reflexivity. am. rw H9. rw fob_twoarrow_functor_R. rw ntrans_twoarrow_nt_R. reflexivity. am. rw source_twoarrow_functor. am. Qed. Lemma vcompose_twoarrow_nt : forall a u1 v1 u2 v2 r s u1' v1' u2' v2' r' s', twoarrow_nt_hypothesis a u1 v1 u2 v2 r s -> twoarrow_nt_hypothesis a u1' v1' u2' v2' r' s' -> u1 = u2' -> v1 = v2' -> vcompose (twoarrow_nt a u1 v1 u2 v2 r s) (twoarrow_nt a u1' v1' u2' v2' r' s') = twoarrow_nt a u1' v1' u2 v2 (comp a r r') (comp a s s'). Proof. ir. wr H1. wr H2. wri H1 H0; wri H2 H0. cp twoarrow_cat_axioms. cp H; cp H0. uh H4; uh H5. ee. assert (twoarrow_hypothesis a u1 v1). uhg; ee; am. assert (twoarrow_hypothesis a u2 v2). uhg; ee; am. assert (twoarrow_hypothesis a u1' v1'). uhg; ee; am. cp (twoarrow_functor_axioms H38). cp (twoarrow_functor_axioms H39). cp (twoarrow_functor_axioms H40). assert (ob a (source u1)). rww ob_source. assert (ob a (target u1)). rww ob_target. assert (ob a (source u2)). rww ob_source. assert (ob a (target u2)). rww ob_target. assert (ob a (source u1')). rww ob_source. assert (ob a (target u1')). rww ob_target. cp (twoarrow_nt_axioms H). cp (twoarrow_nt_axioms H0). assert (source r = target r'). rww H13. assert (source s = target s'). rww H15. assert (twoarrow_nt_hypothesis a u1' v1' u2 v2 (comp a r r') (comp a s s')). uhg; ee. uh H6; ee; am. am. am. am. am. rww mor_comp. rww mor_comp. rww source_comp. rww target_comp. rww source_comp. rww target_comp. am. am. am. am. rww assoc. rw H20. wrr assoc. rw H36. rww assoc. sy; am. sy; am. rww assoc. rw H21. wrr assoc. rw H37. rww assoc. wr H34. sy; am. wr H33. am. wr H32. sy; am. wr H17; am. ap Nat_Trans.axioms_extensionality. rw vcompose_axioms. tv. am. am. rw source_twoarrow_nt. rw target_twoarrow_nt. reflexivity. app twoarrow_nt_axioms. rw source_vcompose. rw source_twoarrow_nt. rw source_twoarrow_nt. reflexivity. rw target_vcompose. rw target_twoarrow_nt. rw target_twoarrow_nt. reflexivity. ir. rwi osource_vcompose H55. rwi osource_twoarrow_nt H55. rw ntrans_vcompose. rw otarget_twoarrow_nt. rwi ob_twoarrow_cat_or H55. nin H55. rw H55. rw ntrans_twoarrow_nt_R. rw ntrans_twoarrow_nt_R. rw ntrans_twoarrow_nt_R. reflexivity. rw H55. rw ntrans_twoarrow_nt_R. rw ntrans_twoarrow_nt_R. rw ntrans_twoarrow_nt_R. reflexivity. rw osource_twoarrow_nt. am. Qed. Lemma twoarrow_nt_hypothesis_for_htrans_left : forall u1 v1 u2 v2 r s f, twoarrow_nt_hypothesis (source f) u1 v1 u2 v2 r s -> Functor.axioms f -> twoarrow_nt_hypothesis (target f) (fmor f u1) (fmor f v1) (fmor f u2) (fmor f v2) (fmor f r) (fmor f s). Proof. ir. cp twoarrow_cat_axioms. cp H. uh H2. ee. assert (twoarrow_hypothesis (source f) u1 v1). uhg; ee; am. assert (twoarrow_hypothesis (source f) u2 v2). uhg; ee; am. cp (twoarrow_functor_axioms H19). cp (twoarrow_functor_axioms H20). assert (ob (source f) (source u1)). rww ob_source. assert (ob (source f) (source u2)). rww ob_source. assert (ob (source f) (target u1)). rww ob_target. assert (ob (source f) (target u2)). rww ob_target. cp (twoarrow_nt_axioms H). uhg; ee; try (app mor_fmor); try (rww source_fmor); try (rww source_fmor); try (rww target_fmor); try (rww target_fmor); try (app uneq). uh H0; ee; am. rww comp_fmor. rww comp_fmor. app uneq. sy; am. rww comp_fmor. rww comp_fmor. app uneq. rww H10. sy; am. wrr H14. Qed. Lemma htrans_left_twoarrow_nt : forall a u1 v1 u2 v2 r s f, twoarrow_nt_hypothesis a u1 v1 u2 v2 r s -> Functor.axioms f -> source f = a -> htrans_left f (twoarrow_nt a u1 v1 u2 v2 r s) = twoarrow_nt (target f) (fmor f u1) (fmor f v1) (fmor f u2) (fmor f v2) (fmor f r) (fmor f s). Proof. ir. wr H1. wri H1 H. cp twoarrow_cat_axioms. cp H. uh H3. ee. assert (twoarrow_hypothesis (source f) u1 v1). uhg; ee; am. assert (twoarrow_hypothesis (source f) u2 v2). uhg; ee; am. cp (twoarrow_functor_axioms H20). cp (twoarrow_functor_axioms H21). assert (ob (source f) (source u1)). rww ob_source. assert (ob (source f) (source u2)). rww ob_source. assert (ob (source f) (target u1)). rww ob_target. assert (ob (source f) (target u2)). rww ob_target. cp (twoarrow_nt_axioms H). ap Nat_Trans.axioms_extensionality. app htrans_left_axioms. rww otarget_twoarrow_nt. app twoarrow_nt_axioms. app twoarrow_nt_hypothesis_for_htrans_left. rww source_htrans_left. rww source_twoarrow_nt. rw source_twoarrow_nt. rw fcompose_twoarrow_functor. tv. am. am. tv. rw target_htrans_left. rw target_twoarrow_nt. rw fcompose_twoarrow_functor. rw target_twoarrow_nt. tv. am. am. tv. ir. rwi osource_htrans_left H29. rwi osource_twoarrow_nt H29. rw ntrans_htrans_left. rwi ob_twoarrow_cat_or H29. nin H29. rw H29. rw ntrans_twoarrow_nt_R. rw ntrans_twoarrow_nt_R. reflexivity. rw H29. rw ntrans_twoarrow_nt_R. rw ntrans_twoarrow_nt_R. reflexivity. rww osource_twoarrow_nt. Qed. Lemma twoarrow_nt_hypothesis_for_htrans_right : forall y u v, Nat_Trans.axioms y -> twoarrow_hypothesis (osource y) u v -> twoarrow_nt_hypothesis (otarget y) (fmor (source y) u) (fmor (source y) v) (fmor (target y) u) (fmor (target y) v) (ntrans y (source u)) (ntrans y (target u)). Proof. ir. cp twoarrow_cat_axioms. cp H0. uh H2; ee. assert (ob (osource y) (source u)). rww ob_source. assert (ob (osource y) (target u)). rww ob_target. assert (Functor.axioms (source y)). rww functor_axioms_source. assert (Functor.axioms (target y)). rww functor_axioms_target. assert (Category.axioms (osource y)). rww category_axioms_osource. assert (Category.axioms (otarget y)). rww category_axioms_otarget. uhg; ee. am. wrr target_source; app mor_fmor. wrr target_source; app mor_fmor. wrr target_target; app mor_fmor; rww source_target. wrr target_target; app mor_fmor; rww source_target. app mor_ntrans. app mor_ntrans. rww source_ntrans. rww source_fmor. rww target_ntrans. rww source_fmor. rww source_target. rww source_ntrans. rww target_fmor. rww target_ntrans. rww target_fmor. rww source_target. rww source_fmor. rww source_fmor. rww H4. rww target_fmor. rww target_fmor. rww H5. rww source_fmor. rww source_fmor. rww H4. rww source_target. rww source_target. rww target_fmor. rww target_fmor. rww H5. rww source_target. rww source_target. rww carre. rw H4; rw H5. rww carre. Qed. Lemma htrans_right_twoarrow_functor : forall y a u v, Nat_Trans.axioms y -> twoarrow_hypothesis a u v -> osource y = a -> htrans_right y (twoarrow_functor a u v) = twoarrow_nt (otarget y) (fmor (source y) u) (fmor (source y) v) (fmor (target y) u) (fmor (target y) v) (ntrans y (source u)) (ntrans y (target u)). Proof. ir. wr H1. wri H1 H0. cp twoarrow_cat_axioms. cp H0. uh H3; ee. assert (ob (osource y) (source u)). rww ob_source. assert (ob (osource y) (target u)). rww ob_target. assert (Functor.axioms (source y)). rww functor_axioms_source. assert (Functor.axioms (target y)). rww functor_axioms_target. assert (Category.axioms (osource y)). rww category_axioms_osource. assert (Category.axioms (otarget y)). rww category_axioms_otarget. ap Nat_Trans.axioms_extensionality. ap htrans_right_axioms. app twoarrow_functor_axioms. am. rww target_twoarrow_functor. ap twoarrow_nt_axioms. app twoarrow_nt_hypothesis_for_htrans_right. rw source_htrans_right. rw fcompose_twoarrow_functor. rw source_twoarrow_nt. rww target_source. am. am. tv. rw target_htrans_right. rw fcompose_twoarrow_functor. rw target_twoarrow_nt. reflexivity. am. am. rww source_target. ir. rwi osource_htrans_right H13. cp H13. rwi source_twoarrow_functor H14. rww ntrans_htrans_right. rwi ob_twoarrow_cat_or H14. nin H14; rw H14. rw fob_twoarrow_functor_R. rw ntrans_twoarrow_nt_R. reflexivity. am. rw fob_twoarrow_functor_R. rw ntrans_twoarrow_nt_R. reflexivity. am. Qed. Lemma hcompose_twoarrow_nt1 : forall u a u1 v1 u2 v2 r s, twoarrow_nt_hypothesis a u1 v1 u2 v2 r s -> Nat_Trans.axioms u -> osource u = a -> hcompose u (twoarrow_nt a u1 v1 u2 v2 r s) = twoarrow_nt (otarget u) (fmor (source u) u1) (fmor (source u) v1) (fmor (target u) u2) (fmor (target u) v2) (comp (otarget u) (ntrans u (source u2)) (fmor (source u) r)) (comp (otarget u) (ntrans u (target u2)) (fmor (source u) s)). Proof. ir. uf hcompose. rw target_twoarrow_nt. util (htrans_right_twoarrow_functor (y:=u) (a:=a) (u:=u2) (v:=v2)). am. uh H; uhg; xd. am. rw H2. util (htrans_left_twoarrow_nt (a:=a) (u1:=u1) (v1:=v1) (u2:=u2) (v2:=v2) (r:=r) (s:=s) (f:=source u)). am. rww functor_axioms_source. am. rw H3. rw target_source. rw vcompose_twoarrow_nt. reflexivity. ap twoarrow_nt_hypothesis_for_htrans_right. am. rw H1. uh H; uhg; xd. wr target_source. ap twoarrow_nt_hypothesis_for_htrans_left. rw source_source; rw H1. am. rww functor_axioms_source. am. tv. tv. am. Qed. Lemma hcompose_twoarrow_nt2 : forall u a u1 v1 u2 v2 r s, twoarrow_nt_hypothesis a u1 v1 u2 v2 r s -> Nat_Trans.axioms u -> osource u = a -> hcompose u (twoarrow_nt a u1 v1 u2 v2 r s) = twoarrow_nt (otarget u) (fmor (source u) u1) (fmor (source u) v1) (fmor (target u) u2) (fmor (target u) v2) (comp (otarget u) (fmor (target u) r) (ntrans u (source u1)) ) (comp (otarget u) (fmor (target u) s) (ntrans u (target u1)) ). Proof. ir. rw Nat_Trans.hcompose_other. uf hcompose1. rw source_twoarrow_nt. util (htrans_right_twoarrow_functor (y:=u) (a:=a) (u:=u1) (v:=v1)). am. uh H; uhg; xd. am. rw H2. util (htrans_left_twoarrow_nt (a:=a) (u1:=u1) (v1:=v1) (u2:=u2) (v2:=v2) (r:=r) (s:=s) (f:=target u)). am. rww functor_axioms_target. rww source_target. rw H3. rw target_target. rw vcompose_twoarrow_nt. reflexivity. wr target_target. ap twoarrow_nt_hypothesis_for_htrans_left. rw source_target. rw H1. am. am. rww functor_axioms_target. ap twoarrow_nt_hypothesis_for_htrans_right. am. rw H1. uh H; uhg; xd. tv. tv. uhg. ee. am. app twoarrow_nt_axioms. rww otarget_twoarrow_nt. Qed. Lemma ta_obs_tack : tack (R o1) (tack (R o2) emptyset) = ta_obs. Proof. ap extensionality; uhg; ir. rwi tack_inc H. nin H. rwi tack_inc H. nin H. nin H. elim x0. rw H. ap R_inc. rw H. ap R_inc. nin H. wr H. nin x0. rw tack_inc. ap or_intror. tv. rw tack_inc. ap or_introl. rw tack_inc. ap or_intror; tv. Qed. Lemma ta_maps_tack : tack (R i1) (tack (R i2) (tack (R a0) (tack (R a1) emptyset))) = ta_maps. Proof. ap extensionality; uhg; ir. rwi tack_inc H. nin H. rwi tack_inc H. nin H. rwi tack_inc H. nin H. rwi tack_inc H. nin H. nin H. nin x0. rw H. ap R_inc. rw H. ap R_inc. rw H. ap R_inc. rw H. ap R_inc. rw tack_inc. rw tack_inc. rw tack_inc. rw tack_inc. nin H. wr H. nin x0. ap or_intror. tv. ap or_introl; ap or_intror; tv. ap or_introl; ap or_introl; ap or_intror; tv. ap or_introl; ap or_introl; ap or_introl. ap or_intror; tv. Qed. Lemma is_finite_ta_obs : is_finite (ta_obs). Proof. wr ta_obs_tack. ap finite_tack. ap finite_tack. ap finite_emptyset. Qed. Lemma is_finite_ta_maps : is_finite (ta_maps). Proof. wr ta_maps_tack. ap finite_tack. ap finite_tack. ap finite_tack. ap finite_tack. ap finite_emptyset. Qed. Lemma is_finite_twoarrow_cat : is_finite_cat twoarrow_cat. Proof. uf twoarrow_cat. ap is_finite_catyd. ap twoarrow_data_property. exact (is_finite_ta_obs). exact (is_finite_ta_maps). Qed. End Twoarrow_Cat. Module Vee_Cat. Export From_Types. Export Finite_Cat. (***** we hope to be able to basically recopy the previous module with a minimum of changes *****) Inductive vee_obs : Set := o1 : vee_obs | o2 : vee_obs | o3 : vee_obs. Inductive vee_maps : Set := i1 : vee_maps | i2 : vee_maps |i3 : vee_maps | a12 : vee_maps | a32 : vee_maps. Definition vee_src u := match u with i1 => o1 | i2 => o2 | i3 => o3 | a12 => o1 | a32 => o3 end. Definition vee_trg u := match u with i1 => o1 | i2 => o2 | i3 => o3 | a12 => o2 | a32 => o2 end. Definition vee_id x := match x with o1 => i1 | o2 => i2 | o3 => i3 end. Definition vee_comp u v := match (u, v) with (i1, v') => v' | (i2, v') => v' | (i3, v') => v' | (u', i1) => u' | (u', i2) => u' | (u', i3) => u' | _ => i1 end. Definition vee_data := Build_cat_type_data vee_src vee_trg vee_id vee_comp. Lemma vee_data_property : catyd_property vee_data. Proof. show_catyd_property. Qed. Definition vee_cat := catyd vee_data. Lemma vee_cat_axioms : Category.axioms vee_cat. Proof. uf vee_cat. ap catyd_axioms. ap vee_data_property. Qed. (*** the constructions (R o1) and (R o2) dont work well with the implicit arguments mechanism because they don't introduce the type (obsy _); it is better to redefine the objects ***) Definition o1' : obsy vee_data := o1. Definition o2' : obsy vee_data := o2. Definition o3' : obsy vee_data := o3. Definition i1' : morsy vee_data := i1. Definition i2' : morsy vee_data := i2. Definition i3' : morsy vee_data := i3. Definition a12' : morsy vee_data := a12. Definition a32' : morsy vee_data := a32. Lemma ob_vee_cat_ex : forall x, ob vee_cat x = (exists x':obsy vee_data, x = R x'). Proof. ir. uf vee_cat. rw ob_catyd. tv. ap vee_data_property. Qed. Lemma ob_vee_cat : forall (x:obsy vee_data), ob vee_cat (R x). Proof. ir. uf vee_cat. app ob_catyd_R. ap vee_data_property. Qed. Lemma mor_vee_cat : forall (y:morsy vee_data), mor vee_cat (catyd_arrow y). Proof. ir. uf vee_cat. app mor_catyd_catyd_arrow. ap vee_data_property. Qed. Lemma mor_vee_cat_ex : forall u, mor vee_cat u = (exists y:morsy vee_data, u = catyd_arrow y). Proof. ir. ap iff_eq; ir. ufi vee_cat H; rwi mor_catyd H. am. ap vee_data_property. nin H. rw H. ap mor_vee_cat. Qed. Lemma id_vee_cat_R : forall (x:obsy vee_data), id vee_cat (R x) = match x with o1 => (catyd_arrow i1') | o2 => (catyd_arrow i2') | o3 => (catyd_arrow i3') end. Proof. ir. nin x; uf vee_cat; rww id_catyd_R; ap vee_data_property. Qed. Definition vee_hypothesis a u v := mor a u & mor a v & target u = target v. Definition vee_fun_data a u v := Build_fun_type_data (d:= vee_data) a (fun x => match x with o1 => (source u) | o2 => (target u) | o3 => (source v) end) (fun y => match y with i1 => id a (source u) | i2 => id a (target u) | i3 => id a (source v) | a12 => u | a32 => v end). Lemma ft_vee_fun_data : forall a u v, ft (vee_fun_data a u v) = a. Proof. ir. uf vee_fun_data. rww ft_Build_fun_type_data. Qed. Lemma vee_fun_data_property : forall a u v, vee_hypothesis a u v -> funtyd_property (vee_fun_data a u v). Proof. ir. uh H; ee. uf vee_fun_data. start_funtyd_proof; funtyd_dispatch. Qed. Definition vee_functor a u v := funtyd (vee_fun_data a u v). Lemma vee_functor_axioms : forall a u v, vee_hypothesis a u v -> Functor.axioms (vee_functor a u v). Proof. ir. uh H; ee. uf vee_functor. ap funtyd_axioms. app vee_fun_data_property. uhg; ee; am. Qed. Lemma source_vee_functor : forall a u v, source (vee_functor a u v) = vee_cat. Proof. ir. uf vee_functor. rww source_funtyd. Qed. Lemma target_vee_functor : forall a u v, target (vee_functor a u v) = a. Proof. ir. uf vee_functor. rww target_funtyd. Qed. Lemma fob_vee_functor_R : forall a u v (x:obsy vee_data), vee_hypothesis a u v -> fob (vee_functor a u v) (R x) = match x with o1 => (source u) | o2 => (target u) | o3 => (source v) end. Proof. ir. cp (vee_fun_data_property H). uf vee_functor. nin x; rww fob_funtyd_R. Qed. Lemma fmor_vee_functor_catyd_arrow :forall a u v (y:morsy vee_data), vee_hypothesis a u v -> fmor (vee_functor a u v) (catyd_arrow y) = match y with i1 => id a (source u) | i2 => id a (target u) | i3 => id a (source v) | a12 => u | a32 => v end. Proof. ir. cp (vee_fun_data_property H). uf vee_functor. nin y; rww fmor_funtyd_catyd_arrow. Qed. (**** every functor from vee_cat is of the form vee_functor _ _ _ **********************) Lemma functor_vee_hypothesis : forall f, Functor.axioms f -> source f = vee_cat -> vee_hypothesis (target f) (fmor f (catyd_arrow a12')) (fmor f (catyd_arrow a32')). Proof. ir. uhg; ee. app mor_fmor. rw H0. ap mor_vee_cat. app mor_fmor. rw H0. ap mor_vee_cat. rww target_fmor. rw target_catyd_arrow. rww target_fmor. rww target_catyd_arrow. rw H0. ap mor_vee_cat. rw H0. ap mor_vee_cat. Qed. Lemma functor_vee_eq : forall f, Functor.axioms f -> source f = vee_cat -> f = vee_functor (target f) (fmor f (catyd_arrow a12')) (fmor f (catyd_arrow a32')). Proof. ir. ap Functor.axioms_extensionality. am. ap vee_functor_axioms. app functor_vee_hypothesis. rww source_vee_functor. rww target_vee_functor. ir. rwi H0 H1. set (p:= (fmor f (catyd_arrow (d:=vee_data) a12'))). set (q:= (fmor f (catyd_arrow (d:=vee_data) a32'))). rwi mor_vee_cat_ex H1. nin H1. rw H1. rw fmor_vee_functor_catyd_arrow. assert (catyd_arrow (d:= vee_data) i1 = id vee_cat (R o1')). rw id_vee_cat_R. reflexivity. assert (catyd_arrow (d:= vee_data) i2 = id vee_cat (R o2')). rw id_vee_cat_R. reflexivity. assert (lem1: catyd_arrow (d:= vee_data) i3 = id vee_cat (R o3')). rw id_vee_cat_R. reflexivity. nin x. rw H2. wr H0. rw fmor_id. uf p. rw source_fmor. rw source_catyd_arrow. tv. am. rw H0. ap mor_vee_cat. am. tv. rw H0; ap ob_vee_cat. rw H3. wr H0. rw fmor_id. uf p. rw target_fmor. rw target_catyd_arrow. reflexivity. am. rw H0; ap mor_vee_cat. am. tv. rw H0; ap ob_vee_cat. rw lem1. wr H0. rw fmor_id. uf q. rw source_fmor. rw source_catyd_arrow. reflexivity. am. rw H0; ap mor_vee_cat. am. tv. rw H0; ap ob_vee_cat. reflexivity. reflexivity. uf p. uf q. app functor_vee_hypothesis. Qed. Lemma functor_vee_eq2 : forall a u v f, Functor.axioms f -> source f = vee_cat -> a = target f -> u = (fmor f (catyd_arrow a12')) -> v = (fmor f (catyd_arrow a32')) -> f = vee_functor a u v. Proof. ir. rw H1; rw H2; rw H3; app functor_vee_eq. Qed. Lemma constant_functor_vee_functor : forall a b x, a = vee_cat -> ob b x -> constant_functor a b x = vee_functor b (id b x) (id b x). Proof. ir. ap functor_vee_eq2. ap constant_functor_axioms. rw H; ap vee_cat_axioms. uh H0; ee; am. am. rww source_constant_functor. rww target_constant_functor. rw fmor_constant_functor. tv. rw H. ap mor_vee_cat. rw fmor_constant_functor. tv. rw H. ap mor_vee_cat. Qed. Lemma fidentity_vee_cat : fidentity vee_cat = vee_functor vee_cat (catyd_arrow a12') (catyd_arrow a32'). Proof. cp vee_cat_axioms. app functor_vee_eq2. rww fidentity_axioms. rww source_fidentity. rww target_fidentity. rww fmor_fidentity. ap mor_vee_cat. rww fmor_fidentity; ap mor_vee_cat. Qed. Lemma fcompose_vee_functor : forall a u v f, vee_hypothesis a u v -> Functor.axioms f -> source f = a -> fcompose f (vee_functor a u v) = vee_functor (target f) (fmor f u) (fmor f v). Proof. ir. ap functor_vee_eq2. app fcompose_axioms. app vee_functor_axioms. rww target_vee_functor. rww source_fcompose. rww source_vee_functor. rww target_fcompose. rww fmor_fcompose. rww fmor_vee_functor_catyd_arrow. app vee_functor_axioms. rww target_vee_functor. rww source_vee_functor. ap mor_vee_cat. rww fmor_fcompose. rww fmor_vee_functor_catyd_arrow. app vee_functor_axioms. rww target_vee_functor. rww source_vee_functor. ap mor_vee_cat. Qed. Definition vee_nt a u1 v1 u2 v2 r s t := nttyd (vee_fun_data a u1 v1) (vee_fun_data a u2 v2) (fun x : (obsy vee_data) => match x with o1 => r | o2 => s | o3 => t end). Definition vee_nt_hypothesis a u1 v1 u2 v2 r s t:= Category.axioms a & mor a u1 & mor a v1 & mor a u2 & mor a v2 & mor a r & mor a s & mor a t & source r = source u1 & target r = source u2 & source s = target u1 & target s = target u2 & source t = source v1 & target t = source v2 & target u1 = target v1 & target u2 = target v2 & comp a s u1 = comp a u2 r & comp a s v1 = comp a v2 t. Lemma vee_nttyd_property : forall a u1 v1 u2 v2 r s t, vee_nt_hypothesis a u1 v1 u2 v2 r s t -> nttyd_property (vee_fun_data a u1 v1) (vee_fun_data a u2 v2) (fun x : (obsy vee_data) => match x with o1 => r | o2 => s | o3 => t end). Proof. ir. uh H; ee. assert (lem1: vee_hypothesis a u1 v1). uhg; ee; am. assert (lem2: vee_hypothesis a u2 v2). uhg; ee; am. uhg; ee. ap vee_data_property. app vee_fun_data_property. app vee_fun_data_property. rw ft_vee_fun_data; rww ft_vee_fun_data. ir. rw ft_vee_fun_data. nin x. am. am. am. ir. nin x. rww H7. rww H9. rww H11. ir. nin x. rww H8. rww H10. rww H12. ir. rw ft_vee_fun_data. nin u. change (comp a r (id a (source u1)) = comp a (id a (source u2)) r). rww right_id. rww left_id. rww ob_source. rww ob_source. change (comp a s (id a (target u1)) = comp a (id a (target u2)) s). rww left_id. rww right_id. rww ob_target. rww ob_target. change (comp a t (id a (source v1)) = comp a (id a (source v2)) t). rww left_id. rww right_id. rww ob_source. rww ob_source. am. am. Qed. Lemma vee_nt_axioms : forall a u1 v1 u2 v2 r s t, vee_nt_hypothesis a u1 v1 u2 v2 r s t-> Nat_Trans.axioms (vee_nt a u1 v1 u2 v2 r s t). Proof. ir. uf vee_nt. ap nttyd_axioms. ap vee_nttyd_property. am. Qed. Lemma source_vee_nt : forall a u1 v1 u2 v2 r s t, source (vee_nt a u1 v1 u2 v2 r s t) = vee_functor a u1 v1. Proof. ir. uf vee_nt. rww source_nttyd. Qed. Lemma target_vee_nt : forall a u1 v1 u2 v2 r s t, target (vee_nt a u1 v1 u2 v2 r s t) = vee_functor a u2 v2. Proof. ir. uf vee_nt. rww target_nttyd. Qed. Lemma osource_vee_nt : forall a u1 v1 u2 v2 r s t, osource (vee_nt a u1 v1 u2 v2 r s t) = vee_cat. Proof. ir. uf osource. rw source_vee_nt. rww source_vee_functor. Qed. Lemma otarget_vee_nt : forall a u1 v1 u2 v2 r s t, otarget (vee_nt a u1 v1 u2 v2 r s t) = a. Proof. ir. uf otarget. rw target_vee_nt. rww target_vee_functor. Qed. Lemma ntrans_vee_nt_R : forall a u1 v1 u2 v2 r s t (x:obsy vee_data), ntrans (vee_nt a u1 v1 u2 v2 r s t) (R x) = match x with o1 => r | o2 => s | o3 => t end. Proof. ir. uf vee_nt. rw ntrans_nttyd. rw X_rewrite. tv. rw ob_catyd. sh x; tv. ap vee_data_property. Qed. Lemma vee_nt_hypothesis_ntrans : forall u, Nat_Trans.axioms u -> osource u = vee_cat -> vee_nt_hypothesis (otarget u) (fmor (source u) (catyd_arrow a12')) (fmor (source u) (catyd_arrow a32')) (fmor (target u) (catyd_arrow a12')) (fmor (target u) (catyd_arrow a32')) (ntrans u (R o1')) (ntrans u (R o2')) (ntrans u (R o3')). Proof. ir. assert (Category.axioms (otarget u)). rww category_axioms_otarget. assert (Functor.axioms (source u)). rww functor_axioms_source. assert (Functor.axioms (target u)). rww functor_axioms_target. uhg; ee. am. wrr target_source. app mor_fmor. rw source_source. rw H0. ap mor_vee_cat. wr target_source. app mor_fmor. rw source_source. rw H0. ap mor_vee_cat. am. uf otarget. app mor_fmor. rw source_target. rw H0. ap mor_vee_cat. am. uf otarget. app mor_fmor. rw source_target. rw H0. ap mor_vee_cat. am. app mor_ntrans. rw H0. ap ob_vee_cat. app mor_ntrans. rw H0. ap ob_vee_cat. app mor_ntrans. rw H0. ap ob_vee_cat. rww source_fmor. rww source_catyd_arrow. rww source_ntrans. rw H0. ap ob_vee_cat. rw source_source; rw H0; ap mor_vee_cat. rww target_ntrans. rww source_fmor. rww source_catyd_arrow. rww source_target. rw H0. ap mor_vee_cat. rw H0. ap ob_vee_cat. rww source_ntrans. rww target_fmor. rww target_catyd_arrow. rw source_source; rw H0; ap mor_vee_cat. rw H0. ap ob_vee_cat. rww target_ntrans. rww target_fmor. rww target_catyd_arrow. rww source_target. rw H0. ap mor_vee_cat. rw H0. ap ob_vee_cat. rww source_ntrans. rww source_fmor. rww source_catyd_arrow. rw source_source. rw H0. ap mor_vee_cat. rw H0. ap ob_vee_cat. rww target_ntrans. rww source_fmor. rww source_catyd_arrow. rw source_target. rw H0. ap mor_vee_cat. am. rw H0. ap ob_vee_cat. rw target_fmor. rw target_catyd_arrow. rw target_fmor. rw target_catyd_arrow. reflexivity. am. rw source_source; rw H0; ap mor_vee_cat. am. rw source_source; rw H0; ap mor_vee_cat. rw target_fmor. rw target_catyd_arrow. rw target_fmor. rw target_catyd_arrow. reflexivity. am. rww source_target; rw H0; ap mor_vee_cat. am. rww source_target; rw H0; ap mor_vee_cat. assert (R o2' = target (catyd_arrow a12')). rww target_catyd_arrow. rw H4. rw carre. rw source_catyd_arrow. reflexivity. am. rw H0. ap mor_vee_cat. assert (R o2' = target (catyd_arrow a32')). rww target_catyd_arrow. rw H4. rw carre. rw source_catyd_arrow. reflexivity. am. rw H0. ap mor_vee_cat. Qed. Lemma vee_nt_ntrans : forall u, Nat_Trans.axioms u -> osource u = vee_cat -> vee_nt (otarget u) (fmor (source u) (catyd_arrow a12')) (fmor (source u) (catyd_arrow a32')) (fmor (target u) (catyd_arrow a12')) (fmor (target u) (catyd_arrow a32')) (ntrans u (R o1')) (ntrans u (R o2')) (ntrans u (R o3')) = u. Proof. ir. ap Nat_Trans.axioms_extensionality. ap vee_nt_axioms. app vee_nt_hypothesis_ntrans. am. rw source_vee_nt. wr target_source. sy; ap functor_vee_eq. uh H; ee. am. am. am. rw target_vee_nt. uf otarget. sy; ap functor_vee_eq. uh H; ee; am. rww source_target. ir. ufi osource H1. rwi source_vee_nt H1. rwi source_vee_functor H1. rwi ob_vee_cat_ex H1. nin H1. nin x0. rw H1. rw ntrans_vee_nt_R. reflexivity. rw H1. rw ntrans_vee_nt_R. reflexivity. rw H1. rw ntrans_vee_nt_R. reflexivity. Qed. Lemma eq_vee_nt : forall u a u1 v1 u2 v2 r s t, Nat_Trans.axioms u -> osource u = vee_cat -> a = (otarget u) -> u1 = (fmor (source u) (catyd_arrow a12')) -> v1 =(fmor (source u) (catyd_arrow a32')) -> u2 =(fmor (target u) (catyd_arrow a12')) -> v2 =(fmor (target u) (catyd_arrow a32')) -> r =(ntrans u (R o1')) -> s =(ntrans u (R o2')) -> t = (ntrans u (R o3')) -> u = vee_nt a u1 v1 u2 v2 r s t. Proof. ir. rw H1; rw H2; rw H3; rw H4; rw H5; rw H6; rw H7; rw H8; rww vee_nt_ntrans. Qed. Lemma constant_nt_vee_nt : forall a b u, a = vee_cat -> mor b u -> constant_nt a b u = vee_nt b (id b (source u)) (id b (source u)) (id b (target u)) (id b (target u)) u u u. Proof. ir. rw H. ap eq_vee_nt. app constant_nt_axioms. ap vee_cat_axioms. uh H0; ee; am. rww osource_constant_nt. rww otarget_constant_nt. rw source_constant_nt. rw fmor_constant_functor. tv. ap mor_vee_cat. rw source_constant_nt. rw fmor_constant_functor. tv. ap mor_vee_cat. rw target_constant_nt. rw fmor_constant_functor. tv. ap mor_vee_cat. rw target_constant_nt. rw fmor_constant_functor. tv. ap mor_vee_cat. rww ntrans_constant_nt. ap ob_vee_cat. rww ntrans_constant_nt. ap ob_vee_cat. rww ntrans_constant_nt. ap ob_vee_cat. Qed. Lemma vident_vee_functor : forall a u v, vee_hypothesis a u v -> vident (vee_functor a u v) = vee_nt a u v u v (id a (source u)) (id a (target u)) (id a (source v)). Proof. ir. cp vee_cat_axioms. cp (vee_functor_axioms H). cp H; uh H; ee. assert (ob a (source u)). rww ob_source. assert (ob a (target u)). rww ob_target. assert (ob a (source v)). rww ob_source. assert (vee_nt_hypothesis a u v u v (id a (source u)) (id a (target u)) (id a (source v))). uhg; ee. uh H; ee; am. am. am. am. am. app mor_id. app mor_id. app mor_id. rww source_id. rww target_id. rww source_id. rww target_id. rww source_id. rww target_id. am. am. rww left_id. rww right_id. rww left_id. rww right_id. sy; am. ap Nat_Trans.axioms_extensionality. rww vident_axioms. ap vee_nt_axioms. am. rww source_vident. rww source_vee_nt. rww target_vident. rww target_vee_nt. ir. rwi osource_vident H9. rwi source_vee_functor H9. rw ntrans_vident. rww target_vee_functor. rwi ob_vee_cat_ex H9. nin H9. nin x0. rw H9. rw fob_vee_functor_R. rw ntrans_vee_nt_R. reflexivity. am. rw H9. rw fob_vee_functor_R. rw ntrans_vee_nt_R. reflexivity. am. rw H9. rw fob_vee_functor_R. rw ntrans_vee_nt_R. reflexivity. am. rw source_vee_functor. am. Qed. Lemma vcompose_vee_nt : forall a u1 v1 u2 v2 r s t u1' v1' u2' v2' r' s' t', vee_nt_hypothesis a u1 v1 u2 v2 r s t -> vee_nt_hypothesis a u1' v1' u2' v2' r' s' t' -> u1 = u2' -> v1 = v2' -> vcompose (vee_nt a u1 v1 u2 v2 r s t) (vee_nt a u1' v1' u2' v2' r' s' t') = vee_nt a u1' v1' u2 v2 (comp a r r') (comp a s s') (comp a t t'). Proof. ir. wr H1. wr H2. wri H1 H0; wri H2 H0. cp vee_cat_axioms. cp H; cp H0. uh H4; uh H5. ee. assert (vee_hypothesis a u1 v1). uhg; ee; am. assert (vee_hypothesis a u2 v2). uhg; ee; am. assert (vee_hypothesis a u1' v1'). uhg; ee; am. cp (vee_functor_axioms H40). cp (vee_functor_axioms H41). cp (vee_functor_axioms H42). assert (ob a (source u1)). rww ob_source. assert (ob a (target u1)). rww ob_target. assert (ob a (source v1)). rww ob_source. assert (ob a (source u2)). rww ob_source. assert (ob a (target u2)). rww ob_target. assert (ob a (source v2)). rww ob_source. assert (ob a (source u1')). rww ob_source. assert (ob a (target u1')). rww ob_target. assert (ob a (source v1')). rww ob_source. cp (vee_nt_axioms H). cp (vee_nt_axioms H0). assert (source r = target r'). rww H14. assert (source s = target s'). rww H16. assert (source t = target t'). rww H18. assert (vee_nt_hypothesis a u1' v1' u2 v2 (comp a r r') (comp a s s') (comp a t t')). uhg; ee. uh H6; ee; am. am. am. am. am. rww mor_comp. rww mor_comp. rww mor_comp. rww source_comp. rww target_comp. rww source_comp. rww target_comp. rww source_comp. rww target_comp. am. am. rww assoc. rw H21. wrr assoc. rw H38. rww assoc. sy; am. sy; am. rww assoc. rw H22. wrr assoc. rw H39. rww assoc. sy; am. wr H36. am. sy; am. wrr H19. ap Nat_Trans.axioms_extensionality. rw vcompose_axioms. tv. am. am. rw source_vee_nt. rw target_vee_nt. reflexivity. app vee_nt_axioms. rw source_vcompose. rw source_vee_nt. rw source_vee_nt. reflexivity. rw target_vcompose. rw target_vee_nt. rw target_vee_nt. reflexivity. ir. rwi osource_vcompose H61. rwi osource_vee_nt H61. rw ntrans_vcompose. rw otarget_vee_nt. rwi ob_vee_cat_ex H61. nin H61. nin x0. rw H61. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. reflexivity. rw H61. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. reflexivity. rw H61. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. reflexivity. rw osource_vee_nt. am. Qed. Lemma vee_nt_hypothesis_for_htrans_left : forall u1 v1 u2 v2 r s t f, vee_nt_hypothesis (source f) u1 v1 u2 v2 r s t -> Functor.axioms f -> vee_nt_hypothesis (target f) (fmor f u1) (fmor f v1) (fmor f u2) (fmor f v2) (fmor f r) (fmor f s) (fmor f t). Proof. ir. cp vee_cat_axioms. cp H. uh H2. ee. assert (vee_hypothesis (source f) u1 v1). uhg; ee; am. assert (vee_hypothesis (source f) u2 v2). uhg; ee; am. cp (vee_functor_axioms H20). cp (vee_functor_axioms H21). assert (ob (source f) (source u1)). rww ob_source. assert (ob (source f) (source u2)). rww ob_source. assert (ob (source f) (target u1)). rww ob_target. assert (ob (source f) (target u2)). rww ob_target. assert (ob (source f) (source v1)). rww ob_source. assert (ob (source f) (source v2)). rww ob_source. cp (vee_nt_axioms H). uhg; ee; try (app mor_fmor); try (rww source_fmor); try (rww source_fmor); try (rww target_fmor); try (rww target_fmor); try (app uneq). uh H0; ee; am. rww comp_fmor. rww comp_fmor. app uneq. sy; am. rww comp_fmor. rww comp_fmor. app uneq. sy; am. wrr H16. Qed. Lemma htrans_left_vee_nt : forall a u1 v1 u2 v2 r s t f, vee_nt_hypothesis a u1 v1 u2 v2 r s t -> Functor.axioms f -> source f = a -> htrans_left f (vee_nt a u1 v1 u2 v2 r s t) = vee_nt (target f) (fmor f u1) (fmor f v1) (fmor f u2) (fmor f v2) (fmor f r) (fmor f s) (fmor f t). Proof. ir. wr H1. wri H1 H. cp vee_cat_axioms. cp H. uh H3. ee. assert (vee_hypothesis (source f) u1 v1). uhg; ee; am. assert (vee_hypothesis (source f) u2 v2). uhg; ee; am. cp (vee_functor_axioms H21). cp (vee_functor_axioms H22). assert (ob (source f) (source u1)). rww ob_source. assert (ob (source f) (source u2)). rww ob_source. assert (ob (source f) (target u1)). rww ob_target. assert (ob (source f) (target u2)). rww ob_target. assert (ob (source f) (source v1)). rww ob_source. assert (ob (source f) (source v2)). rww ob_source. cp (vee_nt_axioms H). ap Nat_Trans.axioms_extensionality. app htrans_left_axioms. rww otarget_vee_nt. app vee_nt_axioms. app vee_nt_hypothesis_for_htrans_left. rww source_htrans_left. rww source_vee_nt. rw source_vee_nt. rw fcompose_vee_functor. tv. am. am. tv. rw target_htrans_left. rw target_vee_nt. rw fcompose_vee_functor. rw target_vee_nt. tv. am. am. tv. ir. rwi osource_htrans_left H32. rwi osource_vee_nt H32. rw ntrans_htrans_left. rwi ob_vee_cat_ex H32. nin H32. nin x0. rw H32. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. reflexivity. rw H32. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. reflexivity. rw H32. rw ntrans_vee_nt_R. rw ntrans_vee_nt_R. reflexivity. rww osource_vee_nt. Qed. Lemma vee_nt_hypothesis_for_htrans_right : forall y u v, Nat_Trans.axioms y -> vee_hypothesis (osource y) u v -> vee_nt_hypothesis (otarget y) (fmor (source y) u) (fmor (source y) v) (fmor (target y) u) (fmor (target y) v) (ntrans y (source u)) (ntrans y (target u)) (ntrans y (source v)). Proof. ir. cp vee_cat_axioms. cp H0. uh H2; ee. assert (ob (osource y) (source u)). rww ob_source. assert (ob (osource y) (target u)). rww ob_target. assert (ob (osource y) (source v)). rww ob_source. assert (Functor.axioms (source y)). rww functor_axioms_source. assert (Functor.axioms (target y)). rww functor_axioms_target. assert (Category.axioms (osource y)). rww category_axioms_osource. assert (Category.axioms (otarget y)). rww category_axioms_otarget. uhg; ee. am. wrr target_source; app mor_fmor. wrr target_source; app mor_fmor. wrr target_target; app mor_fmor; rww source_target. wrr target_target; app mor_fmor; rww source_target. app mor_ntrans. app mor_ntrans. app mor_ntrans. rww source_ntrans. rww source_fmor. rww target_ntrans. rww source_fmor. rww source_target. rww source_ntrans. rww target_fmor. rww target_ntrans. rww target_fmor. rww source_target. rww source_ntrans. rww source_fmor. rww target_ntrans. rww source_fmor. rww source_target. rww target_fmor. rww target_fmor. rww H4. rww target_fmor. rww target_fmor. rww H4. rww source_target. rww source_target. rww carre. rw H4. rww carre. Qed. Lemma htrans_right_vee_functor : forall y a u v, Nat_Trans.axioms y -> vee_hypothesis a u v -> osource y = a -> htrans_right y (vee_functor a u v) = vee_nt (otarget y) (fmor (source y) u) (fmor (source y) v) (fmor (target y) u) (fmor (target y) v) (ntrans y (source u)) (ntrans y (target u)) (ntrans y (source v)). Proof. ir. wr H1. wri H1 H0. cp vee_cat_axioms. cp H0. uh H3; ee. assert (ob (osource y) (source u)). rww ob_source. assert (ob (osource y) (target u)). rww ob_target. assert (Functor.axioms (source y)). rww functor_axioms_source. assert (Functor.axioms (target y)). rww functor_axioms_target. assert (Category.axioms (osource y)). rww category_axioms_osource. assert (Category.axioms (otarget y)). rww category_axioms_otarget. ap Nat_Trans.axioms_extensionality. ap htrans_right_axioms. app vee_functor_axioms. am. rww target_vee_functor. ap vee_nt_axioms. app vee_nt_hypothesis_for_htrans_right. rw source_htrans_right. rw fcompose_vee_functor. rw source_vee_nt. rww target_source. am. am. tv. rw target_htrans_right. rw fcompose_vee_functor. rw target_vee_nt. reflexivity. am. am. rww source_target. ir. rwi osource_htrans_right H12. cp H12. rwi source_vee_functor H13. rww ntrans_htrans_right. rwi ob_vee_cat_ex H13. nin H13. nin x0; rw H13. rw fob_vee_functor_R. rw ntrans_vee_nt_R. reflexivity. am. rw fob_vee_functor_R. rw ntrans_vee_nt_R. reflexivity. am. rw fob_vee_functor_R. rw ntrans_vee_nt_R. reflexivity. am. Qed. Lemma hcompose_vee_nt1 : forall u a u1 v1 u2 v2 r s t, vee_nt_hypothesis a u1 v1 u2 v2 r s t -> Nat_Trans.axioms u -> osource u = a -> hcompose u (vee_nt a u1 v1 u2 v2 r s t) = vee_nt (otarget u) (fmor (source u) u1) (fmor (source u) v1) (fmor (target u) u2) (fmor (target u) v2) (comp (otarget u) (ntrans u (source u2)) (fmor (source u) r)) (comp (otarget u) (ntrans u (target u2)) (fmor (source u) s)) (comp (otarget u) (ntrans u (source v2)) (fmor (source u) t)). Proof. ir. uf hcompose. rw target_vee_nt. util (htrans_right_vee_functor (y:=u) (a:=a) (u:=u2) (v:=v2)). am. uh H; uhg; xd. am. rw H2. util (htrans_left_vee_nt (a:=a) (u1:=u1) (v1:=v1) (u2:=u2) (v2:=v2) (r:=r) (s:=s) (t:=t) (f:=source u)). am. rww functor_axioms_source. am. rw H3. rw target_source. rw vcompose_vee_nt. reflexivity. ap vee_nt_hypothesis_for_htrans_right. am. rw H1. uh H; uhg; xd. wr target_source. ap vee_nt_hypothesis_for_htrans_left. rw source_source; rw H1. am. rww functor_axioms_source. am. tv. tv. am. Qed. Lemma hcompose_vee_nt2 : forall u a u1 v1 u2 v2 r s t, vee_nt_hypothesis a u1 v1 u2 v2 r s t -> Nat_Trans.axioms u -> osource u = a -> hcompose u (vee_nt a u1 v1 u2 v2 r s t) = vee_nt (otarget u) (fmor (source u) u1) (fmor (source u) v1) (fmor (target u) u2) (fmor (target u) v2) (comp (otarget u) (fmor (target u) r) (ntrans u (source u1)) ) (comp (otarget u) (fmor (target u) s) (ntrans u (target u1)) ) (comp (otarget u) (fmor (target u) t) (ntrans u (source v1)) ). Proof. ir. rw Nat_Trans.hcompose_other. uf hcompose1. rw source_vee_nt. util (htrans_right_vee_functor (y:=u) (a:=a) (u:=u1) (v:=v1)). am. uh H; uhg; xd. am. rw H2. util (htrans_left_vee_nt (a:=a) (u1:=u1) (v1:=v1) (u2:=u2) (v2:=v2) (r:=r) (s:=s) (t:=t) (f:=target u)). am. rww functor_axioms_target. rww source_target. rw H3. rw target_target. rw vcompose_vee_nt. reflexivity. wr target_target. ap vee_nt_hypothesis_for_htrans_left. rw source_target. rw H1. am. am. rww functor_axioms_target. ap vee_nt_hypothesis_for_htrans_right. am. rw H1. uh H; uhg; xd. tv. tv. uhg. ee. am. app vee_nt_axioms. rww otarget_vee_nt. Qed. Lemma vee_obs_tack : tack (R o1) (tack (R o2) (tack (R o3) emptyset)) = vee_obs. Proof. ap extensionality; uhg; ir. rwi tack_inc H. nin H. rwi tack_inc H. nin H. rwi tack_inc H. nin H. nin H. elim x0. rw H. ap R_inc. rw H. ap R_inc. rw H. ap R_inc. nin H. wr H. nin x0. rw tack_inc. ap or_intror. tv. rw tack_inc. ap or_introl. rw tack_inc. ap or_intror; tv. rw tack_inc. ap or_introl. rw tack_inc. ap or_introl. rw tack_inc. ap or_intror; tv. Qed. Lemma vee_maps_tack : tack (R i1) (tack (R i2) (tack (R i3) (tack (R a12) (tack (R a32) emptyset)))) = vee_maps. Proof. ap extensionality; uhg; ir. rwi tack_inc H. nin H. rwi tack_inc H. nin H. rwi tack_inc H. nin H. rwi tack_inc H. nin H. rwi tack_inc H. nin H. nin H. nin x0. rw H. ap R_inc. rw H. ap R_inc. rw H. ap R_inc. rw H. ap R_inc. rw H. ap R_inc. rw tack_inc. rw tack_inc. rw tack_inc. rw tack_inc. nin H. wr H. nin x0. ap or_intror. tv. ap or_introl; ap or_intror; tv. ap or_introl; ap or_introl; ap or_intror; tv. ap or_introl; ap or_introl; ap or_introl. ap or_intror; tv. ap or_introl; ap or_introl; ap or_introl; ap or_introl. rw tack_inc. ap or_intror; tv. Qed. Lemma is_finite_vee_obs : is_finite (vee_obs). Proof. wr vee_obs_tack. ap finite_tack. ap finite_tack. ap finite_tack. ap finite_emptyset. Qed. Lemma is_finite_vee_maps : is_finite (vee_maps). Proof. wr vee_maps_tack. ap finite_tack. ap finite_tack. ap finite_tack. ap finite_tack. ap finite_tack. ap finite_emptyset. Qed. Lemma is_finite_vee_cat : is_finite_cat vee_cat. Proof. uf vee_cat. ap is_finite_catyd. ap vee_data_property. exact (is_finite_vee_obs). exact (is_finite_vee_maps). Qed. End Vee_Cat. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Module Fiprod. Export Finite_Cat. Export Limit. Export Vee_Cat. Definition fiprod_hypothesis a u v y1 y2 := vee_hypothesis a u v & mor a y1 & mor a y2 & source u = target y1 & source v = target y2 & source y1 = source y2 & comp a u y1 = comp a v y2. Definition fiprod_cone a u v y1 y2 := cone_create (source y1) (vee_nt a (id a (source y1)) (id a (source y2)) u v y1 (comp a u y1) y2). Lemma vertex_fiprod_cone : forall a u v y1 y2, vertex (fiprod_cone a u v y1 y2) = source y1. Proof. ir. uf fiprod_cone. rw vertex_cone_create. tv. Qed. Lemma edge_nt_fiprod_cone : forall a u v y1 y2, edge_nt (fiprod_cone a u v y1 y2) = (vee_nt a (id a (source y1)) (id a (source y2)) u v y1 (comp a u y1) y2). Proof. ir. uf fiprod_cone. rw edge_nt_cone_create. tv. Qed. Lemma edge_fiprod_cone_R : forall a u v y1 y2 (x:obsy vee_data), edge (fiprod_cone a u v y1 y2) (R x) = match x with o1 => y1 | o2 => (comp a u y1) | o3 => y2 end. Proof. ir. uf edge. rw edge_nt_fiprod_cone. rw ntrans_vee_nt_R. tv. Qed. Lemma socle_fiprod_cone : forall a u v y1 y2, socle (fiprod_cone a u v y1 y2) = vee_functor a u v. Proof. ir. uf socle. rw edge_nt_fiprod_cone. rw target_vee_nt. tv. Qed. Lemma cone_source_fiprod_cone : forall a u v y1 y2, cone_source (fiprod_cone a u v y1 y2) = vee_cat. Proof. ir. uf cone_source. rw socle_fiprod_cone. rww source_vee_functor. Qed. Lemma cone_target_fiprod_cone : forall a u v y1 y2, cone_target (fiprod_cone a u v y1 y2) = a. Proof. ir. uf cone_target. rw socle_fiprod_cone. rww target_vee_functor. Qed. Lemma fiprod_vee_nt_hypothesis : forall a u v y1 y2, fiprod_hypothesis a u v y1 y2 -> vee_nt_hypothesis a (id a (source y1)) (id a (source y2)) u v y1 (comp a u y1) y2. Proof. ir. uh H; ee. uh H; ee. assert (ob a (source y1)). rww ob_source. assert (ob a (target y1)). rww ob_target. assert (ob a (source y2)). rww ob_source. assert (ob a (target y2)). rww ob_target. uhg; ee. uh H; ee; am. app mor_id. app mor_id. am. am. am. rww mor_comp. am. rww source_id. sy; am. rww source_comp. rww target_id. rww target_comp. rww source_id. sy; am. rww H4. am. rww assoc. rww right_id. app mor_id. rww target_id. rww assoc. rww right_id. app mor_id. rww target_id. Qed. Lemma is_cone_fiprod_cone : forall a u v y1 y2, fiprod_hypothesis a u v y1 y2 -> is_cone (fiprod_cone a u v y1 y2). Proof. ir. uhg; ee. uf fiprod_cone. ap cone_like_cone_create. rw edge_nt_fiprod_cone. ap vee_nt_axioms. app fiprod_vee_nt_hypothesis. rw cone_target_fiprod_cone. rw vertex_fiprod_cone. uh H; ee. rww ob_source. rw edge_nt_fiprod_cone. rw source_vee_nt. rw cone_source_fiprod_cone. rw cone_target_fiprod_cone. rw vertex_fiprod_cone. sy; rw constant_functor_vee_functor. uh H; ee. rww H4. tv. uh H; ee. rww ob_source. Qed. Definition fimap1 c := edge c (R o1'). Definition fimap2 c := edge c (R o3'). Lemma source_fimap1 : forall c, is_cone c -> cone_source c = vee_cat -> source (fimap1 c) = vertex c. Proof. ir. uf fimap1. rww source_edge. rw H0. app ob_vee_cat. Qed. Lemma source_fimap2 : forall c, is_cone c -> cone_source c = vee_cat -> source (fimap2 c) = vertex c. Proof. ir. uf fimap2. rww source_edge. rw H0. app ob_vee_cat. Qed. Lemma fiprod_hypothesis_fimaps : forall a u v c, vee_hypothesis a u v -> is_cone c -> socle c = vee_functor a u v -> fiprod_hypothesis a u v (fimap1 c) (fimap2 c). Proof. ir. assert (a = cone_target c). uf cone_target. rw H1. rw target_vee_functor. tv. assert (cone_source c = vee_cat). uf cone_source. rw H1. rww source_vee_functor. uhg. ee. am. uf fimap1. rw H2. ap mor_edge. rw H3. ap ob_vee_cat. am. uf fimap2. rw H2. ap mor_edge. rw H3. ap ob_vee_cat. am. uf fimap1. rw target_edge. rw H1. rw fob_vee_functor_R. tv. am. rw H3. ap ob_vee_cat. am. uf fimap2. rw target_edge. rw H1. rw fob_vee_functor_R. tv. am. rw H3. ap ob_vee_cat. am. uf fimap1. uf fimap2. rw source_edge. rw source_edge. tv. rw H3. ap ob_vee_cat. am. rw H3. ap ob_vee_cat. am. set (k:= edge_nt c). util (vee_nt_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rww osource_edge_nt. assert (otarget k = a). uf k. rww otarget_edge_nt. sy; am. assert (fmor (source k) (catyd_arrow (d:=vee_data) a12') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_vee_cat. am. assert (fmor (source k) (catyd_arrow (d:=vee_data) a32') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_vee_cat. am. assert (fmor (target k) (catyd_arrow (d:=vee_data) a12') = u). uf k. rw target_edge_nt. rw H1. rw fmor_vee_functor_catyd_arrow. tv. am. assert (fmor (target k) (catyd_arrow (d:=vee_data) a32') = v). uf k. rw target_edge_nt. rw H1. rw fmor_vee_functor_catyd_arrow. tv. am. util (vee_nt_hypothesis_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rw osource_edge_nt. am. am. rwi H6 H10. rwi H5 H10. rwi H7 H10. rwi H8 H10. rwi H9 H10. assert (ntrans k (R o1') = (fimap1 c)). uf fimap1. uf edge. tv. assert (ntrans k (R o3') = (fimap2 c)). uf fimap2. uf edge. tv. rwi H11 H10. set (m:= ntrans k (R o2')). assert (m = ntrans k (R o2')). tv. rwi H12 H10. wri H13 H10. uh H10; ee. wr H29. wr H30. reflexivity. Qed. Lemma fiprod_cone_eq : forall a u v c, vee_hypothesis a u v -> is_cone c -> socle c = vee_functor a u v -> c = fiprod_cone a u v (fimap1 c) (fimap2 c). Proof. ir. assert (a = cone_target c). uf cone_target. rw H1. rw target_vee_functor. tv. assert (cone_source c = vee_cat). uf cone_source. rw H1. rww source_vee_functor. set (k:= edge_nt c). util (vee_nt_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rww osource_edge_nt. assert (otarget k = a). uf k. rww otarget_edge_nt. sy; am. assert (fmor (source k) (catyd_arrow (d:=vee_data) a12') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_vee_cat. am. assert (fmor (source k) (catyd_arrow (d:=vee_data) a32') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_vee_cat. am. assert (fmor (target k) (catyd_arrow (d:=vee_data) a12') = u). uf k. rw target_edge_nt. rw H1. rw fmor_vee_functor_catyd_arrow. tv. am. assert (fmor (target k) (catyd_arrow (d:=vee_data) a32') = v). uf k. rw target_edge_nt. rw H1. rw fmor_vee_functor_catyd_arrow. tv. am. rwi H5 H4. rwi H6 H4. rwi H7 H4. rwi H8 H4. rwi H9 H4. transitivity (cone_create (vertex c) k). uh H0; ee. uh H0; ee. sy; am. uf fiprod_cone. rw source_fimap1. rw source_fimap2. ap uneq. wr H4. assert (lem1 : ntrans k (R o1') = (fimap1 c)). uf fimap1. uf edge. tv. assert (lem2 : ntrans k (R o3') = (fimap2 c)). uf fimap2. uf edge. tv. assert (ntrans k (R o2') = comp a u (fimap1 c)). uf fimap1. util (vee_nt_hypothesis_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rw osource_edge_nt. am. am. rwi H6 H10. rwi H5 H10. rwi H7 H10. rwi H8 H10. rwi H9 H10. rwi lem1 H10. rwi lem2 H10. set (m:= ntrans k (R o2')). assert (m = ntrans k (R o2')). tv. wri H11 H10. uh H10; ee. uf edge. change (m=comp a u (ntrans k (R o1'))). rw lem1. wr H27. rw right_id. tv. rw H2. app ob_vertex. am. rw H21. rw target_id. tv. rw H2; app ob_vertex. tv. rw lem1. rw lem2. rw H10. reflexivity. am. am. am. am. Qed. Lemma fimap1_fiprod_cone : forall a u v y1 y2, fimap1 (fiprod_cone a u v y1 y2) = y1. Proof. ir. uf fimap1. rw edge_fiprod_cone_R. tv. Qed. Lemma fimap2_fiprod_cone : forall a u v y1 y2, fimap2 (fiprod_cone a u v y1 y2) = y2. Proof. ir. uf fimap2. rw edge_fiprod_cone_R. tv. Qed. Lemma fimap1_cone_compose : forall c z, is_cone c -> cone_source c = vee_cat -> cone_composable c z -> fimap1 (cone_compose c z) = (comp (cone_target c) (fimap1 c) z). Proof. ir. uf fimap1. rw edge_cone_compose. tv. rw H0. ap ob_vee_cat. am. Qed. Lemma fimap2_cone_compose : forall c z, is_cone c -> cone_source c = vee_cat -> cone_composable c z -> fimap2 (cone_compose c z) = (comp (cone_target c) (fimap2 c) z). Proof. ir. uf fimap2. rw edge_cone_compose. tv. rw H0. ap ob_vee_cat. am. Qed. Definition veefirst c := (fmor (socle c) (catyd_arrow (d:=vee_data) a12')). Definition veesecond c := (fmor (socle c) (catyd_arrow (d:=vee_data) a32')). Lemma fiprod_hypothesis_vee_fimaps : forall c, is_cone c -> cone_source c = vee_cat -> fiprod_hypothesis (cone_target c) (veefirst c) (veesecond c) (fimap1 c) (fimap2 c). Proof. ir. util (fiprod_hypothesis_fimaps (a:= cone_target c) (u:= veefirst c) (v:= veesecond c) (c:=c)). uf veefirst. uf veesecond. uf cone_target. ap functor_vee_hypothesis. app socle_axioms. am. am. uf cone_target. uf veefirst. uf veesecond. ap functor_vee_eq. app socle_axioms. am. am. Qed. Lemma fiprod_cone_eq2 : forall c, is_cone c -> cone_source c = vee_cat -> c = fiprod_cone (cone_target c) (veefirst c) (veesecond c) (fimap1 c) (fimap2 c). Proof. ir. util (fiprod_cone_eq (a:= cone_target c) (u:= veefirst c) (v:= veesecond c) (c:=c)). uf veefirst. uf veesecond. uf cone_target. ap functor_vee_hypothesis. app socle_axioms. am. am. uf cone_target. uf veefirst. uf veesecond. ap functor_vee_eq. app socle_axioms. am. am. Qed. Lemma fimaps_extensionality : forall a b, is_cone a -> is_cone b -> cone_source a = vee_cat -> socle a = socle b -> fimap1 a = fimap1 b -> fimap2 a = fimap2 b -> a = b. Proof. ir. assert (cone_source b = vee_cat). uf cone_source. wr H2. am. util (fiprod_cone_eq2 (c:= a)). am. am. util (fiprod_cone_eq2 (c:= b)). am. am. rw H6; rw H7. assert (veefirst a = veefirst b). uf veefirst. rww H2. assert (veesecond a = veesecond b). uf veesecond. rw H2. reflexivity. rw H3; rw H8; rw H9. assert (cone_target a = cone_target b). uf cone_target. rww H2. rw H10. rw H4. reflexivity. Qed. Lemma cone_compose_fiprod_cone : forall a u v y1 y2 z, fiprod_hypothesis a u v y1 y2 -> mor a z -> source y1 = target z -> cone_compose (fiprod_cone a u v y1 y2) z = fiprod_cone a u v (comp a y1 z) (comp a y2 z). Proof. ir. assert (lem1: fiprod_hypothesis a u v (comp a y1 z) (comp a y2 z)). uh H; uhg; ee. am. rww mor_comp. rww mor_comp. wrr H6. rww target_comp. rww target_comp. wrr H6. rww source_comp. rww source_comp. wrr H6. wr assoc. rw H7. rww assoc. uh H; ee; am. wrr H6. uh H; ee; am. am. am. am. am. tv. assert (lem2 : cone_composable (fiprod_cone a u v y1 y2) z). uhg; ee. app is_cone_fiprod_cone. rww cone_target_fiprod_cone. rww vertex_fiprod_cone. sy; am. ap fimaps_extensionality. rww is_cone_cone_compose. app is_cone_fiprod_cone. rw cone_source_cone_compose. rww cone_source_fiprod_cone. rw socle_cone_compose. rww socle_fiprod_cone. rww socle_fiprod_cone. rww fimap1_cone_compose. rww cone_target_fiprod_cone. rww fimap1_fiprod_cone. rww fimap1_fiprod_cone. app is_cone_fiprod_cone. rww cone_source_fiprod_cone. rww fimap2_cone_compose. rww cone_target_fiprod_cone. rww fimap2_fiprod_cone. rww fimap2_fiprod_cone. app is_cone_fiprod_cone. rww cone_source_fiprod_cone. Qed. Lemma cone_composable_fiprod_cone : forall a u v y1 y2 z, fiprod_hypothesis a u v y1 y2 -> mor a z -> source y1 = target z -> cone_composable (fiprod_cone a u v y1 y2) z. Proof. ir. uhg; ee. app is_cone_fiprod_cone. rww cone_target_fiprod_cone. rww vertex_fiprod_cone. sy; am. Qed. Lemma is_uni_fiprod_cone : forall a u v y1 y2, fiprod_hypothesis a u v y1 y2 -> is_uni (fiprod_cone a u v y1 y2) = (forall z z', mor a z -> mor a z' -> source y1 = target z -> source y1 = target z' -> comp a y1 z = comp a y1 z' -> comp a y2 z = comp a y2 z'-> z = z'). Proof. ir. ap iff_eq; ir. uh H0. ee. ap H7. app cone_composable_fiprod_cone. app cone_composable_fiprod_cone. rw cone_compose_fiprod_cone. sy; rw cone_compose_fiprod_cone. sy. rw H5. rw H6. tv. am. am. am. am. am. am. uhg. ee. app is_cone_fiprod_cone. ir. cp H1; cp H2. uh H4; uh H5; ee. rwi cone_target_fiprod_cone H8. rwi cone_target_fiprod_cone H6. rwi vertex_fiprod_cone H9. rwi vertex_fiprod_cone H7. app H0. sy; am. sy; am. rwi cone_compose_fiprod_cone H3. tv. transitivity (fimap1 (fiprod_cone a u v (comp a y1 u0) (comp a y2 u0))). rw fimap1_fiprod_cone. tv. rw H3. rw fimap1_cone_compose. rw cone_target_fiprod_cone. rw fimap1_fiprod_cone. tv. am. rww cone_source_fiprod_cone. am. am. am. sy; am. transitivity (fimap2 (cone_compose (fiprod_cone a u v y1 y2) u0)). rw cone_compose_fiprod_cone. rw fimap2_fiprod_cone. tv. am. am. sy; am. rw H3. rw fimap2_cone_compose. rw cone_target_fiprod_cone. rw fimap2_fiprod_cone. tv. am. rww cone_source_fiprod_cone. am. Qed. Lemma is_versal_fiprod_cone : forall a u v y1 y2, fiprod_hypothesis a u v y1 y2 -> is_versal (fiprod_cone a u v y1 y2) = (forall z1 z2, fiprod_hypothesis a u v z1 z2 -> (exists w, (mor a w & source y1 = target w & comp a y1 w = z1 & comp a y2 w = z2))). Proof. ir. ap iff_eq; ir. uh H0; ee. util (H2 (fiprod_cone a u v z1 z2)). app is_cone_fiprod_cone. rww socle_fiprod_cone; sy; rww socle_fiprod_cone. nin H3. ee. cp H3. uh H5; ee. rwi cone_target_fiprod_cone H6. rwi vertex_fiprod_cone H7. rwi cone_compose_fiprod_cone H4. sh x; ee. am. sy; am. transitivity (fimap1 (fiprod_cone a u v (comp a y1 x) (comp a y2 x))). rw fimap1_fiprod_cone. tv. rw H4. rw fimap1_fiprod_cone. tv. transitivity (fimap2 (fiprod_cone a u v (comp a y1 x) (comp a y2 x))). rw fimap2_fiprod_cone. tv. rw H4. rw fimap2_fiprod_cone. tv. am. am. sy; am. assert (lem1: fiprod_hypothesis a u v y1 y2). am. uh H; uhg; ee; try am. app is_cone_fiprod_cone. ir. rwi socle_fiprod_cone H8. cp (fiprod_cone_eq H H7 H8). cp (fiprod_hypothesis_fimaps H H7 H8). util (H0 (fimap1 b) (fimap2 b)). am. nin H11. ee. sh x; ee. app cone_composable_fiprod_cone. rww cone_compose_fiprod_cone. rw H13. rw H14. sy; am. Qed. Definition is_fiprod a u v y1 y2 := fiprod_hypothesis a u v y1 y2 & is_limit (fiprod_cone a u v y1 y2). Lemma show_is_fiprod : forall a u v y1 y2 , fiprod_hypothesis a u v y1 y2 -> (forall z z', mor a z -> mor a z' -> source y1 = target z -> source y1 = target z' -> comp a y1 z = comp a y1 z' -> comp a y2 z = comp a y2 z' -> z = z') -> (forall z1 z2, fiprod_hypothesis a u v z1 z2 -> (exists w, (mor a w & source y1 = target w & comp a y1 w = z1 & comp a y2 w = z2))) -> is_fiprod a u v y1 y2. Proof. ir. uhg; ee. am. uhg. ee. rww is_uni_fiprod_cone. rww is_versal_fiprod_cone. Qed. Definition has_fiprod a u v := vee_hypothesis a u v & has_limit (vee_functor a u v). Lemma has_fiprod_rw : forall a u v, has_fiprod a u v = (exists y1, exists y2, is_fiprod a u v y1 y2). Proof. ir. ap iff_eq; ir. uh H; ee. uh H0. nin H0. uh H0; ee. sh (fimap1 x). sh (fimap2 x). uhg; ee. ap fiprod_hypothesis_fimaps. am. app is_limit_is_cone. am. assert (is_cone x). app is_limit_is_cone. util (fiprod_cone_eq (a:=a) (u:=u) (v:=v) (c:=x)). am. am. am. wr H3. am. nin H. nin H. uhg; ee. uh H; ee. uh H; ee; am. uh H; ee. uhg. sh (fiprod_cone a u v x x0). uhg; ee. am. rww socle_fiprod_cone. Qed. Definition has_fiprods a := Category.axioms a & (forall u v, vee_hypothesis a u v -> has_fiprod a u v). Definition fipr1 a u v := fimap1 (limit (vee_functor a u v)). Definition fipr2 a u v := fimap2 (limit (vee_functor a u v)). Lemma fiprod_hypothesis_fiprod : forall a u v, has_fiprod a u v -> fiprod_hypothesis a u v (fipr1 a u v) (fipr2 a u v). Proof. ir. uf fipr1; uf fipr2. app fiprod_hypothesis_fimaps. uh H; ee; am. ap is_limit_is_cone. ap is_limit_limit. uh H; ee; am. rw socle_limit. tv. uh H; ee; am. Qed. Lemma fiprod_hypothesis_comp : forall a u v y1 y2 z, fiprod_hypothesis a u v y1 y2 -> mor a z -> source y1 = target z -> fiprod_hypothesis a u v (comp a y1 z) (comp a y2 z). Proof. ir. uh H; uhg; ee. am. rww mor_comp. rww mor_comp. wrr H6. rww target_comp. rww target_comp. wrr H6. rww source_comp. rww source_comp. wrr H6. wrr assoc. rw H7. rww assoc. uh H; ee. am. wrr H6. uh H; ee; am. Qed. Lemma is_fiprod_fiprod : forall a u v, has_fiprod a u v -> is_fiprod a u v (fipr1 a u v) (fipr2 a u v). Proof. ir. uhg; ee. app fiprod_hypothesis_fiprod. uf fipr1; uf fipr2. wr fiprod_cone_eq. ap is_limit_limit. uh H; ee; am. uh H; ee. am. ap is_limit_is_cone. ap is_limit_limit. uh H; ee; am. rw socle_limit. tv. uh H; ee; am. Qed. Lemma has_fiprods_has_fiprod : forall a u v, has_fiprods a -> vee_hypothesis a u v-> has_fiprod a u v. Proof. ir. uh H; ee. ap H1. am. Qed. Lemma has_fiprods_has_limits_over : forall a, Category.axioms a -> has_fiprods a = has_limits_over vee_cat a. Proof. ir. ap iff_eq; ir. uhg. ir. uh H0. ee. util (H4 (fmor f (catyd_arrow a12')) (fmor f (catyd_arrow a32'))). wr H3. ap functor_vee_hypothesis. am. am. uh H5. ee. wri H3 H6. rww functor_vee_eq. uh H0. uhg; ee. am. ir. uhg; ee; try am. ap H0. app vee_functor_axioms. rww source_vee_functor. rww target_vee_functor. Qed. Lemma mor_fipr1 : forall a u v, has_fiprod a u v -> mor a (fipr1 a u v). Proof. ir. cp (is_fiprod_fiprod H). uh H0; ee. uh H0; ee. am. Qed. Lemma mor_fipr2 : forall a u v, has_fiprod a u v -> mor a (fipr2 a u v). Proof. ir. cp (is_fiprod_fiprod H). uh H0; ee. uh H0; ee. am. Qed. Lemma target_fipr1 : forall a u v, has_fiprod a u v -> target (fipr1 a u v) = source u. Proof. ir. cp (is_fiprod_fiprod H). uh H0; ee. uh H0; ee. sy; am. Qed. Lemma target_fipr2 : forall a u v, has_fiprod a u v -> target (fipr2 a u v) = source v. Proof. ir. cp (is_fiprod_fiprod H). uh H0; ee. uh H0; ee. sy; am. Qed. Lemma source_fipr2 : forall a u v, has_fiprod a u v -> source (fipr2 a u v) = source (fipr1 a u v). Proof. ir. cp (is_fiprod_fiprod H). uh H0; ee. uh H0; ee. sy; am. Qed. Lemma comp_fiprod_eq : forall a u v, has_fiprod a u v -> comp a u (fipr1 a u v) = comp a v (fipr2 a u v). Proof. ir. cp (is_fiprod_fiprod H). uh H0; ee. uh H0; ee. am. Qed. Definition fipr_dotted a u v y1 y2 := dotted (fiprod_cone a u v y1 y2). Lemma fiprod_cone_fiprod : forall a u v, has_fiprod a u v -> fiprod_cone a u v (fipr1 a u v) (fipr2 a u v) = limit (vee_functor a u v). Proof. ir. uf fipr1; uf fipr2. wr fiprod_cone_eq. tv. uh H; ee; am. ap is_limit_is_cone. ap is_limit_limit. uh H; ee; am. rw socle_limit. tv. uh H; ee; am. Qed. Lemma cone_composable_fipr_dotted : forall a u v y1 y2, has_fiprod a u v -> fiprod_hypothesis a u v y1 y2 -> cone_composable (fiprod_cone a u v (fipr1 a u v) (fipr2 a u v)) (fipr_dotted a u v y1 y2). Proof. ir. uf fipr_dotted. rw fiprod_cone_fiprod. assert (vee_functor a u v = socle (fiprod_cone a u v y1 y2)). rww socle_fiprod_cone. rw H1. ap cone_composable_dotted. app is_cone_fiprod_cone. rw socle_fiprod_cone. uh H; ee; am. am. Qed. Lemma cone_compose_fipr_dotted : forall a u v y1 y2, has_fiprod a u v -> fiprod_hypothesis a u v y1 y2 -> cone_compose (fiprod_cone a u v (fipr1 a u v) (fipr2 a u v)) (fipr_dotted a u v y1 y2) = fiprod_cone a u v y1 y2. Proof. ir. uf fipr_dotted. rw fiprod_cone_fiprod. assert (vee_functor a u v = socle (fiprod_cone a u v y1 y2)). rww socle_fiprod_cone. rw H1. ap cone_compose_dotted. app is_cone_fiprod_cone. rw socle_fiprod_cone. uh H; ee; am. am. Qed. Lemma fipr_dotted_uni : forall a u v y1 y2 r, has_fiprod a u v -> fiprod_hypothesis a u v y1 y2 -> cone_composable (fiprod_cone a u v (fipr1 a u v) (fipr2 a u v)) r -> cone_compose (fiprod_cone a u v (fipr1 a u v) (fipr2 a u v)) r = fiprod_cone a u v y1 y2 -> fipr_dotted a u v y1 y2 = r. Proof. ir. uf fipr_dotted. wr H2. rw fiprod_cone_fiprod. ap dotted_unique. ap vee_functor_axioms. uh H0; ee; am. uh H; ee; am. wr fiprod_cone_fiprod. am. am. am. Qed. Lemma mor_fipr_dotted : forall a u v y1 y2, has_fiprod a u v -> fiprod_hypothesis a u v y1 y2 -> mor a (fipr_dotted a u v y1 y2). Proof. ir. cp (cone_composable_fipr_dotted H H0). uh H1; ee. rwi cone_target_fiprod_cone H2. am. Qed. Lemma target_fipr_dotted : forall a u v y1 y2, has_fiprod a u v -> fiprod_hypothesis a u v y1 y2 -> target (fipr_dotted a u v y1 y2) = source (fipr1 a u v). Proof. ir. cp (cone_composable_fipr_dotted H H0). uh H1; ee. rwi vertex_fiprod_cone H3. am. Qed. Lemma comp_fipr1_fipr_dotted : forall a u v y1 y2, has_fiprod a u v -> fiprod_hypothesis a u v y1 y2 -> comp a (fipr1 a u v) (fipr_dotted a u v y1 y2) = y1. Proof. ir. cp (cone_compose_fipr_dotted H H0). transitivity (fimap1 (fiprod_cone a u v y1 y2)). wr H1. rw fimap1_cone_compose. rw cone_target_fiprod_cone. rw fimap1_fiprod_cone. tv. ap is_cone_fiprod_cone. ap fiprod_hypothesis_fiprod. am. rww cone_source_fiprod_cone. app cone_composable_fipr_dotted. rww fimap1_fiprod_cone. Qed. Lemma comp_fipr2_fipr_dotted : forall a u v y1 y2, has_fiprod a u v -> fiprod_hypothesis a u v y1 y2 -> comp a (fipr2 a u v) (fipr_dotted a u v y1 y2) = y2. Proof. ir. cp (cone_compose_fipr_dotted H H0). transitivity (fimap2 (fiprod_cone a u v y1 y2)). wr H1. rw fimap2_cone_compose. rw cone_target_fiprod_cone. rw fimap2_fiprod_cone. tv. ap is_cone_fiprod_cone. app fiprod_hypothesis_fiprod. rww cone_source_fiprod_cone. app cone_composable_fipr_dotted. rww fimap2_fiprod_cone. Qed. Lemma fipr_dotted_comp : forall a u v z, has_fiprod a u v -> mor a z -> source (fipr1 a u v) = target z -> fipr_dotted a u v (comp a (fipr1 a u v) z) (comp a (fipr2 a u v) z) = z. Proof. ir. assert (fiprod_hypothesis a u v (fipr1 a u v) (fipr2 a u v)). app fiprod_hypothesis_fiprod. ap fipr_dotted_uni. am. app fiprod_hypothesis_comp. uhg; ee. app is_cone_fiprod_cone. rww cone_target_fiprod_cone. rww vertex_fiprod_cone. sy; am. rw cone_compose_fiprod_cone. tv. am. am. am. Qed. (*** now we apply the result of fc_limits to the case of fiprods ***********************) Lemma has_fiprods_functor_cat : forall a b, Category.axioms a -> has_fiprods b -> has_fiprods (functor_cat a b). Proof. ir. rw has_fiprods_has_limits_over. cp H0. uh H1; ee. rwi has_fiprods_has_limits_over H0. ap has_limits_functor_cat. am. am. ap vee_cat_axioms. am. am. ap functor_cat_axioms. am. uh H0; ee; am. Qed. Lemma has_finite_limits_has_fiprods : forall a, has_finite_limits a -> has_fiprods a. Proof. ir. rw has_fiprods_has_limits_over. uh H; ee. ap H0. ap is_finite_vee_cat. uh H; ee; am. Qed. End Fiprod. Export Fiprod. (*** we should be able to more or less recopy fiprod to get a module Fiprod for fiber products; then also dualize to get cofiprods and cofiber products. The other main type of limits and colimits we need to do are direct products and coproducts ... *****************************) Module Cofiprod. (**** we do this module by dualizing the module fiprod, rather than by relying on colimits *******) Definition covee_hypothesis a u v := mor a u & mor a v & source u = source v. Definition cofiprod_hypothesis a u v y1 y2 := covee_hypothesis a u v & mor a y1 & mor a y2 & source y1 = target u & source y2 = target v & comp a y1 u = comp a y2 v. Lemma cofi_hyp_fi_hyp : forall a u v y1 y2, Category.axioms a -> cofiprod_hypothesis a u v y1 y2 = fiprod_hypothesis (opp a) (flip u) (flip v) (flip y1) (flip y2). Proof. ir. ap iff_eq; ir. uh H0; uhg; ee. uh H0; uhg; ee. rww mor_opp. rww flip_flip. rww mor_opp. rww flip_flip. rw target_flip. rw target_flip. am. alike. alike. rww mor_opp. rww flip_flip. rw mor_opp; rww flip_flip. rw target_flip; try alike. rw source_flip; try alike. sy; am. uh H0; ee; alike. rw target_flip; try alike. rw source_flip; try alike. sy; am. uh H0; ee; alike. rw source_flip; try alike. rw source_flip; try alike. transitivity (target (comp a y1 u)). rw target_comp. tv. am. uh H0; ee; am. am. rw H5. rww target_comp. uh H0; ee; am. rw comp_opp. rw comp_opp. rw flip_flip. rw flip_flip. rw flip_flip. rw flip_flip. ap uneq. am. rww mor_opp; rww flip_flip. uh H0; ee; am. rww mor_opp; rww flip_flip. rww target_flip; try alike. rww source_flip; try alike. uh H0; ee. sy; am. uh H0; ee; alike. rww mor_opp; rww flip_flip. uh H0; ee; am. rww mor_opp; rww flip_flip. rww target_flip; try alike. rww source_flip; try alike. sy; am. uh H0; ee; alike. uh H0; ee. uh H0; ee. uhg; dj. uhg; dj. rwi mor_opp H0. rwi flip_flip H0. am. rwi mor_opp H7. rwi flip_flip H7. am. wr target_flip; try alike. rw H8. rw target_flip; try alike. tv. rwi mor_opp H1. rwi flip_flip H1; am. rwi mor_opp H2. rwi flip_flip H2; am. wr source_flip; try alike. rw H3. rww target_flip; try alike. rwi mor_opp H0. rwi flip_flip H0. alike. wr target_flip; try alike. wr H4. uh H9; ee. rww source_flip; try alike. rwi comp_opp H6. rwi flip_flip H6. rwi flip_flip H6. ap flip_eq. rw H6. rw comp_opp. rw flip_flip. rw flip_flip. tv. am. am. am. am. am. am. Qed. Definition is_cofiprod a u v y1 y2 := Category.axioms a & is_fiprod (opp a) (flip u) (flip v) (flip y1) (flip y2). Lemma show_is_cofiprod : forall a u v y1 y2, Category.axioms a -> cofiprod_hypothesis a u v y1 y2 -> (forall z z', mor a z -> mor a z' -> source z = target y1 -> source z' = target y1 -> comp a z y1 = comp a z' y1 -> comp a z y2 = comp a z' y2 -> z = z') -> (forall z1 z2, cofiprod_hypothesis a u v z1 z2 -> (exists w, (mor a w & source w = target y1 & comp a w y1 = z1 & comp a w y2 = z2))) -> is_cofiprod a u v y1 y2. Proof. ir. assert (lem1 : target y1 = target y2). uh H0. ee. transitivity (target (comp a y1 u)). rww target_comp. uh H0; ee; am. rw H7. rww target_comp. uh H0; ee; am. uhg; ee. am. ap show_is_fiprod. wr cofi_hyp_fi_hyp. am. am. ir. set (z1:=flip z). set (z2 := flip z'). assert (z1 = z2). ap H1. uf z1. rwi mor_opp H3. am. rwi mor_opp H4. am. uf z1. rw source_flip; try alike. wr H5. rww source_flip; try alike. uh H0; ee. alike. uf z2. rw source_flip; try alike. wr H6. rww source_flip; try alike. uh H0; ee. alike. uf z1; uf z2. rwi comp_opp H7. rwi flip_flip H7. rwi comp_opp H7. rwi flip_flip H7. rwi comp_opp H8. rwi flip_flip H8. rwi comp_opp H8. rwi flip_flip H8. ap flip_eq. am. rww mor_opp. rw flip_flip. uh H0; ee; am. am. uh H0; ee. rw source_flip. wr lem1. rwi source_flip H6. am. alike. alike. rww mor_opp. rw flip_flip. uh H0; ee; am. am. rw source_flip; try alike. wr lem1. rwi source_flip H5. am. uh H0; ee; alike. uh H0; ee; alike. rw mor_opp; rww flip_flip. uh H0; ee; am. am. am. rw mor_opp; rw flip_flip; uh H0; ee; am. am. am. uf z1; uf z2. rwi comp_opp H7. rwi flip_flip H7. rwi comp_opp H7. rwi flip_flip H7. rwi comp_opp H8. rwi flip_flip H8. rwi comp_opp H8. rwi flip_flip H8. ap flip_eq. am. rww mor_opp. rw flip_flip. uh H0; ee; am. am. uh H0; ee. rw source_flip. wr lem1. rwi source_flip H6. am. alike. alike. rww mor_opp. rw flip_flip. uh H0; ee; am. am. rw source_flip; try alike. wr lem1. rwi source_flip H5. am. uh H0; ee; alike. uh H0; ee; alike. rw mor_opp; rww flip_flip. uh H0; ee; am. am. am. rw mor_opp; rw flip_flip; uh H0; ee; am. am. am. ap flip_eq. am. ir. cp H3. set (z1' := flip z1). assert (z1= flip z1'). uf z1'; rww flip_flip. rwi H5 H4. set (z2' := flip z2). assert (z2= flip z2'). uf z2'; rww flip_flip. rwi H6 H4. wri cofi_hyp_fi_hyp H4. nin (H2 z1' z2' H4). ee. sh (flip x). ee. rww mor_opp. rww flip_flip. rw source_flip. rw target_flip. sy; am. alike. uh H0; ee; alike. rw comp_opp. rw flip_flip. rw flip_flip. ap flip_eq. rw flip_flip. exact H9. rww mor_opp. rw flip_flip. uh H0; ee; am. rww mor_opp. rww flip_flip. rw source_flip. rw target_flip. sy; am. alike. uh H0; ee; alike. rw comp_opp. rw flip_flip. rw flip_flip. ap flip_eq. rw flip_flip. exact H10. rw mor_opp; rw flip_flip. uh H0; ee; am. rw mor_opp; rww flip_flip. rw source_flip. rw target_flip. rww H8. sy; am. alike. uh H0; ee; alike. am. Qed. Definition has_cofiprod a u v := covee_hypothesis a u v & has_fiprod (opp a) (flip u) (flip v). Lemma has_cofiprod_rw : forall a u v, has_cofiprod a u v = (exists y1, exists y2, is_cofiprod a u v y1 y2). Proof. ir. ap iff_eq; ir. uh H; ee. rwi has_fiprod_rw H0. nin H0. nin H0. sh (flip x). sh (flip x0). uhg; ee. uh H; ee. uh H; ee; am. rw flip_flip. rw flip_flip. am. nin H. nin H. assert (cofiprod_hypothesis a u v x x0). rw cofi_hyp_fi_hyp. uh H; ee. uh H0; ee. am. uh H; ee. am. uhg; ee. uh H0; ee; am. uh H; ee. rw has_fiprod_rw. sh (flip x). sh (flip x0). am. Qed. Definition has_cofiprods a := Category.axioms a & (forall u v, covee_hypothesis a u v -> has_cofiprod a u v). Definition cofipr1 a u v := flip (fipr1 (opp a) (flip u) (flip v)). Definition cofipr2 a u v := flip (fipr2 (opp a) (flip u) (flip v)). Lemma cofiprod_hypothesis_cofiprod : forall a u v, has_cofiprod a u v -> cofiprod_hypothesis a u v (cofipr1 a u v) (cofipr2 a u v). Proof. ir. uf cofipr1; uf cofipr2. rw cofi_hyp_fi_hyp. rw flip_flip. rw flip_flip. ap fiprod_hypothesis_fiprod. uh H. ee; am. uh H; ee. uh H; ee. uh H; ee; am. Qed. Lemma cofiprod_hypothesis_comp : forall a u v y1 y2 z, cofiprod_hypothesis a u v y1 y2 -> mor a z -> source z = target y1 -> cofiprod_hypothesis a u v (comp a z y1) (comp a z y2). Proof. ir. rw cofi_hyp_fi_hyp. rwi cofi_hyp_fi_hyp H. assert (flip (comp a z y1) = comp (opp a) (flip y1) (flip z)). rw comp_opp. rw flip_flip. rww flip_flip. uh H; ee; am. rww mor_opp. rww flip_flip. rw source_flip; try alike. rw target_flip. sy; am. alike. uh H; ee. rwi mor_opp H2. rwi flip_flip H2; alike. assert (flip (comp a z y2) = comp (opp a) (flip y2) (flip z)). rw comp_opp. rw flip_flip. rww flip_flip. uh H; ee; am. rww mor_opp. rww flip_flip. uh H; ee. wr H7. rw source_flip; try alike. rw target_flip. sy; am. alike. rwi mor_opp H3. rwi flip_flip H3; alike. rw H2; rw H3. ap fiprod_hypothesis_comp. am. rww mor_opp. rww flip_flip. rw source_flip; try alike. rw target_flip. sy; am. alike. uh H; ee. rwi mor_opp H4. rwi flip_flip H4; alike. uh H0; ee; am. uh H0; ee; am. Qed. Lemma is_cofiprod_cofiprod : forall a u v, has_cofiprod a u v -> is_cofiprod a u v (cofipr1 a u v) (cofipr2 a u v). Proof. ir. assert (Category.axioms a). uh H; ee. uh H; ee. uh H; ee; am. uhg; ee; try am. uf cofipr1; uf cofipr2. rw flip_flip. rw flip_flip. ap is_fiprod_fiprod. uh H; ee. am. Qed. Lemma has_cofiprods_has_cofiprod : forall a u v, has_cofiprods a -> covee_hypothesis a u v-> has_cofiprod a u v. Proof. ir. uh H; ee. ap H1. am. Qed. Lemma covee_hypothesis_opp1 : forall a u v, Category.axioms a -> covee_hypothesis a u v -> vee_hypothesis (opp a) (flip u) (flip v). Proof. ir. uh H0; ee. uhg; ee. rww mor_opp. rww flip_flip. rww mor_opp. rww flip_flip. rw target_flip; try alike. rw target_flip; try alike. am. Qed. Lemma covee_hypothesis_opp : forall a u v, Category.axioms a -> covee_hypothesis (opp a) u v = vee_hypothesis a (flip u) (flip v). Proof. ir. ap iff_eq; ir. uh H0; uhg; ee. rwi mor_opp H0. am. wrr mor_opp. rw target_flip; try alike. rw target_flip; try alike. am. uh H0; ee. uhg; ee. rw mor_opp; am. rw mor_opp; am. rwi target_flip H2; try alike. rwi target_flip H2; try alike. am. wri mor_opp H1; alike. wri mor_opp H0; alike. Qed. Lemma vee_hypothesis_opp_flip : forall a u v, Category.axioms a -> vee_hypothesis (opp a) (flip u) (flip v) = covee_hypothesis a u v. Proof. ir. transitivity (covee_hypothesis (opp (opp a)) u v). rw covee_hypothesis_opp. tv. app opp_axioms. rww opp_opp. Qed. Lemma has_cofipr_has_fipr : forall a u v, Category.axioms a -> has_cofiprod a u v = has_fiprod (opp a) (flip u) (flip v). Proof. ir. ap iff_eq; ir. uh H0; ee. am. uhg; ee. uh H0; ee. rwi vee_hypothesis_opp_flip H0. am. am. am. Qed. Lemma has_fipr_has_cofipr : forall a u v, Category.axioms a -> has_fiprod a u v = has_cofiprod (opp a) (flip u) (flip v). Proof. ir. rw has_cofipr_has_fipr. rw flip_flip. rw flip_flip. rw opp_opp. tv. app opp_axioms. Qed. Lemma has_cofiprods_opp : forall a, has_cofiprods (opp a) = has_fiprods a. Proof. ir. ap iff_eq; ir. uh H; ee. uhg; ee. wrr axioms_opp. ir. rw has_fipr_has_cofipr. ap H0. rw covee_hypothesis_opp. rw flip_flip. rw flip_flip. am. wrr axioms_opp. wrr axioms_opp. uh H; ee. uhg; ee. app opp_axioms. ir. rw has_cofipr_has_fipr. rw opp_opp. ap H0. wr covee_hypothesis_opp. am. am. app opp_axioms. Qed. Lemma has_fiprods_opp : forall a, has_fiprods (opp a) = has_cofiprods a. Proof. ir. wr has_cofiprods_opp. rww opp_opp. Qed. Lemma has_cofiprods_has_colimits_over_opp : forall a, Category.axioms a -> has_cofiprods a = has_colimits_over (opp vee_cat) a. Proof. ir. ap iff_eq; ir. assert (a = opp (opp a)). rww opp_opp. rw H1. ap has_colimits_over_opp. app opp_axioms. ap vee_cat_axioms. wr has_fiprods_has_limits_over. rw has_fiprods_opp. am. app opp_axioms. wr has_fiprods_opp. rw has_fiprods_has_limits_over. assert (vee_cat = opp (opp vee_cat)). rww opp_opp. rw H1. ap has_limits_over_opp. am. ap opp_axioms. ap vee_cat_axioms. am. app opp_axioms. Qed. Lemma mor_cofipr1 : forall a u v, has_cofiprod a u v -> mor a (cofipr1 a u v). Proof. ir. cp (cofiprod_hypothesis_cofiprod H). uh H0; ee. am. Qed. Lemma mor_cofipr2 : forall a u v, has_cofiprod a u v -> mor a (cofipr2 a u v). Proof. ir. cp (cofiprod_hypothesis_cofiprod H). uh H0; ee. am. Qed. Lemma source_cofipr1 : forall a u v, has_cofiprod a u v -> source (cofipr1 a u v) = target u. Proof. ir. cp (cofiprod_hypothesis_cofiprod H). uh H0; ee. am. Qed. Lemma source_cofipr2 : forall a u v, has_cofiprod a u v -> source (cofipr2 a u v) = target v. Proof. ir. cp (cofiprod_hypothesis_cofiprod H). uh H0; ee. am. Qed. Lemma target_cofipr2 : forall a u v, has_cofiprod a u v -> target (cofipr2 a u v) = target (cofipr1 a u v). Proof. ir. cp (cofiprod_hypothesis_cofiprod H). uh H0; ee. uh H0; ee. transitivity (target (comp a (cofipr1 a u v) u)). rw H5. rw target_comp. tv. ap mor_cofipr2. am. am. rw source_cofipr2. tv. am. rw target_comp. tv. app mor_cofipr1. am. rww source_cofipr1. Qed. Lemma comp_cofiprod_eq : forall a u v, has_cofiprod a u v -> comp a (cofipr1 a u v) u = comp a (cofipr2 a u v) v. Proof. ir. cp (cofiprod_hypothesis_cofiprod H). uh H0; ee. am. Qed. Definition cofipr_dotted a u v y1 y2 := flip (fipr_dotted (opp a) (flip u) (flip v) (flip y1) (flip y2)). Lemma mor_cofipr_dotted : forall a u v y1 y2, has_cofiprod a u v -> cofiprod_hypothesis a u v y1 y2 -> mor a (cofipr_dotted a u v y1 y2). Proof. ir. rwi has_cofipr_has_fipr H. rwi cofi_hyp_fi_hyp H0. uf cofipr_dotted. wr mor_opp. app mor_fipr_dotted. uh H0; ee. uh H1; ee; am. uh H0; ee. uh H1; ee; am. Qed. Lemma source_fipr_dotted : forall a u v y1 y2, has_cofiprod a u v -> cofiprod_hypothesis a u v y1 y2 -> source (cofipr_dotted a u v y1 y2) = target (cofipr1 a u v). Proof. ir. rwi has_cofipr_has_fipr H. rwi cofi_hyp_fi_hyp H0. uf cofipr_dotted. rw source_flip. rw target_fipr_dotted. uf cofipr1. rw target_flip. tv. apply mor_arrow_like with (opp a). app mor_fipr1. am. am. apply mor_arrow_like with (opp a). app mor_fipr_dotted. uh H0; ee. uh H1; ee; am. uh H0; ee. uh H1; ee; am. Qed. Lemma comp_cofipr1_cofipr_dotted : forall a u v y1 y2, has_cofiprod a u v -> cofiprod_hypothesis a u v y1 y2 -> comp a (cofipr_dotted a u v y1 y2) (cofipr1 a u v) = y1. Proof. ir. rwi has_cofipr_has_fipr H. rwi cofi_hyp_fi_hyp H0. uf cofipr_dotted. uf cofipr1. ap flip_eq. wr comp_opp. ap comp_fipr1_fipr_dotted. am. am. app mor_fipr1. app mor_fipr_dotted. rw target_fipr_dotted. tv. am. am. uh H0; ee. uh H1; ee; am. uh H0; ee. uh H1; ee; am. Qed. Lemma comp_cofipr2_cofipr_dotted : forall a u v y1 y2, has_cofiprod a u v -> cofiprod_hypothesis a u v y1 y2 -> comp a (cofipr_dotted a u v y1 y2) (cofipr2 a u v) = y2. Proof. ir. rwi has_cofipr_has_fipr H. rwi cofi_hyp_fi_hyp H0. uf cofipr_dotted. uf cofipr2. ap flip_eq. wr comp_opp. ap comp_fipr2_fipr_dotted. am. am. app mor_fipr2. app mor_fipr_dotted. rw target_fipr_dotted. tv. rw source_fipr2. tv. am. am. am. uh H0; ee. uh H1; ee; am. uh H0; ee. uh H1; ee; am. Qed. Lemma cofipr_dotted_comp : forall a u v z, has_cofiprod a u v -> mor a z -> source z = target (cofipr1 a u v) -> cofipr_dotted a u v (comp a z (cofipr1 a u v)) (comp a z (cofipr2 a u v)) = z. Proof. ir. cp H. rwi has_cofipr_has_fipr H. assert (cofiprod_hypothesis a u v (comp a z (cofipr1 a u v)) (comp a z (cofipr2 a u v))). app cofiprod_hypothesis_comp. app cofiprod_hypothesis_cofiprod. rwi cofi_hyp_fi_hyp H3. uf cofipr_dotted. assert (flip (comp a z (cofipr1 a u v)) = comp (opp a) (fipr1 (opp a) (flip u) (flip v)) (flip z)). rw comp_opp. sy; rw flip_flip. uf cofipr1. tv. app mor_fipr1. rww mor_opp. rww flip_flip. ufi cofipr1 H1. rwi target_flip H1. wr H1. rww target_flip. alike. apply mor_arrow_like with (opp a). app mor_fipr1. assert (flip (comp a z (cofipr2 a u v)) = comp (opp a) (fipr2 (opp a) (flip u) (flip v)) (flip z)). rw comp_opp. sy; rw flip_flip. uf cofipr2. tv. app mor_fipr2. rww mor_opp. rww flip_flip. assert (lem1 : source z = target (cofipr2 a u v)). rw target_cofipr2. am. am. ufi cofipr2 lem1. rwi target_flip lem1. wr lem1. rww target_flip. alike. apply mor_arrow_like with (opp a). app mor_fipr2. rw H4. rw H5. rw fipr_dotted_comp. rww flip_flip. am. rw mor_opp. rww flip_flip. ufi cofipr1 H1. rwi target_flip H1. wr H1. rww target_flip. alike. apply mor_arrow_like with (opp a). app mor_fipr1. uh H0; ee; am. uh H0; ee; am. Qed. (*** now we apply the result of fc_limits to the case of cofiprods ***********************) Lemma has_cofiprods_functor_cat : forall a b, Category.axioms a -> has_cofiprods b -> has_cofiprods (functor_cat a b). Proof. ir. rw has_cofiprods_has_colimits_over_opp. cp H0. uh H1; ee. rwi has_cofiprods_has_colimits_over_opp H0. ap has_colimits_functor_cat. am. am. ap opp_axioms. ap vee_cat_axioms. am. am. ap functor_cat_axioms. am. uh H0; ee; am. Qed. Lemma has_finite_limits_has_cofiprods : forall a, has_finite_colimits a -> has_cofiprods a. Proof. ir. rw has_cofiprods_has_colimits_over_opp. uh H; ee. ap H0. ap is_finite_cat_opp. ap is_finite_vee_cat. uh H; ee; am. Qed. End Cofiprod. Export Cofiprod. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) Module Equalizer. Export Finite_Cat. Export Limit. Export Twoarrow_Cat. Definition equalizer_hypothesis a u v y := twoarrow_hypothesis a u v & mor a y & source u = target y & comp a u y = comp a v y. Definition equalizer_cone a u v y := cone_create (source y) (twoarrow_nt a (id a (source y)) (id a (source y)) u v y (comp a u y)). Lemma vertex_equalizer_cone : forall a u v y, vertex (equalizer_cone a u v y) = source y. Proof. ir. uf equalizer_cone. rw vertex_cone_create. tv. Qed. Lemma edge_nt_equalizer_cone : forall a u v y, edge_nt (equalizer_cone a u v y) = (twoarrow_nt a (id a (source y)) (id a (source y)) u v y (comp a u y)). Proof. ir. uf equalizer_cone. rw edge_nt_cone_create. tv. Qed. Lemma edge_equalizer_cone_R : forall a u v y (x:obsy twoarrow_data), edge (equalizer_cone a u v y) (R x) = match x with o1 => y | o2 => (comp a u y) end. Proof. ir. uf edge. rw edge_nt_equalizer_cone. rw ntrans_twoarrow_nt_R. tv. Qed. Lemma socle_equalizer_cone : forall a u v y, socle (equalizer_cone a u v y) = twoarrow_functor a u v. Proof. ir. uf socle. rw edge_nt_equalizer_cone. rw target_twoarrow_nt. tv. Qed. Lemma cone_source_equalizer_cone : forall a u v y, cone_source (equalizer_cone a u v y) = twoarrow_cat. Proof. ir. uf cone_source. rw socle_equalizer_cone. rww source_twoarrow_functor. Qed. Lemma cone_target_equalizer_cone : forall a u v y, cone_target (equalizer_cone a u v y) = a. Proof. ir. uf cone_target. rw socle_equalizer_cone. rww target_twoarrow_functor. Qed. Lemma equalizer_twoarrow_nt_hypothesis : forall a u v y, equalizer_hypothesis a u v y -> twoarrow_nt_hypothesis a (id a (source y)) (id a (source y)) u v y (comp a u y). Proof. ir. uh H; ee. uh H; ee. assert (ob a (source y)). rww ob_source. assert (ob a (target y)). rww ob_target. uhg; ee. uh H0; ee; am. app mor_id. app mor_id. am. am. am. rww mor_comp. rww source_id. sy; am. rww source_comp. rww target_id. rww target_comp. tv. tv. am. am. rww assoc. rww right_id. app mor_id. rww target_id. rww assoc. rww right_id. app mor_id. rww target_id. Qed. Lemma is_cone_equalizer_cone : forall a u v y, equalizer_hypothesis a u v y -> is_cone (equalizer_cone a u v y). Proof. ir. uhg; ee. uf equalizer_cone. ap cone_like_cone_create. rw edge_nt_equalizer_cone. ap twoarrow_nt_axioms. app equalizer_twoarrow_nt_hypothesis. rw cone_target_equalizer_cone. rw vertex_equalizer_cone. uh H; ee. rww ob_source. rw edge_nt_equalizer_cone. rw source_twoarrow_nt. rw cone_source_equalizer_cone. rw cone_target_equalizer_cone. rw vertex_equalizer_cone. sy; rw constant_functor_twoarrow_functor. tv. tv. uh H; ee. rww ob_source. Qed. Definition eqzmap c := edge c (R o1'). Lemma source_eqzmap : forall c, is_cone c -> cone_source c = twoarrow_cat -> source (eqzmap c) = vertex c. Proof. ir. uf eqzmap. rww source_edge. rw H0. app ob_twoarrow_cat. Qed. Lemma equalizer_hypothesis_eqzmap : forall a u v c, twoarrow_hypothesis a u v -> is_cone c -> socle c = twoarrow_functor a u v -> equalizer_hypothesis a u v (eqzmap c). Proof. ir. assert (a = cone_target c). uf cone_target. rw H1. rw target_twoarrow_functor. tv. assert (cone_source c = twoarrow_cat). uf cone_source. rw H1. rww source_twoarrow_functor. uhg. ee. am. uf eqzmap. rw H2. ap mor_edge. rw H3. ap ob_twoarrow_cat. am. uf eqzmap. rw target_edge. rw H1. rw fob_twoarrow_functor_R. tv. am. rw H3. ap ob_twoarrow_cat. am. set (k:= edge_nt c). util (twoarrow_nt_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rww osource_edge_nt. assert (otarget k = a). uf k. rww otarget_edge_nt. sy; am. assert (fmor (source k) (catyd_arrow (d:=twoarrow_data) a0') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_twoarrow_cat. am. assert (fmor (source k) (catyd_arrow (d:=twoarrow_data) a1') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_twoarrow_cat. am. assert (fmor (target k) (catyd_arrow (d:=twoarrow_data) a0') = u). uf k. rw target_edge_nt. rw H1. rw fmor_twoarrow_functor_catyd_arrow. tv. am. assert (fmor (target k) (catyd_arrow (d:=twoarrow_data) a1') = v). uf k. rw target_edge_nt. rw H1. rw fmor_twoarrow_functor_catyd_arrow. tv. am. util (twoarrow_nt_hypothesis_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rw osource_edge_nt. am. am. rwi H6 H10. rwi H5 H10. rwi H7 H10. rwi H8 H10. rwi H9 H10. assert (ntrans k (R o1') = eqzmap c). uf eqzmap. uf edge. tv. rwi H11 H10. set (m:= ntrans k (R o2')). assert (m = ntrans k (R o2')). tv. wri H12 H10. uh H10; ee. wr H27. wr H28. reflexivity. Qed. Lemma equalizer_cone_eq : forall a u v c, twoarrow_hypothesis a u v -> is_cone c -> socle c = twoarrow_functor a u v -> c = equalizer_cone a u v (eqzmap c). Proof. ir. assert (a = cone_target c). uf cone_target. rw H1. rw target_twoarrow_functor. tv. assert (cone_source c = twoarrow_cat). uf cone_source. rw H1. rww source_twoarrow_functor. set (k:= edge_nt c). util (twoarrow_nt_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rww osource_edge_nt. assert (otarget k = a). uf k. rww otarget_edge_nt. sy; am. assert (fmor (source k) (catyd_arrow (d:=twoarrow_data) a0') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_twoarrow_cat. am. assert (fmor (source k) (catyd_arrow (d:=twoarrow_data) a1') = id a (vertex c)). uf k. rw source_edge_nt. rw fmor_constant_functor. wr H2. tv. rw H3. ap mor_twoarrow_cat. am. assert (fmor (target k) (catyd_arrow (d:=twoarrow_data) a0') = u). uf k. rw target_edge_nt. rw H1. rw fmor_twoarrow_functor_catyd_arrow. tv. am. assert (fmor (target k) (catyd_arrow (d:=twoarrow_data) a1') = v). uf k. rw target_edge_nt. rw H1. rw fmor_twoarrow_functor_catyd_arrow. tv. am. rwi H5 H4. rwi H6 H4. rwi H7 H4. rwi H8 H4. rwi H9 H4. transitivity (cone_create (vertex c) k). uh H0; ee. uh H0; ee. sy; am. uf equalizer_cone. rw source_eqzmap. ap uneq. wr H4. ap uneq. util (twoarrow_nt_hypothesis_ntrans (u:=k)). uf k. app edge_nt_axioms. uf k. rw osource_edge_nt. am. am. rwi H6 H10. rwi H5 H10. rwi H7 H10. rwi H8 H10. rwi H9 H10. assert (ntrans k (R o1') = eqzmap c). uf eqzmap. uf edge. tv. rwi H11 H10. set (m:= ntrans k (R o2')). assert (m = ntrans k (R o2')). tv. wri H12 H10. uh H10; ee. wr H27. rw right_id. tv. rw H2. app ob_vertex. am. rw H21. rw target_id. tv. rw H2; app ob_vertex. tv. am. am. Qed. Lemma eqzmap_equalizer_cone : forall a u v y, equalizer_hypothesis a u v y -> eqzmap (equalizer_cone a u v y) = y. Proof. ir. uf eqzmap. rw edge_equalizer_cone_R. tv. Qed. Lemma eqzmap_cone_compose : forall c z, is_cone c -> cone_source c = twoarrow_cat -> cone_composable c z -> eqzmap (cone_compose c z) = comp (cone_target c) (eqzmap c) z. Proof. ir. uf eqzmap. rw edge_cone_compose. tv. rw H0; ap ob_twoarrow_cat. am. Qed. Definition eqzfirst c := (fmor (socle c) (catyd_arrow (d:=twoarrow_data) a0')). Definition eqzsecond c := (fmor (socle c) (catyd_arrow (d:=twoarrow_data) a1')). Lemma equalizer_hypothesis_eqz : forall c, is_cone c -> cone_source c = twoarrow_cat -> equalizer_hypothesis (cone_target c) (eqzfirst c) (eqzsecond c) (eqzmap c). Proof. ir. util (equalizer_hypothesis_eqzmap (a:= cone_target c) (u:= eqzfirst c) (v:= eqzsecond c) (c:=c)). uf eqzfirst. uf eqzsecond. uf cone_target. ap functor_twoarrow_hypothesis. app socle_axioms. am. am. uf cone_target. uf eqzfirst. uf eqzsecond. ap functor_twoarrow_eq. app socle_axioms. am. am. Qed. Lemma equalizer_cone_eq2 : forall c, is_cone c -> cone_source c = twoarrow_cat -> c = equalizer_cone (cone_target c) (eqzfirst c) (eqzsecond c) (eqzmap c). Proof. ir. util (equalizer_cone_eq (a:= cone_target c) (u:= eqzfirst c) (v:= eqzsecond c) (c:=c)). uf eqzfirst. uf eqzsecond. uf cone_target. ap functor_twoarrow_hypothesis. app socle_axioms. am. am. uf cone_target. uf eqzfirst. uf eqzsecond. ap functor_twoarrow_eq. app socle_axioms. am. am. Qed. Lemma eqzmap_extensionality : forall a b, is_cone a -> is_cone b -> cone_source a = twoarrow_cat -> socle a = socle b -> eqzmap a = eqzmap b -> a = b. Proof. ir. assert (cone_source b = twoarrow_cat). uf cone_source. wr H2. am. util (equalizer_cone_eq2 (c:= a)). am. am. util (equalizer_cone_eq2 (c:= b)). am. am. rw H5; rw H6. assert (eqzfirst a = eqzfirst b). uf eqzfirst. rww H2. assert (eqzsecond a = eqzsecond b). uf eqzsecond. rw H2. reflexivity. rw H3; rw H7; rw H8. assert (cone_target a = cone_target b). uf cone_target. rww H2. rw H9. reflexivity. Qed. Lemma cone_compose_equalizer_cone : forall a u v y z, equalizer_hypothesis a u v y -> mor a z -> source y = target z -> cone_compose (equalizer_cone a u v y) z = equalizer_cone a u v (comp a y z). Proof. ir. assert (lem1: equalizer_hypothesis a u v (comp a y z)). uh H; uhg; ee. am. rww mor_comp. rww target_comp. wr assoc. rw H4. rww assoc. uh H; ee; am. uh H; ee. wr H6. am. uh H; ee; am. am. am. am. am. tv. assert (lem2 : cone_composable (equalizer_cone a u v y) z). uhg; ee. app is_cone_equalizer_cone. rww cone_target_equalizer_cone. rww vertex_equalizer_cone. sy; am. ap eqzmap_extensionality. rww is_cone_cone_compose. app is_cone_equalizer_cone. rw cone_source_cone_compose. rww cone_source_equalizer_cone. rw socle_cone_compose. rww socle_equalizer_cone. rww socle_equalizer_cone. rww eqzmap_cone_compose. rww cone_target_equalizer_cone. rww eqzmap_equalizer_cone. rww eqzmap_equalizer_cone. app is_cone_equalizer_cone. rww cone_source_equalizer_cone. Qed. Lemma cone_composable_equalizer_cone : forall a u v y z, equalizer_hypothesis a u v y -> mor a z -> source y = target z -> cone_composable (equalizer_cone a u v y) z. Proof. ir. uhg; ee. app is_cone_equalizer_cone. rww cone_target_equalizer_cone. rww vertex_equalizer_cone. sy; am. Qed. Lemma is_uni_equalizer_cone : forall a u v y, equalizer_hypothesis a u v y -> is_uni (equalizer_cone a u v y) = (forall z z', mor a z -> mor a z' -> source y = target z -> source y = target z' -> comp a y z = comp a y z' -> z = z'). Proof. ir. ap iff_eq; ir. uh H0. ee. ap H6. app cone_composable_equalizer_cone. app cone_composable_equalizer_cone. rw cone_compose_equalizer_cone. sy; rw cone_compose_equalizer_cone. rww H5. am. am. am. am. am. am. uhg. ee. app is_cone_equalizer_cone. ir. cp H1; cp H2. uh H4; uh H5; ee. rwi cone_target_equalizer_cone H8. rwi cone_target_equalizer_cone H6. rwi vertex_equalizer_cone H9. rwi vertex_equalizer_cone H7. app H0. sy; am. sy; am. rwi cone_compose_equalizer_cone H3. transitivity (eqzmap (equalizer_cone a u v (comp a y u0))). rw eqzmap_equalizer_cone. tv. uh H; ee. uhg; ee; try am. rww mor_comp. sy; am. rww target_comp. sy; am. wr assoc. rw H12. rww assoc. uh H; ee; am. uh H; ee. sy; wrr H14. sy; am. uh H; ee; sy; am. uh H; ee; am. am. am. am. sy; am. tv. rw H3. rw cone_compose_equalizer_cone. rw eqzmap_equalizer_cone. tv. uh H; ee. uh H; ee. uhg; ee; try am. uhg; ee; am. rww mor_comp. sy; am. rww target_comp. sy; am. wr assoc. rw H12. rww assoc. wr H14. am. sy; am. am. am. am. am. sy; am. tv. am. am. sy; am. am. am. sy; am. Qed. Lemma is_versal_equalizer_cone : forall a u v y, equalizer_hypothesis a u v y -> is_versal (equalizer_cone a u v y) = (forall z, equalizer_hypothesis a u v z -> (exists w, (mor a w & source y = target w & comp a y w = z))). Proof. ir. ap iff_eq; ir. uh H0; ee. util (H2 (equalizer_cone a u v z)). app is_cone_equalizer_cone. rww socle_equalizer_cone; sy; rww socle_equalizer_cone. nin H3. ee. cp H3. uh H5; ee. rwi cone_target_equalizer_cone H6. rwi vertex_equalizer_cone H7. rwi cone_compose_equalizer_cone H4. sh x; ee. am. sy; am. transitivity (eqzmap (equalizer_cone a u v (comp a y x))). rw eqzmap_equalizer_cone. tv. uh H; uhg; ee; try am. rww mor_comp. sy; am. rww target_comp. sy; am. uh H; ee. wrr assoc. rw H10; rww assoc. wr H12. am. sy; am. sy; am. rw H4. rww eqzmap_equalizer_cone. am. am. sy; am. uhg; ee. app is_cone_equalizer_cone. ir. rwi socle_equalizer_cone H2. cp H. uh H3. ee. cp (equalizer_cone_eq H3 H1 H2). cp (equalizer_hypothesis_eqzmap H3 H1 H2). util (H0 (eqzmap b)). am. nin H9. ee. sh x; ee. app cone_composable_equalizer_cone. rww cone_compose_equalizer_cone. rw H11. sy; am. Qed. Definition is_equalizer a u v y := equalizer_hypothesis a u v y & is_limit (equalizer_cone a u v y). Lemma show_is_equalizer : forall a u v y , equalizer_hypothesis a u v y -> (forall z z', mor a z -> mor a z' -> source y = target z -> source y = target z' -> comp a y z = comp a y z' -> z = z') -> (forall z, equalizer_hypothesis a u v z -> (exists w, (mor a w & source y = target w & comp a y w = z))) -> is_equalizer a u v y. Proof. ir. uhg; ee. am. uhg. ee. rww is_uni_equalizer_cone. rww is_versal_equalizer_cone. Qed. Definition has_equalizer a u v := twoarrow_hypothesis a u v & has_limit (twoarrow_functor a u v). Lemma has_equalizer_rw : forall a u v, has_equalizer a u v = (exists y, is_equalizer a u v y). Proof. ir. ap iff_eq; ir. uh H; ee. uh H0. nin H0. uh H0; ee. sh (eqzmap x). uhg; ee. ap equalizer_hypothesis_eqzmap. am. app is_limit_is_cone. am. assert (is_cone x). app is_limit_is_cone. util (equalizer_cone_eq (a:=a) (u:=u) (v:=v) (c:=x)). am. am. am. wr H3. am. nin H. uhg; ee. uh H; ee. uh H; ee; am. uh H; ee. uhg. sh (equalizer_cone a u v x). uhg; ee. am. rww socle_equalizer_cone. Qed. Definition has_equalizers a := Category.axioms a & (forall u v, twoarrow_hypothesis a u v -> has_equalizer a u v). Definition equalizer a u v := eqzmap (limit (twoarrow_functor a u v)). Lemma equalizer_hypothesis_equalizer : forall a u v, has_equalizer a u v -> equalizer_hypothesis a u v (equalizer a u v). Proof. ir. uf equalizer. app equalizer_hypothesis_eqzmap. uh H; ee; am. ap is_limit_is_cone. ap is_limit_limit. uh H; ee; am. rw socle_limit. tv. uh H; ee; am. Qed. Lemma equalizer_hypothesis_comp : forall a u v y z, equalizer_hypothesis a u v y -> mor a z -> source y = target z -> equalizer_hypothesis a u v (comp a y z). Proof. ir. uh H; uhg; ee. am. rww mor_comp. rww target_comp. wrr assoc. rw H4. rww assoc. uh H; ee. am. uh H; ee. wrr H6. uh H; ee; am. Qed. Lemma is_equalizer_equalizer : forall a u v, has_equalizer a u v -> is_equalizer a u v (equalizer a u v). Proof. ir. uhg; ee. app equalizer_hypothesis_equalizer. uf equalizer. wr equalizer_cone_eq. ap is_limit_limit. uh H; ee; am. uh H; ee. am. ap is_limit_is_cone. ap is_limit_limit. uh H; ee; am. rw socle_limit. tv. uh H; ee; am. Qed. Lemma has_equalizers_has_equalizer : forall a u v, has_equalizers a -> twoarrow_hypothesis a u v-> has_equalizer a u v. Proof. ir. uh H; ee. ap H1. am. Qed. Lemma has_equalizers_has_limits_over : forall a, Category.axioms a -> has_equalizers a = has_limits_over twoarrow_cat a. Proof. ir. ap iff_eq; ir. uhg. ir. uh H0. ee. util (H4 (fmor f (catyd_arrow a0')) (fmor f (catyd_arrow a1'))). wr H3. ap functor_twoarrow_hypothesis. am. am. uh H5. ee. wri H3 H6. rww functor_twoarrow_eq. uh H0. uhg; ee. am. ir. uhg; ee; try am. ap H0. app twoarrow_functor_axioms. rww source_twoarrow_functor. rww target_twoarrow_functor. Qed. Lemma mor_equalizer : forall a u v, has_equalizer a u v -> mor a (equalizer a u v). Proof. ir. cp (is_equalizer_equalizer H). uh H0; ee. uh H0; ee. am. Qed. Lemma target_equalizer : forall a u v, has_equalizer a u v -> target (equalizer a u v) = source u. Proof. ir. cp (is_equalizer_equalizer H). uh H0; ee. uh H0; ee. sy; am. Qed. Lemma comp_equalizer_eq : forall a u v, has_equalizer a u v -> comp a u (equalizer a u v) = comp a v (equalizer a u v). Proof. ir. cp (is_equalizer_equalizer H). uh H0; ee. uh H0; ee. am. Qed. Definition eqz_dotted a u v y := dotted (equalizer_cone a u v y). Lemma equalizer_cone_equalizer : forall a u v, has_equalizer a u v -> equalizer_cone a u v (equalizer a u v) = limit (twoarrow_functor a u v). Proof. ir. uf equalizer. wr equalizer_cone_eq. tv. uh H; ee; am. ap is_limit_is_cone. ap is_limit_limit. uh H; ee; am. rw socle_limit. tv. uh H; ee; am. Qed. Lemma cone_composable_eqz_dotted : forall a u v y, has_equalizer a u v -> equalizer_hypothesis a u v y -> cone_composable (equalizer_cone a u v (equalizer a u v)) (eqz_dotted a u v y). Proof. ir. uf eqz_dotted. rw equalizer_cone_equalizer. assert (twoarrow_functor a u v = socle (equalizer_cone a u v y)). rww socle_equalizer_cone. rw H1. ap cone_composable_dotted. app is_cone_equalizer_cone. rw socle_equalizer_cone. uh H; ee; am. am. Qed. Lemma cone_compose_eqz_dotted : forall a u v y, has_equalizer a u v -> equalizer_hypothesis a u v y -> cone_compose (equalizer_cone a u v (equalizer a u v)) (eqz_dotted a u v y) = equalizer_cone a u v y. Proof. ir. uf eqz_dotted. rw equalizer_cone_equalizer. assert (twoarrow_functor a u v = socle (equalizer_cone a u v y)). rww socle_equalizer_cone. rw H1. ap cone_compose_dotted. app is_cone_equalizer_cone. rw socle_equalizer_cone. uh H; ee; am. am. Qed. Lemma eqz_dotted_uni : forall a u v y r, has_equalizer a u v -> equalizer_hypothesis a u v y -> cone_composable (equalizer_cone a u v (equalizer a u v)) r -> cone_compose (equalizer_cone a u v (equalizer a u v)) r = equalizer_cone a u v y -> eqz_dotted a u v y = r. Proof. ir. uf eqz_dotted. wr H2. rw equalizer_cone_equalizer. ap dotted_unique. ap twoarrow_functor_axioms. uh H0; ee; am. uh H; ee; am. wr equalizer_cone_equalizer. am. am. am. Qed. Lemma mor_eqz_dotted : forall a u v y, has_equalizer a u v -> equalizer_hypothesis a u v y -> mor a (eqz_dotted a u v y). Proof. ir. cp (cone_composable_eqz_dotted H H0). uh H1; ee. rwi cone_target_equalizer_cone H2. am. Qed. Lemma target_eqz_dotted : forall a u v y, has_equalizer a u v -> equalizer_hypothesis a u v y -> target (eqz_dotted a u v y) = source (equalizer a u v). Proof. ir. cp (cone_composable_eqz_dotted H H0). uh H1; ee. rwi vertex_equalizer_cone H3. am. Qed. Lemma comp_equalizer_eqz_dotted : forall a u v y, has_equalizer a u v -> equalizer_hypothesis a u v y -> comp a (equalizer a u v) (eqz_dotted a u v y) = y. Proof. ir. cp (cone_compose_eqz_dotted H H0). transitivity (eqzmap (equalizer_cone a u v y)). wr H1. rw eqzmap_cone_compose. rw cone_target_equalizer_cone. rw eqzmap_equalizer_cone. tv. ap equalizer_hypothesis_equalizer. am. ap is_cone_equalizer_cone. app equalizer_hypothesis_equalizer. rww cone_source_equalizer_cone. app cone_composable_eqz_dotted. rww eqzmap_equalizer_cone. Qed. Lemma eqz_dotted_comp : forall a u v z, has_equalizer a u v -> mor a z -> source (equalizer a u v) = target z -> eqz_dotted a u v (comp a (equalizer a u v) z) = z. Proof. ir. assert (equalizer_hypothesis a u v (equalizer a u v)). app equalizer_hypothesis_equalizer. ap eqz_dotted_uni. am. app equalizer_hypothesis_comp. uhg; ee. app is_cone_equalizer_cone. rww cone_target_equalizer_cone. rww vertex_equalizer_cone. sy; am. rw cone_compose_equalizer_cone. tv. am. am. am. Qed. (*** now we apply the result of fc_limits to the case of equalizers ***********************) Lemma has_equalizers_functor_cat : forall a b, Category.axioms a -> has_equalizers b -> has_equalizers (functor_cat a b). Proof. ir. rw has_equalizers_has_limits_over. cp H0. uh H1; ee. rwi has_equalizers_has_limits_over H0. ap has_limits_functor_cat. am. am. ap twoarrow_cat_axioms. am. am. ap functor_cat_axioms. am. uh H0; ee; am. Qed. Lemma has_finite_limits_has_equalizers : forall a, has_finite_limits a -> has_equalizers a. Proof. ir. rw has_equalizers_has_limits_over. uh H; ee. ap H0. ap is_finite_twoarrow_cat. uh H; ee; am. Qed. End Equalizer. Export Equalizer. (*** we should be able to more or less recopy Equalizer to get a module Fiprod for fiber products; then also dualize to get coequalizers and cofiber products. The other main type of limits and colimits we need to do are direct products and coproducts ... *****************************) Module Coequalizer. (**** we do this module by dualizing the module Equalizer, rather than by relying on colimits *******) Definition coequalizer_hypothesis a u v y := twoarrow_hypothesis a u v & mor a y & source y = target u & comp a y u = comp a y v. Lemma coeq_hyp_eq_hyp : forall a u v y, Category.axioms a -> coequalizer_hypothesis a u v y = equalizer_hypothesis (opp a) (flip u) (flip v) (flip y). Proof. ir. ap iff_eq; ir. uh H0; uhg; ee. uh H0; uhg; ee. rww mor_opp. rww flip_flip. rww mor_opp. rww flip_flip. rw source_flip. rw source_flip. am. alike. alike. rw target_flip; try alike. rww target_flip; try alike. rww mor_opp; rww flip_flip. rww target_flip; try alike. rww source_flip; try alike. sy; am. uh H0; ee; alike. rw comp_opp. rw comp_opp. rw flip_flip. rw flip_flip. rw flip_flip. ap uneq. am. rww mor_opp; rww flip_flip. uh H0; ee; am. rww mor_opp; rww flip_flip. rww target_flip; try alike. rww source_flip; try alike. uh H0; ee. wr H6. sy; am. uh H0; ee; alike. rww mor_opp; rww flip_flip. uh H0; ee; am. rww mor_opp; rww flip_flip. rww target_flip; try alike. rww source_flip; try alike. sy; am. uh H0; ee; alike. uh H0; ee. uh H0; ee. uhg; dj. uhg; dj. rwi mor_opp H0. rwi flip_flip H0. am. rwi mor_opp H4. rwi flip_flip H4. am. wr target_flip; try alike. rw H6. rw target_flip; try alike. tv. wr source_flip; try alike. rw H5. rww source_flip; try alike. rwi mor_opp H1. rwi flip_flip H1. am. uh H7; ee. wr target_flip; try alike. wr H2. rw H5. rww source_flip; try alike. sy; am. rwi comp_opp H3. rwi flip_flip H3. rwi flip_flip H3. transitivity (flip (flip (comp a y u))). rww flip_flip. rw H3. rw comp_opp. rw flip_flip. rw flip_flip. rw flip_flip. tv. am. am. wr H5. am. am. am. am. Qed. Definition is_coequalizer a u v y := Category.axioms a & is_equalizer (opp a) (flip u) (flip v) (flip y). Lemma show_is_coequalizer : forall a u v y , Category.axioms a -> coequalizer_hypothesis a u v y -> (forall z z', mor a z -> mor a z' -> source z = target y -> source z' = target y -> comp a z y = comp a z' y -> z = z') -> (forall z, coequalizer_hypothesis a u v z -> (exists w, (mor a w & source w = target y & comp a w y = z))) -> is_coequalizer a u v y. Proof. ir. uhg; ee. am. ap show_is_equalizer. wr coeq_hyp_eq_hyp. am. am. ir. set (z1:=flip z). set (z2 := flip z'). assert (z1 = z2). ap H1. uf z1. rwi mor_opp H3. am. rwi mor_opp H4. am. uf z1. rw source_flip; try alike. wr H5. rww source_flip; try alike. uh H0; ee. alike. uf z2. rw source_flip; try alike. wr H6. rww source_flip; try alike. uh H0; ee. alike. rwi comp_opp H7. rwi flip_flip H7. rwi comp_opp H7. rwi flip_flip H7. ap flip_eq. am. rww mor_opp. rw flip_flip. uh H0; ee; am. am. am. rww mor_opp. rw flip_flip. uh H0; ee; am. am. am. ap flip_eq. am. ir. cp H3. set (z1 := flip z). assert (z= flip z1). uf z1; rww flip_flip. rwi H5 H4. wri coeq_hyp_eq_hyp H4. nin (H2 z1 H4). ee. sh (flip x). ee. rww mor_opp. rww flip_flip. rw source_flip. rw target_flip. sy; am. alike. uh H0; ee; alike. rw comp_opp. rw flip_flip. rw flip_flip. ap flip_eq. rw flip_flip. am. rww mor_opp. rw flip_flip. uh H0; ee; am. rww mor_opp. rww flip_flip. rw source_flip. rw target_flip. sy; am. alike. uh H0; ee; alike. am. Qed. Definition has_coequalizer a u v := twoarrow_hypothesis a u v & has_equalizer (opp a) (flip u) (flip v). Lemma has_coequalizer_rw : forall a u v, has_coequalizer a u v = (exists y, is_coequalizer a u v y). Proof. ir. ap iff_eq; ir. uh H; ee. rwi has_equalizer_rw H0. nin H0. sh (flip x). uhg; ee. uh H; ee. uh H; ee; am. rww flip_flip. nin H. uh H; ee. uhg; ee. uh H0; ee. wri coeq_hyp_eq_hyp H0. uh H0. ee; am. am. rw has_equalizer_rw. sh (flip x). am. Qed. Definition has_coequalizers a := Category.axioms a & (forall u v, twoarrow_hypothesis a u v -> has_coequalizer a u v). Definition coequalizer a u v := flip (equalizer (opp a) (flip u) (flip v)). Lemma coequalizer_hypothesis_coequalizer : forall a u v, has_coequalizer a u v -> coequalizer_hypothesis a u v (coequalizer a u v). Proof. ir. uf coequalizer. rw coeq_hyp_eq_hyp. rw flip_flip. ap equalizer_hypothesis_equalizer. uh H. ee; am. uh H; ee. uh H; ee. uh H; ee; am. Qed. Lemma coequalizer_hypothesis_comp : forall a u v y z, coequalizer_hypothesis a u v y -> mor a z -> source z = target y -> coequalizer_hypothesis a u v (comp a z y). Proof. ir. rw coeq_hyp_eq_hyp. rwi coeq_hyp_eq_hyp H. assert (flip (comp a z y) = comp (opp a) (flip y) (flip z)). rw comp_opp. rw flip_flip. rww flip_flip. uh H; ee; am. rww mor_opp. rww flip_flip. rw source_flip; try alike. rw target_flip. sy; am. alike. uh H; ee. rwi mor_opp H2. rwi flip_flip H2; alike. rw H2. ap equalizer_hypothesis_comp. am. rww mor_opp. rww flip_flip. rw source_flip; try alike. rw target_flip. sy; am. alike. uh H; ee. rwi mor_opp H3. rwi flip_flip H3; alike. uh H0; ee; am. uh H0; ee; am. Qed. Lemma is_coequalizer_coequalizer : forall a u v, has_coequalizer a u v -> is_coequalizer a u v (coequalizer a u v). Proof. ir. assert (Category.axioms a). uh H; ee. uh H; ee. uh H; ee; am. uhg; ee; try am. uf coequalizer. rw flip_flip. ap is_equalizer_equalizer. uh H; ee. am. Qed. Lemma has_coequalizers_has_coequalizer : forall a u v, has_coequalizers a -> twoarrow_hypothesis a u v-> has_coequalizer a u v. Proof. ir. uh H; ee. ap H1. am. Qed. Lemma twoarrow_hypothesis_opp1 : forall a u v, Category.axioms a -> twoarrow_hypothesis a u v -> twoarrow_hypothesis (opp a) (flip u) (flip v). Proof. ir. uh H0; ee. uhg; ee. rww mor_opp. rww flip_flip. rww mor_opp. rww flip_flip. rw source_flip; try alike. rw source_flip; try alike. am. rw target_flip; try alike. rw target_flip; try alike. am. Qed. Lemma twoarrow_hypothesis_opp : forall a u v, Category.axioms a -> twoarrow_hypothesis (opp a) u v = twoarrow_hypothesis a (flip u) (flip v). Proof. ir. ap iff_eq; ir. uh H0; uhg; ee. rwi mor_opp H0. am. wrr mor_opp. rw source_flip; try alike. rw source_flip; try alike. am. rw target_flip; try alike. rw target_flip; try alike. am. uh H0; ee. wri mor_opp H0. wri mor_opp H1. uhg; ee; try am. rwi target_flip H3; try alike. rwi target_flip H3; try alike. am. rwi source_flip H2; try alike. rwi source_flip H2; try alike. am. Qed. Lemma twoarrow_hypothesis_opp_flip : forall a u v, Category.axioms a -> twoarrow_hypothesis (opp a) (flip u) (flip v) = twoarrow_hypothesis a u v. Proof. ir. rw twoarrow_hypothesis_opp. rw flip_flip. rw flip_flip. tv. am. Qed. Lemma has_coeq_has_eq : forall a u v, Category.axioms a -> has_coequalizer a u v = has_equalizer (opp a) (flip u) (flip v). Proof. ir. ap iff_eq; ir. uh H0; ee. am. uhg; ee. uh H0; ee. rwi twoarrow_hypothesis_opp_flip H0. am. am. am. Qed. Lemma has_eq_has_coeq : forall a u v, Category.axioms a -> has_equalizer a u v = has_coequalizer (opp a) (flip u) (flip v). Proof. ir. rw has_coeq_has_eq. rw flip_flip. rw flip_flip. rw opp_opp. tv. app opp_axioms. Qed. Lemma has_coequalizers_opp : forall a, has_coequalizers (opp a) = has_equalizers a. Proof. ir. ap iff_eq; ir. uh H; ee. uhg; ee. wrr axioms_opp. ir. rw has_eq_has_coeq. ap H0. rw twoarrow_hypothesis_opp_flip. am. wrr axioms_opp. wrr axioms_opp. uh H; ee. uhg; ee. app opp_axioms. ir. rw has_coeq_has_eq. rw opp_opp. ap H0. wr twoarrow_hypothesis_opp. am. am. app opp_axioms. Qed. Lemma has_equalizers_opp : forall a, has_equalizers (opp a) = has_coequalizers a. Proof. ir. wr has_coequalizers_opp. rww opp_opp. Qed. Lemma has_coequalizers_has_colimits_over_opp : forall a, Category.axioms a -> has_coequalizers a = has_colimits_over (opp twoarrow_cat) a. Proof. ir. ap iff_eq; ir. assert (a = opp (opp a)). rww opp_opp. rw H1. ap has_colimits_over_opp. app opp_axioms. ap twoarrow_cat_axioms. wr has_equalizers_has_limits_over. rw has_equalizers_opp. am. app opp_axioms. wr has_equalizers_opp. rw has_equalizers_has_limits_over. assert (twoarrow_cat = opp (opp twoarrow_cat)). rww opp_opp. rw H1. ap has_limits_over_opp. am. ap opp_axioms. ap twoarrow_cat_axioms. am. app opp_axioms. Qed. Lemma mor_coequalizer : forall a u v, has_coequalizer a u v -> mor a (coequalizer a u v). Proof. ir. cp (coequalizer_hypothesis_coequalizer H). uh H0; ee. am. Qed. Lemma source_coequalizer : forall a u v, has_coequalizer a u v -> source (coequalizer a u v) = target u. Proof. ir. cp (coequalizer_hypothesis_coequalizer H). uh H0; ee. am. Qed. Lemma comp_coequalizer_eq : forall a u v, has_coequalizer a u v -> comp a (coequalizer a u v) u = comp a (coequalizer a u v) v. Proof. ir. cp (coequalizer_hypothesis_coequalizer H). uh H0; ee. am. Qed. Definition coeqz_dotted a u v y := flip (eqz_dotted (opp a) (flip u) (flip v) (flip y)). Lemma mor_coeqz_dotted : forall a u v y, has_coequalizer a u v -> coequalizer_hypothesis a u v y -> mor a (coeqz_dotted a u v y). Proof. ir. rwi has_coeq_has_eq H. rwi coeq_hyp_eq_hyp H0. uf coeqz_dotted. wr mor_opp. app mor_eqz_dotted. uh H0; ee. uh H1; ee; am. uh H0; ee. uh H1; ee; am. Qed. Lemma source_eqz_dotted : forall a u v y, has_coequalizer a u v -> coequalizer_hypothesis a u v y -> source (coeqz_dotted a u v y) = target (coequalizer a u v). Proof. ir. rwi has_coeq_has_eq H. rwi coeq_hyp_eq_hyp H0. uf coeqz_dotted. rw source_flip. rw target_eqz_dotted. uf coequalizer. rw target_flip. tv. apply mor_arrow_like with (opp a). app mor_equalizer. am. am. apply mor_arrow_like with (opp a). app mor_eqz_dotted. uh H0; ee. uh H1; ee; am. uh H0; ee. uh H1; ee; am. Qed. Lemma comp_coequalizer_coeqz_dotted : forall a u v y, has_coequalizer a u v -> coequalizer_hypothesis a u v y -> comp a (coeqz_dotted a u v y) (coequalizer a u v) = y. Proof. ir. rwi has_coeq_has_eq H. rwi coeq_hyp_eq_hyp H0. uf coeqz_dotted. uf coequalizer. ap flip_eq. wr comp_opp. ap comp_equalizer_eqz_dotted. am. am. app mor_equalizer. app mor_eqz_dotted. rw target_eqz_dotted. tv. am. am. uh H0; ee. uh H1; ee; am. uh H0; ee. uh H1; ee; am. Qed. Lemma coeqz_dotted_comp : forall a u v z, has_coequalizer a u v -> mor a z -> source z = target (coequalizer a u v) -> coeqz_dotted a u v (comp a z (coequalizer a u v)) = z. Proof. ir. cp H. rwi has_coeq_has_eq H. assert (coequalizer_hypothesis a u v (comp a z (coequalizer a u v))). app coequalizer_hypothesis_comp. app coequalizer_hypothesis_coequalizer. rwi coeq_hyp_eq_hyp H3. uf coeqz_dotted. assert (flip (comp a z (coequalizer a u v)) = comp (opp a) (equalizer (opp a) (flip u) (flip v)) (flip z)). rw comp_opp. sy; rw flip_flip. uf coequalizer. tv. app mor_equalizer. rww mor_opp. rww flip_flip. ufi coequalizer H1. rwi target_flip H1. wr H1. rww target_flip. alike. apply mor_arrow_like with (opp a). app mor_equalizer. rw H4. rw eqz_dotted_comp. rww flip_flip. am. rw mor_opp. rww flip_flip. ufi coequalizer H1. rwi target_flip H1. wr H1. rww target_flip. alike. apply mor_arrow_like with (opp a). app mor_equalizer. uh H0; ee; am. uh H0; ee; am. Qed. (*** now we apply the result of fc_limits to the case of coequalizers ***********************) Lemma has_coequalizers_functor_cat : forall a b, Category.axioms a -> has_coequalizers b -> has_coequalizers (functor_cat a b). Proof. ir. rw has_coequalizers_has_colimits_over_opp. cp H0. uh H1; ee. rwi has_coequalizers_has_colimits_over_opp H0. ap has_colimits_functor_cat. am. am. ap opp_axioms. ap twoarrow_cat_axioms. am. am. ap functor_cat_axioms. am. uh H0; ee; am. Qed. Lemma has_finite_limits_has_coequalizers : forall a, has_finite_colimits a -> has_coequalizers a. Proof. ir. rw has_coequalizers_has_colimits_over_opp. uh H; ee. ap H0. ap is_finite_cat_opp. ap is_finite_twoarrow_cat. uh H; ee; am. Qed. End Coequalizer. Export Coequalizer. (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************) (*****************************************************************************************)