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
module P(G : Sig.P) = struct
module CT = Cliquetree.CliqueTree(G)
type edgeset = (G.V.t * G.V.t) list
let md g =
let gref = ref g in
let gtri = ref g in
let n = G.nb_vertex g in
let tri = ref [] in
let ord = ref [] in
let i = ref 0 in
while not (CT.is_chordal !gtri) && !i < n do
let v =
let x =
G.fold_vertex
(fun v' x ->
let deg' = G.out_degree !gref v' in
match x with
Some (_,deg) when deg' > deg -> x
| _ -> Some (v', deg'))
!gref None
in match x with
Some (v,_) -> v
| None -> failwith "Expecting some vertex"
in
let ng = G.succ !gref v in
let g', tri' =
List.fold_left
(fun (g, tri) v ->
let tri' =
List.fold_left
(fun tri v' ->
if v <> v' && not (G.mem_edge g v v') then
(v, v') :: tri
else tri)
tri ng
in
let g' =
List.fold_left
(fun g v' ->
if v <> v' then
G.add_edge g v v'
else g)
g ng
in
(g', tri'))
(!gref, []) ng
in
ord := v :: !ord;
gtri := List.fold_left
(fun g (x,y) -> G.add_edge g x y)
!gtri tri';
gref := G.remove_vertex g' v;
tri := tri' @ !tri;
incr i;
done;
(!gtri, !tri, !ord)
let triangulate g =
let gtri, _, _ = md g in
gtri
end
module I(G : Sig.I) = struct
module CT = Cliquetree.CliqueTree(G)
type edgeset = (G.V.t * G.V.t) list
module Copy = Gmap.Vertex(G)(struct include G include Builder.I(G) end)
let md g =
let gtri = Copy.map (fun x -> x) g in
let gcur = Copy.map (fun x -> x) g in
let n = G.nb_vertex g in
let tri = ref [] in
let ord = ref [] in
let i = ref 0 in
while not (CT.is_chordal gtri) && !i < n do
let v =
let x =
G.fold_vertex
(fun v' x ->
let deg' = G.out_degree gcur v' in
match x with
Some (_,deg) when deg' > deg -> x
| _ -> Some (v', deg'))
gcur None
in match x with
Some (v,_) -> v
| None -> failwith "Expecting some vertex"
in
let ng = G.succ gcur v in
let tri' =
List.fold_left
(fun tri v ->
List.fold_left
(fun tri v' ->
let tri' =
if v <> v' && not (G.mem_edge g v v') then
(v, v') :: tri
else
tri
in
List.iter (fun v' -> if v <> v' then G.add_edge gcur v v') ng;
tri')
tri ng)
[] ng
in
ord := v :: !ord;
List.iter
(fun (x,y) -> G.add_edge gtri x y)
tri';
G.remove_vertex gcur v;
tri := tri' @ !tri;
incr i;
done;
(gtri, !tri, !ord)
let triangulate g =
let gtri, _, _ = md g in
gtri
end