Finish proof of left and right identity

This commit is contained in:
Frederik Hanghøj Iversen 2017-11-15 20:45:35 +01:00
parent da0f4a365b
commit 50f1ce448b

View file

@ -67,33 +67,23 @@ module _ {A B : Set} {S : Subset (A × B)} (ab : A × B) where
(a , b) S (a , b) S
backwards (a' , (a=a' , a'b∈S)) = subst (sym a=a') a'b∈S backwards (a' , (a=a' , a'b∈S)) = subst (sym a=a') a'b∈S
isbijective : (x : (a , b) S) (backwards forwards) x x fwd-bwd : (x : (a , b) S) (backwards forwards) x x
-- isbijective x = pathJ (λ y x₁ → (backwards ∘ forwards) x ≡ x) {!!} {!!} {!!} -- isbijective x = pathJ (λ y x₁ → (backwards ∘ forwards) x ≡ x) {!!} {!!} {!!}
isbijective x = pathJprop (λ y _ y) x fwd-bwd x = pathJprop (λ y _ y) x
postulate bwd-fwd : (x : Σ[ a' A ] (a , a') Diag A × (a' , b) S)
back-fwd : (x : Σ[ a' A ] (a , a') Diag A × (a' , b) S)
(forwards backwards) x x (forwards backwards) x x
-- back-fwd (a , (p , ab∈S)) -- bwd-fwd (y , a≡y , z) = ?
-- = =-ind (λ x y p → {!(forwards ∘ backwards) x ≡ x!}) {!!} {!!} {!!} p bwd-fwd (a' , a≡y , z) = pathJ lem0 lem1 a' a≡y z
-- = pathJprop (λ y _ → snd (snd y)) ab∈S where
-- has type P x refl where P is the first argument lem0 = (λ a'' a≡a'' a''b∈S (forwards backwards) (a'' , a≡a'' , a''b∈S) (a'' , a≡a'' , a''b∈S))
{- lem1 = (λ z₁ cong (\ z a , refl , z) (pathJprop (\ y _ y) z₁))
module _ { '} {A : Set } {x : A}
(P : y x y Set ') (d : P x ((λ i x))) where
pathJ : (y : A) (p : x y) P y p
pathJ _ p = transp (λ i uncurry P (contrSingl p i)) d
pathJprop : pathJ _ refl d
pathJprop i = primComp (λ _ P x refl) i (λ {j (i = i1) d}) d
-}
isequiv : isEquiv isequiv : isEquiv
(Σ[ a' A ] (a , a') Diag A × (a' , b) S) (Σ[ a' A ] (a , a') Diag A × (a' , b) S)
((a , b) S) ((a , b) S)
backwards backwards
-- isequiv ab∈S = (forwards ab∈S , sym (isbijective ab∈S)) , λ y → fiberhelp y isequiv y = gradLemma backwards forwards fwd-bwd bwd-fwd y
isequiv y = gradLemma backwards forwards isbijective back-fwd y
equi : (Σ[ a' A ] (a , a') Diag A × (a' , b) S) equi : (Σ[ a' A ] (a , a') Diag A × (a' , b) S)
(a , b) S (a , b) S
@ -113,18 +103,22 @@ module _ { '} {A : Set } {x : A}
(a , b) S (a , b) S
backwards (b' , (ab'∈S , b'=b)) = subst b'=b ab'∈S backwards (b' , (ab'∈S , b'=b)) = subst b'=b ab'∈S
isbijective : (x : (a , b) S) (backwards forwards) x x bwd-fwd : (x : (a , b) S) (backwards forwards) x x
isbijective x = pathJprop (λ y _ y) x bwd-fwd x = pathJprop (λ y _ y) x
fwd-bwd : (x : Σ[ b' B ] (a , b') S × (b' , b) Diag B) fwd-bwd : (x : Σ[ b' B ] (a , b') S × (b' , b) Diag B)
(forwards backwards) x x (forwards backwards) x x
fwd-bwd (b , (ab∈S , refl)) = pathJprop (λ y _ fst (snd y)) ab∈S -- fwd-bwd (b , (ab∈S , refl)) = pathJprop (λ y _ → fst (snd y)) ab∈S
fwd-bwd (b' , (ab'∈S , b'≡b)) = pathJ lem0 lem1 b' (sym b'≡b) ab'∈S
where
lem0 = (λ b'' b≡b'' (ab''∈S : (a , b'') S) (forwards backwards) (b'' , ab''∈S , sym b≡b'') (b'' , ab''∈S , sym b≡b''))
lem1 = (λ ab''∈S cong (\z b , z , refl) (pathJprop (λ y _ y) ab''∈S))
isequiv : isEquiv isequiv : isEquiv
(Σ[ b' B ] (a , b') S × (b' , b) Diag B) (Σ[ b' B ] (a , b') S × (b' , b) Diag B)
((a , b) S) ((a , b) S)
backwards backwards
isequiv ab∈S = gradLemma backwards forwards isbijective fwd-bwd ab∈S isequiv ab∈S = gradLemma backwards forwards bwd-fwd fwd-bwd ab∈S
equi : (Σ[ b' B ] (a , b') S × (b' , b) Diag B) equi : (Σ[ b' B ] (a , b') S × (b' , b) Diag B)
ab S ab S
@ -153,7 +147,7 @@ module _ { ' : Level} { : Category {} {}} where
RepFunctor = RepFunctor =
record record
{ F = λ A (B : C-Obj) Hom { = } A B { F = λ A (B : C-Obj) Hom { = } A B
; f = λ { {c' = c'} f g HomFromArrow { = {!𝕊et-as-Cat!}} c' g} ; f = λ { {c' = c'} f g {!HomFromArrow { = } c' g!}}
; ident = {!!} ; ident = {!!}
; distrib = {!!} ; distrib = {!!}
} }