perga/examples/category.pg

@include logic.pg

section Category
    variable
        (Obj  : ★)
        (~>   : Obj -> Obj -> ★);

    infixr 10 ~>;

    variable
        (id   : forall (A     : Obj), A ~> A)
        (comp : forall (A B C : Obj), A ~> B -> B ~> C -> A ~> C);

    hypothesis
        (id_l  : forall (A B     : Obj) (f : A ~> B), eq (A ~> B) (comp A A B (id A) f) f)
        (id_r  : forall (A B     : Obj) (f : B ~> A), eq (A ~> B) (comp B A A f (id A)) f)
        (assoc : forall (A B C D : Obj) (f : A ~> B) (g : B ~> C) (h : C ~> D),
            eq (A ~> D)
                (comp A B D f (comp B C D g h))
                (comp A C D (comp A B C f g) h));

    def initial  (A : Obj) := forall (B : Obj), exists_uniq_t (A ~> B);
    def terminal (A : Obj) := forall (B : Obj), exists_uniq_t (B ~> A);

    def × (A B C : Obj) (piA : C ~> A) (piB : C ~> B) :=
        forall (D : Obj) (f : D ~> A) (g : D ~> B),
            exists_uniq (D ~> C) (fun (fxg : D ~> C) =>
                (eq (D ~> A) (comp D C A fxg piA) f)
                ∧ (eq (D ~> B) (comp D C B fxg piB) g));

    section Inverses
        variable
            (A B : Obj)
            (f : A ~> B)
            (g : B ~> A);

        def inv_l := eq (A ~> A) (comp A B A f g) (id A);
        def inv_r := eq (B ~> B) (comp B A B g f) (id B);

        def inv := inv_l ∧ inv_r;
    end Inverses

    def ≅ (A B : Obj) :=
        exists (A ~> B) (fun (f : A ~> B) =>
            exists (B ~> A) (inv A B f));

    infixl 20 ≅;

    def initial_uniq (A B : Obj) (hA : initial A) (hB : initial B) : A ≅ B :=
        exists_uniq_t_elim (A ~> B) (A ≅ B) (hA B) (fun (f : A ~> B) (f_uniq : forall (y : A ~> B), eq (A ~> B) f y) =>
        exists_uniq_t_elim (B ~> A) (A ≅ B) (hB A) (fun (g : B ~> A) (g_uniq : forall (y : B ~> A), eq (B ~> A) g y) =>
        exists_uniq_t_elim (A ~> A) (A ≅ B) (hA A) (fun (a : A ~> A) (a_uniq : forall (y : A ~> A), eq (A ~> A) a y) =>
        exists_uniq_t_elim (B ~> B) (A ≅ B) (hB B) (fun (b : B ~> B) (b_uniq : forall (y : B ~> B), eq (B ~> B) b y) =>
            exists_intro (A ~> B) (fun (f : A ~> B) => exists (B ~> A) (inv A B f)) f
                (exists_intro (B ~> A) (inv A B f) g
                    (and_intro (inv_l A B f g) (inv_r A B f g)
                        (eq_trans (A ~> A) (comp A B A f g) a (id A)
                            (eq_sym (A ~> A) a (comp A B A f g) (a_uniq (comp A B A f g)))
                            (a_uniq (id A)))
                        (eq_trans (B ~> B) (comp B A B g f) b (id B)
                            (eq_sym (B ~> B) b (comp B A B g f) (b_uniq (comp B A B g f)))
                            (b_uniq (id B)))))))));

    def terminal_uniq (A B : Obj) (hA : terminal A) (hB : terminal B) : A ≅ B :=
        exists_uniq_t_elim (A ~> B) (A ≅ B) (hB A) (fun (f : A ~> B) (f_uniq : forall (y : A ~> B), eq (A ~> B) f y) =>
        exists_uniq_t_elim (B ~> A) (A ≅ B) (hA B) (fun (g : B ~> A) (g_uniq : forall (y : B ~> A), eq (B ~> A) g y) =>
        exists_uniq_t_elim (A ~> A) (A ≅ B) (hA A) (fun (a : A ~> A) (a_uniq : forall (y : A ~> A), eq (A ~> A) a y) =>
        exists_uniq_t_elim (B ~> B) (A ≅ B) (hB B) (fun (b : B ~> B) (b_uniq : forall (y : B ~> B), eq (B ~> B) b y) =>
            exists_intro (A ~> B) (fun (f : A ~> B) => exists (B ~> A) (inv A B f)) f
                (exists_intro (B ~> A) (inv A B f) g
                    (and_intro (inv_l A B f g) (inv_r A B f g)
                        (eq_trans (A ~> A) (comp A B A f g) a (id A)
                            (eq_sym (A ~> A) a (comp A B A f g) (a_uniq (comp A B A f g)))
                            (a_uniq (id A)))
                        (eq_trans (B ~> B) (comp B A B g f) b (id B)
                            (eq_sym (B ~> B) b (comp B A B g f) (b_uniq (comp B A B g f)))
                            (b_uniq (id B)))))))));
end Category