Changed lattice

FiniteSets/_CoqProject

@@ -16,8 +16,8 @@ fsets/properties_decidable.v
 fsets/length.v
 fsets/monad.v
 FSets.v
+Sub.v
 implementations/lists.v
 variations/enumerated.v
-variations/k_finite.v
 #empty_set.v
 #ordered.v

FiniteSets/disjunction.v

@@ -2,7 +2,7 @@
 Require Import HoTT.
 Require Import lattice.
 
-Definition lor (X Y : hProp) : hProp := BuildhProp (Trunc (-1) (sum X Y)).
+Instance lor : maximum hProp := fun X Y => BuildhProp (Trunc (-1) (sum X Y)).
 
 Delimit Scope logic_scope with L.
 Notation "A ∨ B" := (lor A B) (at level 20, right associativity) : logic_scope.
@@ -75,7 +75,8 @@ Section lor_props.
 
 End lor_props.
 
-Definition land (X Y : hProp) : hProp := BuildhProp (prod X Y).
+Instance land : minimum hProp := fun X Y => BuildhProp (prod X Y).
+Instance lfalse : bottom hProp := False_hp.
 
 Notation "A ∧ B" := (land A B) (at level 20, right associativity) : logic_scope.
 Arguments land _%L _%L.
@@ -84,7 +85,7 @@ Open Scope logic_scope.
 Section hPropLattice.
   Context `{Univalence}.
 
-  Global Instance lor_commutative : Commutative lor.
+  Instance lor_commutative : Commutative lor.
   Proof.
     unfold Commutative.
     intros.
@@ -131,21 +132,21 @@ Section hPropLattice.
     - intros a ; apply (pair a a).
   Defined.
   
-  Instance lor_neutrall : NeutralL lor False_hp.
+  Instance lor_neutrall : NeutralL lor lfalse.
   Proof.
     unfold NeutralL.
     intros.
     apply lor_nl.
   Defined.
 
-  Instance lor_neutralr : NeutralR lor False_hp.
+  Instance lor_neutralr : NeutralR lor lfalse.
   Proof.
     unfold NeutralR.
     intros.
     apply lor_nr.
   Defined.
 
-  Instance bool_absorption_orb_andb : Absorption lor land.
+  Instance absorption_orb_andb : Absorption lor land.
   Proof.
     unfold Absorption.
     intros.
@@ -156,7 +157,7 @@ Section hPropLattice.
       apply (tr (inl X)).
   Defined.
 
-  Instance bool_absorption_andb_orb : Absorption land lor.
+  Instance absorption_andb_orb : Absorption land lor.
   Proof.
     unfold Absorption.
     intros.
@@ -169,15 +170,15 @@ Section hPropLattice.
       * apply (tr (inl X)).
   Defined.
   
-  Global Instance lattice_hprop : Lattice land lor False_hp :=
+  Global Instance lattice_hprop : Lattice hProp :=
     { commutative_min := _ ;
       commutative_max := _ ;
       associative_min := _ ;
       associative_max := _ ;
       idempotent_min := _ ;
       idempotent_max := _ ;
-      neutralL_min := _ ;
-      neutralR_min := _ ;
+      neutralL_max := _ ;
+      neutralR_max := _ ;
       absorption_min_max := _ ;
       absorption_max_min := _
   }.

FiniteSets/fsets/operations.v

@@ -75,11 +75,11 @@ Proof.
   - apply true.
   - apply (fun _ => false).
   - apply andb.
-  - intros. symmetry. eauto with bool_lattice_hints.
-  - eauto with bool_lattice_hints.
-  - eauto with bool_lattice_hints.
-  - eauto with bool_lattice_hints.
-  - eauto with bool_lattice_hints.
+  - intros. symmetry. eauto with lattice_hints typeclass_instances.
+  - eauto with bool_lattice_hints typeclass_instances.
+  - eauto with bool_lattice_hints typeclass_instances.
+  - eauto with bool_lattice_hints typeclass_instances.
+  - eauto with bool_lattice_hints typeclass_instances.
 Defined.    
   
 End operations.

FiniteSets/fsets/operations_decidable.v

@@ -12,7 +12,14 @@ Section decidable_A.
     intros a.
     hinduction ; try (intros ; apply path_ishprop).
     - apply _.
-    - intros. apply _.
+    - intros.
+      unfold Decidable.
+      destruct (dec (a = a0)) as [p | np].
+      * apply (inl (tr p)).
+      * right.
+        intro p.
+        strip_truncations.
+        contradiction.
     - intros. apply _. 
   Defined.
 

FiniteSets/fsets/properties.v

@@ -7,12 +7,10 @@ Section operations_isIn.
   Context {A : Type}.
   Context `{Univalence}.
 
