helm/software/matita/contribs/formal_topology/overlap/apply_functor.ma

   1 (**************************************************************************)
   2 (*       ___                                                              *)
   3 (*      ||M||                                                             *)
   4 (*      ||A||       A project by Andrea Asperti                           *)
   5 (*      ||T||                                                             *)
   6 (*      ||I||       Developers:                                           *)
   7 (*      ||T||         The HELM team.                                      *)
   8 (*      ||A||         http://helm.cs.unibo.it                             *)
   9 (*      \   /                                                             *)
  10 (*       \ /        This file is distributed under the terms of the       *)
  11 (*        v         GNU General Public License Version 2                  *)
  12 (*                                                                        *)
  13 (**************************************************************************)
  14
  15 include "categories.ma".
  16 include "notation.ma".
  17
  18 record Fo (C1,C2:CAT2) (F:arrows3 CAT2 C1 C2) : Type2 ≝ {
  19   F2: C2;
  20   F1: C1;
  21   FP: map_objs2 ?? F F1 =_\ID F2
  22 }.
  23
  24 notation "ℱ\sub 1 x" non associative with precedence 60 for @{'F1 $x}.
  25 notation > "ℱ_1" non associative with precedence 90 for @{F1 ???}.
  26 interpretation "F1" 'F1 x = (F1 ??? x).
  27
  28 notation "ℱ\sub 2 x" non associative with precedence 60 for @{'F2 $x}.
  29 notation > "ℱ_2" non associative with precedence 90 for @{F2 ???}.
  30 interpretation "F2" 'F2 x = (F2 ??? x).
  31
  32 lemma REW : ∀C1,C2: CAT2.∀F:arrows3 CAT2 C1 C2.∀X,Y:Fo ?? F.
  33   arrows2 C2 (F (ℱ_1 X)) (F (ℱ_1 Y)) →
  34   arrows2 C2 (ℱ_2 X) (ℱ_2 Y).
  35 intros 5; cases X; cases Y; clear X Y;
  36 cases H; cases H1; intros; assumption;
  37 qed.
  38
  39 record Fm_c (C1,C2:CAT2) (F:arrows3 CAT2 C1 C2) (X,Y:Fo ?? F) : Type2 ≝ {
  40   Fm2: arrows2 C2 (F2 ??? X) (F2 ??? Y);
  41   Fm1: arrows2 C1 (F1 ??? X) (F1 ??? Y);
  42   FmP: REW ?? F X Y (map_arrows2 ?? F ?? Fm1) = Fm2
  43 }.
  44
  45 notation "ℳ\sub 1 x" non associative with precedence 60 for @{'Fm1 $x}.
  46 notation > "ℳ_1" non associative with precedence 90 for @{Fm1 ?????}.
  47 interpretation "Fm1" 'Fm1 x = (Fm1 ????? x).
  48
  49 notation "ℳ\sub 2 x" non associative with precedence 60 for @{'Fm2 $x}.
  50 notation > "ℳ_2" non associative with precedence 90 for @{Fm2 ?????}.
  51 interpretation "Fm2" 'Fm2 x = (Fm2 ????? x).
  52
  53 definition Fm :
  54  ∀C1,C2: CAT2.∀F:arrows3 CAT2 C1 C2.
  55    Fo ?? F → Fo ?? F → setoid2.
  56 intros (C1 C2 F X Y); constructor 1; [apply (Fm_c C1 C2 F X Y)]
  57 constructor 1; [apply (λf,g.Fm2 ????? f =_2 Fm2 ????? g);]
  58 [ intro; apply refl2;
  59 | intros 3; apply sym2; assumption;
  60 | intros 5; apply (trans2 ?? ??? x1 x2);]
  61 qed.
  62
  63 definition F_id :
  64  ∀C1,C2: CAT2.∀F:arrows3 CAT2 C1 C2.∀o.Fm ?? F o o.
  65 intros; constructor 1;
  66    [ apply (id2 C2 (F2 ??? o));
  67    | apply (id2 C1 (F1 ??? o));
  68    | cases o; cases H; simplify; apply (respects_id2 ?? F);]
  69 qed.
  70
  71 definition F_comp :
  72   ∀C1,C2: CAT2.∀F:arrows3 CAT2 C1 C2.∀o1,o2,o3.
  73     binary_morphism2 (Fm ?? F o1 o2) (Fm ?? F o2 o3) (Fm ?? F o1 o3).
  74 intros; constructor 1;
  75 [ intros (f g); constructor 1;
  76     [ apply (comp2 C2 ??? (ℳ_2 f) (ℳ_2 g));
  77     | apply (comp2 C1 ??? (ℳ_1 f) (ℳ_1 g));
  78     | apply hide; cases o1 in f; cases o2 in g; cases o3; clear o1 o2 o3;
  79       cases H; cases H1; cases H2; intros 2; cases c; cases c1; clear c c1;
  80       simplify; apply (.= (respects_comp2:?)); apply (e1‡e);]
  81 | intros 6; change with ((ℳ_2 b ∘ ℳ_2 a) = (ℳ_2 b' ∘ ℳ_2 a'));
  82   change in e1 with (ℳ_2 b = ℳ_2 b');
  83   change in e with (ℳ_2 a = ℳ_2 a');
  84   apply (e‡e1);]
  85 qed.
  86
  87
  88 definition Apply : ∀C1,C2: CAT2.arrows3 CAT2 C1 C2 → CAT2.
  89 intros (C1 C2 F);
  90 constructor 1;
  91 [ apply (Fo ?? F);
  92 | apply (Fm ?? F);
  93 | apply F_id;
  94 | apply F_comp;
  95 | intros; apply (comp_assoc2 C2 ???? (ℳ_2 a12) (ℳ_2 a23) (ℳ_2 a34));
  96 | intros; apply (id_neutral_right2 C2 ?? (ℳ_2 a));
  97 | intros; apply (id_neutral_left2 C2 ?? (ℳ_2 a));]
  98 qed.
  99
 100 definition faithful ≝
 101    λC1,C2.λF:arrows3 CAT2 C1 C2.∀S,T.∀f,g:arrows2 C1 S T.
 102      map_arrows2 ?? F ?? f = map_arrows2 ?? F ?? g → f=g.
 103
 104 definition Ylppa : ∀C1,C2: CAT2.∀F:arrows3 CAT2 C1 C2.
 105   faithful ?? F →  let rC2 ≝ Apply ?? F in arrows3 CAT2 rC2 C1.
 106 intros; constructor 1;
 107 [ intro; apply (ℱ_1 o);
 108 | intros; constructor 1;
 109   [ intros; apply (ℳ_1 c);
 110   | apply hide; intros; apply f;  change in e with (ℳ_2 a = ℳ_2 a');
 111     lapply (FmP ????? a) as H1; lapply (FmP ????? a') as H2;
 112     cut (REW ????? (map_arrows2 ?? F ?? (ℳ_1 a)) =
 113          REW ????? (map_arrows2 ?? F ?? (ℳ_1 a')));[2:
 114       apply (.= H1); apply (.= e); apply H2^-1;]
 115     clear H1 H2 e; cases S in a a' Hcut; cases T;
 116     cases H; cases H1; simplify; intros; assumption;]
 117 | intro; apply rule #;
 118 | intros; simplify; apply rule #;]
 119 qed.
 120
 121
 122