1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(digraph_utils_SUITE).
21
22%%-define(debug, true).
23-ifdef(debug).
24-define(line, put(line, ?LINE), ).
25-else.
26-include_lib("common_test/include/ct.hrl").
27-endif.
28
29-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
30	 init_per_group/2,end_per_group/2]).
31
32-export([simple/1, loop/1, isolated/1, topsort/1, subgraph/1,
33         condensation/1, tree/1]).
34
35
36%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37
38suite() -> [{ct_hooks,[ts_install_cth]}].
39
40all() ->
41    [simple, loop, isolated, topsort, subgraph,
42     condensation, tree].
43
44groups() ->
45    [].
46
47init_per_suite(Config) ->
48    Config.
49
50end_per_suite(_Config) ->
51    ok.
52
53init_per_group(_GroupName, Config) ->
54    Config.
55
56end_per_group(_GroupName, Config) ->
57    Config.
58
59
60%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
61
62simple(Config) when is_list(Config) ->
63    G = digraph:new(),
64    add_vertices(G, [a]),
65    add_edges(G, [{b,c},{b,d},{e,f},{f,g},{g,e},{h,h},{i,i},{i,j}]),
66    10 = length(digraph_utils:postorder(G)),
67    10 = length(digraph_utils:preorder(G)),
68    ok = evall(digraph_utils:components(G),
69	       [[a],[b,c,d],[e,f,g],[h],[i,j]]),
70    ok = evall(digraph_utils:strong_components(G),
71	       [[a],[b],[c],[d],[e,f,g],[h],[i],[j]]),
72    ok = evall(digraph_utils:cyclic_strong_components(G),
73	       [[e,f,g],[h],[i]]),
74    true = path(G, e, e),
75    false = path(G, e, j),
76    false = path(G, a, a),
77    false = digraph_utils:topsort(G),
78    false = digraph_utils:is_acyclic(G),
79    ok = eval(digraph_utils:loop_vertices(G), [h,i]),
80    ok = eval(digraph_utils:reaching([e], G), [e,f,g]),
81    ok = eval(digraph_utils:reaching_neighbours([e], G), [e,f,g]),
82    ok = eval(digraph_utils:reachable([e], G), [e,f,g]),
83    ok = eval(digraph_utils:reachable_neighbours([e], G), [e,f,g]),
84    ok = eval(digraph_utils:reaching([b], G), [b]),
85    ok = eval(digraph_utils:reaching_neighbours([b], G), []),
86    ok = eval(digraph_utils:reachable([b], G), [b,c,d]),
87    ok = eval(digraph_utils:reachable_neighbours([b], G), [c,d]),
88    ok = eval(digraph_utils:reaching([h], G), [h]),
89    ok = eval(digraph_utils:reaching_neighbours([h], G), [h]),
90    ok = eval(digraph_utils:reachable([h], G), [h]),
91    ok = eval(digraph_utils:reachable_neighbours([h], G), [h]),
92    ok = eval(digraph_utils:reachable([e,f], G), [e,f,g]),
93    ok = eval(digraph_utils:reachable_neighbours([e,f], G), [e,f,g]),
94    ok = eval(digraph_utils:reachable([h,h,h], G), [h]),
95    true = digraph:delete(G),
96    ok.
97
98loop(Config) when is_list(Config) ->
99    G = digraph:new(),
100    add_vertices(G, [a,b]),
101    add_edges(G, [{a,a},{b,b}]),
102    ok = evall(digraph_utils:components(G), [[a],[b]]),
103    ok = evall(digraph_utils:strong_components(G), [[a],[b]]),
104    ok = evall(digraph_utils:cyclic_strong_components(G), [[a],[b]]),
105    [_,_] = digraph_utils:topsort(G),
106    false = digraph_utils:is_acyclic(G),
107    ok = eval(digraph_utils:loop_vertices(G), [a,b]),
108    [_,_] = digraph_utils:preorder(G),
109    [_,_] = digraph_utils:postorder(G),
110    ok = eval(digraph_utils:reaching([b], G), [b]),
111    ok = eval(digraph_utils:reaching_neighbours([b], G), [b]),
112    ok = eval(digraph_utils:reachable([b], G), [b]),
113    ok = eval(digraph_utils:reachable_neighbours([b], G), [b]),
114    true = path(G, a, a),
115    true = digraph:delete(G),
116    ok.
117
118isolated(Config) when is_list(Config) ->
119    G = digraph:new(),
120    add_vertices(G, [a,b]),
121    ok = evall(digraph_utils:components(G), [[a],[b]]),
122    ok = evall(digraph_utils:strong_components(G), [[a],[b]]),
123    ok = evall(digraph_utils:cyclic_strong_components(G), []),
124    [_,_] = digraph_utils:topsort(G),
125    true = digraph_utils:is_acyclic(G),
126    ok = eval(digraph_utils:loop_vertices(G), []),
127    [_,_] = digraph_utils:preorder(G),
128    [_,_] = digraph_utils:postorder(G),
129    ok = eval(digraph_utils:reaching([b], G), [b]),
130    ok = eval(digraph_utils:reaching_neighbours([b], G), []),
131    ok = eval(digraph_utils:reachable([b], G), [b]),
132    ok = eval(digraph_utils:reachable_neighbours([b], G), []),
133    false = path(G, a, a),
134    true = digraph:delete(G),
135    ok.
136
137topsort(Config) when is_list(Config) ->
138    G = digraph:new(),
139    add_edges(G, [{a,b},{b,c},{c,d},{d,e},{e,f}]),
140    ok = eval(digraph_utils:topsort(G), [a,b,c,d,e,f]),
141    true = digraph:delete(G),
142    ok.
143
144subgraph(Config) when is_list(Config) ->
145    G = digraph:new([acyclic]),
146    add_edges(G, [{b,c},{b,d},{e,f},{f,fg,fgl,g},{f,fg2,fgl2,g},{g,e},
147		  {h,h},{i,i},{i,j}]),
148    add_vertices(G, [{b,bl},{f,fl}]),
149    SG = digraph_utils:subgraph(G, [u1,b,c,u2,f,g,i,u3]),
150    [b,c,f,g,i] = lists:sort(digraph:vertices(SG)),
151    {b,bl} = digraph:vertex(SG, b),
152    {c,[]} = digraph:vertex(SG, c),
153    {fg,f,g,fgl} = digraph:edge(SG, fg),
154    {fg2,f,g,fgl2} = digraph:edge(SG, fg2),
155    {_, {_, acyclic}} = lists:keysearch(cyclicity, 1, digraph:info(SG)),
156    true = digraph:delete(SG),
157
158    SG1 = digraph_utils:subgraph(G, [f, g, h],
159				 [{type, []}, {keep_labels, false}]),
160    [f,g,h] = lists:sort(digraph:vertices(SG1)),
161    {f,[]} = digraph:vertex(SG1, f),
162    {fg,f,g,[]} = digraph:edge(SG1, fg),
163    {_, {_, cyclic}} = lists:keysearch(cyclicity, 1, digraph:info(SG1)),
164    true = digraph:delete(SG1),
165
166    SG2 = digraph_utils:subgraph(G, [f, g, h],
167				 [{type, [acyclic]},
168				  {keep_labels, true}]),
169    [f,g,h] = lists:sort(digraph:vertices(SG2)),
170    {f,fl} = digraph:vertex(SG2, f),
171    {fg,f,g,fgl} = digraph:edge(SG2, fg),
172    {_, {_, acyclic}} = lists:keysearch(cyclicity, 1, digraph:info(SG2)),
173    true = digraph:delete(SG2),
174
175    {'EXIT',{badarg,_}} =
176	(catch digraph_utils:subgraph(G, [f], [{invalid, opt}])),
177    {'EXIT',{badarg,_}} =
178	(catch digraph_utils:subgraph(G, [f], [{keep_labels, not_Bool}])),
179    {'EXIT',{badarg,_}} =
180	(catch digraph_utils:subgraph(G, [f], [{type, not_type}])),
181    {'EXIT',{badarg,_}} =
182	(catch digraph_utils:subgraph(G, [f], [{type, [not_type]}])),
183    {'EXIT',{badarg,_}} =
184	(catch digraph_utils:subgraph(G, [f], not_a_list)),
185
186    true = digraph:delete(G),
187
188    ok.
189
190condensation(Config) when is_list(Config) ->
191    G = digraph:new([]),
192    add_edges(G, [{b,c},{b,d},{e,f},{f,fg,fgl,g},{f,fg2,fgl2,g},{g,e},
193		  {h,h},{j,i},{i,j}]),
194    add_vertices(G, [q]),
195    CG = digraph_utils:condensation(G),
196    Vs = sort_2(digraph:vertices(CG)),
197    [[b],[c],[d],[e,f,g],[h],[i,j],[q]] = Vs,
198    Fun = fun(E) ->
199		  {_E, V1, V2, _L} = digraph:edge(CG, E),
200		  {lists:sort(V1), lists:sort(V2)}
201	  end,
202    Es = lists:map(Fun, digraph:edges(CG)),
203    [{[b],[c]},{[b],[d]}] = lists:sort(Es),
204    true = digraph:delete(CG),
205    true = digraph:delete(G),
206    ok.
207
208%% OTP-7081
209tree(Config) when is_list(Config) ->
210    false = is_tree([], []),
211    true = is_tree([a], []),
212    false = is_tree([a,b], []),
213    true = is_tree([{a,b}]),
214    false = is_tree([{a,b},{b,a}]),
215    true = is_tree([{a,b},{a,c},{b,d},{b,e}]),
216    false = is_tree([{a,b},{a,c},{b,d},{b,e}, {d,e}]),
217    false = is_tree([{a,b},{a,c},{b,d},{b,e}, {b,e}]),
218    true = is_tree([{a,c},{c,b}]),
219    true = is_tree([{b,a},{c,a}]),
220    %% Parallel edges. Acyclic and with one componets
221    %% (according to the digraph module).
222    false = is_tree([{a,b},{a,b}]),
223
224    no = arborescence_root([], []),
225    {yes, a} = arborescence_root([a], []),
226    no = arborescence_root([a,b], []),
227    {yes, a} = arborescence_root([{a,b}]),
228    no = arborescence_root([{a,b},{b,a}]),
229    {yes, a} = arborescence_root([{a,b},{a,c},{b,d},{b,e}]),
230    no = arborescence_root([{a,b},{a,c},{b,d},{b,e}, {d,e}]),
231    no = arborescence_root([{a,b},{a,c},{b,d},{b,e}, {b,e}]),
232    {yes, a} = arborescence_root([{a,c},{c,b}]),
233    no = arborescence_root([{b,a},{c,a}]),
234
235    false = is_arborescence([], []),
236    true = is_arborescence([a], []),
237    false = is_arborescence([a,b], []),
238    true = is_arborescence([{a,b}]),
239    false = is_arborescence([{a,b},{b,a}]),
240    true = is_arborescence([{a,b},{a,c},{b,d},{b,e}]),
241    false = is_arborescence([{a,b},{a,c},{b,d},{b,e}, {d,e}]),
242    false = is_arborescence([{a,b},{a,c},{b,d},{b,e}, {b,e}]),
243    true = is_arborescence([{a,c},{c,b}]),
244    false = is_arborescence([{b,a},{c,a}]),
245
246    %% Parallel edges.
247    false = is_arborescence([{a,b},{a,b}]),
248
249    ok.
250
251is_tree(Es) ->
252    is_tree([], Es).
253
254is_tree(Vs, Es) ->
255    gu(Vs, Es, is_tree).
256
257is_arborescence(Es) ->
258    is_arborescence([], Es).
259
260is_arborescence(Vs, Es) ->
261    gu(Vs, Es, is_arborescence).
262
263arborescence_root(Es) ->
264    arborescence_root([], Es).
265
266arborescence_root(Vs, Es) ->
267    gu(Vs, Es, arborescence_root).
268
269gu(Vs, Es, F) ->
270    G = digraph:new(),
271    add_vertices(G, Vs),
272    add_edges(G, Es),
273    Reply = digraph_utils:F(G),
274    true = digraph:delete(G),
275    Reply.
276
277%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
278
279sort_2(L) ->
280    lists:sort(lists:map(fun(V) -> lists:sort(V) end, L)).
281
282path(G, V1, V2) ->
283    digraph:get_path(G, V1, V2) /= false.
284
285add_vertices(G, Vs) ->
286    lists:foreach(fun({V, Label}) -> digraph:add_vertex(G, V, Label);
287		     (V) -> digraph:add_vertex(G, V)
288		  end, Vs).
289
290add_edges(G, L) ->
291    Fun = fun({From, To}) ->
292		  digraph:add_vertex(G, From),
293		  digraph:add_vertex(G, To),
294		  digraph:add_edge(G, From, To);
295	     ({From, Edge, Label, To}) ->
296		  digraph:add_vertex(G, From),
297		  digraph:add_vertex(G, To),
298		  digraph:add_edge(G, Edge, From, To, Label)
299	  end,
300    lists:foreach(Fun, L).
301
302eval(L, E) ->
303    Expected = lists:sort(E),
304    Got = lists:sort(L),
305    if
306	Expected == Got ->
307	    ok;
308	true ->
309	    not_ok
310    end.
311
312evall(L, E) ->
313    F = fun(L1) -> lists:sort(L1) end,
314    Fun = fun(LL) -> F(lists:map(F, LL)) end,
315
316    Expected = Fun(E),
317    Got = Fun(L),
318    if
319	Expected == Got ->
320	    ok;
321	true ->
322	    not_ok
323    end.
324