-
-
   Lemma union_idem : forall x: FSet A, U x x = x.
   Proof.
     hinduction; 
-try (intros ; apply set_path2) ; cbn.
+      try (intros ; apply set_path2).
     - apply nl.
     - apply idem.
     - intros x y P Q.
@@ -23,7 +21,7 @@ try (intros ; apply set_path2) ; cbn.
       rewrite (comm y x).
       rewrite <- (assoc x y y).
       f_ap. 
-Defined.
+  Qed.
 
   (** ** Properties about subset relation. *)
   Lemma subset_union (X Y : FSet A) : 
@@ -37,7 +35,7 @@ hinduction X; try (intros; apply path_forall; intro; apply set_path2).
         contradiction.
       + intro a0.
         simple refine (Trunc_ind _ _).
-    intro p ; cbn. 
+        intro p ; simpl. 
         rewrite p; apply idem.
       + intros X1 X2 IH1 IH2.
         simple refine (Trunc_ind _ _).
@@ -83,8 +81,8 @@ Lemma comprehension_or : forall ϕ ψ (x: FSet A),
   Proof.
     intros ϕ ψ.
     hinduction; try (intros; apply set_path2). 
-- cbn. apply (union_idem _)^.
-- cbn. intros.
+    - apply (union_idem _)^.
+    - intros.
       destruct (ϕ a) ; destruct (ψ a) ; symmetry.
       * apply union_idem.
       * apply nr. 

FiniteSets/fsets/properties_decidable.v

@@ -133,8 +133,15 @@ Proof.
   Defined.
 End operations_isIn.
 
-Global Opaque isIn_b.
 (* Some suporting tactics *)
+(*
+Ltac simplify_isIn :=
+  repeat (rewrite union_isIn
+          || rewrite L_isIn_b_aa      
+          || rewrite intersection_isIn
+          || rewrite comprehension_isIn).
+ *)
+
 Ltac simplify_isIn :=
   repeat (rewrite union_isIn
        || rewrite L_isIn_b_aa      
@@ -142,7 +149,7 @@ Ltac simplify_isIn :=
        || rewrite comprehension_isIn).
 
 Ltac toBool := try (intro) ;
-    intros ; apply ext ; intros ; simplify_isIn ; eauto with bool_lattice_hints.
+               intros ; apply ext ; intros ; simplify_isIn ; eauto with bool_lattice_hints typeclass_instances.
 
 Section SetLattice.
 
