The R13B03 release.OTP_R13B03

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).