From 2ccece32253171ccc75f21f1d1c14ea554dadfb9 Mon Sep 17 00:00:00 2001 From: Niels Date: Wed, 2 Aug 2017 11:40:03 +0200 Subject: [PATCH] Splitted cons_repr --- FiniteSets/_CoqProject | 6 +- FiniteSets/fsets/extensionality.v | 194 ++++----- FiniteSets/fsets/isomorphism.v | 69 +++ FiniteSets/fsets/length.v | 40 ++ FiniteSets/fsets/operations_cons_repr.v | 19 + FiniteSets/fsets/properties_cons_repr.v | 75 ++++ FiniteSets/implementations/lists.v | 6 +- FiniteSets/representations/bad.v | 538 ++++++++++++------------ FiniteSets/representations/cons_repr.v | 415 +++++------------- FiniteSets/representations/definition.v | 317 +++++++------- 10 files changed, 840 insertions(+), 839 deletions(-) create mode 100644 FiniteSets/fsets/isomorphism.v create mode 100644 FiniteSets/fsets/length.v create mode 100644 FiniteSets/fsets/operations_cons_repr.v create mode 100644 FiniteSets/fsets/properties_cons_repr.v diff --git a/FiniteSets/_CoqProject b/FiniteSets/_CoqProject index aa0f7e5..aa99194 100644 --- a/FiniteSets/_CoqProject +++ b/FiniteSets/_CoqProject @@ -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 diff --git a/FiniteSets/fsets/extensionality.v b/FiniteSets/fsets/extensionality.v index 838afb9..d730474 100644 --- a/FiniteSets/fsets/extensionality.v +++ b/FiniteSets/fsets/extensionality.v @@ -4,108 +4,108 @@ 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 - : forall X Y : FSet A, subset X Y <~> U X Y = Y. -Proof. - intros X Y. - eapply equiv_iff_hprop_uncurried. - split. - - apply subset_union. - - intro HXY. - rewrite <- HXY. - apply subset_union_l. -Defined. - -Lemma subset_isIn (X Y : FSet A) : - (forall (a : A), isIn a X -> isIn a Y) - <~> (subset X Y). -Proof. - eapply equiv_iff_hprop_uncurried. - split. - - hinduction X ; - try (intros; repeat (apply path_forall; intro); apply equiv_hprop_allpath ; apply _). - + intros ; reflexivity. - + intros a f. - apply f. - apply tr ; reflexivity. - + intros X1 X2 H1 H2 f. - enough (subset X1 Y). - enough (subset X2 Y). - { split. apply X. apply X0. } - * apply H2. - intros a Ha. - apply f. - apply tr. - right. - apply Ha. - * apply H1. - intros a Ha. - apply f. - apply tr. - left. - apply Ha. - - hinduction X ; - try (intros; repeat (apply path_forall; intro); apply equiv_hprop_allpath ; apply _). - + intros. contradiction. - + intros b f a. - simple refine (Trunc_ind _ _) ; cbn. - intro p. - rewrite p^ in f. - apply f. - + intros X1 X2 IH1 IH2 [H1 H2] a. - simple refine (Trunc_ind _ _) ; cbn. - intros [C1 | C2]. - ++ apply (IH1 H1 a C1). - ++ apply (IH2 H2 a C2). -Defined. - -(** ** Extensionality 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. - { intros [H1 H2]. etransitivity. apply H1^. - rewrite comm. apply H2. } - intro; apply path_prod; apply set_path2. - all: intro; apply set_path2. -Defined. - -Lemma eq_subset (X Y : FSet A) : - X = Y <~> (subset Y X * subset X Y). -Proof. - transitivity ((U Y X = X) * (U X Y = Y)). - apply eq_subset'. - symmetry. - eapply equiv_functor_prod'; apply subset_union_equiv. -Defined. - -Theorem fset_ext (X Y : FSet A) : - X = Y <~> (forall (a : A), isIn a X = isIn a Y). -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)) _ _ _). - - apply equiv_iff_hprop_uncurried. + Lemma subset_union_equiv + : forall X Y : FSet A, subset X Y <~> U X Y = Y. + Proof. + intros X Y. + eapply equiv_iff_hprop_uncurried. split. - * intros [H1 H2 a]. - specialize (H1 a) ; specialize (H2 a). - apply path_iff_hprop. - apply H2. - apply H1. - * intros H1. - split ; intro a ; intro H2. + - apply subset_union. + - intro HXY. + rewrite <- HXY. + apply subset_union_l. + Defined. + + Lemma subset_isIn (X Y : FSet A) : + (forall (a : A), isIn a X -> isIn a Y) + <~> (subset X Y). + Proof. + eapply equiv_iff_hprop_uncurried. + split. + - hinduction X ; + try (intros; repeat (apply path_forall; intro); apply equiv_hprop_allpath ; apply _). + + intros ; reflexivity. + + intros a f. + apply f. + apply tr ; reflexivity. + + intros X1 X2 H1 H2 f. + enough (subset X1 Y). + enough (subset X2 Y). + { split. apply X. apply X0. } + * apply H2. + intros a Ha. + apply f. + apply tr. + right. + apply Ha. + * apply H1. + intros a Ha. + apply f. + apply tr. + left. + apply Ha. + - hinduction X ; + try (intros; repeat (apply path_forall; intro); apply equiv_hprop_allpath ; apply _). + + intros. contradiction. + + intros b f a. + simple refine (Trunc_ind _ _) ; cbn. + intro p. + rewrite p^ in f. + apply f. + + intros X1 X2 IH1 IH2 [H1 H2] a. + simple refine (Trunc_ind _ _) ; cbn. + intros [C1 | C2]. + ++ apply (IH1 H1 a C1). + ++ apply (IH2 H2 a C2). + Defined. + + (** ** Extensionality 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. + { intros [H1 H2]. etransitivity. apply H1^. + rewrite comm. apply H2. } + intro; apply path_prod; apply set_path2. + all: intro; apply set_path2. + Defined. + + Lemma eq_subset (X Y : FSet A) : + X = Y <~> (subset Y X * subset X Y). + Proof. + transitivity ((U Y X = X) * (U X Y = Y)). + apply eq_subset'. + symmetry. + eapply equiv_functor_prod'; apply subset_union_equiv. + Defined. + + Theorem fset_ext (X Y : FSet A) : + X = Y <~> (forall (a : A), isIn a X = isIn a Y). + 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)) _ _ _). + - apply equiv_iff_hprop_uncurried. + split. + * intros [H1 H2 a]. + specialize (H1 a) ; specialize (H2 a). + apply path_iff_hprop. + apply H2. + apply H1. + * intros H1. + split ; intro a ; intro H2. + rewrite (H1 a). apply H2. + rewrite <- (H1 a). apply H2. - - eapply equiv_functor_prod' ; - apply equiv_iff_hprop_uncurried ; - split ; apply subset_isIn. -Defined. + - eapply equiv_functor_prod' ; + apply equiv_iff_hprop_uncurried ; + split ; apply subset_isIn. + Defined. End ext. diff --git a/FiniteSets/fsets/isomorphism.v b/FiniteSets/fsets/isomorphism.v new file mode 100644 index 0000000..253b433 --- /dev/null +++ b/FiniteSets/fsets/isomorphism.v @@ -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. \ No newline at end of file diff --git a/FiniteSets/fsets/length.v b/FiniteSets/fsets/length.v new file mode 100644 index 0000000..c2aa64d --- /dev/null +++ b/FiniteSets/fsets/length.v @@ -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. \ No newline at end of file diff --git a/FiniteSets/fsets/operations_cons_repr.v b/FiniteSets/fsets/operations_cons_repr.v new file mode 100644 index 0000000..1ac1482 --- /dev/null +++ b/FiniteSets/fsets/operations_cons_repr.v @@ -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. \ No newline at end of file diff --git a/FiniteSets/fsets/properties_cons_repr.v b/FiniteSets/fsets/properties_cons_repr.v new file mode 100644 index 0000000..5efa948 --- /dev/null +++ b/FiniteSets/fsets/properties_cons_repr.v @@ -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. diff --git a/FiniteSets/implementations/lists.v b/FiniteSets/implementations/lists.v index cb96c89..2994b41 100644 --- a/FiniteSets/implementations/lists.v +++ b/FiniteSets/implementations/lists.v @@ -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. diff --git a/FiniteSets/representations/bad.v b/FiniteSets/representations/bad.v index e54c229..e0abc6c 100644 --- a/FiniteSets/representations/bad.v +++ b/FiniteSets/representations/bad.v @@ -4,188 +4,188 @@ Require Import HoTT. Require Import HitTactics. Module Export FSet. - -Section FSet. -Variable A : 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. - -Axiom assoc : forall (x y z : FSet ), - x ∪ (y ∪ z) = (x ∪ y) ∪ z. - -Axiom comm : forall (x y : FSet), - x ∪ y = y ∪ x. - -Axiom nl : forall (x : FSet), - ∅ ∪ x = x. - -Axiom nr : forall (x : FSet), - x ∪ ∅ = x. - -Axiom idem : forall (x : A), - {| x |} ∪ {|x|} = {|x|}. - -End FSet. - -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) - (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), - comm x y # - uP x y px py = uP y x py px). -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), - nr x # uP x E px eP = px). -Variable (idemP : forall (x : A), - idem x # uP (L x) (L x) (lP x) (lP x) = lP x). - -(* Induction principle *) -Fixpoint FSet_ind - (x : FSet A) - {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) - end) assocP commP nlP nrP idemP. - - -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), - 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)). - -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. - -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. - -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), - 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. - -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. - -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. - -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. - -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. -End FSet_recursion. + Section FSet. + Variable A : Type. -Instance FSet_recursion A : HitRecursion (FSet A) := { - indTy := _; recTy := _; - H_inductor := FSet_ind A; H_recursor := FSet_rec A }. + 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. + + Axiom assoc : forall (x y z : FSet ), + x ∪ (y ∪ z) = (x ∪ y) ∪ z. + + Axiom comm : forall (x y : FSet), + x ∪ y = y ∪ x. + + Axiom nl : forall (x : FSet), + ∅ ∪ x = x. + + Axiom nr : forall (x : FSet), + x ∪ ∅ = x. + + Axiom idem : forall (x : A), + {| x |} ∪ {|x|} = {|x|}. + + End FSet. + + 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) + (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), + comm x y # + uP x y px py = uP y x py px). + 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), + nr x # uP x E px eP = px). + Variable (idemP : forall (x : A), + idem x # uP (L x) (L x) (lP x) (lP x) = lP x). + + (* Induction principle *) + Fixpoint FSet_ind + (x : FSet A) + {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) + end) assocP commP nlP nrP idemP. + + + 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), + 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)). + + 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. + + 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. + + 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), + 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. + + 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. + + 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. + + 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. + + 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. + + End FSet_recursion. + + Instance FSet_recursion A : HitRecursion (FSet A) := { + indTy := _; recTy := _; + H_inductor := FSet_ind A; H_recursor := FSet_rec A }. End FSet. @@ -194,104 +194,104 @@ 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 := { - indTy := _; recTy := _; - H_inductor := S1_ind; H_recursor := S1_rec }. + 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. - eapply (@transport_paths_FlFr S1 S1 idmap idmap). - hott_simpl. -Defined. + Definition f (x : S1) : x = x. + Proof. + hrecursion x. + - exact loop. + - etransitivity. + eapply (@transport_paths_FlFr S1 S1 idmap idmap). + hott_simpl. + 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. - 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. + 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. -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. - rewrite S1_rec_beta_loop. - rewrite ap_compose. - rewrite S1_rec_beta_loop. - hrecursion y. - + symmetry. apply S1_rec_beta_loop. - + apply is1type_S1. -Qed. + 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. + rewrite S1_rec_beta_loop. + rewrite ap_compose. + rewrite S1_rec_beta_loop. + hrecursion y. + + symmetry. apply S1_rec_beta_loop. + + apply is1type_S1. + Qed. -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. + 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. -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'. - rewrite FSet_rec_beta_nr in H'. - simpl in H'. unfold S1op_nr in H'. - exact H'^. -- f_ap. -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'. + rewrite FSet_rec_beta_nr in H'. + simpl in H'. unfold S1op_nr in H'. + exact H'^. + - 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. - rewrite S1_encode_loopexp in H'. simpl in H'. symmetry in H'. - apply (pos_neq_zero H'). -- apply FSet_S_ap. - apply set_path2. -Qed. + 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 set_path2. + Qed. End set_sphere. diff --git a/FiniteSets/representations/cons_repr.v b/FiniteSets/representations/cons_repr.v index 87b592e..ec150e6 100644 --- a/FiniteSets/representations/cons_repr.v +++ b/FiniteSets/representations/cons_repr.v @@ -1,323 +1,116 @@ +(* 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 := - | Nil : FSetC - | Cns : A -> FSetC -> FSetC. + 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), - a ;; a ;; x = a ;; x. + Axiom dupl : forall (a: A) (x: FSetC), + a ;; a ;; x = a ;; x. -Axiom comm : forall (a b: A) (x: FSetC), - a ;; b ;; x = b ;; a ;; x. + Axiom comm : forall (a b: A) (x: FSetC), + a ;; b ;; x = b ;; a ;; x. -Axiom trunc : IsHSet FSetC. + Axiom trunc : IsHSet FSetC. + + End FSetC. + + Arguments Nil {_}. + Arguments Cns {_} _ _. + Arguments dupl {_} _ _. + Arguments comm {_} _ _ _. + + Infix ";;" := Cns (at level 8, right associativity). + Notation "∅" := Nil. + + 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), + 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), + 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 + (x : FSetC A) + {struct x} + : P x + := (match x return _ -> _ -> _ -> P x with + | Nil => fun _ => fun _ => fun _ => eP + | a ;; y => fun _ => fun _ => fun _ => cnsP a y (FSetC_ind y) + end) H duplP commP. + + + 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), + apD FSetC_ind (comm a b x) = commP a b x (FSetC_ind x). + + End FSetC_induction. + + 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)). + + (* 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), + ap FSetC_rec (dupl a x) = duplP a (FSetC_rec x). + 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), + ap FSetC_rec (comm a b x) = commP a b (FSetC_rec x). + Proof. + intros. + eapply (cancelL (transport_const (comm a b x) _)). + simple refine ((apD_const _ _)^ @ _). + apply FSetC_ind_beta_comm. + Defined. + + End FSetC_recursion. + + + Instance FSetC_recursion A : HitRecursion (FSetC A) := { + indTy := _; recTy := _; + H_inductor := FSetC_ind A; H_recursor := FSetC_rec A }. End FSetC. -Arguments Nil {_}. -Arguments Cns {_} _ _. -Arguments dupl {_} _ _. -Arguments comm {_} _ _ _. - Infix ";;" := Cns (at level 8, right associativity). -Notation "∅" := Nil. - -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), - 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), - 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 - (x : FSetC A) - {struct x} - : P x - := (match x return _ -> _ -> _ -> P x with - | Nil => fun _ => fun _ => fun _ => eP - | a ;; y => fun _ => fun _ => fun _ => cnsP a y (FSetC_ind y) - end) H duplP commP. - - -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), - apD FSetC_ind (comm a b x) = commP a b x (FSetC_ind x). - -End FSetC_induction. - -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)). - -(* 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), - 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. - -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. - -End FSetC_recursion. - - -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. - - - -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. +Notation "∅" := Nil. \ No newline at end of file diff --git a/FiniteSets/representations/definition.v b/FiniteSets/representations/definition.v index ea167b4..5c6848a 100644 --- a/FiniteSets/representations/definition.v +++ b/FiniteSets/representations/definition.v @@ -3,190 +3,189 @@ Require Import HoTT. Require Import HitTactics. Module Export FSet. - -Section FSet. -Variable A : Type. + Section FSet. + Variable A : Type. -Private Inductive FSet : Type := - | E : FSet - | L : A -> FSet - | U : FSet -> FSet -> FSet. + 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 ), - x ∪ (y ∪ z) = (x ∪ y) ∪ z. + Axiom assoc : forall (x y z : FSet ), + x ∪ (y ∪ z) = (x ∪ y) ∪ z. -Axiom comm : forall (x y : FSet), - x ∪ y = y ∪ x. + Axiom comm : forall (x y : FSet), + x ∪ y = y ∪ x. -Axiom nl : forall (x : FSet), - ∅ ∪ x = x. + Axiom nl : forall (x : FSet), + ∅ ∪ x = x. -Axiom nr : forall (x : FSet), - x ∪ ∅ = x. + Axiom nr : forall (x : FSet), + x ∪ ∅ = x. -Axiom idem : forall (x : A), - {| x |} ∪ {|x|} = {|x|}. + 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) - (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), - comm x y # - uP x y px py = uP y x py px). -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), - nr x # uP x E px eP = px). -Variable (idemP : forall (x : A), - idem x # uP (L x) (L x) (lP x) (lP x) = lP x). + 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), + comm x y # + uP x y px py = uP y x py px). + 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), + nr x # uP x E px eP = px). + Variable (idemP : forall (x : A), + idem x # uP (L x) (L x) (lP x) (lP x) = lP x). + + (* Induction principle *) + Fixpoint FSet_ind + (x : FSet A) + {struct x} + : P x + := (match x return _ -> _ -> _ -> _ -> _ -> _ -> P x with + | E => fun _ _ _ _ _ _ => eP + | L a => fun _ _ _ _ _ _ => lP a + | U y z => fun _ _ _ _ _ _ => uP y z (FSet_ind y) (FSet_ind z) + end) H assocP commP nlP nrP idemP. -(* Induction principle *) -Fixpoint FSet_ind - (x : FSet A) - {struct x} - : P x - := (match x return _ -> _ -> _ -> _ -> _ -> _ -> P x with - | E => fun _ _ _ _ _ _ => eP - | L a => fun _ _ _ _ _ _ => lP a - | 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), + 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), + apD FSet_ind (comm x y) = (commP x y (FSet_ind x) (FSet_ind y)). -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_nl : forall (x : FSet A), + apD FSet_ind (nl x) = (nlP x (FSet_ind x)). -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_nr : forall (x : FSet A), + apD FSet_ind (nr x) = (nrP x (FSet_ind x)). -Axiom FSet_ind_beta_nl : forall (x : FSet A), - apD FSet_ind (nl x) = (nlP 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_nr : forall (x : FSet A), - apD FSet_ind (nr x) = (nrP x (FSet_ind x)). + Section FSet_recursion. -Axiom FSet_ind_beta_idem : forall (x : A), apD FSet_ind (idem x) = idemP x. -End FSet_induction. + 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. -Section FSet_recursion. + 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. -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_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. -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_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. -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. + 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. -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. + 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. -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. + 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. + + End FSet_recursion. -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. - -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. - -End FSet_recursion. - -Instance FSet_recursion A : HitRecursion (FSet A) := { - indTy := _; recTy := _; - H_inductor := FSet_ind A; H_recursor := FSet_rec A }. + Instance FSet_recursion A : HitRecursion (FSet A) := { + indTy := _; recTy := _; + H_inductor := FSet_ind A; H_recursor := FSet_rec A }. End FSet.