diff --git a/FiniteSets/_CoqProject b/FiniteSets/_CoqProject index 19f4b3b..e0a1976 100644 --- a/FiniteSets/_CoqProject +++ b/FiniteSets/_CoqProject @@ -16,7 +16,6 @@ kuratowski/properties.v kuratowski/length.v FSets.v interfaces/set_interface.v -implementations/lists.v subobjects/sub.v subobjects/k_finite.v subobjects/enumerated.v @@ -26,4 +25,5 @@ misc/dec_lem.v misc/ordered.v misc/projective.v misc/dec_kuratowski.v -misc/dec_fset.v \ No newline at end of file +misc/dec_fset.v +implementations/lists.v \ No newline at end of file diff --git a/FiniteSets/implementations/lists.v b/FiniteSets/implementations/lists.v index 304b90c..09ef949 100644 --- a/FiniteSets/implementations/lists.v +++ b/FiniteSets/implementations/lists.v @@ -1,6 +1,6 @@ (* Implementation of [FSet A] using lists *) Require Import HoTT HitTactics. -Require Import FSets set_interface. +Require Import FSets set_interface kuratowski.length prelude dec_fset. Section Operations. Context `{Univalence}. @@ -96,7 +96,7 @@ Section ListToSet. Proof. induction l ; simpl. - reflexivity. - - rewrite append_union, ?IHl. + - rewrite IHl, append_union. simpl. symmetry. rewrite nr, comm, <- assoc, idem. @@ -108,7 +108,7 @@ End ListToSet. Section lists_are_sets. Context `{Univalence}. - Instance lists_sets : sets list list_to_set. + Global Instance lists_sets : sets list list_to_set. Proof. split ; intros. - apply empty_empty. @@ -118,3 +118,126 @@ Section lists_are_sets. - apply member_isIn. Defined. End lists_are_sets. + +Section refinement_examples. + Context `{Univalence}. + Context {A : Type}. + + Definition list_all (ϕ : A -> hProp) : list A -> hProp + := refinement list list_to_set (all ϕ). + + Lemma list_all_set (ϕ : A -> hProp) (X : list A) + : list_all ϕ X = all ϕ (list_to_set A X). + Proof. + induction X ; try reflexivity. + Defined. + + Lemma list_all_intro (X : list A) (ϕ : A -> hProp) + : forall (HX : forall a, a ∈ X -> ϕ a), list_all ϕ X. + Proof. + rewrite list_all_set. + intros H1. + assert (forall (a : A), a ∈ (list_to_set A X) -> ϕ a) as H2. + { + intros a H3. + rewrite <- (member_isIn A a X) in H3. + apply (H1 a H3). + } + apply (all_intro _ _ H2). + Defined. + + Lemma list_all_elim (X : list A) (ϕ : A -> hProp) a + : list_all ϕ X -> (a ∈ X) -> ϕ a. + Proof. + rewrite list_all_set, (member_isIn A a X). + apply all_elim. + Defined. + + Definition list_exist (ϕ : A -> hProp) : list A -> hProp + := refinement list list_to_set (exist ϕ). + + Lemma list_exist_set (ϕ : A -> hProp) (X : list A) + : list_exist ϕ X = exist ϕ (list_to_set A X). + Proof. + induction X ; try reflexivity. + Defined. + + Lemma listexist_intro (X : list A) (ϕ : A -> hProp) a + : a ∈ X -> ϕ a -> list_exist ϕ X. + Proof. + rewrite list_exist_set, (member_isIn A a X). + apply exist_intro. + Defined. + + Lemma exist_elim (X : list A) (ϕ : A -> hProp) + : list_exist ϕ X -> hexists (fun a => a ∈ X * ϕ a). + Proof. + rewrite list_exist_set. + assert (hexists (fun a : A => a ∈ (list_to_set A X) * ϕ a) + -> hexists (fun a : A => a ∈ X * ϕ a)) + as H2. + { + intros H1. + strip_truncations. + destruct H1 as [a H1]. + rewrite <- (member_isIn A a X) in H1. + refine (tr(a;H1)). + } + intros H1. + apply (H2 (exist_elim _ _ H1)). + Defined. + + Context `{MerelyDecidablePaths A}. + + Global Instance dec_memb a (l : list A) : Decidable (a ∈ l). + Proof. + induction l as [ | a0 l] ; simpl. + - apply _. + - unfold Decidable. + destruct IHl as [t | p]. + * apply (inl(tr(inr t))). + * destruct (H0 a a0) as [t | p']. + ** left. + strip_truncations. + apply (tr(inl t)). + ** refine (inr(fun n => _)). + strip_truncations. + destruct n as [n1 | n2]. + *** apply (p' (tr n1)). + *** apply (p n2). + Defined. + + Global Instance dec_memb_list : hasMembership_decidable (list A) A. + Proof. + intros a l. + destruct (dec (a ∈ l)). + - apply true. + - apply false. + Defined. + + Lemma fset_list_memb a (l : list A) : a ∈_d (list_to_set A l) = a ∈_d l. + Proof. + unfold member_dec, dec_memb_list, fset_member_bool. + destruct (dec a ∈ (list_to_set A l)), (dec a ∈ l) ; try reflexivity. + - contradiction n. + rewrite <- (f_member _ list_to_set) in t. + apply t. + - contradiction n. + rewrite (f_member _ list_to_set) in t. + apply t. + Defined. + + Definition set_length : list A -> nat + := refinement list list_to_set length. + + Definition set_length_nil : set_length nil = 0 := idpath. + + Definition set_length_cons a l + : set_length (cons a l) = if (a ∈_d l) then set_length l else S(set_length l). + Proof. + unfold set_length, refinement. + simpl. + rewrite length_compute, fset_list_memb. + reflexivity. + Defined. +End refinement_examples. \ No newline at end of file diff --git a/FiniteSets/interfaces/set_interface.v b/FiniteSets/interfaces/set_interface.v index 9ce119f..bf8519e 100644 --- a/FiniteSets/interfaces/set_interface.v +++ b/FiniteSets/interfaces/set_interface.v @@ -357,7 +357,7 @@ Section refinement. Context `{sets T f} `{sets S g}. Theorem transfer - (A B : Type) + {A B : Type} `{IsHSet B} (h : T A -> B) (hresp : forall x y : T A, set_eq f x y -> h x = h y) @@ -370,8 +370,8 @@ Section refinement. apply (quotient_iso (g A) (class_of _ X)). Defined. - Definition refine - (A B : Type) + Definition refinement + {A B : Type} `{IsHSet B} (h : FSet A -> B) : T A -> B diff --git a/FiniteSets/misc/dec_fset.v b/FiniteSets/misc/dec_fset.v index b295230..4d608d7 100644 --- a/FiniteSets/misc/dec_fset.v +++ b/FiniteSets/misc/dec_fset.v @@ -223,9 +223,9 @@ Section pauli. destruct x ; rewrite ?union_isIn; solve_in_list. Defined. - Definition comm x y : hProp := BuildhProp(Pauli_mult x y = Pauli_mult y x). + Definition pauli_comm x y : hProp := BuildhProp(Pauli_mult x y = Pauli_mult y x). - Theorem Pauli_mult_comm : all (fun x => all (fun y => comm x y) Pauli_list) Pauli_list. + Theorem Pauli_mult_comm : all (fun x => all (fun y => pauli_comm x y) Pauli_list) Pauli_list. Proof. refine (from_squash (all _ _)). compute.