@@ -150,70 +157,15 @@ Section SetLattice.
   Context {A_deceq : DecidablePaths A}.
   Context `{Univalence}.
 
-  Instance fset_union_com : Commutative (@U A).
-  Proof.
-    toBool.
-  Defined.
+  Instance fset_max : maximum (FSet A) := U.
+  Instance fset_min : minimum (FSet A) := intersection.
+  Instance fset_bot : bottom (FSet A) := E.
 
-  Instance fset_intersection_com : Commutative intersection.
+  Instance lattice_fset : Lattice (FSet A).
   Proof.
-    toBool.
+    split ; toBool.      
   Defined.
   
-  Instance fset_union_assoc : Associative (@U A).
-  Proof.
-    toBool.
-  Defined.
-
-  Instance fset_intersection_assoc : Associative intersection.
-  Proof.
-    toBool.
-  Defined.
-
-  Instance fset_union_idem : Idempotent (@U A).
-  Proof.
-    exact union_idem.
-  Defined.
-
-  Instance fset_intersection_idem : Idempotent intersection.
-  Proof.
-    toBool.
-  Defined.
-
-  Instance fset_union_nl : NeutralL (@U A) (@E A).
-  Proof.
-    toBool.
-  Defined.
-
-  Instance fset_union_nr : NeutralR (@U A) (@E A).
-  Proof.
-    toBool.
-  Defined.
-
-  Instance fset_absorption_intersection_union : Absorption (@U A) intersection.
-  Proof.
-    toBool.
-  Defined.
-
-  Instance fset_absorption_union_intersection : Absorption intersection (@U A).
-  Proof.
-    toBool.
-  Defined.
-  
-  Instance lattice_fset : Lattice intersection (@U A)  (@E A) :=
-    {
-      commutative_min := _ ;
-      commutative_max := _ ;
-      associative_min := _ ;
-      associative_max := _ ;
-      idempotent_min := _ ;
-      idempotent_max := _ ;
-      neutralL_min := _ ;
-      neutralR_min := _ ;
-      absorption_min_max := _ ;
-      absorption_max_min := _
-    }.
-
 End SetLattice.
 
 (* Comprehension properties *)
@@ -236,13 +188,13 @@ Section comprehension_properties.
   Lemma comprehension_false Y : comprehension (fun (_ : A) => false) Y = E.
   Proof.
     toBool.
-  Defined.
+  Qed.
 
   Lemma comprehension_all : forall (X : FSet A),
       comprehension (fun a => isIn_b a X) X = X.
   Proof.
     toBool.
-  Defined.
+  Qed.
   
   Lemma comprehension_subset : forall ϕ (X : FSet A),
       U (comprehension ϕ X) X = X.

FiniteSets/lattice.v

@@ -1,7 +1,24 @@
 (* Typeclass for lattices *)
 Require Import HoTT.
 
-Definition operation (A : Type) := A -> A -> A.
+Section binary_operation.
+  Variable A : Type.
+  
+  Definition operation := A -> A -> A.
+
+  Class maximum :=
+    max_L : operation.
+
+  Class minimum :=
+    min_L : operation.
+
+  Class bottom :=
+    empty : A.
+End binary_operation.
+
+Arguments max_L {_} _ _.
+Arguments min_L {_} _ _.
+Arguments empty {_}.
 
 Section Defs.
   Variable A : Type.
@@ -19,7 +36,7 @@ Section Defs.
   Variable g : operation A.
 
   Class Absorption :=
-    absrob : forall x y, f x (g x y) = x.
+    absorb : forall x y, f x (g x y) = x.
 
   Variable n : A.
 
@@ -40,27 +57,32 @@ Arguments Absorption {_} _ _.
 
 Section Lattice.
   Variable A : Type.
-  Variable min max : operation A.
-  Variable empty : A.
+  Context {max_L : maximum A} {min_L : minimum A} {empty_L : bottom A}.
 
   Class Lattice :=
     {
-      commutative_min :> Commutative min ;
-      commutative_max :> Commutative max ;
-      associative_min :> Associative min ;
-      associative_max :> Associative max ;
-      idempotent_min :> Idempotent min ;
-      idempotent_max :> Idempotent max ;
-      neutralL_max :> NeutralL max empty ;
-      neutralR_max :> NeutralR max empty ;
-      absorption_min_max :> Absorption min max ;
-      absorption_max_min :> Absorption max min
+      commutative_min :> Commutative min_L ;
+      commutative_max :> Commutative max_L ;
+      associative_min :> Associative min_L ;
+      associative_max :> Associative max_L ;
+      idempotent_min :> Idempotent min_L ;
+      idempotent_max :> Idempotent max_L ;
+      neutralL_max :> NeutralL max_L empty_L ;
+      neutralR_max :> NeutralR max_L empty_L ;
+      absorption_min_max :> Absorption min_L max_L ;
+      absorption_max_min :> Absorption max_L min_L
     }.
-                     
 End Lattice.
 
-Arguments Lattice {_} _ _ _.
+Arguments Lattice _ {_} {_} {_}.
 
+Create HintDb lattice_hints.
+Hint Resolve associativity : lattice_hints.
+Hint Resolve commutative : lattice_hints.
+Hint Resolve absorb : lattice_hints.
+Hint Resolve idempotency : lattice_hints.
+Hint Resolve neutralityL : lattice_hints.
+Hint Resolve neutralityR : lattice_hints.
 
 Section BoolLattice.
 
@@ -71,69 +93,15 @@ Section BoolLattice.
     ; auto
     ; try contradiction.
 
-  Instance orb_com : Commutative orb.
-  Proof.
-    solve_bool.
-  Defined.
+  Instance maximum_bool : maximum Bool := orb.
+  Instance minimum_bool : minimum Bool := andb.
+  Instance bottom_bool : bottom Bool := false.
   
-  Instance andb_com : Commutative andb.
+  Global Instance lattice_bool : Lattice Bool.
   Proof.
-    solve_bool.
+    split ; solve_bool.
   Defined.
   
-  Instance orb_assoc : Associative orb.
-  Proof.
-    solve_bool.
-  Defined.
-
-  Instance andb_assoc : Associative andb.
-  Proof.
-    solve_bool.
-  Defined.
-
-  Instance orb_idem : Idempotent orb.
-  Proof.
-    solve_bool.
-  Defined.
-
-  Instance andb_idem : Idempotent andb.
-  Proof.
-    solve_bool.
-  Defined.
-
-  Instance orb_nl : NeutralL orb false.
-  Proof.
-    solve_bool.
-  Defined.
-
-  Instance orb_nr : NeutralR orb false.
-  Proof.
-    solve_bool.
-  Defined.
-
-  Instance bool_absorption_orb_andb : Absorption orb andb.
-  Proof.
-    solve_bool.
-  Defined.
-
-  Instance bool_absorption_andb_orb : Absorption andb orb.
-  Proof.
-    solve_bool.
-  Defined.
-  
-  Global Instance lattice_bool : Lattice andb orb false :=
-    { commutative_min := _ ;
-      commutative_max := _ ;
-      associative_min := _ ;
-      associative_max := _ ;
-      idempotent_min := _ ;
-      idempotent_max := _ ;
-      neutralL_max := _ ;
-      neutralR_max := _ ;
-      absorption_min_max := _ ;
-      absorption_max_min := _
-  }.
-
   Definition and_true : forall b, andb b true = b.
   Proof.
     solve_bool.
@@ -165,124 +133,53 @@ Section BoolLattice.
 End BoolLattice.
 
 Section fun_lattice.
-  Context {A B : Type} {maxB minB : B -> B -> B} {botB : B}.
-  Context `{Lattice B minB maxB botB}.
+  Context {A B : Type}.
+  Context `{Lattice B}.
   Context `{Funext}.
 
