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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
(** Build graphml graph *)
module S = Statocaml
module Log = Statocaml.Log
module X = Xtmpl.Xml
let keys = [%xtmpl.string {xml|
<key id="d0" for="node" attr.name="label" attr.type="string">
<default></default>
</key>
<key id="d1" for="node" attr.name="x_coordinate" attr.type="double">
<default>0.0</default>
</key>
<key id="d2" for="node" attr.name="y_coordinate" attr.type="double">
<default>0.0</default>
</key>
<key id="d3" for="node" attr.name="size" attr.type="double">
<default>10</default>
</key>
<key id="d4" for="node" attr.name="color" attr.type="string">
<default>red</default>
</key>
<key id="d5" for="node" attr.name="shape" attr.type="string">
<default>circle</default>
</key>
<key id="d6" for="node" attr.name="label.color" attr.type="string">
<default>#8d8d8d</default>
</key>
<key id="d7" for="node" attr.name="label.size" attr.type="string">
<default>8</default>
</key>
<key id="d8" for="edge" attr.name="weight" attr.type="double">
<default>1.0</default>
</key>
<key id="d9" for="edge" attr.name="color" attr.type="string">
<default>#666666</default>
</key>
<key id="d10" for="edge" attr.name="label" attr.type="string">
<default></default>
</key>
<key id="d11" for="node" attr.name="contrib_id" attr.type="int">
<default>-1</default>
</key>
|xml}]
let keys = Xtmpl.Rewrite.to_xmls (keys())
module Make (P:Statocaml_profile.T.S) =
struct
let graphml ~file f_edges by_id =
let no_loc x = x, None in
let node_id = string_of_int in
let f_edge source_id target_id weight edges =
if source_id <= target_id then
(
let atts= X.atts_of_list [
("","source"), no_loc (node_id source_id) ;
("","target"), no_loc (node_id target_id) ;
]
in
let data = X.node ("","data")
~atts:(X.atts_one ("","key") (no_loc "d8"))
[X.cdata (string_of_int (truncate weight))]
in
let edge = X.node ("","edge") ~atts [data] in
edge :: edges
)
else
edges
in
let f id (user:P.profile) (nodes,edges) =
let nid = node_id id in
let dated = P.get_dated user S.Period.All in
let node =
let data = [
X.node ("","data")
~atts:(X.atts_one ("","key") (no_loc "d0"))
[X.cdata user.name] ;
X.node ("","data")
~atts:(X.atts_one ("","key") (no_loc "d11"))
[X.cdata (string_of_int user.id)] ;
]
in
X.node ("","node") ~atts:(X.atts_one ("","id") (no_loc nid)) data
in
let nodes = node :: nodes in
let edges = S.Imap.fold (f_edge id) (f_edges dated) edges in
(nodes, edges)
in
let nodes, edges = S.Imap.fold f by_id ([], []) in
let elements = nodes @ edges in
let graph_atts = X.atts_of_list [
("","id"), no_loc "G" ;
("", "edgedefault"), no_loc "undirected" ;
]
in
let graph = X.node ~atts:graph_atts ("","graph") elements in
let root_atts = X.atts_of_list [
("","xmlns"), no_loc "http://graphml.graphdrawing.org/xmlns" ;
("xmlns","xsi"), no_loc "http://www.w3.org/2001/XMLSchema-instance" ;
("xsi","schemaLocation"), no_loc "http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd" ;
]
in
let root = X.node ~atts:root_atts ("","graphml") (keys @ [graph]) in
let str = X.to_string [root] in
Log.info (fun m -> m "Generating graph %s" file);
Lwt_io.(with_file ~mode:Output file (fun oc -> write oc str))
end