aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/src/digraph_utils.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/src/digraph_utils.erl')
-rw-r--r--lib/stdlib/src/digraph_utils.erl338
1 files changed, 338 insertions, 0 deletions
diff --git a/lib/stdlib/src/digraph_utils.erl b/lib/stdlib/src/digraph_utils.erl
new file mode 100644
index 0000000000..080cae4742
--- /dev/null
+++ b/lib/stdlib/src/digraph_utils.erl
@@ -0,0 +1,338 @@
+%%
+%% %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).
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-11 11:51:52 +0000