-  Definition max_fun (f g : (A -> B)) (a : A) : B
-    := maxB (f a) (g a).
+  Global Instance max_fun : maximum (A -> B) :=
+    fun (f g : A -> B) (a : A) => max_L0 (f a) (g a).
 
-  Definition min_fun (f g : (A -> B)) (a : A) : B
-    := minB (f a) (g a).
+  Global Instance min_fun : minimum (A -> B) :=
+    fun (f g : A -> B) (a : A) => min_L0 (f a) (g a).
 
-  Definition bot_fun (a : A) : B
-    := botB.
+  Global Instance bot_fun : bottom (A -> B)
+    := fun _ => empty_L.
 
-  Hint Unfold max_fun min_fun bot_fun.
+  Ltac solve_fun :=
+    compute ; intros ; apply path_forall ; intro ;
+    eauto with lattice_hints typeclass_instances.
 
-  Ltac solve_fun := compute ; intros ; apply path_forall ; intro.
-  
-  Instance max_fun_com : Commutative max_fun.
+  Global Instance lattice_fun : Lattice (A -> B).
   Proof.
-    solve_fun.
-    refine (commutative_max _ _ _ _ _ _).
+    split ; solve_fun.
   Defined.
   
-  Instance min_fun_com : Commutative min_fun.
-  Proof.
-    solve_fun.
-    refine (commutative_min _ _ _ _ _ _).
-  Defined.
-
-  Instance max_fun_assoc : Associative max_fun.
-  Proof.
-    solve_fun.
-    refine (associative_max _ _ _ _ _ _ _).
-  Defined.
-
-  Instance min_fun_assoc : Associative min_fun.
-  Proof.
-    solve_fun.
-    refine (associative_min _ _ _ _ _ _ _).
-  Defined.
-
-  Instance max_fun_idem : Idempotent max_fun.
-  Proof.
-    solve_fun.
-    refine (idempotent_max _ _ _ _ _).
-  Defined.
-
-  Instance min_fun_idem : Idempotent min_fun.
-  Proof.
-    solve_fun.
-    refine (idempotent_min _ _ _ _ _).
-  Defined.
-
-  Instance max_fun_nl : NeutralL max_fun bot_fun.
-  Proof.
-    solve_fun.
-    simple refine (neutralL_max _ _ _ _ _).
-  Defined.
-
-  Instance max_fun_nr : NeutralR max_fun bot_fun.
-  Proof.
-    solve_fun.
-    simple refine (neutralR_max _ _ _ _ _).
-  Defined.
-
-  Instance absorption_max_fun_min_fun : Absorption max_fun min_fun.
-  Proof.
-    solve_fun.
-    simple refine (absorption_max_min _ _ _ _ _ _).
-  Defined.
-
-  Instance absorption_min_fun_max_fun : Absorption min_fun max_fun.
-  Proof.
-    solve_fun.
-    simple refine (absorption_min_max _ _ _ _ _ _).
-  Defined.
-  
-  Global Instance lattice_fun : Lattice min_fun max_fun bot_fun :=
-    { commutative_min := _ ;
-      commutative_max := _ ;
-      associative_min := _ ;
-      associative_max := _ ;
-      idempotent_min := _ ;
-      idempotent_max := _ ;
-      neutralL_max := _ ;
-      neutralR_max := _ ;
-      absorption_min_max := _ ;
-      absorption_max_min := _
-  }.
 End fun_lattice.
 
 Section sub_lattice.
