Library RelationAlgebra.lset
lset: finite sets represented as lists
Require Import lattice comparisons.
Require Export List. Export ListNotations.
Set Implicit Arguments.
semi-lattice of finite sets as simple lists
Universe lset.
Canonical Structure lset_ops (A:Type@{lset}) := lattice.mk_ops (list A)
(fun h k ⇒ ∀ a, In a h → In a k)
(fun h k ⇒ ∀ a, In a h ↔ In a k)
(@app A) (@app A) (assert_false id) (@nil A) (@nil A).
the fact that this makes a semi-lattice is almost trivial
#[export] Instance lset_laws (A:Type@{lset}) : lattice.laws BSL (lset_ops A).
Proof.
constructor; simpl; try discriminate.
firstorder.
firstorder.
setoid_rewrite in_app_iff. firstorder.
firstorder.
Qed.
Proof.
constructor; simpl; try discriminate.
firstorder.
firstorder.
setoid_rewrite in_app_iff. firstorder.
firstorder.
Qed.
the map function on lists is actually a monotone function over the
represented sets
#[export] Instance map_leq A B (f: A → B): Proper (leq ==> leq) (map f).
Proof.
intro h. induction h as [|a h IH]; intros k H. apply leq_bx.
intros i [<-|I]. apply in_map. apply H. now left.
apply IH. 2: assumption. intros ? ?. apply H. now right.
Qed.
#[export] Instance map_weq A B (f: A → B): Proper (weq ==> weq) (map f) := op_leq_weq_1.
Proof.
intro h. induction h as [|a h IH]; intros k H. apply leq_bx.
intros i [<-|I]. apply in_map. apply H. now left.
apply IH. 2: assumption. intros ? ?. apply H. now right.
Qed.
#[export] Instance map_weq A B (f: A → B): Proper (weq ==> weq) (map f) := op_leq_weq_1.
map is extensional
#[export] Instance map_compat A B: Proper (pwr eq ==> eq ==> eq) (@map A B).
Proof. intros f g H h k <-. apply map_ext, H. Qed.
Proof. intros f g H h k <-. apply map_ext, H. Qed.
belonging to a singleton
the following tactic replaces all occurrences of cons with
degenerated concatenations, so that the lattice can subsequently
handle them
Ltac fold_cons :=
repeat match goal with
| |- context[@cons ?A ?x ?q] ⇒ (constr_eq q (@nil A); fail 1) || change (x::q) with ([x]++q)
| H: context[!cons ?A ?x ?q] |- _ ⇒ (constr_eq q (@nil A); fail 1) || change (x::q) with ([x]++q) in H
end.
sorted lists without duplicates
sorted merge of sorted lists
Fixpoint union (l1: list A) :=
match l1 with
| nil ⇒ fun l2 ⇒ l2
| h1::t1 ⇒
let fix union' l2 :=
match l2 with
| nil ⇒ l1
| h2::t2 ⇒
match cmp h1 h2 with
| Eq ⇒ h1::union t1 t2
| Lt ⇒ h1::union t1 l2
| Gt ⇒ h2::union' t2
end
end
in union'
end.
match l1 with
| nil ⇒ fun l2 ⇒ l2
| h1::t1 ⇒
let fix union' l2 :=
match l2 with
| nil ⇒ l1
| h2::t2 ⇒
match cmp h1 h2 with
| Eq ⇒ h1::union t1 t2
| Lt ⇒ h1::union t1 l2
| Gt ⇒ h2::union' t2
end
end
in union'
end.
sorted insertion in a sorted list
Fixpoint insert (i: A) l :=
match l with
| nil ⇒ i::nil
| j::q ⇒
match cmp i j with
| Eq ⇒ l
| Lt ⇒ i::l
| Gt ⇒ j::insert i q
end
end.
match l with
| nil ⇒ i::nil
| j::q ⇒
match cmp i j with
| Eq ⇒ l
| Lt ⇒ i::l
| Gt ⇒ j::insert i q
end
end.
weak specification: union actually performs an union
Lemma union_app: ∀ h k, union h k ≡ h ++ k.
Proof.
induction h as [|x h IHh]; simpl union. reflexivity.
induction k as [|y k IHk]. lattice. case cmp_spec.
intros →. fold_cons. rewrite IHh. lattice.
intros _. fold_cons. rewrite IHh. lattice.
intros _. fold_cons. rewrite IHk. lattice.
Qed.
Proof.
induction h as [|x h IHh]; simpl union. reflexivity.
induction k as [|y k IHk]. lattice. case cmp_spec.
intros →. fold_cons. rewrite IHh. lattice.
intros _. fold_cons. rewrite IHh. lattice.
intros _. fold_cons. rewrite IHk. lattice.
Qed.
and insert actually performs an insertion
Lemma insert_union: ∀ i l, insert i l = union [i] l.
Proof.
induction l; simpl. reflexivity.
case cmp_spec. congruence. reflexivity. now rewrite IHl.
Qed.
Lemma insert_app: ∀ i l, insert i l ≡ [i] ++ l.
Proof. intros. rewrite insert_union. apply union_app. Qed.
End m.
Module Fix.
Canonical Structure lset_ops A := lattice.mk_ops (list A)
(fun h k ⇒ ∀ a, In a h → In a k)
(fun h k ⇒ ∀ a, In a h ↔ In a k)
(@app A) (@app A) (assert_false id) (@nil A) (@nil A).
End Fix.
Proof.
induction l; simpl. reflexivity.
case cmp_spec. congruence. reflexivity. now rewrite IHl.
Qed.
Lemma insert_app: ∀ i l, insert i l ≡ [i] ++ l.
Proof. intros. rewrite insert_union. apply union_app. Qed.
End m.
Module Fix.
Canonical Structure lset_ops A := lattice.mk_ops (list A)
(fun h k ⇒ ∀ a, In a h → In a k)
(fun h k ⇒ ∀ a, In a h ↔ In a k)
(@app A) (@app A) (assert_false id) (@nil A) (@nil A).
End Fix.