dan
/
HITs-Examples
mirror of https://github.com/nmvdw/HITs-Examples
1
0
Fork 0
Code Issues Releases Wiki Activity

Some cleaning

This commit is contained in:
Niels 2017-08-07 16:22:55 +02:00
parent a0844f6be4
commit 1bab2206a3
2 changed files with 86 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

157
FiniteSets/fsets/properties.v
View File

@ -9,8 +9,7 @@ Section operations_isIn.
Lemma union_idem : forall x: FSet A, U x x = x.
Proof.
hinduction;
try (intros ; apply set_path2).
hinduction ; try (intros ; apply set_path2).
- apply nl.
- apply idem.
- intros x y P Q.
@ -21,7 +20,7 @@ Section operations_isIn.
rewrite (comm y x).
rewrite <- (assoc x y y).
f_ap.
Qed.
Defined.
(** ** Properties about subset relation. *)
Lemma subset_union (X Y : FSet A) :
@ -29,8 +28,8 @@ Section operations_isIn.
Proof.
hinduction X ; try (intros; apply path_forall; intro; apply set_path2).
- intros. apply nl.
- intros a. hinduction Y;
try (intros; apply path_forall; intro; apply set_path2).
- intros a.
hinduction Y ; try (intros; apply path_forall; intro; apply set_path2).
+ intro.
contradiction.
+ intro a0.
@ -57,24 +56,18 @@ Section operations_isIn.
Lemma subset_union_l (X : FSet A) :
forall Y, subset X (U X Y).
Proof.
hinduction X ;
try (repeat (intro; intros; apply path_forall); intro; apply equiv_hprop_allpath ; apply _).
hinduction X ; try (repeat (intro; intros; apply path_forall);
intro ; apply equiv_hprop_allpath ; apply _).
- apply (fun _ => tt).
- intros a Y.
apply tr ; left ; apply tr ; reflexivity.
apply (tr(inl(tr idpath))).
- intros X1 X2 HX1 HX2 Y.
split.
* rewrite <- assoc. apply HX1.
* rewrite (comm X1 X2). rewrite <- assoc. apply HX2.
Defined.
(* Union and membership *)
Lemma union_isIn (X Y : FSet A) (a : A) :
isIn a (U X Y) = isIn a X ∨ isIn a Y.
Proof.
reflexivity.
Defined.
(* simplify it using extensionality *)
Lemma comprehension_or : forall ϕ ψ (x: FSet A),
comprehension (fun a => orb (ϕ a) (ψ a)) x = U (comprehension ϕ x)
(comprehension ψ x).
@ -108,78 +101,12 @@ Section properties.
Context `{Univalence}.
(** isIn properties *)
Lemma singleton_isIn (a b: A) : isIn a (L b) -> Trunc (-1) (a = b).
Proof.
apply idmap.
Defined.
Definition empty_isIn (a: A) : isIn a E -> Empty := idmap.
Lemma empty_isIn (a: A) : isIn a E -> Empty.
Proof.
apply idmap.
Defined.
Definition singleton_isIn (a b: A) : isIn a (L b) -> Trunc (-1) (a = b) := idmap.
(** comprehension properties *)
Lemma comprehension_false Y : comprehension (fun (_ : A) => false) Y = E.
Proof.
hrecursion Y; try (intros; apply set_path2).
- reflexivity.
- reflexivity.
- intros x y IHa IHb.
rewrite IHa.
rewrite IHb.
apply union_idem.
Defined.
Lemma comprehension_subset : forall ϕ (X : FSet A),
U (comprehension ϕ X) X = X.
Proof.
intros ϕ.
hrecursion; try (intros ; apply set_path2) ; cbn.
- apply union_idem.
- intro a.
destruct (ϕ a).
* apply union_idem.
* apply nl.
- intros X Y P Q.
rewrite assoc.
rewrite <- (assoc (comprehension ϕ X) (comprehension ϕ Y) X).
rewrite (comm (comprehension ϕ Y) X).
rewrite assoc.
rewrite P.
rewrite <- assoc.
rewrite Q.
reflexivity.
Defined.
Lemma merely_choice : forall X : FSet A, hor (X = E) (hexists (fun a => isIn a X)).
Proof.
hinduction; try (intros; apply equiv_hprop_allpath ; apply _).
- apply (tr (inl idpath)).
- intro a.
refine (tr (inr (tr (a ; tr idpath)))).
- intros X Y TX TY.
strip_truncations.
destruct TX as [XE | HX] ; destruct TY as [YE | HY] ; try(strip_truncations ; apply tr).
* apply tr ; left.
rewrite XE, YE.
apply (union_idem E).
* right.
destruct HY as [a Ya].
apply tr.
exists a.
apply (tr (inr Ya)).
* right.
destruct HX as [a Xa].
apply tr.
exists a.
apply (tr (inl Xa)).
* right.
destruct HX as [a Xa].
destruct HY as [b Yb].
apply tr.
exists a.
apply (tr (inl Xa)).
Defined.
Definition union_isIn (X Y : FSet A) (a : A)
: isIn a (U X Y) = isIn a X ∨ isIn a Y := idpath.
Lemma comprehension_isIn (ϕ : A -> Bool) (a : A) : forall X : FSet A,
isIn a (comprehension ϕ X) = if ϕ a then isIn a X else False_hp.
@ -210,4 +137,64 @@ Section properties.
** intros ; apply tr ; right ; assumption.
Defined.
(* The proof can be simplified using extensionality *)
(** comprehension properties *)
Lemma comprehension_false Y : comprehension (fun (_ : A) => false) Y = E.
Proof.
hrecursion Y; try (intros; apply set_path2).
- reflexivity.
- reflexivity.
- intros x y IHa IHb.
rewrite IHa, IHb.
apply union_idem.
Defined.
(* Can be simplified using extensionality *)
Lemma comprehension_subset : forall ϕ (X : FSet A),
U (comprehension ϕ X) X = X.
Proof.
intros ϕ.
hrecursion; try (intros ; apply set_path2) ; cbn.
- apply union_idem.
- intro a.
destruct (ϕ a).
* apply union_idem.
* apply nl.
- intros X Y P Q.
rewrite assoc.
rewrite <- (assoc (comprehension ϕ X) (comprehension ϕ Y) X).
rewrite (comm (comprehension ϕ Y) X).
rewrite assoc.
rewrite P.
rewrite <- assoc.
rewrite Q.
reflexivity.
Defined.
Lemma merely_choice : forall X : FSet A, hor (X = E) (hexists (fun a => isIn a X)).
Proof.
hinduction; try (intros; apply equiv_hprop_allpath ; apply _).
- apply (tr (inl idpath)).
- intro a.
refine (tr (inr (tr (a ; tr idpath)))).
- intros X Y TX TY.
strip_truncations.
destruct TX as [XE | HX] ; destruct TY as [YE | HY] ; try(strip_truncations ; apply tr).
* refine (tr (inl _)).
rewrite XE, YE.
apply (union_idem E).
* destruct HY as [a Ya].
refine (inr (tr _)).
exists a.
apply (tr (inr Ya)).
* destruct HX as [a Xa].
refine (inr (tr _)).
exists a.
apply (tr (inl Xa)).
* destruct (HX, HY) as [[a Xa] [b Yb]].
refine (inr (tr _)).
exists a.
apply (tr (inl Xa)).
Defined.
End properties.

56
FiniteSets/representations/bad.v
View File

@ -42,19 +42,22 @@ Module Export FSet.
Arguments nl {_} _.
Arguments nr {_} _.
Arguments idem {_} _.
Notation "{| x |}" := (L x).
Infix "∪" := U (at level 8, right associativity).
Notation "∅" := E.
Section FSet_induction.
Variable A: Type.
Variable (P : FSet A -> Type).
Variable (eP : P E).
Variable (lP : forall a: A, P (L a)).
Variable (uP : forall (x y: FSet A), P x -> P y -> P (U x y)).
Variable (eP : P ∅).
Variable (lP : forall a: A, P {|a |}).
Variable (uP : forall (x y: FSet A), P x -> P y -> P (x ∪ y)).
Variable (assocP : forall (x y z : FSet A)
(px: P x) (py: P y) (pz: P z),
assoc x y z #
(uP x (U y z) px (uP y z py pz))
(uP x (y ∪ z) px (uP y z py pz))
=
(uP (U x y) z (uP x y px py) pz)).
(uP (x ∪ y) z (uP x y px py) pz)).
Variable (commP : forall (x y: FSet A) (px: P x) (py: P y),
comm x y #
uP x y px py = uP y x py px).
@ -71,11 +74,9 @@ Module Export FSet.
{struct x}
: P x
:= (match x return _ -> _ -> _ -> _ -> _ -> P x with
| E => fun _ => fun _ => fun _ => fun _ => fun _ => eP
| L a => fun _ => fun _ => fun _ => fun _ => fun _ => lP a
| U y z => fun _ => fun _ => fun _ => fun _ => fun _ => uP y z
(FSet_ind y)
(FSet_ind z)
| ∅ => fun _ _ _ _ _ => eP
| {|a|} => fun _ _ _ _ _ => lP a
| y ∪ z => fun _ _ _ _ _ => uP y z (FSet_ind y) (FSet_ind z)
end) assocP commP nlP nrP idemP.
@ -84,13 +85,13 @@ Module Export FSet.
(assocP x y z (FSet_ind x) (FSet_ind y) (FSet_ind z)).
Axiom FSet_ind_beta_comm : forall (x y : FSet A),
apD FSet_ind (comm x y) = (commP x y (FSet_ind x) (FSet_ind y)).
apD FSet_ind (comm x y) = commP x y (FSet_ind x) (FSet_ind y).
Axiom FSet_ind_beta_nl : forall (x : FSet A),
apD FSet_ind (nl x) = (nlP x (FSet_ind x)).
apD FSet_ind (nl x) = nlP x (FSet_ind x).
Axiom FSet_ind_beta_nr : forall (x : FSet A),
apD FSet_ind (nr x) = (nrP x (FSet_ind x)).
apD FSet_ind (nr x) = nrP x (FSet_ind x).
Axiom FSet_ind_beta_idem : forall (x : A), apD FSet_ind (idem x) = idemP x.
End FSet_induction.
@ -183,9 +184,11 @@ Module Export FSet.
End FSet_recursion.
Instance FSet_recursion A : HitRecursion (FSet A) := {
Instance FSet_recursion A : HitRecursion (FSet A) :=
{
indTy := _; recTy := _;
H_inductor := FSet_ind A; H_recursor := FSet_rec A }.
H_inductor := FSet_ind A; H_recursor := FSet_rec A
}.
End FSet.
@ -195,10 +198,12 @@ Notation "∅" := E.
Section set_sphere.
From HoTT.HIT Require Import Circle.
From HoTT Require Import UnivalenceAxiom.
Instance S1_recursion : HitRecursion S1 := {
Context `{Univalence}.
Instance S1_recursion : HitRecursion S1 :=
{
indTy := _; recTy := _;
H_inductor := S1_ind; H_recursor := S1_rec }.
H_inductor := S1_ind; H_recursor := S1_rec
}.
Variable A : Type.
@ -206,8 +211,7 @@ Section set_sphere.
Proof.
hrecursion x.
- exact loop.
- etransitivity.
eapply (@transport_paths_FlFr S1 S1 idmap idmap).
- refine (transport_paths_FlFr _ _ @ _).
hott_simpl.
Defined.
@ -225,11 +229,10 @@ Section set_sphere.
Proof.
hrecursion x.
- exact loop.
- etransitivity.
apply (@transport_paths_FlFr _ _ (fun x => S1op base x) idmap _ _ loop loop).
- refine (transport_paths_FlFr loop _ @ _).
hott_simpl.
apply moveR_pM. apply moveR_pM. hott_simpl.
etransitivity. apply (ap_V (S1op base) loop).
refine (ap_V _ _ @ _).
f_ap. apply S1_rec_beta_loop.
Defined.
@ -237,8 +240,7 @@ Section set_sphere.
Proof.
hrecursion z.
- reflexivity.
- etransitivity.
apply (@transport_paths_FlFr _ _ (fun z => S1op x (S1op y z)) (S1op (S1op x y)) _ _ loop idpath).
- refine (transport_paths_FlFr loop _ @ _).
hott_simpl.
apply moveR_Mp. hott_simpl.
rewrite S1_rec_beta_loop.
@ -274,7 +276,7 @@ Section set_sphere.
Lemma FSet_S_ap : (nl (@E A)) = (nr E) -> idpath = loop.
Proof.
intros H.
intros H1.
enough (ap FSet_to_S (nl E) = ap FSet_to_S (nr E)) as H'.
- rewrite FSet_rec_beta_nl in H'.
rewrite FSet_rec_beta_nr in H'.
@ -285,7 +287,7 @@ Section set_sphere.
Lemma FSet_not_hset : IsHSet (FSet A) -> False.
Proof.
intros H.
intros H1.
enough (idpath = loop).
- assert (S1_encode _ idpath = S1_encode _ (loopexp loop (pos Int.one))) as H' by f_ap.
rewrite S1_encode_loopexp in H'. simpl in H'. symmetry in H'.