-  Context {A : Type} {P : A -> hProp} {maxA minA : A -> A -> A} {botA : A}.
-  Context {Hmax : forall x y, P x -> P y -> P (maxA x y)}.
-  Context {Hmin : forall x y, P x -> P y -> P (minA x y)}.
-  Context {Hbot : P botA}.
-  Context `{Lattice A minA maxA botA}.
+  Context {A : Type} {P : A -> hProp}.
+  Context `{Lattice A}.
+  Context {Hmax : forall x y, P x -> P y -> P (max_L0 x y)}.
+  Context {Hmin : forall x y, P x -> P y -> P (min_L0 x y)}.
+  Context {Hbot : P empty_L}.
 
   Definition AP : Type := sig P.
   
-  Definition botAP : AP := (botA ; Hbot).
+  Instance botAP : bottom AP := (empty_L ; Hbot).
 
-  Definition maxAP (x y : AP) : AP :=
-    match x with
-    | (a ; pa) => match y with
-                  | (b ; pb) => (maxA a b ; Hmax a b pa pb)
-                  end
+  Instance maxAP : maximum AP :=
+    fun x y =>
+      match x, y with
+      | (a ; pa), (b ; pb) => (max_L0 a b ; Hmax a b pa pb)
       end.
 
-  Definition minAP (x y : AP) : AP :=
-    match x with
-    | (a ; pa) => match y with
-                  | (b ; pb) => (minA a b ; Hmin a b pa pb)
-                  end
+  Instance minAP : minimum AP :=
+    fun x y =>
+      match x, y with
+      | (a ; pa), (b ; pb) => (min_L0 a b ; Hmin a b pa pb)
       end.
 
