diff --git a/src/lib/CoAlgLogicUtils.ml b/src/lib/CoAlgLogicUtils.ml index 591cf8cfd0504ffdafe3e2f8e959e4990c840f56..698f7d959b36bb958792527aefec6dc9b07dfcda 100644 --- a/src/lib/CoAlgLogicUtils.ml +++ b/src/lib/CoAlgLogicUtils.ml @@ -4,8 +4,20 @@ open Graph open CoAlgMisc open CoolUtils +module L = List -let disjointAgents sort a b = +let string_of_cl_modality sort modality = + let (o,c) = (* open/close brackets *) + match lfGetType sort modality with + | EnforcesF -> ("[","]") + | AllowsF -> ("{","}") + | _ -> ("¿","?") + in + let agents = (Array.to_list (lfGetDestAg sort modality)) in + let agents = List.map string_of_int agents in + o^(String.concat ", " agents)^c + +let disjointAgents sort a b : bool = assert (lfGetType sort a = EnforcesF || lfGetType sort a = AllowsF); assert (lfGetType sort b = EnforcesF || lfGetType sort b = AllowsF); let la = lfGetDestAg sort a in @@ -16,6 +28,11 @@ let disjointAgents sort a b = else () in Array.iter f la; + (* + let s_o_cl = string_of_cl_modality sort in + let str = (s_o_cl a) ^ " disj. " ^ (s_o_cl b) in + print_endline (str ^ "= " ^ (string_of_bool !res)); + *) !res (* Maximal Clique finding *) @@ -60,11 +77,20 @@ let maxDisjoints sort (a: bset) : bset list = (fun (x,y) -> disjointAgents sort (lfFromInt x) (lfFromInt y)) (cartesian vl vl) in + (* + let se = String.concat ", " (List.map (fun (x,y) -> (string_of_int x)^"-"^(string_of_int y)) edges) in + print_endline ("Graph: "^se); + *) 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 + (* + foreach_l intlist (fun s -> let s = L.map string_of_int (S.elements s) in + print_endline ("Cliqu: "^ String.concat "," s) + ); + *) let tmpf : bset -> int -> bset = (fun bs f -> bsetAdd bs (lfFromInt f) ; bs) in @@ -73,18 +99,7 @@ let maxDisjoints sort (a: bset) : bset list = let string_of_coalition sort bs = let modlist = bsetFold (fun x l -> x::l) bs [] in - let show modality = - let (o,c) = (* open/close brackets *) - match lfGetType sort modality with - | EnforcesF -> ("[","]") - | AllowsF -> ("{","}") - | _ -> ("¿","?") - in - let agents = (Array.to_list (lfGetDestAg sort modality)) in - let agents = List.map string_of_int agents in - o^(String.concat ", " agents)^c - in - let modlist = List.map show modlist in + let modlist = List.map (string_of_cl_modality sort) modlist in "{ " ^ (String.concat ", " modlist) ^ " }" diff --git a/src/lib/CoAlgLogics.ml b/src/lib/CoAlgLogics.ml index 7e16949dd99040631aa9ab14277c1732225c8a66..6474c4526532a6b9653321661be90ae70dfac1fc 100644 --- a/src/lib/CoAlgLogics.ml +++ b/src/lib/CoAlgLogics.ml @@ -202,6 +202,7 @@ let mkRule_CL sort bs sl = let boxes = bsetFilter bs (fun f -> lfGetType sort f = EnforcesF) in let diamonds = bsetFilter bs (fun f -> lfGetType sort f = AllowsF) in let disjoints = maxDisjoints sort boxes in + (*print_endline ("disjoints: "^(string_of_coalition_list sort disjoints)); *) let nCands = bsetMakeRealEmpty () in (* all N-diamonds *) let hasFullAgentList formula = let aglist = lfGetDestAg sort formula in @@ -215,6 +216,7 @@ let mkRule_CL sort bs sl = bsetFold (fun f a -> (lfGetDest1 sort f)::a) nCands [] in let getRule2 diamDb acc = (* diamDb = <D> b *) + (* print_endline "Rule2" ; *) let d = lfGetDestAg sort diamDb in (* the agent list *) let b = lfGetDest1 sort diamDb in let hasAppropriateAglist f = @@ -240,6 +242,7 @@ let mkRule_CL sort bs sl = in let rules = bsetFold getRule2 dCands [] in let getRule1 acc coalitions = + (* print_endline "Rule1" ; *) (* do rule 1: coalitions ————————————