%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
-module(digraph_utils).
%%% Operations on directed (and undirected) graphs.
%%%
%%% Implementation based on Launchbury, John: Graph Algorithms with a
%%% Functional Flavour, in Jeuring, Johan, and Meijer, Erik (Eds.):
%%% Advanced Functional Programming, Lecture Notes in Computer
%%% Science 925, Springer Verlag, 1995.
-export([components/1, strong_components/1, cyclic_strong_components/1,
reachable/2, reachable_neighbours/2,
reaching/2, reaching_neighbours/2,
topsort/1, is_acyclic/1,
arborescence_root/1, is_arborescence/1, is_tree/1,
loop_vertices/1,
subgraph/2, subgraph/3, condensation/1,
preorder/1, postorder/1]).
%%
%% A convenient type alias
%%
-type vertices() :: [digraph:vertex()].
%%
%% Exported functions
%%
-spec components(digraph()) -> vertices().
components(G) ->
forest(G, fun inout/3).
-spec strong_components(digraph()) -> vertices().
strong_components(G) ->
forest(G, fun in/3, revpostorder(G)).
-spec cyclic_strong_components(digraph()) -> vertices().
cyclic_strong_components(G) ->
remove_singletons(strong_components(G), G, []).
-spec reachable(vertices(), digraph()) -> vertices().
reachable(Vs, G) when is_list(Vs) ->
lists:append(forest(G, fun out/3, Vs, first)).
-spec reachable_neighbours(vertices(), digraph()) -> vertices().
reachable_neighbours(Vs, G) when is_list(Vs) ->
lists:append(forest(G, fun out/3, Vs, not_first)).
-spec reaching(vertices(), digraph()) -> vertices().
reaching(Vs, G) when is_list(Vs) ->
lists:append(forest(G, fun in/3, Vs, first)).
-spec reaching_neighbours(vertices(), digraph()) -> vertices().
reaching_neighbours(Vs, G) when is_list(Vs) ->
lists:append(forest(G, fun in/3, Vs, not_first)).
-spec topsort(digraph()) -> vertices() | 'false'.
topsort(G) ->
L = revpostorder(G),
case length(forest(G, fun in/3, L)) =:= length(digraph:vertices(G)) of
true -> L;
false -> false
end.
-spec is_acyclic(digraph()) -> boolean().
is_acyclic(G) ->
loop_vertices(G) =:= [] andalso topsort(G) =/= false.
-spec arborescence_root(digraph()) -> 'no' | {'yes', digraph:vertex()}.
arborescence_root(G) ->
case digraph:no_edges(G) =:= digraph:no_vertices(G) - 1 of
true ->
try
F = fun(V, Z) ->
case digraph:in_degree(G, V) of
1 -> Z;
0 when Z =:= [] -> [V]
end
end,
[Root] = lists:foldl(F, [], digraph:vertices(G)),
{yes, Root}
catch _:_ ->
no
end;
false ->
no
end.
-spec is_arborescence(digraph()) -> boolean().
is_arborescence(G) ->
arborescence_root(G) =/= no.
-spec is_tree(digraph()) -> boolean().
is_tree(G) ->
(digraph:no_edges(G) =:= digraph:no_vertices(G) - 1)
andalso (length(components(G)) =:= 1).
-spec loop_vertices(digraph()) -> vertices().
loop_vertices(G) ->
[V || V <- digraph:vertices(G), is_reflexive_vertex(V, G)].
-spec subgraph(digraph(), vertices()) -> digraph().
subgraph(G, Vs) ->
try
subgraph_opts(G, Vs, [])
catch
throw:badarg ->
erlang:error(badarg)
end.
-type option() :: {'type', 'inherit' | [digraph:d_type()]}
| {'keep_labels', boolean()}.
-spec subgraph(digraph(), vertices(), [option()]) -> digraph().
subgraph(G, Vs, Opts) ->
try
subgraph_opts(G, Vs, Opts)
catch
throw:badarg ->
erlang:error(badarg)
end.
-spec condensation(digraph()) -> digraph().
condensation(G) ->
SCs = strong_components(G),
%% Each component is assigned a number.
%% V2I: from vertex to number.
%% I2C: from number to component.
V2I = ets:new(condensation, []),
I2C = ets:new(condensation, []),
CFun = fun(SC, N) -> lists:foreach(fun(V) ->
true = ets:insert(V2I, {V,N})
end,
SC),
true = ets:insert(I2C, {N, SC}),
N + 1
end,
lists:foldl(CFun, 1, SCs),
SCG = subgraph_opts(G, [], []),
lists:foreach(fun(SC) -> condense(SC, G, SCG, V2I, I2C) end, SCs),
ets:delete(V2I),
ets:delete(I2C),
SCG.
-spec preorder(digraph()) -> vertices().
preorder(G) ->
lists:reverse(revpreorder(G)).
-spec postorder(digraph()) -> vertices().
postorder(G) ->
lists:reverse(revpostorder(G)).
%%
%% Local functions
%%
forest(G, SF) ->
forest(G, SF, digraph:vertices(G)).
forest(G, SF, Vs) ->
forest(G, SF, Vs, first).
forest(G, SF, Vs, HandleFirst) ->
T = ets:new(forest, [set]),
F = fun(V, LL) -> pretraverse(HandleFirst, V, SF, G, T, LL) end,
LL = lists:foldl(F, [], Vs),
ets:delete(T),
LL.
pretraverse(first, V, SF, G, T, LL) ->
ptraverse([V], SF, G, T, [], LL);
pretraverse(not_first, V, SF, G, T, LL) ->
case ets:member(T, V) of
false -> ptraverse(SF(G, V, []), SF, G, T, [], LL);
true -> LL
end.
ptraverse([V | Vs], SF, G, T, Rs, LL) ->
case ets:member(T, V) of
false ->
ets:insert(T, {V}),
ptraverse(SF(G, V, Vs), SF, G, T, [V | Rs], LL);
true ->
ptraverse(Vs, SF, G, T, Rs, LL)
end;
ptraverse([], _SF, _G, _T, [], LL) ->
LL;
ptraverse([], _SF, _G, _T, Rs, LL) ->
[Rs | LL].
revpreorder(G) ->
lists:append(forest(G, fun out/3)).
revpostorder(G) ->
T = ets:new(forest, [set]),
L = posttraverse(digraph:vertices(G), G, T, []),
ets:delete(T),
L.
posttraverse([V | Vs], G, T, L) ->
L1 = case ets:member(T, V) of
false ->
ets:insert(T, {V}),
[V | posttraverse(out(G, V, []), G, T, L)];
true ->
L
end,
posttraverse(Vs, G, T, L1);
posttraverse([], _G, _T, L) ->
L.
in(G, V, Vs) ->
digraph:in_neighbours(G, V) ++ Vs.
out(G, V, Vs) ->
digraph:out_neighbours(G, V) ++ Vs.
inout(G, V, Vs) ->
in(G, V, out(G, V, Vs)).
remove_singletons([C=[V] | Cs], G, L) ->
case is_reflexive_vertex(V, G) of
true -> remove_singletons(Cs, G, [C | L]);
false -> remove_singletons(Cs, G, L)
end;
remove_singletons([C | Cs], G, L) ->
remove_singletons(Cs, G, [C | L]);
remove_singletons([], _G, L) ->
L.
is_reflexive_vertex(V, G) ->
lists:member(V, digraph:out_neighbours(G, V)).
subgraph_opts(G, Vs, Opts) ->
subgraph_opts(Opts, inherit, true, G, Vs).
subgraph_opts([{type, Type} | Opts], _Type0, Keep, G, Vs)
when Type =:= inherit; is_list(Type) ->
subgraph_opts(Opts, Type, Keep, G, Vs);
subgraph_opts([{keep_labels, Keep} | Opts], Type, _Keep0, G, Vs)
when is_boolean(Keep) ->
subgraph_opts(Opts, Type, Keep, G, Vs);
subgraph_opts([], inherit, Keep, G, Vs) ->
Info = digraph:info(G),
{_, {_, Cyclicity}} = lists:keysearch(cyclicity, 1, Info),
{_, {_, Protection}} = lists:keysearch(protection, 1, Info),
subgraph(G, Vs, [Cyclicity, Protection], Keep);
subgraph_opts([], Type, Keep, G, Vs) ->
subgraph(G, Vs, Type, Keep);
subgraph_opts(_, _Type, _Keep, _G, _Vs) ->
throw(badarg).
subgraph(G, Vs, Type, Keep) ->
try digraph:new(Type) of
SG ->
lists:foreach(fun(V) -> subgraph_vertex(V, G, SG, Keep) end, Vs),
EFun = fun(V) -> lists:foreach(fun(E) ->
subgraph_edge(E, G, SG, Keep)
end,
digraph:out_edges(G, V))
end,
lists:foreach(EFun, digraph:vertices(SG)),
SG
catch
error:badarg ->
throw(badarg)
end.
subgraph_vertex(V, G, SG, Keep) ->
case digraph:vertex(G, V) of
false -> ok;
_ when not Keep -> digraph:add_vertex(SG, V);
{_V, Label} when Keep -> digraph:add_vertex(SG, V, Label)
end.
subgraph_edge(E, G, SG, Keep) ->
{_E, V1, V2, Label} = digraph:edge(G, E),
case digraph:vertex(SG, V2) of
false -> ok;
_ when not Keep -> digraph:add_edge(SG, E, V1, V2, []);
_ when Keep -> digraph:add_edge(SG, E, V1, V2, Label)
end.
condense(SC, G, SCG, V2I, I2C) ->
T = ets:new(condense, []),
NFun = fun(Neighbour) ->
[{_V,I}] = ets:lookup(V2I, Neighbour),
ets:insert(T, {I})
end,
VFun = fun(V) -> lists:foreach(NFun, digraph:out_neighbours(G, V)) end,
lists:foreach(VFun, SC),
digraph:add_vertex(SCG, SC),
condense(ets:first(T), T, SC, G, SCG, I2C),
ets:delete(T).
condense('$end_of_table', _T, _SC, _G, _SCG, _I2C) ->
ok;
condense(I, T, SC, G, SCG, I2C) ->
[{_,C}] = ets:lookup(I2C, I),
digraph:add_vertex(SCG, C),
digraph:add_edge(SCG, SC, C),
condense(ets:next(T, I), T, SC, G, SCG, I2C).