-  Hint Unfold maxAP minAP botAP.
-
   Instance hprop_sub : forall c, IsHProp (P c).
   Proof.
     apply _.
@@ -291,85 +188,28 @@ Section sub_lattice.
   Ltac solve_sub :=
     let x := fresh in
     repeat (intro x ; destruct x) 
-    ; simple refine (path_sigma _ _ _ _ _) ; try (apply hprop_sub).
+    ; simple refine (path_sigma _ _ _ _ _)
+    ; simpl
+    ; try (apply hprop_sub)
+    ; eauto 3 with lattice_hints typeclass_instances.
   
-  Instance max_sub_com : Commutative maxAP.
+  Global Instance lattice_sub : Lattice AP.
   Proof.
-    solve_sub.
-    refine (commutative_max _ _ _ _ _ _).
+    split ; solve_sub.
   Defined.
   
-  Instance min_sub_com : Commutative minAP.
-  Proof.
-    solve_sub.
-    refine (commutative_min _ _ _ _ _ _).
-  Defined.
-
-  Instance max_sub_assoc : Associative maxAP.
-  Proof.
-    solve_sub.
-    refine (associative_max _ _ _ _ _ _ _).
-  Defined.
-
-  Instance min_sub_assoc : Associative minAP.
-  Proof.
-    solve_sub.
-    refine (associative_min _ _ _ _ _ _ _).
-  Defined.
-
-  Instance max_sub_idem : Idempotent maxAP.
-  Proof.
-    solve_sub.
-    refine (idempotent_max _ _ _ _ _).
-  Defined.
-
-  Instance min_sub_idem : Idempotent minAP.
-  Proof.
-    solve_sub.
-    refine (idempotent_min _ _ _ _ _).
-  Defined.
-
-  Instance max_sub_nl : NeutralL maxAP botAP.
-  Proof.
-    solve_sub.
-    simple refine (neutralL_max _ _ _ _ _).
-  Defined.
-
-  Instance max_sub_nr : NeutralR maxAP botAP.
-  Proof.
-    solve_sub.
-    simple refine (neutralR_max _ _ _ _ _).
-  Defined.
-
-  Instance absorption_max_sub_min_sub : Absorption maxAP minAP.
-  Proof.
-    solve_sub.
-    simple refine (absorption_max_min _ _ _ _ _ _).
-  Defined.
-
-  Instance absorption_min_sub_max_sub : Absorption minAP maxAP.
-  Proof.
-    solve_sub.
-    simple refine (absorption_min_max _ _ _ _ _ _).
-  Defined.
-  
-  Global Instance lattice_sub : Lattice minAP maxAP botAP :=
-    { commutative_min := _ ;
-      commutative_max := _ ;
-      associative_min := _ ;
-      associative_max := _ ;
-      idempotent_min := _ ;
-      idempotent_max := _ ;
-      neutralL_max := _ ;
-      neutralR_max := _ ;
-      absorption_min_max := _ ;
-      absorption_max_min := _
-  }.
-
 End sub_lattice.
 
+Create HintDb bool_lattice_hints.
+Hint Resolve associativity : bool_lattice_hints.
+Hint Resolve commutative : bool_lattice_hints.
+Hint Resolve absorb : bool_lattice_hints.
+Hint Resolve idempotency : bool_lattice_hints.
+Hint Resolve neutralityL : bool_lattice_hints.
+Hint Resolve neutralityR : bool_lattice_hints.
+
 Hint Resolve
-     orb_com andb_com orb_assoc andb_assoc orb_idem andb_idem orb_nl orb_nr
-     bool_absorption_orb_andb bool_absorption_andb_orb and_true and_false
+     associativity
+     and_true and_false
      dist₁ dist₂ max_min
  : bool_lattice_hints.