Id ((y : A) -> B y) f g = <i> \(a : A) -> (p a) @ i
```
-This proof can be compared with the one in "examples/funext.ctt" which
-proves that univalence implies function extensionality (the normal
-form of these proofs are almost the same).
+This proof can be compared with the one in "examples/uafunext1.ctt"
+which proves that univalence implies function extensionality (the
+normal form of these proofs are almost the same).
For more examples, see "examples/demo.ctt".
\r
-- other proof?\r
\r
-propIsProp (A:U) (f g:prop A) : Id (prop A) f g =\r
- <i> \ (a b :A) -> (propSet A f a b (f a b) (g a b)) @ i\r
-\r
-setIsProp (A:U) (f g:set A) : Id (set A) f g =\r
- <i> \ (a b :A) -> (propIsProp (Id A a b) (f a b) (g a b)) @ i\r
-\r
helixSet : (x:S1) -> set (helix x) = lemPropFib (\ (x:S1) -> set (helix x)) rem ZSet\r
where rem (x:S1) : prop (set (helix x)) = setIsProp (helix x)\r
\r
\r
-- S1 is a groupoid\r
\r
-groupoid (A:U) : U = (x y:A) -> set (Id A x y)\r
-\r
-propPi (A : U) (B : A -> U) (h:(x : A) -> prop (B x)) (f0 f1:(x : A) -> B x) : Id ((x:A)-> B x) f0 f1 \r
- = <i> \ (x:A) -> (h x (f0 x) (f1 x)) @ i\r
-\r
isGroupoidS1 : groupoid S1 = lem\r
where\r
lem2 : (y : S1) -> set (Id S1 base y)\r
prop (A : U) : U = (a b : A) -> Id A a b
set (A : U) : U = (a b : A) -> prop (Id A a b)
+groupoid (A : U) : U = (a b : A) -> set (Id A a b)
propSet (A : U) (h : prop A) (a b : A) (p q : Id A a b) : Id (Id A a b) p q =
<j i> comp A a [ (i=0) -> h a a
setIsProp (A : U) (f g : set A) : Id (set A) f g =
<i> \(a b :A) -> (propIsProp (Id A a b) (f a b) (g a b)) @ i
+propPi (A : U) (B : A -> U) (h : (x : A) -> prop (B x))
+ (f0 f1 : (x : A) -> B x) : Id ((x : A) -> B x) f0 f1
+ = <i> \ (x:A) -> (h x (f0 x) (f1 x)) @ i
+
IdS (A : U) (P : A -> U) (a0 a1 : A) (p : Id A a0 a1) (u0 : P a0) (u1 : P a1) : U =
IdP (<i> P (p @ i)) u0 u1
+++ /dev/null
-module uafunext where
-
-import prelude
-
-diag (A : U) : U = (xy : ((_ : A) * A)) * (Id A xy.1 xy.2)
-
-pi1 (A : U) (d : diag A) : A = d.1.1
-pi2 (A : U) (d : diag A) : A = d.1.2
-toDiag (A : U) (a : A) : diag A = ((a,a),refl A a)
-
-toDiagK1 (A : U) : (x : diag A) -> Id (diag A) (toDiag A (pi1 A x)) x = undefined
-pi1K (A : U) : (x : A) -> Id A (pi1 A (toDiag A x)) x = undefined
-
--- toDiagK2 (A : U) : (x : diag A) -> Id (diag A) (toDiag A (pi2 A x)) x = undefined
--- pi2K (A : U) : (x : A) -> Id A (pi2 A (toDiag A x)) x = undefined
-
--- elimIso (A : U) (P : (B : U) -> (A -> B) -> (B -> A) -> U)
--- (p : P A (idfun A) (idfun 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) : P B f g = undefined
-
-lem (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)
- (C : U) (d e : C -> A)
- (p : Id (C -> B) (\(x : C) -> f (d x)) (\(x : C) -> f (e x)))
- : Id (C -> A) d e = undefined
-
-uaFunExt (A B : U) (f g : A -> B) (p : (x : A) -> Id B (f x) (g x)) :
- Id (A -> B) f g = suff
- where
- d (a : A) : diag B = ((f a,f a),refl B (f a))
- e (a : A) : diag B = ((f a,g a),p a)
-
- -- By eta it suffices to prove:
- suff : Id (A -> B) (\(x : A) -> pi2 B (d x)) (\(x : A) -> pi2 B (e x)) =
- subst (A -> diag B)
- (\(f : A -> diag B) -> Id (A -> B) (\(x : A) -> pi2 B (d x)) (\(x : A) -> pi2 B (f x)))
- d e eq_de (<i> \(x : A) -> pi2 B (d x))
- where
- -- This is the key fact:
- eq_de : Id (A -> diag B) d e =
- lem (diag B) B (pi1 B) (toDiag B) (pi1K B) (toDiagK1 B) A d e (<i> \(x : A) -> f x)
-
-module funext where\r
+module uafunext1 where\r
\r
import prelude\r
\r