(* a relation module parameterized by an ordered type *) module Relation (T: Set.OrderedType) = struct module M = Map.Make(T) (* maps over an ordered type *) module S = Set.Make(T) (* sets of an ordered type *) let comp f g x = f (g x) (* function composition *) let fix f = (* fixpoint of f starting from x *) let rec fix2 x = let y = f x in if y = x then x else fix2 y in fix2 (* return set of y related to x in R(x, y) -- "successors" *) let rels r x = try M.find x r with Not_found -> S.empty (* like rels, but return {x} U map(x) = element + related ones *) let optrels m e = S.add e (rels m e) (* union of mapping f over elements of a set = lift f to sets *) let setmap f s = S.fold (fun x -> S.union (f x)) s S.empty (* r2 U r2r1: apply r1 optionally after r2 *) let rel2opt1 = comp M.map (comp setmap optmap) (* closure R U R^2 U ... U R^n is fixpoint of F(X) = X U XR *) let transclose1 r = fix (rel2opt1 r) r (* r1 U r2, folding r1 into r2 *) let reladd r1 r2 = M.fold (fun x -> comp (M.add x) (S.union (rels r2 x))) r1 r2 (* r \ rs, computed starting from r *) let relsub rs = M.mapi (fun x xm -> S.diff xm (rels rs x)) (* r2 composed with r1: \exists y . R2(x, y) /\ R1(y, z) *) let relcomp21 = comp M.map (comp setmap rels) (* another version, computes R U ... U R^n and difference R^n \ former *) let transclose2 r = let uniondiff (un, dn) = let rn1 = relcomp21 r dn in let dn1 = relsub un rn1 in (reladd dn1 un, dn1) in fst (fix uniondiff (r, r)) (* successor set of a set *) let succset g s = S.fold (comp S.union (rels g)) s S.empty (* union of set and its successor *) let optsuccset g s = S.union s (succset g s) (* all elements reachable by R^+ *) let reachset = comp fix optsuccset let showrel r = List.map (fun (x, y) -> (x, S.elements y)) (M.bindings r) end module R = Relation(String) open R let r = M.add "1" (S.singleton "2") (M.add "2" (S.singleton "3") (M.add "3" (S.singleton "4") (M.singleton "4" (S.singleton "5")))) ;; showrel (transclose1 r);; showrel (transclose2 r);; S.elements (reachset r (S.singleton "1"));;

*This document was generated using
caml2html*