graph.ml
2.39 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
open Xstd
(* type 'a nodes = 'a IntMap.t *)
type edges = IntSet.t IntMap.t
let empty = (*IntMap.empty,*)IntMap.empty (* nodes * edges *)
(* let add_node (nodes,edges) id node =
IntMap.add_inc nodes id node (fun _ ->
failwith ("add_node: node " ^ string_of_int id ^ "is already in graph"), edges) *)
let add(*_edge*) (*nodes,*)edges id_parent id_child =
(*nodes,*) IntMap.add_inc edges id_parent (IntSet.singleton id_child) (fun set ->
if IntSet.mem set id_child then
failwith ("add_edge: edge " ^ string_of_int id_parent ^ "-->" ^ string_of_int id_child ^ "is already in graph")
else IntSet.add set id_child)
(* UWAGA: to działa gdy selektor jest monotoniczny względem relacji *)
let select_node_set edges selected =
IntMap.fold edges IntMap.empty (fun edges pid nodes ->
let nodes = IntSet.fold nodes IntSet.empty (fun nodes id ->
if IntSet.mem selected id then IntSet.add nodes id else nodes) in
if IntSet.is_empty nodes then edges else
IntMap.add edges pid nodes)
let rec get_children_ids edges selected id =
if IntSet.mem selected id then selected else
let selected = IntSet.add selected id in
IntSet.fold (try IntMap.find edges id with Not_found -> IntSet.empty) selected (get_children_ids edges)
let get_all_ids edges =
IntMap.fold edges IntSet.empty (fun ids id nodes ->
IntSet.fold nodes (IntSet.add ids id) IntSet.add)
let select_maximal_ids edges =
let selected = get_all_ids edges in
IntMap.fold edges selected (fun selected _ nodes ->
IntSet.fold nodes selected (fun selected id ->
IntSet.remove selected id))
let print_graph path name lr edges node_fun =
let ids = get_all_ids edges in
let max_ids = select_maximal_ids edges in
File.file_out (path ^ name ^ ".gv") (fun file ->
if lr then Printf.fprintf file "digraph G {\n node [shape=box]\n rankdir = LR\n"
else Printf.fprintf file "digraph G {\n node [shape=box]\n";
IntSet.iter ids (fun id ->
if IntSet.mem max_ids id then
Printf.fprintf file " %d [color=\".7 .3 1.0\",style=filled,label=\"%s\"]\n" id (node_fun id)
else Printf.fprintf file " %d [label=\"%s\"]\n" id (node_fun id));
IntMap.iter edges (fun id1 nodes ->
IntSet.iter nodes (fun id2 ->
Printf.fprintf file " %d -> %d\n" id1 id2));
Printf.fprintf file "}\n");
Sys.chdir path;
ignore (Sys.command ("dot -Tpng " ^ name ^ ".gv -o " ^ name ^ ".png"));
Sys.chdir "..";
()