Uses merely decidable equality, added length.

This commit is contained in:
Niels van der Weide 2017-09-21 14:12:51 +02:00
parent 0def5869cd
commit 39e2ce1c05
15 changed files with 193 additions and 106 deletions

View File

@ -13,6 +13,7 @@ list_representation/properties.v
list_representation/isomorphism.v
kuratowski/operations.v
kuratowski/properties.v
kuratowski/length.v
FSets.v
interfaces/set_interface.v
implementations/lists.v

View File

@ -1,6 +1,7 @@
(** Interface for lattices and join semilattices. *)
Require Import HoTT.
(** Some preliminary notions to define lattices. *)
Section binary_operation.
Definition operation (A : Type) := A -> A -> A.
@ -43,6 +44,7 @@ Arguments neutralityL {_} {_} {_} {_} _.
Arguments neutralityR {_} {_} {_} {_} _.
Arguments absorb {_} {_} {_} {_} _ _.
(** The operations in a lattice. *)
Section lattice_operations.
Variable (A : Type).
@ -60,6 +62,7 @@ Arguments max_L {_} {_} _.
Arguments min_L {_} {_} _.
Arguments empty {_}.
(** Join semilattices as a typeclass. They only have a join operator. *)
Section JoinSemiLattice.
Variable A : Type.
Context {max_L : maximum A} {empty_L : bottom A}.
@ -84,6 +87,7 @@ Hint Resolve idempotency : joinsemilattice_hints.
Hint Resolve neutralityL : joinsemilattice_hints.
Hint Resolve neutralityR : joinsemilattice_hints.
(** Lattices as a typeclass which have both a join and a meet. *)
Section Lattice.
Variable A : Type.
Context {max_L : maximum A} {min_L : minimum A} {empty_L : bottom A}.

View File

@ -1,6 +1,7 @@
(** Classes for set operations, so they can be overloaded. *)
Require Import HoTT.
(** The operations on sets for which we add names. *)
Section structure.
Variable (T A : Type).

View File

