From: coquand Date: Sun, 19 Apr 2015 21:39:47 +0000 (+0200) Subject: any isomorphism is an equivalence X-Git-Url: https://git.ak3n.com/?a=commitdiff_plain;h=65e75d58b04eecf6cdcaa06635c677f0874197b7;p=cubicaltt.git any isomorphism is an equivalence --- diff --git a/examples/gradLemma.ctt b/examples/gradLemma.ctt new file mode 100644 index 0000000..8634135 --- /dev/null +++ b/examples/gradLemma.ctt @@ -0,0 +1,33 @@ +module gradLemma where + +import prelude + +lemIso (A B : U) (f : A -> B) (g : B -> A) + (s : (y:B) -> Id B (f (g y)) y) + (t : (x:A) -> Id A (g (f x)) x) + (y:B) (x0 x1:A) (p0 : Id B y (f x0)) (p1 : Id B y (f x1)) : + Id ((x:A) * Id B y (f x)) (x0,p0) (x1,p1) = (p@i,sq1@i) + where + rem0 : Id A (g y) x0 = comp A (g (p0 @ i)) [(i=1) -> t x0] + rem1 : Id A (g y) x1 = comp A (g (p1 @ i)) [(i=1) -> t x1] + fill0 : Square A (g y) (g (f x0)) (g (p0 @ i)) (g y) x0 rem0 ((g y)) (t x0) = + comp A (g (p0@i)) [(i=1) -> (t x0)@k/\j ] + fill1 : Square A (g y) (g (f x1)) (g (p1 @ i)) (g y) x1 rem1 ((g y)) (t x1) = + comp A (g (p1@i)) [(i=1) -> (t x1)@k/\j ] + p : Id A x0 x1 = comp A (g y) [(i=0) -> rem0, (i=1) -> rem1] + fill : Square A (g y) (g y) (refl A (g y)) x0 x1 p rem0 rem1 = + comp A (g y) [(i=0) -> (rem0@j/\k), (i=1) -> (rem1@j/\k)] + sq : Square A (g y) (g y) (refl A (g y)) (g (f x0)) (g (f x1)) ((g (f (p@i)))) + (g (p0@i)) (g (p1@i)) = + comp A ((fill@i)@j) [(i=0) -> ((fill0@j)@-k), (i=1)->((fill1@j)@-k),(j=1) -> (t (p@i))@-k] + sq1 : Square B y y (refl B y) (f x0) (f x1) (f (p@i)) p0 p1 = + comp B (f ((sq@i)@j)) [(i=0) -> s (p0@j),(i=1) -> s (p1@j),(j=0) -> s y,(j=1)-> s (f (p@i))] + +-- special case + +corrIso (A B : U) (f : A -> B) (g : B -> A) + (s : (y:B) -> Id B (f (g y)) y) + (t : (x:A) -> Id A (g (f x)) x) + (x0:A) : + Id ((x:A) * Id B (f x0) (f x)) (x0,refl B (f x0)) (g (f x0),((s (f x0))@-i)) = + lemIso A B f g s t (f x0) x0 (g (f x0)) (refl B (f x0)) (((s (f x0))@-i))