josch/cycles_johnson_abate
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Speed up implementations for big graphs

Browse source 
- split input graph into scc and only analyze non-degenerate components
 - remove least vertex from input graph instead of retrieving subgraphs
 - directly retrieve scc graph from scc calculation
This commit is contained in:
josch 2012-07-17 19:14:14 +02:00
parent 97c52244e1
commit dfb8541218
1 changed files with 52 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

80
cycles_iter.ml
View file

@ -69,39 +69,63 @@ let find_all_cycles_johnson g =
let module SV = Set.Make(G.V) in let module SV = Set.Make(G.V) in
let extract_subgraph g s = let extract_subgraph g s =
let sg = G.create () in let sg = G.create () in
G.iter_edges (fun v1 v2 -> List.iter (fun v1 ->
if SV.mem v1 s then G.add_vertex sg v1; G.add_vertex sg v1;
if SV.mem v2 s then G.add_vertex sg v2; List.iter (fun e ->
if SV.mem v1 s && SV.mem v2 s then let v2 = G.E.dst e in
G.add_edge sg v1 v2 if List.mem v2 s then
) g; G.add_edge_e sg e
) (G.succ_e g v1)
) s;
sg sg
in in
(* Johnson's algorithm requires some ordering of the nodes. (* Johnson's algorithm requires some ordering of the nodes.
* They might not be sortable so we assign an arbitrary ordering. * They might not be sortable so we assign an arbitrary ordering.
*) *)
let to_set l = List.fold_right SV.add l SV.empty in let scc_with_vertex g v =
let vertex_set = G.fold_vertex SV.add g SV.empty in let _,scc = G.Components.scc g in
let part s w = fst(SV.partition (fun e -> e >= w) s) in let n = scc v in
SV.iter (fun s -> let sg = G.create () in
(* Build the subgraph induced by s and following nodes in the ordering *) G.iter_vertex (fun v1 ->
let subset = SV.add s (part vertex_set s) in if (scc v1) = n then
let subgraph = extract_subgraph g subset in List.iter (fun e ->
let scc = G.Components.scc_list subgraph in if scc (G.E.dst e) = n then
(* Find the strongly connected component in the subgraph G.add_edge_e sg e
* that contains the least node according to the ordering *) ) (G.succ_e g v1)
let minnode = SV.min_elt subset in ) g;
let mincomp = List.find (fun l -> List.mem minnode l) scc in sg
(* smallest node in the component according to the ordering *) in
let component = extract_subgraph subgraph (to_set mincomp) in
if G.nb_edges component > 0 then begin let list_min = function
G.iter_vertex (fun node -> | [] -> invalid_arg "empty list"
Hashtbl.replace blocked node false; | h::tl -> List.fold_left min h tl
Hashtbl.replace b node []; in
) component;
ignore(circuit minnode minnode component); let sort_components a b =
end compare (list_min a) (list_min b)
) vertex_set; in
let non_degenerate_scc = List.filter (fun scc -> (List.length scc) > 1) (G.Components.scc_list g) in
let non_degenerate_subgraphs = List.map
(fun scc -> extract_subgraph g scc)
(List.sort ~cmp:sort_components non_degenerate_scc)
in
List.iter (fun g ->
let vertex_set = G.fold_vertex (fun v l -> v::l) g [] in
List.iter (fun s ->
let component = scc_with_vertex g s in
if G.nb_edges component > 0 then begin
G.iter_vertex (fun node ->
Hashtbl.replace blocked node false;
Hashtbl.replace b node [];
) component;
ignore(circuit s s component);
end;
G.remove_vertex g s;
) (List.sort vertex_set);
) non_degenerate_subgraphs;
List.rev !result List.rev !result
;; ;;