@ -2,6 +2,10 @@
Require Import HoTT HitTactics.
Require Import kuratowski.kuratowski_sets.
(** We prove extensionality via a chain of equivalences.
We end with proving that equality can be defined with the subset relation.
From that we can conclude that [FSet A] has decidable equality if [A] has.
*)
Section ext.
Context {A : Type}.
Context `{Univalence}.

View File

@ -1,4 +1,6 @@
(** Definitions of the Kuratowski-finite sets via a HIT *)
(** Definitions of the Kuratowski-finite sets via a HIT.
We do not need the computation rules in the development, so they are not present here.
*)
Require Import HoTT HitTactics.
Require Export set_names lattice_examples.

View File

@ -0,0 +1,26 @@
Require Import HoTT HitTactics.
Require Import kuratowski.operations kuratowski.properties kuratowski.kuratowski_sets.
Section Length.
Context {A : Type} `{DecidablePaths A} `{Univalence}.
Definition length : FSet A -> nat.
simple refine (FSet_cons_rec _ _ _ _ _ _).
- apply 0.
- intros a X n.
apply (if a _d X then n else (S n)).
- intros X a n.
simpl.
simplify_isIn_d.
destruct (dec (a X)) ; reflexivity.
- intros X a b n.
simpl.
simplify_isIn_d.
destruct (dec (a = b)) as [Hab | Hab].
+ rewrite Hab. simplify_isIn_d. reflexivity.
+ rewrite ?singleton_isIn_d_false; auto.
++ simpl.
destruct (a _d X), (b _d X) ; reflexivity.
++ intro p. contradiction (Hab p^).
Defined.
End Length.

View File

@ -1,6 +1,7 @@
(** Operations on the [FSet A] for an arbitrary [A] *)
Require Import HoTT HitTactics.
Require Import kuratowski_sets monad_interface extensionality.
Require Import HoTT HitTactics prelude.
Require Import kuratowski_sets monad_interface extensionality
list_representation.isomorphism list_representation.list_representation.
Section operations.
(** Monad operations. *)
@ -167,7 +168,7 @@ End operations.
Section operations_decidable.
Context {A : Type}.
Context {A_deceq : DecidablePaths A}.
Context `{MerelyDecidablePaths A}.
Context `{Univalence}.
Global Instance isIn_decidable (a : A) : forall (X : FSet A),
@ -175,12 +176,7 @@ Section operations_decidable.
Proof.
hinduction ; try (intros ; apply path_ishprop).
- apply _.
- intros b.
destruct (dec (a = b)) as [p | np].
* apply (inl (tr p)).
* refine (inr(fun p => _)).
strip_truncations.
contradiction.
- apply (m_dec_path _).
- apply _.
Defined.
@ -207,4 +203,35 @@ Section operations_decidable.
Global Instance fset_intersection : hasIntersection (FSet A)
:= fun X Y => {|X & (fun a => a _d Y)|}.
End operations_decidable.
End operations_decidable.
Section FSet_cons_rec.
Context `{A : Type}.
Variable (P : Type)
(Pset : IsHSet P)
(Pe : P)
(Pcons : A -> FSet A -> P -> P)
(Pdupl : forall X a p, Pcons a ({|a|} X) (Pcons a X p) = Pcons a X p)
(Pcomm : forall X a b p, Pcons a ({|b|} X) (Pcons b X p)
= Pcons b ({|a|} X) (Pcons a X p)).
Definition FSet_cons_rec (X : FSet A) : P.
Proof.
simple refine (FSetC_ind A (fun _ => P) _ Pe _ _ _ (FSet_to_FSetC X)) ; simpl.
- intros a Y p.
apply (Pcons a (FSetC_to_FSet Y) p).
- intros.
refine (transport_const _ _ @ _).
apply Pdupl.
- intros.
refine (transport_const _ _ @ _).
apply Pcomm.
Defined.
Definition FSet_cons_beta_empty : FSet_cons_rec = Pe := idpath.
Definition FSet_cons_beta_cons (a : A) (X : FSet A)
: FSet_cons_rec ({|a|} X) = Pcons a X (FSet_cons_rec X)
:= ap (fun z => Pcons a z _) (repr_iso_id_l _).
End FSet_cons_rec.

View File

