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

Splitted cons_repr

This commit is contained in:
Niels 2017-08-02 11:40:03 +02:00
parent 5ee7053631
commit 2ccece3225
10 changed files with 840 additions and 839 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
FiniteSets/_CoqProject
View File

@ -4,14 +4,18 @@ lattice.v
disjunction.v
representations/bad.v
representations/definition.v
representations/cons_repr.v
fsets/operations_cons_repr.v
fsets/properties_cons_repr.v
fsets/isomorphism.v
fsets/operations.v
fsets/properties.v
fsets/operations_decidable.v
fsets/extensionality.v
fsets/properties_decidable.v
fsets/length.v
fsets/monad.v
FSets.v
representations/cons_repr.v
implementations/lists.v
variations/enumerated.v
#empty_set.v

36
FiniteSets/fsets/extensionality.v
View File

@ -4,12 +4,12 @@ From representations Require Import definition.
From fsets Require Import operations properties.
Section ext.
Context {A : Type}.
Context `{Univalence}.
Context {A : Type}.
Context `{Univalence}.
Lemma subset_union_equiv
Lemma subset_union_equiv
: forall X Y : FSet A, subset X Y <~> U X Y = Y.
Proof.
Proof.
intros X Y.
eapply equiv_iff_hprop_uncurried.
split.
@ -17,12 +17,12 @@ Proof.
- intro HXY.
rewrite <- HXY.
apply subset_union_l.
Defined.
Defined.
Lemma subset_isIn (X Y : FSet A) :
Lemma subset_isIn (X Y : FSet A) :
(forall (a : A), isIn a X -> isIn a Y)
<~> (subset X Y).
Proof.
Proof.
eapply equiv_iff_hprop_uncurried.
split.
- hinduction X ;
@ -60,12 +60,12 @@ Proof.
intros [C1 | C2].
++ apply (IH1 H1 a C1).
++ apply (IH2 H2 a C2).
Defined.
Defined.
(** ** Extensionality proof *)
(** ** Extensionality proof *)
Lemma eq_subset' (X Y : FSet A) : X = Y <~> (U Y X = X) * (U X Y = Y).
Proof.
Lemma eq_subset' (X Y : FSet A) : X = Y <~> (U Y X = X) * (U X Y = Y).
Proof.
unshelve eapply BuildEquiv.
{ intro H'. rewrite H'. split; apply union_idem. }
unshelve esplit.
@ -73,20 +73,20 @@ Proof.
rewrite comm. apply H2. }
intro; apply path_prod; apply set_path2.
all: intro; apply set_path2.
Defined.
Defined.
Lemma eq_subset (X Y : FSet A) :
Lemma eq_subset (X Y : FSet A) :
X = Y <~> (subset Y X * subset X Y).
Proof.
Proof.
transitivity ((U Y X = X) * (U X Y = Y)).
apply eq_subset'.
symmetry.
eapply equiv_functor_prod'; apply subset_union_equiv.
Defined.
Defined.
Theorem fset_ext (X Y : FSet A) :
Theorem fset_ext (X Y : FSet A) :
X = Y <~> (forall (a : A), isIn a X = isIn a Y).
Proof.
Proof.
refine (@equiv_compose' _ _ _ _ _) ; [ | apply eq_subset ].
refine (@equiv_compose' _ ((forall a, isIn a Y -> isIn a X)
*(forall a, isIn a X -> isIn a Y)) _ _ _).
@ -106,6 +106,6 @@ Proof.
- eapply equiv_functor_prod' ;
apply equiv_iff_hprop_uncurried ;
split ; apply subset_isIn.
Defined.
Defined.
End ext.

69
FiniteSets/fsets/isomorphism.v Normal file
View File

