Project

General

Profile

Statistics
| Branch: | Revision:

cool / src / lib / CoAlgLogicUtils.ml @ de84f40d

History | View | Annotate | Download (3.58 KB)

1

    
2

    
3
open Graph
4

    
5
open CoAlgMisc
6
open CoolUtils
7
module L = List
8

    
9
let string_of_cl_modality sort modality =
10
    let (o,c) = (* open/close brackets *)
11
        match lfGetType sort modality with
12
        | EnforcesF -> ("[","]")
13
        | AllowsF -> ("{","}")
14
        | _ -> ("¿","?")
15
    in
16
    let agents = (Array.to_list (lfGetDestAg sort modality)) in
17
    let agents = List.map string_of_int agents in
18
    o^(String.concat ", " agents)^c
19

    
20
let disjointAgents sort a b : bool =
21
    assert (lfGetType sort a = EnforcesF || lfGetType sort a = AllowsF);
22
    assert (lfGetType sort b = EnforcesF || lfGetType sort b = AllowsF);
23
    let la = lfGetDestAg sort a in
24
    let lb = lfGetDestAg sort b in
25
    let res = ref (true) in
26
    let f idx =
27
        if (TArray.elem idx lb) then res := false
28
        else ()
29
    in
30
    Array.iter f la;
31
    (*
32
    let s_o_cl = string_of_cl_modality sort in
33
    let str = (s_o_cl a) ^ " disj. " ^ (s_o_cl b) in
34
    print_endline (str ^ "= " ^ (string_of_bool !res));
35
    *)
36
    !res
37

    
38
(* Maximal Clique finding *)
39
(* Using algorithm implementation from
40
   http://mancoosi.org/~abate/finding-maximal-cliques-and-independent-sets-undirected-graph-bron%E2%80%93kerbosch-algorithm
41
   which implements http://en.wikipedia.org/wiki/Bron%E2%80%93Kerbosch_algorithm
42
   *)
43

    
44
module V = struct
45
  type t = int
46
  let compare = compare
47
  let hash = Hashtbl.hash
48
  let equal = (=)
49
end
50

    
51
module UG = Persistent.Graph.Concrete(V)
52
module N = Oper.Neighbourhood(UG)
53
module S = N.Vertex_Set
54

    
55
let rec bronKerbosch2 gr r p x =
56
  let n v = N.set_from_vertex gr v in
57
  if (S.is_empty p) && (S.is_empty x) then [r]
58
  else
59
    let u = S.choose (S.union p x) in
60
    let (_,_,mxc) =
61
      S.fold (fun v (p,x,acc) ->
62
        let r' = S.union r (S.singleton v) in
63
        let p' = S.inter p (n v) in
64
        let x' = S.inter x (n v) in
65
        (S.remove v p, S.add v x,(bronKerbosch2 gr r' p' x') @ acc)
66
      ) (S.diff p (n u)) (p,x,[])
67
    in mxc
68

    
69
(* thanks to stackoverflow for cartesian product of lists *)
70
let cartesian l l' = 
71
  List.concat (List.map (fun e -> List.map (fun e' -> (e,e')) l') l)
72

    
73
let maxDisjoints sort (a: bset) : bset list =
74
    let vl = bsetFold (fun x l -> (lfToInt x):: l) a [] in
75
    let gr = List.fold_left (fun g v -> UG.add_vertex g v) UG.empty vl in
76
    let edges = List.filter
77
                    (fun (x,y) -> disjointAgents sort (lfFromInt x) (lfFromInt y))
78
                    (cartesian vl vl)
79
    in
80
    (*
81
    let se = String.concat ", " (List.map (fun (x,y) -> (string_of_int x)^"-"^(string_of_int y)) edges) in
82
    print_endline ("Graph: "^se);
83
    *)
84
    let gr = List.fold_left (fun g (x,y) -> UG.add_edge g x y) gr edges in
85
    let r = S.empty in
86
    let p = List.fold_right S.add vl S.empty in
87
    let x = S.empty in
88
    let intlist = bronKerbosch2 gr r p x in
89
    (*
90
    foreach_l intlist (fun s -> let s = L.map string_of_int (S.elements s) in
91
        print_endline ("Cliqu: "^ String.concat "," s)
92
    );
93
    *)
94
    flip List.map intlist (fun elements ->
95
        (* for each maximal clique "elements", do: *)
96
        let elements = S.elements elements in (* obtain a list of ints *)
97
        let elements = L.map lfFromInt elements in (* convert them to local formulas *)
98
        (* throw them into a bset *)
99
        let bs = (bsetMakeRealEmpty ()) in
100
        List.iter (bsetAdd bs) elements;
101
        bs
102
    )
103

    
104

    
105
let string_of_coalition sort bs =
106
    let modlist = bsetFold (fun x l -> x::l) bs [] in
107
    let modlist = List.map (string_of_cl_modality sort) modlist in
108
    "{ " ^ (String.concat ", " modlist) ^ " }"
109

    
110

    
111
let string_of_coalition_list sort bs_list =
112
    String.concat "\n" (List.map (string_of_coalition sort) bs_list)
113