@ -1,4 +1,4 @@
Require Import HoTT HitTactics.
Require Import HoTT HitTactics prelude.
Require Import kuratowski.extensionality kuratowski.operations kuratowski_sets.
Require Import lattice_interface lattice_examples monad_interface.
@ -251,7 +251,7 @@ End fset_join_semilattice.
(* Lemmas relating operations to the membership predicate *)
Section properties_membership_decidable.
Context {A : Type} `{DecidablePaths A} `{Univalence}.
Context {A : Type} `{MerelyDecidablePaths A} `{Univalence}.
Lemma ext : forall (S T : FSet A), (forall a, a _d S = a _d T) -> S = T.
Proof.
@ -267,17 +267,7 @@ Section properties_membership_decidable.
- apply path_iff_hprop ; intro ; contradiction.
Defined.
Lemma empty_isIn_d (a : A) :
a _d = false.
Proof.
reflexivity.
Defined.
Lemma singleton_isIn_d (a b : A) :
a {|b|} -> a = b.
Proof.
intros. strip_truncations. assumption.
Defined.
Definition empty_isIn_d (a : A) : a _d = false := idpath.
Lemma singleton_isIn_d_true (a b : A) (p : a = b) :
a _d {|b|} = true.
@ -329,6 +319,14 @@ Section properties_membership_decidable.
Proof.
apply comprehension_isIn_d.
Defined.
Lemma singleton_isIn_d `{DecidablePaths A} (a b : A) :
a {|b|} -> a = b.
Proof.
intros.
strip_truncations.
assumption.
Defined.
End properties_membership_decidable.
(* Some suporting tactics *)
@ -346,7 +344,7 @@ Ltac toBool :=
(** If `A` has decidable equality, then `FSet A` is a lattice *)
Section set_lattice.
Context {A : Type}.
Context {A_deceq : DecidablePaths A}.
Context `{MerelyDecidablePaths A}.
Context `{Univalence}.
Instance fset_max : maximum (FSet A).

View File

@ -1,16 +1,16 @@
(* The representations [FSet A] and [FSetC A] are isomorphic for every A *)
(** The representations [FSet A] and [FSetC A] are isomorphic for every A *)
Require Import HoTT HitTactics.
Require Import list_representation list_representation.operations
list_representation.properties.
Require Import kuratowski.kuratowski_sets.
Section Iso.
Context {A : Type} `{Univalence}.
Context {A : Type}.
Definition FSetC_to_FSet: FSetC A -> FSet A.
Proof.
hrecursion.
- apply E.
- apply .
- intros a x.
apply ({|a|} x).
- intros a X.
@ -23,8 +23,8 @@ Section Iso.
Proof.
hrecursion.
- apply .
- intro a. apply {|a|}.
- intros X Y. apply (X Y).
- apply (fun a => {|a|}).
- apply ().
- apply append_assoc.
- apply append_comm.
- apply append_nl.
@ -35,19 +35,20 @@ Section Iso.
Lemma append_union: forall (x y: FSetC A),
FSetC_to_FSet (x y) = (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. unfold union, fsetc_union in *.
refine (_ @ assoc _ _ _).
apply (ap ({|a|} ) (HR _)).
intros x y.
hrecursion x ; try (intros ; apply path_ishprop).
- intros.
apply (nl _)^.
- intros a x HR.
refine (ap ({|a|} ) HR @ 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).
hinduction ; try (intros ; apply path_ishprop).
- reflexivity.
- intro. apply nr.
- intro.
apply nr.
- intros x y p q.
refine (append_union _ _ @ _).
refine (ap ( _) p @ _).
@ -56,15 +57,16 @@ Section Iso.
Lemma repr_iso_id_r: forall (x: FSetC A), FSet_to_FSetC (FSetC_to_FSet x) = x.
Proof.
hinduction; try (intros; apply set_path2).
hinduction ; try (intros ; apply path_ishprop).
- reflexivity.
- intros a x HR. rewrite HR. reflexivity.
- intros a x HR.
refine (ap ({|a|} ) HR).
Defined.
Global Instance: IsEquiv FSet_to_FSetC.
Proof.
apply isequiv_biinv.
unfold BiInv. split.
split.
exists FSetC_to_FSet.
unfold Sect. apply repr_iso_id_l.
exists FSetC_to_FSet.
@ -82,12 +84,18 @@ Section Iso.
simple refine (@BuildEquiv (FSet A) (FSetC A) FSet_to_FSetC _ ).
Defined.
Theorem fset_fsetc : FSet A = FSetC A.
Theorem fset_fsetc `{Univalence} : FSet A = FSetC A.
Proof.
apply (equiv_path _ _)^-1.
exact repr_iso.
Defined.
Definition dupl' (a : A) (X : FSet A) : {|a|} {|a|} X = {|a|} X
:= assoc _ _ _ @ ap ( X) (idem a).
Definition comm' (a b : A) (X : FSet A) : {|a|} {|b|} X = {|b|} {|a|} X
:= assoc _ _ _ @ ap ( X) (comm _ _) @ (assoc _ _ _)^.
Theorem FSet_cons_ind (P : FSet A -> Type)
(Pset : forall (X : FSet A), IsHSet (P X))
(Pempt : P )
@ -95,28 +103,28 @@ Section Iso.
(Pdupl : forall (a : A) (X : FSet A) (px : P X),
transport P (dupl' a X) (Pcons a _ (Pcons a X px)) = Pcons a X px)
(Pcomm : forall (a b : A) (X : FSet A) (px : P X),
transport P (comm' a b X) (Pcons a _ (Pcons b X px)) = Pcons b _ (Pcons a X px)) :
forall X, P X.
transport P (comm' a b X) (Pcons a _ (Pcons b X px)) = Pcons b _ (Pcons a X px))
(X : FSet A)
: P X.
Proof.
intros X.
refine (transport P (repr_iso_id_l X) _).
simple refine (FSetC_ind A (fun Z => P (FSetC_to_FSet Z)) _ _ _ _ _ (FSet_to_FSetC X)); simpl.
simple refine (FSetC_ind A (fun Z => P (FSetC_to_FSet Z)) _ _ _ _ _ (FSet_to_FSetC X))
; simpl.
- apply Pempt.
- intros a Y HY. by apply Pcons.
- intros a Y HY.
apply (Pcons a _ HY).
- intros a Y PY.
refine (_ @ (Pdupl _ _ _)).
etransitivity.
{ apply (transport_compose _ FSetC_to_FSet (dupl a Y)). }
refine (transport_compose _ FSetC_to_FSet (dupl a Y) _ @ _).
refine (ap (fun z => transport P z _) _).
apply path_ishprop.
- intros a b Y PY. cbn.
refine (_ @ (Pcomm _ _ _ _)).
etransitivity.
{ apply (transport_compose _ FSetC_to_FSet (FSetC.comm a b Y)). }
- intros a b Y PY.
refine (transport_compose _ FSetC_to_FSet (comm_s a b Y) _ @ _ @ (Pcomm _ _ _ _)).
refine (ap (fun z => transport P z _) _).
apply path_ishprop.
Defined.
(*
Theorem FSet_cons_ind_beta_empty (P : FSet A -> Type)
(Pset : forall (X : FSet A), IsHSet (P X))
(Pempt : P )
@ -130,25 +138,31 @@ Section Iso.
by compute.
Defined.
(* TODO *)
(* Theorem FSet_cons_ind_beta_cons (P : FSet A -> Type) *)
(* (Pset : forall (X : FSet A), IsHSet (P X)) *)
(* (Pempt : P ∅) *)
(* (Pcons : forall (a : A) (X : FSet A), P X -> P ({|a|} X)) *)
(* (Pdupl : forall (a : A) (X : FSet A) (px : P X), *)
(* transport P (dupl' a X) (Pcons a _ (Pcons a X px)) = Pcons a X px) *)
(* (Pcomm : forall (a b : A) (X : FSet A) (px : P X), *)
(* transport P (comm' a b X) (Pcons a _ (Pcons b X px)) = Pcons b _ (Pcons a X px)) : *)
(* forall a X, FSet_cons_ind P Pset Pempt Pcons Pdupl Pcomm ({|a|} X) = Pcons a X (FSet_cons_ind P Pset Pempt Pcons Pdupl Pcomm X). *)
(* Proof. *)
(* Theorem FSet_cons_ind_beta_dupl (P : FSet A -> Type) *)
(* (Pset : forall (X : FSet A), IsHSet (P X)) *)
(* (Pempt : P ∅) *)
(* (Pcons : forall (a : A) (X : FSet A), P X -> P ({|a|} X)) *)
(* (Pdupl : forall (a : A) (X : FSet A) (px : P X), *)
(* transport P (dupl' a X) (Pcons a _ (Pcons a X px)) = Pcons a X px) *)
(* (Pcomm : forall (a b : A) (X : FSet A) (px : P X), *)
(* transport P (comm' a b X) (Pcons a _ (Pcons b X px)) = Pcons b _ (Pcons a X px)) : *)
(* forall a X, apD (FSet_cons_ind P Pset Pempt Pcons Pdupl Pcomm) (dupl' a X) = Pdupl a X (FSet_cons_ind P Pset Pempt Pcons Pdupl Pcomm X). *)
Theorem FSet_cons_ind_beta_cons (P : FSet A -> Type)
(Pset : forall (X : FSet A), IsHSet (P X))
(Pempt : P )
(Pcons : forall (a : A) (X : FSet A), P X -> P ({|a|} X))
(Pdupl : forall (a : A) (X : FSet A) (px : P X),
transport P (dupl' a X) (Pcons a _ (Pcons a X px)) = Pcons a X px)
(Pcomm : forall (a b : A) (X : FSet A) (px : P X),
transport P (comm' a b X) (Pcons a _ (Pcons b X px)) = Pcons b _ (Pcons a X px)) :
forall a X, FSet_cons_ind P Pset Pempt Pcons Pdupl Pcomm ({|a|} X)
= Pcons a X (FSet_cons_ind P Pset Pempt Pcons Pdupl Pcomm X).
Proof.
intros.
unfold FSet_cons_ind.
simpl.
rewrite ?transport_pp.
hinduction X ; try(intros ; apply path_ishprop) ; simpl.
- admit.
- intro b.
unfold FSet_cons_ind.
simpl.
admit.
- intros.
unfold FSet_cons_ind.
simpl.
rewrite X.
*)
End Iso.

View File

@ -18,7 +18,7 @@ Module Export FSetC.
Axiom dupl : forall (a : A) (x : FSetC A),
a ;; a ;; x = a ;; x.
Axiom comm : forall (a b : A) (x : FSetC A),
Axiom comm_s : forall (a b : A) (x : FSetC A),
a ;; b ;; x = b ;; a ;; x.
Axiom trunc : IsHSet (FSetC A).
@ -26,7 +26,7 @@ Module Export FSetC.
Arguments Cns {_} _ _.
Arguments dupl {_} _ _.
Arguments comm {_} _ _ _.
Arguments comm_s {_} _ _ _.
Infix ";;" := Cns (at level 8, right associativity).
@ -39,7 +39,7 @@ Module Export FSetC.
(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)
(commP : forall (a b: A) (x: FSetC A) (px: P x),
comm a b x # cnsP a (b;;x) (cnsP b x px) =
comm_s a b x # cnsP a (b;;x) (cnsP b x px) =
cnsP b (a;;x) (cnsP a x px)).
(* Induction principle *)

View File

@ -10,7 +10,7 @@ Section operations.
- apply y.
- apply Cns.
- apply dupl.
- apply comm.
- apply comm_s.
Defined.
Global Instance fsetc_singleton : forall A, hasSingleton (FSetC A) A := fun A a => a;;.

View File

@ -1,4 +1,5 @@
(** Properties of the operations on [FSetC A] *)
(** Properties of the operations on [FSetC A]. These are needed to prove that the
representations are isomorphic. *)
Require Import HoTT HitTactics.
Require Import list_representation list_representation.operations.
@ -10,7 +11,7 @@ Section properties.
Lemma append_nr : forall (x: FSetC A), x = x.
Proof.
hinduction; try (intros; apply set_path2).
hinduction; try (intros; apply path_ishprop).
- reflexivity.
- intros. apply (ap (fun y => a;;y) X).
Defined.
@ -20,8 +21,7 @@ Section properties.
Proof.
intros x y z.
hinduction x ; try (intros ; apply path_ishprop).
- cbn.
reflexivity.
- reflexivity.
- intros.
cbn.
f_ap.
@ -30,21 +30,21 @@ Section properties.
Lemma append_singleton: forall (a: A) (x: FSetC A),
a ;; x = x (a ;; ).
Proof.
intro a. hinduction; try (intros; apply set_path2).
intro a. hinduction; try (intros; apply path_ishprop).
- reflexivity.
- intros b x HR. refine (_ @ _).
+ apply comm.
+ apply (ap (fun y => b ;; y) HR).
- intros b x HR.
refine (comm_s _ _ _ @ ap (fun y => b ;; y) HR).
Defined.
Lemma append_comm {H: Funext}:
Lemma append_comm :
forall (x1 x2: FSetC A), x1 x2 = x2 x1.
Proof.
hinduction ; try (intros ; apply path_forall ; intro ; apply set_path2).
intros x1 x2.
hinduction x1 ; try (intros ; apply path_ishprop).
- intros.
apply (append_nr _)^.
- intros a x1 HR x2.
refine (ap (fun y => a;;y) (HR x2) @ _).
- intros a x HR.
refine (ap (fun y => a;;y) HR @ _).
refine (append_singleton _ _ @ _).
refine ((append_assoc _ _ _)^ @ _).
refine (ap (x2 ) (append_singleton _ _)^).

View File

@ -7,9 +7,8 @@ Section membership.
Definition dec_membership
(H1 : forall (a : A) (X : FSet A), Decidable(a X))
(a b : A)
: Decidable(merely(a = b))
:= H1 a {|b|}.
: MerelyDecidablePaths A
:= fun a b => H1 a {|b|}.
End membership.
Section intersection.
@ -19,8 +18,9 @@ Section intersection.
(int_member : forall (a : A) (X Y : FSet A),
a (int X Y) = BuildhProp(a X * a Y)).
Theorem dec_intersection (a b : A) : Decidable(merely(a = b)).
Theorem dec_intersection : MerelyDecidablePaths A.
Proof.
intros a b.
destruct (merely_choice (int {|a|} {|b|})) as [p | p].
- refine (inr(fun X => _)).
strip_truncations.
@ -42,24 +42,23 @@ Section subset.
Definition dec_subset
(H1 : forall (X Y : FSet A), Decidable(X Y))
(a b : A)
: Decidable(merely(a = b))
:= H1 {|a|} {|b|}.
: MerelyDecidablePaths A
:= fun a b => H1 {|a|} {|b|}.
End subset.
Section decidable_equality.
Context {A : Type} `{Univalence}.
Definition dec_decidable_equality (H1 : DecidablePaths(FSet A)) (a b : A)
: Decidable(merely(a = b)).
Definition dec_decidable_equality (H1 : DecidablePaths(FSet A))
: MerelyDecidablePaths A.
Proof.
destruct (H1 {|a|} {|b|}) as [p | p].
intros a b.
destruct (H1 {|a|} {|b|}) as [p | n].
- pose (transport (fun z => a z) p) as t.
apply (inl (t (tr idpath))).
- refine (inr (fun n => _)).
- refine (inr (fun p => _)).
strip_truncations.
pose (transport (fun z => {|a|} = {|z|}) n) as t.
apply (p (t idpath)).
apply (n (transport (fun z => {|z|} = {|b|}) p^ idpath)).
Defined.
End decidable_equality.

View File

@ -22,4 +22,17 @@ Proof.
apply (equiv_hprop_allpath _)^-1.
intros [x | nx] [y | ny] ; try f_ap ; try (apply Ttrunc) ; try contradiction.
- apply equiv_hprop_allpath. apply _.
Defined.
Class MerelyDecidablePaths A :=
m_dec_path : forall (a b : A), Decidable(Trunc (-1) (a = b)).
Global Instance DecidableToMerely A (H : DecidablePaths A) : MerelyDecidablePaths A.
Proof.
intros x y.
destruct (dec (x = y)).
- apply (inl(tr p)).
- refine (inr(fun p => _)).
strip_truncations.
apply (n p).
Defined.

View File

@ -254,15 +254,13 @@ Section fset_dec_enumerated.
forall (X : FSet A),
hexists (fun (ls : list A) => forall a, a X = listExt ls a).
Proof.
simple refine (FSet_cons_ind _ _ _ _ _ _); simpl.
simple refine (FSet_cons_ind _ _ _ _ _ _) ; try (intros ; apply path_ishprop).
- apply tr. exists nil. simpl. done.
- intros a X Hls.
strip_truncations. apply tr.
destruct Hls as [ls Hls].
exists (cons a ls). intros b. cbn.
apply (ap (fun z => _ z) (Hls b)).
- intros. apply path_ishprop.
- intros. apply path_ishprop.
Defined.
Definition Kf_enumerated : Kf A -> enumerated A.