From mathcomp
From mathcomp
(***********************************************************************)
(*               Experimental library of generic sets                  *)
(*               ====================================                  *)
(* Contains two structures:                                            *)
(*  semisetType == families of sets, without total set (e.g. {fset T}) *)
(*      setType == families of sets, with total set                    *)
(*                 (e.g. {set T} or {SAset R^n})                       *)
(***********************************************************************)
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Reserved Notation "x \subset y" (at level 70, y at next level).
Reserved Notation "x \contains y" (at level 70, y at next level, only parsing).
Reserved Notation "x \proper y" (at level 70, y at next level).
Reserved Notation "x \containsproper y" (at level 70, y at next level, only parsing).
Reserved Notation "x \subset y :> T" (at level 70, y at next level).
Reserved Notation "x \contains y :> T" (at level 70, y at next level, only parsing).
Reserved Notation "x \proper y :> T" (at level 70, y at next level).
Reserved Notation "x \containsproper y :> T" (at level 70, y at next level, only parsing).
Reserved Notation "\subsets y" (at level 35).
Reserved Notation "\supersets y" (at level 35).
Reserved Notation "\propersets y" (at level 35).
Reserved Notation "\superpropersets y" (at level 35).
Reserved Notation "\subsets y :> T" (at level 35, y at next level).
Reserved Notation "\supersets y :> T" (at level 35, y at next level).
Reserved Notation "\propersets y :> T" (at level 35, y at next level).
Reserved Notation "\superpropersets y :> T" (at level 35, y at next level).
Reserved Notation "x \subset y \subset z" (at level 70, y, z at next level).
Reserved Notation "x \proper y \subset z" (at level 70, y, z at next level).
Reserved Notation "x \subset y \proper z" (at level 70, y, z at next level).
Reserved Notation "x \proper y \proper z" (at level 70, y, z at next level).
Reserved Notation "x \subset y ?= 'iff' c" (at level 70, y, c at next level,
format "x '[hv'  \subset  y '/'  ?=  'iff'  c ']'").
Reserved Notation "x \subset y ?= 'iff' c :> T" (at level 70, y, c at next level,
format "x '[hv'  \subset  y '/'  ?=  'iff'  c  :> T ']'").
Reserved Notation "~: A" (at level 35, right associativity).
Reserved Notation "[ 'set' ~ a ]" (at level 0, format "[ 'set' ~  a ]").
Reserved Notation "[ 'set' a1 ; a2 ; .. ; an ]"
(at level 0, a1 at level 99, format "[ 'set'  a1 ;  a2 ;  .. ;  an ]").
Delimit Scope abstract_set_scope with set.
Local Open Scope abstract_set_scope.
Module SET.
Fact display_set : unit -> unit. Proof. exact. Qed.
Module Import SetSyntax.
Notation "\sub%set" := (@le (display_set _) _) : abstract_set_scope.
Notation "\super%set" := (@ge (display_set _) _) : abstract_set_scope.
Notation "\proper%set" := (@lt (display_set _) _) : abstract_set_scope.
Notation "\superproper%set" := (@gt (display_set _) _) : abstract_set_scope.
Notation "\sub?%set" := (@leif (display_set _) _) : abstract_set_scope.
Notation "\subsets y" := (\super%set y) : abstract_set_scope.
Notation "\subsets y :> T" := (\subsets (y : T)) : abstract_set_scope.
Notation "\supersets y"  := (\sub%set y) : abstract_set_scope.
Notation "\supersets y :> T" := (\supersets (y : T)) : abstract_set_scope.
Notation "\propersets y" := (\superproper%set y) : abstract_set_scope.
Notation "\propersets y :> T" := (\propersets (y : T)) : abstract_set_scope.
Notation "\superpropersets y" := (\proper%set y) : abstract_set_scope.
Notation "\superpropersets y :> T" := (\superpropersets (y : T)) : abstract_set_scope.
Notation "x \subset y" := (\sub%set x y) : abstract_set_scope.
Notation "x \subset y :> T" := ((x : T) \subset (y : T)) : abstract_set_scope.
Notation "x \proper y"  := (\proper%set x y) : abstract_set_scope.
Notation "x \proper y :> T" := ((x : T) \proper (y : T)) : abstract_set_scope.
Notation "x \subset y \subset z" := ((x \subset y)%set && (y \subset z)%set) : abstract_set_scope.
Notation "x \proper y \subset z" := ((x \proper y)%set && (y \subset z)%set) : abstract_set_scope.
Notation "x \subset y \proper z" := ((x \subset y)%set && (y \proper z)%set) : abstract_set_scope.
Notation "x \proper y \proper z" := ((x \proper y)%set && (y \proper z)%set) : abstract_set_scope.
Notation "x \subset y ?= 'iff' C" := (\sub?%set x y C) : abstract_set_scope.
Notation "x \subset y ?= 'iff' C :> R" := ((x : R) \subset (y : R) ?= iff C)
(only parsing) : abstract_set_scope.
Notation set0 := (@bottom (display_set _) _).
Notation setT := (@top (display_set _) _).
Notation setU := (@join (display_set _) _).
Notation setI := (@meet (display_set _) _).
Notation setD := (@sub (display_set _) _).
Notation setC := (@compl (display_set _) _).
Notation "x :&: y" := (setI x y).
Notation "x :|: y" := (setU x y).
Notation "x :\: y" := (setD x y).
Notation "~: x"    := (setC x).
Notation "x \subset y" := (\sub%set x y) : bool_scope.
Notation "x \proper y" := (\proper%set x y) : bool_scope.
End SetSyntax.
Ltac EqualityPack cT xclass xT :=
match type of Equality.Pack with
| forall sort : Type, Equality.mixin_of sort -> eqType =>
(* mathcomp.dev *)
exact (@Equality.Pack cT xclass)
| _ =>
(* mathcomp <= 1.7 *)
exact (@Equality.Pack cT xclass xT)
end.
Ltac ChoicePack cT xclass xT :=
match type of Choice.Pack with
| forall sort : Type, Choice.class_of sort -> choiceType =>
(* mathcomp.dev *)
exact (@Choice.Pack cT xclass)
| _ =>
(* mathcomp <= 1.7 *)
exact (@Choice.Pack cT xclass xT)
end.
Module Semiset.
Section ClassDef.
Variable elementType : Type. (* Universe type *)
Variable eqType_of_elementType : elementType -> eqType.
Coercion eqType_of_elementType : elementType >-> eqType.
Implicit Types (X Y : elementType).
Structure mixin_of d (set : elementType -> (cblatticeType (display_set d))) :=
Mixin {
memset : forall X, set X -> X -> bool;
set1 : forall X, X -> set X;
_ : forall X (x : X), ~~ memset set0 x; (* set0 is empty instead *)
_ : forall X (x y : X), memset (set1 y) x = (x == y);
_ : forall X (x : X) A, (set1 x \subset A) = (memset A x);
_ : forall X (A : set X), (set0 \proper A) -> {x | memset A x} ; (* exists or sig ?? *)
_ : forall X (A B : set X), {subset memset A <= memset B} -> A \subset B;
_ : forall X (x : X) A B, (memset (A :|: B) x) =
(memset A x) || (memset B x);
(* there is no closure in a set *)
funsort : elementType -> elementType -> Type;
fun_of_funsort : forall X Y, funsort X Y -> X -> Y;
imset : forall X Y, funsort X Y -> set X -> set Y;
_ : forall X Y (f : funsort X Y) (A : set X) (y : Y),
reflect (exists2 x : X, memset A x & y = fun_of_funsort f x)
(memset (imset f A) y)
}.
Record class_of d (set : elementType -> Type) := Class {
base  : forall X, @Order.CBLattice.class_of (display_set d) (set X);
mixin : mixin_of (fun X => Order.CBLattice.Pack (base X) (set X))
}.
Local Coercion base : class_of >-> Funclass.
Structure type d := Pack { sort ; _ : class_of d sort;
_ : elementType -> Type }.
Local Coercion sort : type >-> Funclass.
Variables (set : elementType -> Type) (disp : unit) (cT : type disp).
Definition class := let: Pack _ c _ as cT' := cT return class_of _ cT' in c.
Definition clone disp' c of (disp = disp') & phant_id class c :=
@Pack disp' set c set.
Let xset := let: Pack set _ _ := cT in set.
Notation xclass := (class : class_of _ xset).
Definition pack b0
(m0 : mixin_of
(fun X=> @Order.CBLattice.Pack (display_set disp) (set X) (b0 X) (set X))) :=
fun bT b &
(forall X, phant_id (@Order.CBLattice.class (display_set disp) (bT X)) (b X)) =>
fun    m & phant_id m0 m => Pack (@Class disp set b m) set.
End ClassDef.
Section CanonicalDef.
Variable elementType : Type.
Variable eqType_of_elementType : elementType -> eqType.
Coercion eqType_of_elementType : elementType >-> eqType.
Notation type := (type eqType_of_elementType).
Local Coercion base : class_of >-> Funclass.
Local Coercion sort : type >-> Funclass.
Variables (set : elementType -> Type) (X : elementType).
Variables (disp : unit) (cT : type disp).
Local Notation ddisp := (display_set disp).
Let xset := let: Pack set _ _ := cT in set.
Notation xclass := (@class _ eqType_of_elementType _ cT : class_of eqType_of_elementType _ xset).
Definition eqType := ltac:(EqualityPack (cT X) ((@class _ eqType_of_elementType _ cT : class_of eqType_of_elementType _ xset) X) (xset X)).
Definition choiceType := ltac:(ChoicePack (cT X) ((@class _ eqType_of_elementType _ cT : class_of eqType_of_elementType _ xset) X) (xset X)).
Definition porderType :=
@Order.POrder.Pack ddisp (cT X) (xclass X) (xset X).
Definition latticeType :=
@Order.Lattice.Pack ddisp (cT X) (xclass X) (xset X).
Definition blatticeType :=
@Order.BLattice.Pack ddisp (cT X) (xclass X) (xset X).
Definition cblatticeType :=
@Order.CBLattice.Pack ddisp (cT X) (xclass X) (xset X).
End CanonicalDef.
Module Import Exports.
Coercion mixin      : class_of >-> mixin_of.
Coercion base       : class_of >-> Funclass.
Coercion sort       : type >-> Funclass.
Coercion eqType     : type >-> Equality.type.
Coercion choiceType : type >-> Choice.type.
Coercion porderType : type >-> Order.POrder.type.
Coercion latticeType : type >-> Order.Lattice.type.
Coercion blatticeType : type >-> Order.BLattice.type.
Coercion cblatticeType : type >-> Order.CBLattice.type.
Canonical eqType.
Canonical choiceType.
Canonical porderType.
Canonical latticeType.
Canonical blatticeType.
Canonical cblatticeType.
Notation semisetType  := type.
Notation semisetMixin := mixin_of.
Notation SemisetMixin := Mixin.
Notation SemisetType set m := (@pack _ _ set _ _ m _ _ (fun=> id) _ id).
Notation "[ 'semisetType' 'of' set 'for' cset ]" := (@clone _ _ set _ cset _ _ erefl id)
(at level 0, format "[ 'semisetType'  'of'  set  'for'  cset ]") : form_scope.
Notation "[ 'semisetType' 'of' set 'for' cset 'with' disp ]" :=
(@clone _ _ set _ cset disp _ (unit_irrelevance _ _) id)
(at level 0, format "[ 'semisetType'  'of'  set  'for'  cset  'with'  disp ]") : form_scope.
Notation "[ 'semisetType' 'of' set ]" := [semisetType of set for _]
(at level 0, format "[ 'semisetType'  'of'  set ]") : form_scope.
Notation "[ 'semisetType' 'of' set 'with' disp ]" := [semisetType of set for _ with disp]
(at level 0, format "[ 'semisetType'  'of'  set  'with' disp ]") : form_scope.
End Exports.
End Semiset.
Section SemisetOperations.
Context {elementType : Type} {eqType_of_elementType : elementType -> eqType}.
Coercion eqType_of_elementType : elementType >-> eqType.
Context {disp : unit}.
Section setfun.
Variable (set : semisetType eqType_of_elementType disp).
Definition setfun := Semiset.funsort (Semiset.class set).
Definition fun_of_setfun X Y (f : setfun X Y) : X -> Y :=
@Semiset.fun_of_funsort _ _ _ _ (Semiset.class set) _ _ f.
Coercion fun_of_setfun : setfun >-> Funclass.
End setfun.
Context {set : semisetType eqType_of_elementType disp}.
Variable X Y : elementType.
Definition memset : set X -> X -> bool :=
@Semiset.memset _ _ _ _ (Semiset.class set) _.
Definition set1 : X -> set X :=
@Semiset.set1 _ _ _ _ (Semiset.class set) _.
Definition imset : setfun set X Y -> set X -> set Y:=
@Semiset.imset _ _ _ _ (Semiset.class set) _ _.
Canonical set_predType := Eval hnf in mkPredType memset.
Structure setpredType := SetPredType {
setpred_sort :> Type;
tosetpred : setpred_sort -> pred X;
_ : {mem : setpred_sort -> mem_pred X | isMem tosetpred mem};
_ : {pred_fset : setpred_sort -> set X |
forall p x, x \in pred_fset p = tosetpred p x}
}.
Canonical setpredType_predType (fpX : setpredType) :=
@PredType X (setpred_sort fpX) (@tosetpred fpX)
(let: SetPredType _ _ mem _ := fpX in mem).
Definition predset (fpX : setpredType) : fpX -> set X :=
let: SetPredType _ _ _ (exist pred_fset _) := fpX in pred_fset.
End SemisetOperations.
Module Import SemisetSyntax.
Notation "[ 'set' x : T | P ]" := (predset (fun x : T => P%B))
(at level 0, x at level 99, only parsing) : abstract_set_scope.
Notation "[ 'set' x | P ]" := [set x : _ | P]
(at level 0, x, P at level 99, format "[ 'set'  x  |  P ]") : abstract_set_scope.
Notation "[ 'set' x 'in' A ]" := [set x | x \in A]
(at level 0, x at level 99, format "[ 'set'  x  'in'  A ]") : abstract_set_scope.
Notation "[ 'set' x : T 'in' A ]" := [set x : T | x \in A]
(at level 0, x at level 99, only parsing) : abstract_set_scope.
Notation "[ 'set' x : T | P & Q ]" := [set x : T | P && Q]
(at level 0, x at level 99, only parsing) : abstract_set_scope.
Notation "[ 'set' x | P & Q ]" := [set x | P && Q ]
(at level 0, x, P at level 99, format "[ 'set'  x  |  P  &  Q ]") : abstract_set_scope.
Notation "[ 'set' x : T 'in' A | P ]" := [set x : T | x \in A & P]
(at level 0, x at level 99, only parsing) : abstract_set_scope.
Notation "[ 'set' x 'in' A | P ]" := [set x | x \in A & P]
(at level 0, x at level 99, format "[ 'set'  x  'in'  A  |  P ]") : abstract_set_scope.
Notation "[ 'set' x 'in' A | P & Q ]" := [set x in A | P && Q]
(at level 0, x at level 99,
format "[ 'set'  x  'in'  A  |  P  &  Q ]") : abstract_set_scope.
Notation "[ 'set' x : T 'in' A | P & Q ]" := [set x : T in A | P && Q]
(at level 0, x at level 99, only parsing) : abstract_set_scope.
Notation "[ 'set' a ]" := (set1 a)
(at level 0, a at level 99, format "[ 'set'  a ]") : abstract_set_scope.
Notation "[ 'set' a : T ]" := [set (a : T)]
(at level 0, a at level 99, format "[ 'set'  a   :  T ]") : abstract_set_scope.
Notation "a |: y" := ([set a] :|: y) : abstract_set_scope.
Notation "x :\ a" := (x :\: [set a]) : abstract_set_scope.
Notation "[ 'set' a1 ; a2 ; .. ; an ]" := (setU .. (a1 |: [set a2]) .. [set an]).
Notation "f @: A" := (imset f A) (at level 24) : abstract_set_scope.
End SemisetSyntax.
Module Import SemisetTheory.
Section SemisetTheory.
Variable elementType : Type.
Variable eqType_of_elementType : elementType -> eqType.
Coercion eqType_of_elementType : elementType >-> eqType.
Variable disp : unit.
Variable set : semisetType eqType_of_elementType disp.
Section setX.
Variables X : elementType.
Implicit Types (x y : X) (A B C : set X).

Lemma set1U A x : [set x] :&: A = if x \in A then [set x] else set0.