lean2/hott/algebra/category/groupoid.hlean

/-
Copyright (c) 2014 Jakob von Raumer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jakob von Raumer

Ported from Coq HoTT
-/

import .iso ..group

open eq is_trunc iso category algebra nat unit

namespace category

  structure groupoid [class] (ob : Type) extends parent : precategory ob :=
  mk' :: (all_iso : Π ⦃a b : ob⦄ (f : hom a b), @is_iso ob parent a b f)

  abbreviation all_iso := @groupoid.all_iso
  attribute groupoid.all_iso [instance] [priority 100000]

  definition groupoid.mk [reducible] {ob : Type} (C : precategory ob)
    (H : Π (a b : ob) (f : a ⟶ b), is_iso f) : groupoid ob :=
  precategory.rec_on C groupoid.mk' H

  definition precategory_of_1_type.{l} (A : Type.{l})
      [H : is_trunc 1 A] : precategory.{l l} A :=
  precategory.mk
    (λ (a b : A), a = b)
    (λ (a b c : A) (p : b = c) (q : a = b), q ⬝ p)
    (λ (a : A), refl a)
    (λ (a b c d : A) (p : c = d) (q : b = c) (r : a = b), con.assoc r q p)
    (λ (a b : A) (p : a = b), con_idp p)
    (λ (a b : A) (p : a = b), idp_con p)

  definition groupoid_of_1_type.{l} (A : Type.{l})
      [H : is_trunc 1 A] : groupoid.{l l} A :=
  groupoid.mk !precategory_of_1_type
              (λ (a b : A) (p : a = b), is_iso.mk !con.right_inv !con.left_inv)

  -- A groupoid with a contractible carrier is a group
  definition group_of_is_contr_groupoid {ob : Type} [H : is_contr ob]
    [G : groupoid ob] : group (hom (center ob) (center ob)) :=
  begin
    fapply group.mk,
      intro f g, apply (comp f g),
      apply is_hset_hom,
      intro f g h, apply (assoc f g h)⁻¹,
      apply (ID (center ob)),
      intro f, apply id_left,
      intro f, apply id_right,
      intro f, exact (iso.inverse f),
      intro f, exact (iso.left_inverse f),
  end

  definition group_of_groupoid_unit [G : groupoid unit] : group (hom ⋆ ⋆) :=
  begin
    fapply group.mk,
      intro f g, apply (comp f g),
      apply is_hset_hom,
      intro f g h, apply (assoc f g h)⁻¹,
      apply (ID ⋆),
      intro f, apply id_left,
      intro f, apply id_right,
      intro f, exact (iso.inverse f),
      intro f, exact (iso.left_inverse f),
  end

  -- Conversely we can turn each group into a groupoid on the unit type
  definition groupoid_of_group.{l} (A : Type.{l}) [G : group A] : groupoid.{0 l} unit :=
  begin
    fapply groupoid.mk, fapply precategory.mk,
      intros, exact A,
      intros, apply (@group.is_hset_carrier A G),
      intros [a, b, c, g, h], exact (@group.mul A G g h),
      intro a, exact (@group.one A G),
      intros, exact (@group.mul_assoc A G h g f)⁻¹,
      intros, exact (@group.one_mul A G f),
      intros, exact (@group.mul_one A G f),
      intros, esimp [precategory.mk], apply is_iso.mk,
        apply mul.left_inv,
        apply mul.right_inv,
  end

  protected definition hom_group {A : Type} [G : groupoid A] (a : A) :
    group (hom a a) :=
  begin
    fapply group.mk,
      intro f g, apply (comp f g),
      apply is_hset_hom,
      intros f g h, apply (assoc f g h)⁻¹,
      apply (ID a),
      intro f, apply id_left,
      intro f, apply id_right,
      intro f, exact (iso.inverse f),
      intro f, exact (iso.left_inverse f),
  end

  -- Bundled version of categories
  -- we don't use Groupoid.carrier explicitly, but rather use Groupoid.carrier (to_Precategory C)
  structure Groupoid : Type :=
    (carrier : Type)
    (struct : groupoid carrier)

  attribute Groupoid.struct [instance] [coercion]

  definition Groupoid.to_Precategory [coercion] [reducible] (C : Groupoid) : Precategory :=
  Precategory.mk (Groupoid.carrier C) C

  definition groupoid.Mk [reducible] := Groupoid.mk
  definition groupoid.MK [reducible] (C : Precategory) (H : Π (a b : C) (f : a ⟶ b), is_iso f)
    : Groupoid :=
  Groupoid.mk C (groupoid.mk C H)

  definition Groupoid.eta (C : Groupoid) : Groupoid.mk C C = C :=
  Groupoid.rec (λob c, idp) C

end category