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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
let colored = true
module F (R : Repository.S) = struct
open R
module Quotient = Quotient.F(R)
module Conflicts = Conflicts.F (R)
let output
?package_weight
?(edge_color = fun _ _ _ -> Some "blue")
file ?(mark_all = false) ?(roots = [])
quotient deps confl =
let package_weight =
match package_weight with
Some f -> f
| None -> fun p -> float (Quotient.class_size quotient p)
in
let confl_style = if colored then ",color=red" else ",style=dashed" in
let confl_clique_style =
if colored then ",color=red,fontcolor=red" else "" in
let dep_style col = if colored then Format.sprintf "color=%s" col else "" in
let disj_dep_style col =
if colored then Format.sprintf "fontcolor=%s,color=%s" col col else "" in
(* Mark the packages to be included in the graph *)
let marks = Hashtbl.create 101 in
let marked i = Hashtbl.mem marks i in
let has_dependencies p =
let dep = PTbl.get deps p in
not (Formula.implies Formula._true dep ||
Formula.implies (Formula.lit p) dep)
in
let rec mark p =
if not (marked p) then begin
Hashtbl.add marks p ();
PSet.iter mark (Conflict.of_package confl p)
end
in
if mark_all then
Quotient.iter (fun p -> Hashtbl.add marks p ()) quotient
else if roots = [] then
Quotient.iter
(fun p ->
if has_dependencies p then begin
mark p;
Formula.iter (PTbl.get deps p) (fun d -> Disj.iter d mark)
end)
quotient
else (*XXX Find the right algorithm...
Work on transitive closure of dependencies
Mark all conflicts; marks all packages at the other side of
these conflicts and all the alternative in the dependency.
Proceed recursively...
Backward mode:
mark source package and all edges but the one considered
A package is not relevant if installing it or not has no
impact on the considered package
*)
List.iter mark roots;
let ch = open_out file in
let f = Format.formatter_of_out_channel ch in
Format.fprintf f "digraph G {@.";
Format.fprintf f "rankdir=LR;@.";
Format.fprintf f "ratio=1.4;@.margin=5;@.ranksep=3;@.";
Format.fprintf f "node [style=rounded];@.";
let confl_n = ref 0 in
Conflict.iter confl
(fun p q ->
if not (marked p) then begin
assert (not (marked q));
Conflict.remove confl p q
end);
let l = Conflicts.f quotient confl in
List.iter
(fun cset ->
match PSet.elements cset with
[i; j] ->
Format.fprintf f "%d -> %d [dir=none%s];@."
(Package.index i) (Package.index j) confl_style
| l ->
incr confl_n;
let n = !confl_n in
Format.fprintf f
"confl%d [label=\"#\",shape=circle%s];@."
n confl_clique_style;
List.iter
(fun i ->
Format.fprintf f
"%d -> confl%d [dir=none%s];@."
(Package.index i) n confl_style)
l)
l;
let dep_tbl = Hashtbl.create 101 in
let dep_n = ref 0 in
let add_dep i dep d =
let s = Disj.to_lits d in
match edge_color i dep d with
None ->
()
| Some col ->
match PSet.cardinal s with
0 ->
incr dep_n;
let n = !dep_n in
Format.fprintf f
"dep%d \
[label=\"MISSING DEP\",shape=box,fontcolor=red,%s];@."
n (dep_style col);
Format.fprintf f "%d -> dep%d [%s];@."
(Package.index i) n (dep_style col)
| 1 ->
if PSet.choose s <> i then
Format.fprintf f "%d -> %d [minlen=2, weight=2, %s];@."
(Package.index i) (Package.index (PSet.choose s))
(dep_style col)
| _ ->
let n =
try
Hashtbl.find dep_tbl s
with Not_found ->
incr dep_n;
let n = !dep_n in
Hashtbl.add dep_tbl s n;
(*
Format.fprintf f "dep%d [label=\"DEP\",shape=box,color=%s];@."
n col;
*)
Format.fprintf f "dep%d [label=\"∨\",shape=circle,%s];@."
n (disj_dep_style col);
(*
Format.fprintf f "dep%d [label=\"or\",shape=circle,%s];@."
n (disj_dep_style col);
*)
PSet.iter
(fun j ->
Format.fprintf f "dep%d -> %d [%s];@."
n (Package.index j) (dep_style col))
s;
n
in
Format.fprintf f "%d -> dep%d [dir=none,%s];@."
(Package.index i) n (dep_style col)
in
Quotient.iter
(fun i ->
let dep = PTbl.get deps i in
if marked i then begin
let n = package_weight i in
Format.fprintf f
"%d [label=\"%a\",style=\"filled\",\
fillcolor=\"0.0,%f,1.0\"];@."
(Package.index i) (Quotient.print_class quotient) i
(min 1. (log n /. log 1000.));
Formula.iter dep (fun s -> add_dep i dep s)
end)
quotient;
Format.fprintf f "}@.";
close_out ch
end
|