@ -0,0 +1,69 @@
(* The representations [FSet A] and [FSetC A] are isomorphic for every A *)
Require Import HoTT HitTactics.
From representations Require Import cons_repr definition.
From fsets Require Import operations_cons_repr properties_cons_repr.
Section Iso.
Context {A : Type}.
Context `{Univalence}.
Definition FSetC_to_FSet: FSetC A -> FSet A.
Proof.
hrecursion.
- apply E.
- intros a x. apply (U (L a) x).
- intros. cbn.
etransitivity. apply assoc.
apply (ap (fun y => U y x)).
apply idem.
- intros. cbn.
etransitivity. apply assoc.
etransitivity. refine (ap (fun y => U y x) _ ).
apply FSet.comm.
symmetry.
apply assoc.
Defined.
Definition FSet_to_FSetC: FSet A -> FSetC A :=
FSet_rec A (FSetC A) (FSetC.trunc A) Nil singleton append append_assoc
append_comm append_nl append_nr singleton_idem.
Lemma append_union: forall (x y: FSetC A),
FSetC_to_FSet (append x y) = U (FSetC_to_FSet x) (FSetC_to_FSet y).
Proof.
intros x.
hrecursion x; try (intros; apply path_forall; intro; apply set_path2).
- intros. symmetry. apply nl.
- intros a x HR y. rewrite HR. apply assoc.
Defined.
Lemma repr_iso_id_l: forall (x: FSet A), FSetC_to_FSet (FSet_to_FSetC x) = x.
Proof.
hinduction; try (intros; apply set_path2).
- reflexivity.
- intro. apply nr.
- intros x y p q. rewrite append_union, p, q. reflexivity.
Defined.
Lemma repr_iso_id_r: forall (x: FSetC A), FSet_to_FSetC (FSetC_to_FSet x) = x.
Proof.
hinduction; try (intros; apply set_path2).
- reflexivity.
- intros a x HR. rewrite HR. reflexivity.
Defined.
Theorem repr_iso: FSet A <~> FSetC A.
Proof.
simple refine (@BuildEquiv (FSet A) (FSetC A) FSet_to_FSetC _ ).
apply isequiv_biinv.
unfold BiInv. split.
exists FSetC_to_FSet.
unfold Sect. apply repr_iso_id_l.
exists FSetC_to_FSet.
unfold Sect. apply repr_iso_id_r.
Defined.
End Iso.

40
FiniteSets/fsets/length.v Normal file
View File

@ -0,0 +1,40 @@
(* The length function for finite sets *)
Require Import HoTT HitTactics.
From representations Require Import cons_repr definition.
From fsets Require Import operations_decidable isomorphism properties_decidable.
Section Length.
Context {A : Type}.
Context {A_deceq : DecidablePaths A}.
Context `{Univalence}.
Opaque isIn_b.
Definition length (x: FSetC A) : nat.
Proof.
simple refine (FSetC_ind A _ _ _ _ _ _ x ); simpl.
- exact 0.
- intros a y n.
pose (y' := FSetC_to_FSet y).
exact (if isIn_b a y' then n else (S n)).
- intros. rewrite transport_const. cbn.
simplify_isIn. simpl. reflexivity.
- intros. rewrite transport_const. cbn.
simplify_isIn.
destruct (dec (a = b)) as [Hab | Hab].
+ rewrite Hab. simplify_isIn. simpl. reflexivity.
+ rewrite ?L_isIn_b_false; auto. simpl.
destruct (isIn_b a (FSetC_to_FSet x0)), (isIn_b b (FSetC_to_FSet x0)) ; reflexivity.
intro p. contradiction (Hab p^).
Defined.
Definition length_FSet (x: FSet A) := length (FSet_to_FSetC x).
Lemma length_singleton: forall (a: A), length_FSet (L a) = 1.
Proof.
intro a.
cbn. reflexivity.
Defined.
End Length.

19
FiniteSets/fsets/operations_cons_repr.v Normal file
View File

@ -0,0 +1,19 @@
(* Operations on [FSetC A] *)
Require Import HoTT HitTactics.
Require Import representations.cons_repr.
Section operations.
Context {A : Type}.
Definition append (x y: FSetC A) : FSetC A.
hinduction x.
- apply y.
- apply Cns.
- apply dupl.
- apply comm.
Defined.
Definition singleton (a:A) : FSetC A := a;;∅.
End operations.

75
FiniteSets/fsets/properties_cons_repr.v Normal file
View File

@ -0,0 +1,75 @@
(* Properties of the operations on [FSetC A] *)
Require Import HoTT HitTactics.
Require Import representations.cons_repr.
From fsets Require Import operations_cons_repr.
Section properties.
Context {A : Type}.
Lemma append_nl:
forall (x: FSetC A), append ∅ x = x.
Proof.
intro. reflexivity.
Defined.
Lemma append_nr:
forall (x: FSetC A), append x ∅ = x.
Proof.
hinduction; try (intros; apply set_path2).
- reflexivity.
- intros. apply (ap (fun y => a ;; y) X).
Defined.
Lemma append_assoc {H: Funext}:
forall (x y z: FSetC A), append x (append y z) = append (append x y) z.
Proof.
intro x; hinduction x; try (intros; apply set_path2).
- reflexivity.
- intros a x HR y z.
specialize (HR y z).
apply (ap (fun y => a ;; y) HR).
- intros. apply path_forall.
intro. apply path_forall.
intro. apply set_path2.
- intros. apply path_forall.
intro. apply path_forall.
intro. apply set_path2.
Defined.
Lemma append_singleton: forall (a: A) (x: FSetC A),
a ;; x = append x (a ;; ∅).
Proof.
intro a. hinduction; try (intros; apply set_path2).
- reflexivity.
- intros b x HR. refine (_ @ _).
+ apply comm.
+ apply (ap (fun y => b ;; y) HR).
Defined.
Lemma append_comm {H: Funext}:
forall (x1 x2: FSetC A), append x1 x2 = append x2 x1.
Proof.
intro x1.
hinduction x1; try (intros; apply set_path2).
- intros. symmetry. apply append_nr.
- intros a x1 HR x2.
etransitivity.
apply (ap (fun y => a;;y) (HR x2)).
transitivity (append (append x2 x1) (a;;∅)).
+ apply append_singleton.
+ etransitivity.
* symmetry. apply append_assoc.
* simple refine (ap (fun y => append x2 y) (append_singleton _ _)^).
- intros. apply path_forall.
intro. apply set_path2.
- intros. apply path_forall.
intro. apply set_path2.
Defined.
Lemma singleton_idem: forall (a: A),
append (singleton a) (singleton a) = singleton a.
Proof.
unfold singleton. intro. cbn. apply dupl.
Defined.
End properties.

6
FiniteSets/implementations/lists.v
View File

@ -1,5 +1,7 @@
(* Implementation of [FSet A] using lists *)
Require Import HoTT HitTactics.
Require Import representations.cons_repr FSets.
From fsets Require Import operations_cons_repr isomorphism length.
Section Operations.
Variable A : Type.
@ -80,7 +82,7 @@ Section ListToSet.
Defined.
Lemma append_FSetCappend (l1 l2 : list A) :
list_to_setC (append l1 l2) = FSetC.append (list_to_setC l1) (list_to_setC l2).
list_to_setC (append l1 l2) = operations_cons_repr.append (list_to_setC l1) (list_to_setC l2).
Proof.
induction l1 ; simpl in *.
- reflexivity.
@ -117,7 +119,7 @@ Section ListToSet.
Defined.
Lemma length_sizeC (l : list A) :
cardinality l = cons_repr.length (list_to_setC l).
cardinality l = length (list_to_setC l).
Proof.
induction l.
- cbn.

332
FiniteSets/representations/bad.v
View File

@ -5,68 +5,68 @@ Require Import HoTT.
Require Import HitTactics.
Module Export FSet.
Section FSet.
Variable A : Type.
Section FSet.
Variable A : Type.
Private Inductive FSet : Type :=
Private Inductive FSet : Type :=
| E : FSet
| L : A -> FSet
| U : FSet -> FSet -> FSet.
Notation "{| x |}" := (L x).
Infix "∪" := U (at level 8, right associativity).
Notation "∅" := E.
Notation "{| x |}" := (L x).
Infix "∪" := U (at level 8, right associativity).
Notation "∅" := E.
Axiom assoc : forall (x y z : FSet ),
Axiom assoc : forall (x y z : FSet ),
x ∪ (y ∪ z) = (x ∪ y) ∪ z.
Axiom comm : forall (x y : FSet),
Axiom comm : forall (x y : FSet),
x ∪ y = y ∪ x.
Axiom nl : forall (x : FSet),
Axiom nl : forall (x : FSet),
∅ ∪ x = x.
Axiom nr : forall (x : FSet),
Axiom nr : forall (x : FSet),
x ∪ ∅ = x.
Axiom idem : forall (x : A),
Axiom idem : forall (x : A),
{| x |} ∪ {|x|} = {|x|}.
End FSet.
End FSet.
Arguments E {_}.
Arguments U {_} _ _.
Arguments L {_} _.
Arguments assoc {_} _ _ _.
Arguments comm {_} _ _.
Arguments nl {_} _.
Arguments nr {_} _.
Arguments idem {_} _.
Arguments E {_}.
Arguments U {_} _ _.
Arguments L {_} _.
Arguments assoc {_} _ _ _.
Arguments comm {_} _ _.
Arguments nl {_} _.
Arguments nr {_} _.
Arguments idem {_} _.
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 (assocP : forall (x y z : FSet A)
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 (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 (U x y) z (uP x y px py) pz)).
Variable (commP : forall (x y: FSet A) (px: P x) (py: P y),
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).
Variable (nlP : forall (x : FSet A) (px: P x),
Variable (nlP : forall (x : FSet A) (px: P x),
nl x # uP E x eP px = px).
Variable (nrP : forall (x : FSet A) (px: P x),
Variable (nrP : forall (x : FSet A) (px: P x),
nr x # uP x E px eP = px).
Variable (idemP : forall (x : A),
Variable (idemP : forall (x : A),
idem x # uP (L x) (L x) (lP x) (lP x) = lP x).
(* Induction principle *)
Fixpoint FSet_ind
(* Induction principle *)
Fixpoint FSet_ind
(x : FSet A)
{struct x}
: P x
@ -79,111 +79,111 @@ Fixpoint FSet_ind
end) assocP commP nlP nrP idemP.
Axiom FSet_ind_beta_assoc : forall (x y z : FSet A),
Axiom FSet_ind_beta_assoc : forall (x y z : FSet A),
apD FSet_ind (assoc x y z) =
(assocP x y z (FSet_ind x) (FSet_ind y) (FSet_ind z)).
Axiom FSet_ind_beta_comm : forall (x y : FSet A),
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)).
Axiom FSet_ind_beta_nl : forall (x : FSet A),
Axiom FSet_ind_beta_nl : forall (x : FSet A),
apD FSet_ind (nl x) = (nlP x (FSet_ind x)).
Axiom FSet_ind_beta_nr : forall (x : FSet A),
Axiom FSet_ind_beta_nr : forall (x : FSet A),
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.
Axiom FSet_ind_beta_idem : forall (x : A), apD FSet_ind (idem x) = idemP x.
End FSet_induction.
Section FSet_recursion.
Section FSet_recursion.
Variable A : Type.
Variable P : Type.
Variable e : P.
Variable l : A -> P.
Variable u : P -> P -> P.
Variable assocP : forall (x y z : P), u x (u y z) = u (u x y) z.
Variable commP : forall (x y : P), u x y = u y x.
Variable nlP : forall (x : P), u e x = x.
Variable nrP : forall (x : P), u x e = x.
Variable idemP : forall (x : A), u (l x) (l x) = l x.
Variable A : Type.
Variable P : Type.
Variable e : P.
Variable l : A -> P.
Variable u : P -> P -> P.
Variable assocP : forall (x y z : P), u x (u y z) = u (u x y) z.
Variable commP : forall (x y : P), u x y = u y x.
Variable nlP : forall (x : P), u e x = x.
Variable nrP : forall (x : P), u x e = x.
Variable idemP : forall (x : A), u (l x) (l x) = l x.
Definition FSet_rec : FSet A -> P.
Proof.
simple refine (FSet_ind A _ _ _ _ _ _ _ _ _) ; try (intros ; simple refine ((transport_const _ _) @ _)) ; cbn.
- apply e.
- apply l.
- intros x y ; apply u.
- apply assocP.
- apply commP.
- apply nlP.
- apply nrP.
- apply idemP.
Defined.
Definition FSet_rec : FSet A -> P.
Proof.
simple refine (FSet_ind A _ _ _ _ _ _ _ _ _) ; try (intros ; simple refine ((transport_const _ _) @ _)) ; cbn.
- apply e.
- apply l.
- intros x y ; apply u.
- apply assocP.
- apply commP.
- apply nlP.
- apply nrP.
- apply idemP.
Defined.
Definition FSet_rec_beta_assoc : forall (x y z : FSet A),
Definition FSet_rec_beta_assoc : forall (x y z : FSet A),
ap FSet_rec (assoc x y z)
=
assocP (FSet_rec x) (FSet_rec y) (FSet_rec z).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (assoc x y z) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_assoc.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (assoc x y z) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_assoc.
Defined.
Definition FSet_rec_beta_comm : forall (x y : FSet A),
Definition FSet_rec_beta_comm : forall (x y : FSet A),
ap FSet_rec (comm x y)
=
commP (FSet_rec x) (FSet_rec y).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (comm x y) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_comm.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (comm x y) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_comm.
Defined.
Definition FSet_rec_beta_nl : forall (x : FSet A),
Definition FSet_rec_beta_nl : forall (x : FSet A),
ap FSet_rec (nl x)
=
nlP (FSet_rec x).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nl x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nl.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nl x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nl.
Defined.
Definition FSet_rec_beta_nr : forall (x : FSet A),
Definition FSet_rec_beta_nr : forall (x : FSet A),
ap FSet_rec (nr x)
=
nrP (FSet_rec x).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nr x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nr.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nr x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nr.
Defined.
Definition FSet_rec_beta_idem : forall (a : A),
Definition FSet_rec_beta_idem : forall (a : A),
ap FSet_rec (idem a)
=
idemP a.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (idem a) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_idem.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (idem a) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_idem.
Defined.
End FSet_recursion.
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 }.
@ -194,50 +194,50 @@ Infix "∪" := U (at level 8, right associativity).
Notation "∅" := E.
Section set_sphere.
From HoTT.HIT Require Import Circle.
From HoTT Require Import UnivalenceAxiom.
Instance S1_recursion : HitRecursion S1 := {
From HoTT.HIT Require Import Circle.
From HoTT Require Import UnivalenceAxiom.
Instance S1_recursion : HitRecursion S1 := {
indTy := _; recTy := _;
H_inductor := S1_ind; H_recursor := S1_rec }.
Variable A : Type.
Variable A : Type.
Definition f (x : S1) : x = x.
Proof.
hrecursion x.
- exact loop.
- etransitivity.
Definition f (x : S1) : x = x.
Proof.
hrecursion x.
- exact loop.
- etransitivity.
eapply (@transport_paths_FlFr S1 S1 idmap idmap).
hott_simpl.
Defined.
Defined.
Definition S1op (x y : S1) : S1.
Proof.
hrecursion y.
- exact x. (* x + base = x *)
- apply f.
Defined.
Definition S1op (x y : S1) : S1.
Proof.
hrecursion y.
- exact x. (* x + base = x *)
- apply f.
Defined.
Lemma S1op_nr (x : S1) : S1op x base = x.
Proof. reflexivity. Defined.
Lemma S1op_nr (x : S1) : S1op x base = x.
Proof. reflexivity. Defined.
Lemma S1op_nl (x : S1) : S1op base x = x.
Proof.
hrecursion x.
- exact loop.
- etransitivity.
Lemma S1op_nl (x : S1) : S1op base x = x.
Proof.
hrecursion x.
- exact loop.
- etransitivity.
apply (@transport_paths_FlFr _ _ (fun x => S1op base x) idmap _ _ loop loop).
hott_simpl.
apply moveR_pM. apply moveR_pM. hott_simpl.
etransitivity. apply (ap_V (S1op base) loop).
f_ap. apply S1_rec_beta_loop.
Defined.
Defined.
Lemma S1op_assoc (x y z : S1) : S1op x (S1op y z) = S1op (S1op x y) z.
Proof.
hrecursion z.
- reflexivity.
- etransitivity.
Lemma S1op_assoc (x y z : S1) : S1op x (S1op y z) = S1op (S1op x y) z.
Proof.
hrecursion z.
- reflexivity.
- etransitivity.
apply (@transport_paths_FlFr _ _ (fun z => S1op x (S1op y z)) (S1op (S1op x y)) _ _ loop idpath).
hott_simpl.
apply moveR_Mp. hott_simpl.
@ -247,51 +247,51 @@ hrecursion z.
hrecursion y.
+ symmetry. apply S1_rec_beta_loop.
+ apply is1type_S1.
Qed.
Qed.
Lemma S1op_comm (x y : S1) : S1op x y = S1op y x.
Proof.
hrecursion x.
- apply S1op_nl.
- hrecursion y.
Lemma S1op_comm (x y : S1) : S1op x y = S1op y x.
Proof.
hrecursion x.
- apply S1op_nl.
- hrecursion y.
+ rewrite transport_paths_FlFr. hott_simpl.
rewrite S1_rec_beta_loop. reflexivity.
+ apply is1type_S1.
Defined.
Defined.
Definition FSet_to_S : FSet A -> S1.
Proof.
hrecursion.
- exact base.
- intro a. exact base.
- exact S1op.
- apply S1op_assoc.
- apply S1op_comm.
- apply S1op_nl.
- apply S1op_nr.
- simpl. reflexivity.
Defined.
Definition FSet_to_S : FSet A -> S1.
Proof.
hrecursion.
- exact base.
- intro a. exact base.
- exact S1op.
- apply S1op_assoc.
- apply S1op_comm.
- apply S1op_nl.
- apply S1op_nr.
- simpl. reflexivity.
Defined.
Lemma FSet_S_ap : (nl (@E A)) = (nr E) -> idpath = loop.
Proof.
intros H.
enough (ap FSet_to_S (nl E) = ap FSet_to_S (nr E)) as H'.
- rewrite FSet_rec_beta_nl in H'.
Lemma FSet_S_ap : (nl (@E A)) = (nr E) -> idpath = loop.
Proof.
intros H.
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'.
simpl in H'. unfold S1op_nr in H'.
exact H'^.
- f_ap.
Defined.
- f_ap.
Defined.
Lemma FSet_not_hset : IsHSet (FSet A) -> False.
Proof.
intros H.
enough (idpath = loop).
- assert (S1_encode _ idpath = S1_encode _ (loopexp loop (pos Int.one))) as H' by f_ap.
Lemma FSet_not_hset : IsHSet (FSet A) -> False.
Proof.
intros H.
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'.
apply (pos_neq_zero H').
- apply FSet_S_ap.
- apply FSet_S_ap.
apply set_path2.
Qed.
Qed.
End set_sphere.

335
FiniteSets/representations/cons_repr.v
View File

@ -1,52 +1,51 @@
(* Definition of Finite Sets as via cons lists *)
Require Import HoTT HitTactics.
Require Import representations.definition.
From fsets Require Import operations_decidable properties_decidable.
Module Export FSetC.
Section FSetC.
Variable A : Type.
Section FSetC.
Variable A : Type.
Private Inductive FSetC : Type :=
Private Inductive FSetC : Type :=
| Nil : FSetC
| Cns : A -> FSetC -> FSetC.
Infix ";;" := Cns (at level 8, right associativity).
Notation "∅" := Nil.
Infix ";;" := Cns (at level 8, right associativity).
Notation "∅" := Nil.
Axiom dupl : forall (a: A) (x: FSetC),
Axiom dupl : forall (a: A) (x: FSetC),
a ;; a ;; x = a ;; x.
Axiom comm : forall (a b: A) (x: FSetC),
Axiom comm : forall (a b: A) (x: FSetC),
a ;; b ;; x = b ;; a ;; x.
Axiom trunc : IsHSet FSetC.
Axiom trunc : IsHSet FSetC.
End FSetC.
End FSetC.
Arguments Nil {_}.
Arguments Cns {_} _ _.
Arguments dupl {_} _ _.
Arguments comm {_} _ _ _.
Arguments Nil {_}.
Arguments Cns {_} _ _.
Arguments dupl {_} _ _.
Arguments comm {_} _ _ _.
Infix ";;" := Cns (at level 8, right associativity).
Notation "∅" := Nil.
Infix ";;" := Cns (at level 8, right associativity).
Notation "∅" := Nil.
Section FSetC_induction.
Section FSetC_induction.
Variable A: Type.
Variable (P : FSetC A -> Type).
Variable (H : forall x : FSetC A, IsHSet (P x)).
Variable (eP : P ∅).
Variable (cnsP : forall (a:A) (x: FSetC A), P x -> P (a ;; x)).
Variable (duplP : forall (a: A) (x: FSetC A) (px : P x),
Variable A: Type.
Variable (P : FSetC A -> Type).
Variable (H : forall x : FSetC A, IsHSet (P x)).
Variable (eP : P ∅).
Variable (cnsP : forall (a:A) (x: FSetC A), P x -> P (a ;; x)).
Variable (duplP : forall (a: A) (x: FSetC A) (px : P x),
dupl a x # cnsP a (a;;x) (cnsP a x px) = cnsP a x px).
Variable (commP : forall (a b: A) (x: FSetC A) (px: P x),
Variable (commP : forall (a b: A) (x: FSetC A) (px: P x),
comm a b x # cnsP a (b;;x) (cnsP b x px) =
cnsP b (a;;x) (cnsP a x px)).
(* Induction principle *)
Fixpoint FSetC_ind
(* Induction principle *)
Fixpoint FSetC_ind
(x : FSetC A)
{struct x}
: P x
@ -56,268 +55,62 @@ Fixpoint FSetC_ind
end) H duplP commP.
Axiom FSetC_ind_beta_dupl : forall (a: A) (x : FSetC A),
Axiom FSetC_ind_beta_dupl : forall (a: A) (x : FSetC A),
apD FSetC_ind (dupl a x) = duplP a x (FSetC_ind x).
Axiom FSetC_ind_beta_comm : forall (a b: A) (x : FSetC A),
Axiom FSetC_ind_beta_comm : forall (a b: A) (x : FSetC A),
apD FSetC_ind (comm a b x) = commP a b x (FSetC_ind x).
End FSetC_induction.
End FSetC_induction.
Section FSetC_recursion.
Section FSetC_recursion.
Variable A: Type.
Variable (P: Type).
Variable (H: IsHSet P).
Variable (nil : P).
Variable (cns : A -> P -> P).
Variable (duplP : forall (a: A) (x: P), cns a (cns a x) = (cns a x)).
Variable (commP : forall (a b: A) (x: P), cns a (cns b x) = cns b (cns a x)).
Variable A: Type.
Variable (P: Type).
Variable (H: IsHSet P).
Variable (nil : P).
Variable (cns : A -> P -> P).
Variable (duplP : forall (a: A) (x: P), cns a (cns a x) = (cns a x)).
Variable (commP : forall (a b: A) (x: P), cns a (cns b x) = cns b (cns a x)).
(* Recursion principle *)
Definition FSetC_rec : FSetC A -> P.
Proof.
simple refine (FSetC_ind _ _ _ _ _ _ _ );
try (intros; simple refine ((transport_const _ _) @ _ )); cbn.
- apply nil.
- apply (fun a => fun _ => cns a).
- apply duplP.
- apply commP.
Defined.
(* Recursion principle *)
Definition FSetC_rec : FSetC A -> P.
Proof.
simple refine (FSetC_ind _ _ _ _ _ _ _ );
try (intros; simple refine ((transport_const _ _) @ _ )); cbn.
- apply nil.
- apply (fun a => fun _ => cns a).
- apply duplP.
- apply commP.
Defined.
Definition FSetC_rec_beta_dupl : forall (a: A) (x : FSetC A),
Definition FSetC_rec_beta_dupl : forall (a: A) (x : FSetC A),
ap FSetC_rec (dupl a x) = duplP a (FSetC_rec x).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (dupl a x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSetC_ind_beta_dupl.
Defined.
Proof.
intros.
eapply (cancelL (transport_const (dupl a x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSetC_ind_beta_dupl.
Defined.
Definition FSetC_rec_beta_comm : forall (a b: A) (x : FSetC A),
Definition FSetC_rec_beta_comm : forall (a b: A) (x : FSetC A),
ap FSetC_rec (comm a b x) = commP a b (FSetC_rec x).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (comm a b x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSetC_ind_beta_comm.
Defined.
Proof.
intros.
eapply (cancelL (transport_const (comm a b x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSetC_ind_beta_comm.
Defined.
End FSetC_recursion.
End FSetC_recursion.
Instance FSetC_recursion A : HitRecursion (FSetC A) := {
Instance FSetC_recursion A : HitRecursion (FSetC A) := {
indTy := _; recTy := _;
H_inductor := FSetC_ind A; H_recursor := FSetC_rec A }.
Section Append.
Context {A : Type}.
Context {A_deceq : DecidablePaths A}.
Definition append (x y: FSetC A) : FSetC A.
hinduction x.
- apply y.
- apply Cns.
- apply dupl.
- apply comm.
Defined.
Lemma append_nl:
forall (x: FSetC A), append ∅ x = x.
Proof.
intro. reflexivity.
Defined.
Lemma append_nr:
forall (x: FSetC A), append x ∅ = x.
Proof.
hinduction; try (intros; apply set_path2).
- reflexivity.
- intros. apply (ap (fun y => a ;; y) X).
Defined.
Lemma append_assoc {H: Funext}:
forall (x y z: FSetC A), append x (append y z) = append (append x y) z.
Proof.
intro x; hinduction x; try (intros; apply set_path2).
- reflexivity.
- intros a x HR y z.
specialize (HR y z).
apply (ap (fun y => a ;; y) HR).
- intros. apply path_forall.
intro. apply path_forall.
intro. apply set_path2.
- intros. apply path_forall.
intro. apply path_forall.
intro. apply set_path2.
Defined.
Lemma aux: forall (a: A) (x: FSetC A),
a ;; x = append x (a ;; ∅).
Proof.
intro a. hinduction; try (intros; apply set_path2).
- reflexivity.
- intros b x HR. refine (_ @ _).
+ apply comm.
+ apply (ap (fun y => b ;; y) HR).
Defined.
Lemma append_comm {H: Funext}:
forall (x1 x2: FSetC A), append x1 x2 = append x2 x1.
Proof.
intro x1.
hinduction x1; try (intros; apply set_path2).
- intros. symmetry. apply append_nr.
- intros a x1 HR x2.
etransitivity.
apply (ap (fun y => a;;y) (HR x2)).
transitivity (append (append x2 x1) (a;;∅)).
+ apply aux.
+ etransitivity.
* symmetry. apply append_assoc.
* simple refine (ap (fun y => append x2 y) (aux _ _)^).
- intros. apply path_forall.
intro. apply set_path2.
- intros. apply path_forall.
intro. apply set_path2.
Defined.
End Append.
Section Singleton.
Context {A : Type}.
Context {A_deceq : DecidablePaths A}.
Definition singleton (a:A) : FSetC A := a;;∅.
Lemma singleton_idem: forall (a: A),
append (singleton a) (singleton a) = singleton a.
Proof.
unfold singleton. intro. cbn. apply dupl.
Defined.
End Singleton.
End FSetC.
Infix ";;" := Cns (at level 8, right associativity).
Notation "∅" := Nil.
End FSetC.
Section Iso.
Context {A : Type}.
Context {A_deceq : DecidablePaths A}.
Context {H : Funext}.
Definition FSetC_to_FSet: FSetC A -> FSet A.
Proof.
hrecursion.
- apply E.
- intros a x. apply (U (L a) x).
- intros. cbn.
etransitivity. apply assoc.
apply (ap (fun y => U y x)).
apply idem.
- intros. cbn.
etransitivity. apply assoc.
etransitivity. refine (ap (fun y => U y x) _ ).
apply FSet.comm.
symmetry.
apply assoc.
Defined.
Definition FSet_to_FSetC: FSet A -> FSetC A :=
FSet_rec A (FSetC A) (trunc A) ∅ singleton append append_assoc
append_comm append_nl append_nr singleton_idem.
Lemma append_union: forall (x y: FSetC A),
FSetC_to_FSet (append x y) = U (FSetC_to_FSet x) (FSetC_to_FSet y).
Proof.
intros x.
hrecursion x; try (intros; apply path_forall; intro; apply set_path2).
- intros. symmetry. apply nl.
- intros a x HR y. rewrite HR. apply assoc.
Defined.
Lemma repr_iso_id_l: forall (x: FSet A), FSetC_to_FSet (FSet_to_FSetC x) = x.
Proof.
hinduction; try (intros; apply set_path2).
- reflexivity.
- intro. apply nr.
- intros x y p q. rewrite append_union, p, q. reflexivity.
Defined.
Lemma repr_iso_id_r: forall (x: FSetC A), FSet_to_FSetC (FSetC_to_FSet x) = x.
Proof.
hinduction; try (intros; apply set_path2).
- reflexivity.
- intros a x HR. rewrite HR. reflexivity.
Defined.
Theorem repr_iso: FSet A <~> FSetC A.
Proof.
simple refine (@BuildEquiv (FSet A) (FSetC A) FSet_to_FSetC _ ).
apply isequiv_biinv.
unfold BiInv. split.
exists FSetC_to_FSet.
unfold Sect. apply repr_iso_id_l.
exists FSetC_to_FSet.
unfold Sect. apply repr_iso_id_r.
Defined.
End Iso.
Section Length.
Context {A : Type}.
Context {A_deceq : DecidablePaths A}.
Context `{Univalence}.
Opaque isIn_b.
Definition length (x: FSetC A) : nat.
Proof.
simple refine (FSetC_ind A _ _ _ _ _ _ x ); simpl.
- exact 0.
- intros a y n.
pose (y' := FSetC_to_FSet y).
exact (if isIn_b a y' then n else (S n)).
- intros. rewrite transport_const. cbn.
simplify_isIn. simpl. reflexivity.
- intros. rewrite transport_const. cbn.
simplify_isIn.
destruct (dec (a = b)) as [Hab | Hab].
+ rewrite Hab. simplify_isIn. simpl. reflexivity.
+ rewrite ?L_isIn_b_false; auto. simpl.
destruct (isIn_b a (FSetC_to_FSet x0)), (isIn_b b (FSetC_to_FSet x0)) ; reflexivity.
intro p. contradiction (Hab p^).
Defined.
Definition length_FSet (x: FSet A) := length (FSet_to_FSetC x).
Lemma length_singleton: forall (a: A), length_FSet (L a) = 1.
Proof.
intro a.
cbn. reflexivity.
Defined.
End Length.

217
FiniteSets/representations/definition.v
View File

@ -3,72 +3,71 @@ Require Import HoTT.
Require Import HitTactics.
Module Export FSet.
Section FSet.
Variable A : Type.
Section FSet.
Variable A : Type.
Private Inductive FSet : Type :=
Private Inductive FSet : Type :=
| E : FSet
| L : A -> FSet
| U : FSet -> FSet -> FSet.
Notation "{| x |}" := (L x).
Infix "∪" := U (at level 8, right associativity).
Notation "∅" := E.
Notation "{| x |}" := (L x).
Infix "∪" := U (at level 8, right associativity).
Notation "∅" := E.
Axiom assoc : forall (x y z : FSet ),
Axiom assoc : forall (x y z : FSet ),
x ∪ (y ∪ z) = (x ∪ y) ∪ z.
Axiom comm : forall (x y : FSet),
Axiom comm : forall (x y : FSet),
x ∪ y = y ∪ x.
Axiom nl : forall (x : FSet),
Axiom nl : forall (x : FSet),
∅ ∪ x = x.
Axiom nr : forall (x : FSet),
Axiom nr : forall (x : FSet),
x ∪ ∅ = x.
Axiom idem : forall (x : A),
Axiom idem : forall (x : A),
{| x |} ∪ {|x|} = {|x|}.
Axiom trunc : IsHSet FSet.
Axiom trunc : IsHSet FSet.
End FSet.
End FSet.
Arguments E {_}.
Arguments U {_} _ _.
Arguments L {_} _.
Arguments assoc {_} _ _ _.
Arguments comm {_} _ _.
Arguments nl {_} _.
Arguments nr {_} _.
Arguments idem {_} _.
Arguments E {_}.
Arguments U {_} _ _.
Arguments L {_} _.
Arguments assoc {_} _ _ _.
Arguments comm {_} _ _.
Arguments nl {_} _.
Arguments nr {_} _.
Arguments idem {_} _.
Section FSet_induction.
Variable A: Type.
Variable (P : FSet A -> Type).
Variable (H : forall a : FSet A, IsHSet (P a)).
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 (assocP : forall (x y z : FSet A)
Section FSet_induction.
Variable A: Type.
Variable (P : FSet A -> Type).
Variable (H : forall a : FSet A, IsHSet (P a)).
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 (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 (U x y) z (uP x y px py) pz)).
Variable (commP : forall (x y: FSet A) (px: P x) (py: P y),
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).
Variable (nlP : forall (x : FSet A) (px: P x),
Variable (nlP : forall (x : FSet A) (px: P x),
nl x # uP E x eP px = px).
Variable (nrP : forall (x : FSet A) (px: P x),
Variable (nrP : forall (x : FSet A) (px: P x),
nr x # uP x E px eP = px).
Variable (idemP : forall (x : A),
Variable (idemP : forall (x : A),
idem x # uP (L x) (L x) (lP x) (lP x) = lP x).
(* Induction principle *)
Fixpoint FSet_ind
(* Induction principle *)
Fixpoint FSet_ind
(x : FSet A)
{struct x}
: P x
@ -78,113 +77,113 @@ Fixpoint FSet_ind
| U y z => fun _ _ _ _ _ _ => uP y z (FSet_ind y) (FSet_ind z)
end) H assocP commP nlP nrP idemP.
Axiom FSet_ind_beta_assoc : forall (x y z : FSet A),
Axiom FSet_ind_beta_assoc : forall (x y z : FSet A),
apD FSet_ind (assoc x y z) =
(assocP x y z (FSet_ind x) (FSet_ind y) (FSet_ind z)).
Axiom FSet_ind_beta_comm : forall (x y : FSet A),
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)).
Axiom FSet_ind_beta_nl : forall (x : FSet A),
Axiom FSet_ind_beta_nl : forall (x : FSet A),
apD FSet_ind (nl x) = (nlP x (FSet_ind x)).
Axiom FSet_ind_beta_nr : forall (x : FSet A),
Axiom FSet_ind_beta_nr : forall (x : FSet A),
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.
Axiom FSet_ind_beta_idem : forall (x : A), apD FSet_ind (idem x) = idemP x.
End FSet_induction.
Section FSet_recursion.
Section FSet_recursion.
Variable A : Type.
Variable P : Type.
Variable H: IsHSet P.
Variable e : P.
Variable l : A -> P.
Variable u : P -> P -> P.
Variable assocP : forall (x y z : P), u x (u y z) = u (u x y) z.
Variable commP : forall (x y : P), u x y = u y x.
Variable nlP : forall (x : P), u e x = x.
Variable nrP : forall (x : P), u x e = x.
Variable idemP : forall (x : A), u (l x) (l x) = l x.
Variable A : Type.
Variable P : Type.
Variable H: IsHSet P.
Variable e : P.
Variable l : A -> P.
Variable u : P -> P -> P.
Variable assocP : forall (x y z : P), u x (u y z) = u (u x y) z.
Variable commP : forall (x y : P), u x y = u y x.
Variable nlP : forall (x : P), u e x = x.
Variable nrP : forall (x : P), u x e = x.
Variable idemP : forall (x : A), u (l x) (l x) = l x.
Definition FSet_rec : FSet A -> P.
Proof.
simple refine (FSet_ind A _ _ _ _ _ _ _ _ _ _) ; try (intros ; simple refine ((transport_const _ _) @ _)) ; cbn.
- apply e.
- apply l.
- intros x y ; apply u.
- apply assocP.
- apply commP.
- apply nlP.
- apply nrP.
- apply idemP.
Defined.
Definition FSet_rec : FSet A -> P.
Proof.
simple refine (FSet_ind A _ _ _ _ _ _ _ _ _ _)
; try (intros ; simple refine ((transport_const _ _) @ _)) ; cbn.
- apply e.
- apply l.
- intros x y ; apply u.
- apply assocP.
- apply commP.
- apply nlP.
- apply nrP.
- apply idemP.
Defined.
Definition FSet_rec_beta_assoc : forall (x y z : FSet A),
Definition FSet_rec_beta_assoc : forall (x y z : FSet A),
ap FSet_rec (assoc x y z)
=
assocP (FSet_rec x) (FSet_rec y) (FSet_rec z).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (assoc x y z) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_assoc.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (assoc x y z) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_assoc.
Defined.
Definition FSet_rec_beta_comm : forall (x y : FSet A),
Definition FSet_rec_beta_comm : forall (x y : FSet A),
ap FSet_rec (comm x y)
=
commP (FSet_rec x) (FSet_rec y).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (comm x y) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_comm.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (comm x y) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_comm.
Defined.
Definition FSet_rec_beta_nl : forall (x : FSet A),
Definition FSet_rec_beta_nl : forall (x : FSet A),
ap FSet_rec (nl x)
=
nlP (FSet_rec x).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nl x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nl.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nl x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nl.
Defined.
Definition FSet_rec_beta_nr : forall (x : FSet A),
Definition FSet_rec_beta_nr : forall (x : FSet A),
ap FSet_rec (nr x)
=
nrP (FSet_rec x).
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nr x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nr.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (nr x) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_nr.
Defined.
Definition FSet_rec_beta_idem : forall (a : A),
Definition FSet_rec_beta_idem : forall (a : A),
ap FSet_rec (idem a)
=
idemP a.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (idem a) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_idem.
Defined.
Proof.
intros.
unfold FSet_rec.
eapply (cancelL (transport_const (idem a) _)).
simple refine ((apD_const _ _)^ @ _).
apply FSet_ind_beta_idem.
Defined.
End FSet_recursion.
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 }.