### Profile

Statistics
| Branch: | Revision:

## cool / src / lib / CoAlgLogicUtils.ml @ 7c4d2eb4

History | View | Annotate | Download (2.21 KB)

 1 open Graph open CoAlgMisc open CoolUtils let disjointAgents sort a b = assert (lfGetType sort a = EnforcesF || lfGetType sort a = AllowsF); assert (lfGetType sort b = EnforcesF || lfGetType sort b = AllowsF); let la = lfGetDestAg sort a in let lb = lfGetDestAg sort b in let res = ref (true) in let f idx = if (TArray.elem idx lb) then res := false else () in Array.iter f la; !res (* Maximal Clique finding *) (* Using algorithm implementation from http://mancoosi.org/~abate/finding-maximal-cliques-and-independent-sets-undirected-graph-bron%E2%80%93kerbosch-algorithm which implements http://en.wikipedia.org/wiki/Bron%E2%80%93Kerbosch_algorithm *) module V = struct type t = int let compare = compare let hash = Hashtbl.hash let equal = (=) end module UG = Persistent.Graph.Concrete(V) module N = Oper.Neighbourhood(UG) module S = N.Vertex_Set let rec bronKerbosch2 gr r p x = let n v = N.set_from_vertex gr v in if (S.is_empty p) && (S.is_empty x) then [r] else let u = S.choose (S.union p x) in let (_,_,mxc) = S.fold (fun v (p,x,acc) -> let r' = S.union r (S.singleton v) in let p' = S.inter p (n v) in let x' = S.inter x (n v) in (S.remove v p, S.add v x,(bronKerbosch2 gr r' p' x') @ acc) ) (S.diff p (n u)) (p,x,[]) in mxc (* thanks to stackoverflow for cartesian product of lists *) let cartesian l l' = List.concat (List.map (fun e -> List.map (fun e' -> (e,e')) l') l) let maxDisjoints sort (a: bset) : bset list = let vl = bsetFold (fun x l -> (lfToInt x):: l) a [] in let gr = List.fold_left (fun g v -> UG.add_vertex g v) UG.empty vl in let edges = List.filter (fun (x,y) -> disjointAgents sort (lfFromInt x) (lfFromInt y)) (cartesian vl vl) in let gr = List.fold_left (fun g (x,y) -> UG.add_edge g x y) gr edges in let r = S.empty in let p = List.fold_right S.add vl S.empty in let x = S.empty in let intlist = bronKerbosch2 gr r p x in let tmpf : bset -> int -> bset = (fun bs f -> bsetAdd bs (lfFromInt f) ; bs) in List.map (List.fold_left tmpf (bsetMake ())) (List.map S.elements intlist)