The R13B03 release.OTP_R13B03

1 files changed, 570 insertions, 0 deletions

diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl
new file mode 100644
index 0000000000..9bdea671a9
--- /dev/null
+++ b/lib/stdlib/src/digraph.erl
@@ -0,0 +1,570 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-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).
+
+-export([new/0, new/1, delete/1, info/1]).
+
+-export([add_vertex/1, add_vertex/2, add_vertex/3]).
+-export([del_vertex/2, del_vertices/2]).
+-export([vertex/2, no_vertices/1, vertices/1]).
+-export([source_vertices/1, sink_vertices/1]).
+
+-export([add_edge/3, add_edge/4, add_edge/5]).
+-export([del_edge/2, del_edges/2, del_path/3]).
+-export([edge/2, no_edges/1, edges/1]).
+
+-export([out_neighbours/2, in_neighbours/2]).
+-export([out_edges/2, in_edges/2, edges/2]).
+-export([out_degree/2, in_degree/2]).
+-export([get_path/3, get_cycle/2]).
+
+-export([get_short_path/3, get_short_cycle/2]).
+
+-record(digraph, {vtab = notable :: ets:tab(),
+		  etab = notable :: ets:tab(),
+		  ntab = notable :: ets:tab(),
+	          cyclic = true  :: boolean()}).
+%% A declaration equivalent to the following one is hard-coded in erl_types.
+%% That declaration contains hard-coded information about the #digraph{}
+%% record and the types of its fields.  So, please make sure that any
+%% changes to its structure are also propagated to erl_types.erl.
+%%
+%% -opaque digraph() :: #digraph{}.
+
+-type edge()    :: term().
+-type label()   :: term().
+-type vertex()  :: term().
+
+-type add_edge_err_rsn() :: {'bad_edge', [vertex()]} | {'bad_vertex', vertex()}.
+
+%%
+%% Type is a list of
+%%  protected | private
+%%  acyclic | cyclic
+%%
+%%  default is [cyclic,protected]
+%%
+-type d_protection() :: 'private' | 'protected'.
+-type d_cyclicity()  :: 'acyclic' | 'cyclic'.
+-type d_type()       :: d_cyclicity() | d_protection().
+
+-spec new() -> digraph().
+
+new() -> new([]).
+
+-spec new([d_type()]) -> digraph().
+
+new(Type) ->
+    case check_type(Type, protected, []) of
+	{Access, Ts} ->
+	    V = ets:new(vertices, [set, Access]),
+	    E = ets:new(edges, [set, Access]),
+	    N = ets:new(neighbours, [bag, Access]),
+	    ets:insert(N, [{'$vid', 0}, {'$eid', 0}]),
+	    set_type(Ts, #digraph{vtab=V, etab=E, ntab=N});
+	error ->
+	    erlang:error(badarg)
+    end.
+
+%%
+%% Check type of graph
+%%
+%-spec check_type([d_type()], d_protection(), [{'cyclic', boolean()}]) ->
+%       	{d_protection(), [{'cyclic', boolean()}]}.
+
+check_type([acyclic|Ts], A, L) ->
+    check_type(Ts, A,[{cyclic,false} | L]);
+check_type([cyclic | Ts], A, L) ->
+    check_type(Ts, A, [{cyclic,true} | L]);
+check_type([protected | Ts], _, L) ->
+    check_type(Ts, protected, L);
+check_type([private | Ts], _, L) ->
+    check_type(Ts, private, L);
+check_type([], A, L) -> {A, L};
+check_type(_, _, _) -> error.
+
+%%
+%% Set graph type
+%%
+-spec set_type([{'cyclic', boolean()}], digraph()) -> digraph().
+
+set_type([{cyclic,V} | Ks], G) ->
+    set_type(Ks, G#digraph{cyclic = V});
+set_type([], G) -> G.
+
+
+%% Data access functions
+
+-spec delete(digraph()) -> 'true'.
+
+delete(G) ->
+    ets:delete(G#digraph.vtab),
+    ets:delete(G#digraph.etab),
+    ets:delete(G#digraph.ntab).
+
+-spec info(digraph()) -> [{'cyclicity', d_cyclicity()} |
+			  {'memory', non_neg_integer()} |
+			  {'protection', d_protection()}].
+info(G) ->
+    VT = G#digraph.vtab,
+    ET = G#digraph.etab,
+    NT = G#digraph.ntab,
+    Cyclicity = case G#digraph.cyclic of
+		    true  -> cyclic;
+		    false -> acyclic
+		end,
+    Protection = ets:info(VT, protection),
+    Memory = ets:info(VT, memory) + ets:info(ET, memory) + ets:info(NT, memory),
+    [{cyclicity, Cyclicity}, {memory, Memory}, {protection, Protection}].
+
+-spec add_vertex(digraph()) -> vertex().
+
+add_vertex(G) ->
+    do_add_vertex({new_vertex_id(G), []}, G).
+
+-spec add_vertex(digraph(), vertex()) -> vertex().
+
+add_vertex(G, V) ->
+    do_add_vertex({V, []}, G).
+
+-spec add_vertex(digraph(), vertex(), label()) -> vertex().
+
+add_vertex(G, V, D) ->
+    do_add_vertex({V, D}, G).
+
+-spec del_vertex(digraph(), vertex()) -> 'true'.
+
+del_vertex(G, V) ->
+    do_del_vertex(V, G).
+
+-spec del_vertices(digraph(), [vertex()]) -> 'true'.
+
+del_vertices(G, Vs) -> 
+    do_del_vertices(Vs, G).
+
+-spec vertex(digraph(), vertex()) -> {vertex(), label()} | 'false'.
+
+vertex(G, V) ->
+    case ets:lookup(G#digraph.vtab, V) of
+	[] -> false;
+	[Vertex] -> Vertex
+    end.
+
+-spec no_vertices(digraph()) -> non_neg_integer().
+
+no_vertices(G) ->
+    ets:info(G#digraph.vtab, size).
+
+-spec vertices(digraph()) -> [vertex()].
+
+vertices(G) ->
+    ets:select(G#digraph.vtab, [{{'$1', '_'}, [], ['$1']}]).
+
+-spec source_vertices(digraph()) -> [vertex()].
+
+source_vertices(G) ->
+    collect_vertices(G, in).
+
+-spec sink_vertices(digraph()) -> [vertex()].
+
+sink_vertices(G) ->
+    collect_vertices(G, out).
+
+-spec in_degree(digraph(), vertex()) -> non_neg_integer().
+
+in_degree(G, V) ->
+    length(ets:lookup(G#digraph.ntab, {in, V})).
+
+-spec in_neighbours(digraph(), vertex()) -> [vertex()].
+
+in_neighbours(G, V) ->
+    ET = G#digraph.etab,
+    NT = G#digraph.ntab,
+    collect_elems(ets:lookup(NT, {in, V}), ET, 2).
+
+-spec in_edges(digraph(), vertex()) -> [edge()].
+
+in_edges(G, V) ->
+    ets:select(G#digraph.ntab, [{{{in, V}, '$1'}, [], ['$1']}]).
+
+-spec out_degree(digraph(), vertex()) -> non_neg_integer().
+
+out_degree(G, V) ->
+    length(ets:lookup(G#digraph.ntab, {out, V})).
+
+-spec out_neighbours(digraph(), vertex()) -> [vertex()].
+
+out_neighbours(G, V) ->
+    ET = G#digraph.etab,
+    NT = G#digraph.ntab,
+    collect_elems(ets:lookup(NT, {out, V}), ET, 3).
+
+-spec out_edges(digraph(), vertex()) -> [edge()].
+
+out_edges(G, V) ->
+    ets:select(G#digraph.ntab, [{{{out, V}, '$1'}, [], ['$1']}]).
+
+-spec add_edge(digraph(), vertex(), vertex()) ->
+	 edge() | {'error', add_edge_err_rsn()}.
+
+add_edge(G, V1, V2) ->
+    do_add_edge({new_edge_id(G), V1, V2, []}, G).
+
+-spec add_edge(digraph(), vertex(), vertex(), label()) ->
+	 edge() | {'error', add_edge_err_rsn()}.
+
+add_edge(G, V1, V2, D) ->
+    do_add_edge({new_edge_id(G), V1, V2, D}, G).
+
+-spec add_edge(digraph(), edge(), vertex(), vertex(), label()) ->
+	 edge() | {'error', add_edge_err_rsn()}.
+
+add_edge(G, E, V1, V2, D) ->
+    do_add_edge({E, V1, V2, D}, G).
+
+-spec del_edge(digraph(), edge()) -> 'true'.
+
+del_edge(G, E) ->
+    do_del_edges([E], G).
+
+-spec del_edges(digraph(), [edge()]) -> 'true'.
+
+del_edges(G, Es) ->
+    do_del_edges(Es, G).
+
+-spec no_edges(digraph()) -> non_neg_integer().
+
+no_edges(G) ->
+    ets:info(G#digraph.etab, size).
+
+-spec edges(digraph()) -> [edge()].
+
+edges(G) ->
+    ets:select(G#digraph.etab, [{{'$1', '_', '_', '_'}, [], ['$1']}]).
+
+-spec edges(digraph(), vertex()) -> [edge()].
+
+edges(G, V) ->
+    ets:select(G#digraph.ntab, [{{{out, V},'$1'}, [], ['$1']},
+				{{{in, V}, '$1'}, [], ['$1']}]).
+
+-spec edge(digraph(), edge()) -> {edge(),vertex(),vertex(),label()} | 'false'.
+
+edge(G, E) ->
+    case ets:lookup(G#digraph.etab,E) of
+	[] -> false;
+	[Edge] -> Edge
+    end.
+
+%%
+%% Generate a "unique" edge identifier (relative to this graph)
+%%
+-spec new_edge_id(digraph()) -> nonempty_improper_list('$e', non_neg_integer()).
+
+new_edge_id(G) ->
+    NT = G#digraph.ntab,
+    [{'$eid', K}] = ets:lookup(NT, '$eid'),
+    true = ets:delete(NT, '$eid'),
+    true = ets:insert(NT, {'$eid', K+1}),
+    ['$e' | K].
+
+%%
+%% Generate a "unique" vertex identifier (relative to this graph)
+%%
+-spec new_vertex_id(digraph()) -> nonempty_improper_list('$v', non_neg_integer()).
+
+new_vertex_id(G) ->
+    NT = G#digraph.ntab,
+    [{'$vid', K}] = ets:lookup(NT, '$vid'),
+    true = ets:delete(NT, '$vid'),
+    true = ets:insert(NT, {'$vid', K+1}),
+    ['$v' | K].
+
+%%
+%% Collect elements for a index in a tuple
+%%
+collect_elems(Keys, Table, Index) ->
+    collect_elems(Keys, Table, Index, []).
+
+collect_elems([{_,Key}|Keys], Table, Index, Acc) ->
+    collect_elems(Keys, Table, Index,
+		  [ets:lookup_element(Table, Key, Index)|Acc]);
+collect_elems([], _, _, Acc) -> Acc.
+
+-spec do_add_vertex({vertex(), label()}, digraph()) -> vertex().
+
+do_add_vertex({V, _Label} = VL, G) ->
+    ets:insert(G#digraph.vtab, VL),
+    V.
+
+%%
+%% Collect either source or sink vertices.
+%%
+collect_vertices(G, Type) ->
+    Vs = vertices(G),
+    lists:foldl(fun(V, A) ->
+			case ets:member(G#digraph.ntab, {Type, V}) of
+			    true -> A;
+			    false -> [V|A]
+			end
+		end, [], Vs).
+
+%%
+%% Delete vertices
+%%
+do_del_vertices([V | Vs], G) ->
+    do_del_vertex(V, G),
+    do_del_vertices(Vs, G);
+do_del_vertices([], #digraph{}) -> true.
+
+do_del_vertex(V, G) ->
+    do_del_nedges(ets:lookup(G#digraph.ntab, {in, V}), G),
+    do_del_nedges(ets:lookup(G#digraph.ntab, {out, V}), G),
+    ets:delete(G#digraph.vtab, V).
+
+do_del_nedges([{_, E}|Ns], G) ->
+    case ets:lookup(G#digraph.etab, E) of
+	[{E, V1, V2, _}] ->
+	    do_del_edge(E, V1, V2, G),
+	    do_del_nedges(Ns, G);
+	[] -> % cannot happen
+	    do_del_nedges(Ns, G)
+    end;
+do_del_nedges([], #digraph{}) -> true.
+
+%%
+%% Delete edges
+%%
+do_del_edges([E|Es], G) ->
+    case ets:lookup(G#digraph.etab, E) of
+	[{E,V1,V2,_}] ->
+	    do_del_edge(E,V1,V2,G),
+	    do_del_edges(Es, G);
+	[] ->
+	    do_del_edges(Es, G)
+    end;
+do_del_edges([], #digraph{}) -> true.
+
+do_del_edge(E, V1, V2, G) ->
+    ets:select_delete(G#digraph.ntab, [{{{in, V2}, E}, [], [true]},
+				       {{{out,V1}, E}, [], [true]}]),
+    ets:delete(G#digraph.etab, E).
+
+-spec rm_edges([vertex(),...], digraph()) -> 'true'.
+
+rm_edges([V1, V2|Vs], G) ->
+    rm_edge(V1, V2, G),
+    rm_edges([V2|Vs], G);
+rm_edges(_, _) -> true.
+
+-spec rm_edge(vertex(), vertex(), digraph()) -> 'ok'.
+
+rm_edge(V1, V2, G) ->
+    Es = out_edges(G, V1),
+    rm_edge_0(Es, V1, V2, G).
+    
+rm_edge_0([E|Es], V1, V2, G) ->
+    case ets:lookup(G#digraph.etab, E) of
+	[{E, V1, V2, _}]  ->
+            do_del_edge(E, V1, V2, G),
+	    rm_edge_0(Es, V1, V2, G);
+	_ ->
+	    rm_edge_0(Es, V1, V2, G)
+    end;
+rm_edge_0([], _, _, #digraph{}) -> ok.
+    
+%%
+%% Check that endpoints exist
+%%
+-spec do_add_edge({edge(), vertex(), vertex(), label()}, digraph()) ->
+	edge() | {'error', add_edge_err_rsn()}.
+
+do_add_edge({E, V1, V2, Label}, G) ->
+    case ets:member(G#digraph.vtab, V1) of
+	false -> {error, {bad_vertex, V1}};
+	true  ->
+	    case ets:member(G#digraph.vtab, V2) of
+		false -> {error, {bad_vertex, V2}};
+                true ->
+                    case other_edge_exists(G, E, V1, V2) of
+                        true -> {error, {bad_edge, [V1, V2]}};
+                        false when G#digraph.cyclic =:= false ->
+                            acyclic_add_edge(E, V1, V2, Label, G);
+                        false ->
+                            do_insert_edge(E, V1, V2, Label, G)
+                    end
+	    end
+    end.
+
+other_edge_exists(#digraph{etab = ET}, E, V1, V2) ->
+    case ets:lookup(ET, E) of
+        [{E, Vert1, Vert2, _}] when Vert1 =/= V1; Vert2 =/= V2 ->
+            true;
+        _ ->
+            false
+    end.
+
+-spec do_insert_edge(edge(), vertex(), vertex(), label(), digraph()) -> edge().
+
+do_insert_edge(E, V1, V2, Label, #digraph{ntab=NT, etab=ET}) ->
+    ets:insert(NT, [{{out, V1}, E}, {{in, V2}, E}]),
+    ets:insert(ET, {E, V1, V2, Label}),
+    E.
+
+-spec acyclic_add_edge(edge(), vertex(), vertex(), label(), digraph()) ->
+	edge() | {'error', {'bad_edge', [vertex()]}}.
+
+acyclic_add_edge(_E, V1, V2, _L, _G) when V1 =:= V2 ->
+    {error, {bad_edge, [V1, V2]}};
+acyclic_add_edge(E, V1, V2, Label, G) ->
+    case get_path(G, V2, V1) of
+	false -> do_insert_edge(E, V1, V2, Label, G);
+	Path -> {error, {bad_edge, Path}}
+    end.
+
+%%
+%% Delete all paths from vertex V1 to vertex V2
+%%
+
+-spec del_path(digraph(), vertex(), vertex()) -> 'true'.
+
+del_path(G, V1, V2) ->
+    case get_path(G, V1, V2) of
+	false -> true;
+	Path ->
+	    rm_edges(Path, G),
+	    del_path(G, V1, V2)
+    end.
+
+%%
+%% Find a cycle through V
+%% return the cycle as list of vertices [V ... V]
+%% if no cycle exists false is returned
+%% if only a cycle of length one exists it will be
+%% returned as [V] but only after longer cycles have
+%% been searched.
+%%
+
+-spec get_cycle(digraph(), vertex()) -> [vertex(),...] | 'false'.
+
+get_cycle(G, V) ->
+    case one_path(out_neighbours(G, V), V, [], [V], [V], 2, G, 1) of
+	false ->
+	    case lists:member(V, out_neighbours(G, V)) of
+		true -> [V];
+		false -> false
+	    end;
+	Vs -> Vs
+    end.
+
+%%
+%% Find a path from V1 to V2
+%% return the path as list of vertices [V1 ... V2]
+%% if no path exists false is returned
+%%
+
+-spec get_path(digraph(), vertex(), vertex()) -> [vertex(),...] | 'false'.
+
+get_path(G, V1, V2) ->
+    one_path(out_neighbours(G, V1), V2, [], [V1], [V1], 1, G, 1).
+
+%%
+%% prune_short_path (evaluate conditions on path)
+%% short : if path is too short
+%% ok    : if path is ok
+%%
+prune_short_path(Counter, Min) when Counter < Min ->
+    short;
+prune_short_path(_Counter, _Min) ->
+    ok.
+
+one_path([W|Ws], W, Cont, Xs, Ps, Prune, G, Counter) ->
+    case prune_short_path(Counter, Prune) of
+	short -> one_path(Ws, W, Cont, Xs, Ps, Prune, G, Counter);
+	ok -> lists:reverse([W|Ps])
+    end;
+one_path([V|Vs], W, Cont, Xs, Ps, Prune, G, Counter) ->
+    case lists:member(V, Xs) of
+	true ->  one_path(Vs, W, Cont, Xs, Ps, Prune, G, Counter);
+	false -> one_path(out_neighbours(G, V), W, 
+			  [{Vs,Ps} | Cont], [V|Xs], [V|Ps], 
+			  Prune, G, Counter+1)
+    end;
+one_path([], W, [{Vs,Ps}|Cont], Xs, _, Prune, G, Counter) ->
+    one_path(Vs, W, Cont, Xs, Ps, Prune, G, Counter-1);
+one_path([], _, [], _, _, _, _, _Counter) -> false.
+
+%%
+%% Like get_cycle/2, but a cycle of length one is preferred.
+%%
+
+-spec get_short_cycle(digraph(), vertex()) -> [vertex(),...] | 'false'.
+
+get_short_cycle(G, V) ->
+    get_short_path(G, V, V).
+
+%%
+%% Like get_path/3, but using a breadth-first search makes it possible
+%% to find a short path.
+%%
+
+-spec get_short_path(digraph(), vertex(), vertex()) -> [vertex(),...] | 'false'.
+
+get_short_path(G, V1, V2) ->
+    T = new(),
+    add_vertex(T, V1),
+    Q = queue:new(),
+    Q1 = queue_out_neighbours(V1, G, Q),
+    L = spath(Q1, G, V2, T),
+    delete(T),
+    L.
+    
+spath(Q, G, Sink, T) ->
+    case queue:out(Q) of
+	{{value, E}, Q1} ->
+	    {_E, V1, V2, _Label} = edge(G, E),
+	    if 
+		Sink =:= V2 ->
+		    follow_path(V1, T, [V2]);
+		true ->
+		    case vertex(T, V2) of
+			false ->
+			    add_vertex(T, V2),
+			    add_edge(T, V2, V1),
+			    NQ = queue_out_neighbours(V2, G, Q1),
+			    spath(NQ, G, Sink, T);
+			_V ->
+			    spath(Q1, G, Sink, T)
+		    end
+	    end;
+	{empty, _Q1} ->
+	    false
+    end.
+
+follow_path(V, T, P) ->
+    P1 = [V | P],
+    case out_neighbours(T, V) of
+	[N] ->
+	    follow_path(N, T, P1);
+	[] ->
+	    P1
+    end.
+
+queue_out_neighbours(V, G, Q0) ->
+    lists:foldl(fun(E, Q) -> queue:in(E, Q) end, Q0, out_edges(G, V)).