View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        R.A.O'Keefe, Vitor Santos Costa, Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1984-2023, VU University Amsterdam
    7                              CWI, Amsterdam
    8                              SWI-Prolog Solutions .b.v
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(ugraphs,
   38          [ add_edges/3,                % +Graph, +Edges, -NewGraph
   39            add_vertices/3,             % +Graph, +Vertices, -NewGraph
   40            complement/2,               % +Graph, -NewGraph
   41            compose/3,                  % +LeftGraph, +RightGraph, -NewGraph
   42            del_edges/3,                % +Graph, +Edges, -NewGraph
   43            del_vertices/3,             % +Graph, +Vertices, -NewGraph
   44            edges/2,                    % +Graph, -Edges
   45            neighbors/3,                % +Vertex, +Graph, -Vertices
   46            neighbours/3,               % +Vertex, +Graph, -Vertices
   47            reachable/3,                % +Vertex, +Graph, -Vertices
   48            top_sort/2,                 % +Graph, -Sort
   49            ugraph_layers/2,            % +Graph, -Layers
   50            transitive_closure/2,       % +Graph, -Closure
   51            transpose_ugraph/2,         % +Graph, -NewGraph
   52            vertices/2,                 % +Graph, -Vertices
   53            vertices_edges_to_ugraph/3, % +Vertices, +Edges, -Graph
   54            ugraph_union/3,             % +Graph1, +Graph2, -Graph
   55            connect_ugraph/3            % +Graph1, -Start, -Graph
   56          ]).   57
   58/** <module> Graph manipulation library
   59
   60The S-representation of a graph is  a list of (vertex-neighbours) pairs,
   61where the pairs are in standard order   (as produced by keysort) and the
   62neighbours of each vertex are also  in   standard  order (as produced by
   63sort). This form is convenient for many calculations.
   64
   65A   new   UGraph   from    raw    data     can    be    created    using
   66vertices_edges_to_ugraph/3.
   67
   68Adapted to support some of  the   functionality  of  the SICStus ugraphs
   69library by Vitor Santos Costa.
   70
   71Ported from YAP 5.0.1 to SWI-Prolog by Jan Wielemaker.
   72
   73@author R.A.O'Keefe
   74@author Vitor Santos Costa
   75@author Jan Wielemaker
   76@license BSD-2 or Artistic 2.0
   77*/
   78
   79:- autoload(library(lists),[append/3]).   80:- autoload(library(ordsets),
   81	    [ord_subtract/3,ord_union/3,ord_add_element/3,ord_union/4]).   82:- autoload(library(error), [instantiation_error/1]).   83
   84%!  vertices(+Graph, -Vertices)
   85%
   86%   Unify Vertices with all vertices appearing in Graph. Example:
   87%
   88%       ?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
   89%       L = [1, 2, 3, 4, 5]
   90
   91vertices([], []) :- !.
   92vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
   93    vertices(Graph, Vertices).
   94
   95
   96%!  vertices_edges_to_ugraph(+Vertices, +Edges, -UGraph) is det.
   97%
   98%   Create a UGraph from Vertices and edges.   Given  a graph with a
   99%   set of Vertices and a set of   Edges,  Graph must unify with the
  100%   corresponding S-representation. Note that   the vertices without
  101%   edges will appear in Vertices but not  in Edges. Moreover, it is
  102%   sufficient for a vertice to appear in Edges.
  103%
  104%   ==
  105%   ?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
  106%   L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[]]
  107%   ==
  108%
  109%   In this case all  vertices  are   defined  implicitly.  The next
  110%   example shows three unconnected vertices:
  111%
  112%   ==
  113%   ?- vertices_edges_to_ugraph([6,7,8],[1-3,2-4,4-5,1-5], L).
  114%   L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[], 6-[], 7-[], 8-[]]
  115%   ==
  116
  117vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
  118    sort(Edges, EdgeSet),
  119    p_to_s_vertices(EdgeSet, IVertexBag),
  120    append(Vertices, IVertexBag, VertexBag),
  121    sort(VertexBag, VertexSet),
  122    p_to_s_group(VertexSet, EdgeSet, Graph).
  123
  124
  125%!  add_vertices(+Graph, +Vertices, -NewGraph)
  126%
  127%   Unify NewGraph with a new  graph  obtained   by  adding  the list of
  128%   Vertices to Graph. Example:
  129%
  130%   ```
  131%   ?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
  132%   NG = [0-[], 1-[3,5], 2-[], 9-[]]
  133%   ```
  134
  135add_vertices(Graph, Vertices, NewGraph) :-
  136    msort(Vertices, V1),
  137    add_vertices_to_s_graph(V1, Graph, NewGraph).
  138
  139add_vertices_to_s_graph(L, [], NL) :-
  140    !,
  141    add_empty_vertices(L, NL).
  142add_vertices_to_s_graph([], L, L) :- !.
  143add_vertices_to_s_graph([V1|VL], [V-Edges|G], NGL) :-
  144    compare(Res, V1, V),
  145    add_vertices_to_s_graph(Res, V1, VL, V, Edges, G, NGL).
  146
  147add_vertices_to_s_graph(=, _, VL, V, Edges, G, [V-Edges|NGL]) :-
  148    add_vertices_to_s_graph(VL, G, NGL).
  149add_vertices_to_s_graph(<, V1, VL, V, Edges, G, [V1-[]|NGL]) :-
  150    add_vertices_to_s_graph(VL, [V-Edges|G], NGL).
  151add_vertices_to_s_graph(>, V1, VL, V, Edges, G, [V-Edges|NGL]) :-
  152    add_vertices_to_s_graph([V1|VL], G, NGL).
  153
  154add_empty_vertices([], []).
  155add_empty_vertices([V|G], [V-[]|NG]) :-
  156    add_empty_vertices(G, NG).
  157
  158%!  del_vertices(+Graph, +Vertices, -NewGraph) is det.
  159%
  160%   Unify NewGraph with a new graph obtained by deleting the list of
  161%   Vertices and all the edges that start from  or go to a vertex in
  162%   Vertices to the Graph. Example:
  163%
  164%   ==
  165%   ?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
  166%                   [2,1],
  167%                   NL).
  168%   NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
  169%   ==
  170%
  171%   @compat Upto 5.6.48 the argument order was (+Vertices, +Graph,
  172%   -NewGraph). Both YAP and SWI-Prolog have changed the argument
  173%   order for compatibility with recent SICStus as well as
  174%   consistency with del_edges/3.
  175
  176del_vertices(Graph, Vertices, NewGraph) :-
  177    sort(Vertices, V1),             % JW: was msort
  178    (   V1 = []
  179    ->  Graph = NewGraph
  180    ;   del_vertices(Graph, V1, V1, NewGraph)
  181    ).
  182
  183del_vertices(G, [], V1, NG) :-
  184    !,
  185    del_remaining_edges_for_vertices(G, V1, NG).
  186del_vertices([], _, _, []).
  187del_vertices([V-Edges|G], [V0|Vs], V1, NG) :-
  188    compare(Res, V, V0),
  189    split_on_del_vertices(Res, V,Edges, [V0|Vs], NVs, V1, NG, NGr),
  190    del_vertices(G, NVs, V1, NGr).
  191
  192del_remaining_edges_for_vertices([], _, []).
  193del_remaining_edges_for_vertices([V0-Edges|G], V1, [V0-NEdges|NG]) :-
  194    ord_subtract(Edges, V1, NEdges),
  195    del_remaining_edges_for_vertices(G, V1, NG).
  196
  197split_on_del_vertices(<, V, Edges, Vs, Vs, V1, [V-NEdges|NG], NG) :-
  198    ord_subtract(Edges, V1, NEdges).
  199split_on_del_vertices(>, V, Edges, [_|Vs], Vs, V1, [V-NEdges|NG], NG) :-
  200    ord_subtract(Edges, V1, NEdges).
  201split_on_del_vertices(=, _, _, [_|Vs], Vs, _, NG, NG).
  202
  203%!  add_edges(+Graph, +Edges, -NewGraph)
  204%
  205%   Unify NewGraph with a new graph obtained by adding the list of Edges
  206%   to Graph. Example:
  207%
  208%   ```
  209%   ?- add_edges([1-[3,5],2-[4],3-[],4-[5],
  210%                 5-[],6-[],7-[],8-[]],
  211%                [1-6,2-3,3-2,5-7,3-2,4-5],
  212%                NL).
  213%   NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5],
  214%         5-[7], 6-[], 7-[], 8-[]]
  215%   ```
  216
  217add_edges(Graph, Edges, NewGraph) :-
  218    p_to_s_graph(Edges, G1),
  219    ugraph_union(Graph, G1, NewGraph).
  220
  221%!  ugraph_union(+Graph1, +Graph2, -NewGraph)
  222%
  223%   NewGraph is the union of Graph1 and Graph2. Example:
  224%
  225%   ```
  226%   ?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
  227%   L = [1-[2], 2-[3,4], 3-[1,2,4]]
  228%   ```
  229
  230ugraph_union(Set1, [], Set1) :- !.
  231ugraph_union([], Set2, Set2) :- !.
  232ugraph_union([Head1-E1|Tail1], [Head2-E2|Tail2], Union) :-
  233    compare(Order, Head1, Head2),
  234    ugraph_union(Order, Head1-E1, Tail1, Head2-E2, Tail2, Union).
  235
  236ugraph_union(=, Head-E1, Tail1, _-E2, Tail2, [Head-Es|Union]) :-
  237    ord_union(E1, E2, Es),
  238    ugraph_union(Tail1, Tail2, Union).
  239ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
  240    ugraph_union(Tail1, [Head2|Tail2], Union).
  241ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
  242    ugraph_union([Head1|Tail1], Tail2, Union).
  243
  244%!  del_edges(+Graph, +Edges, -NewGraph)
  245%
  246%   Unify NewGraph with a new graph  obtained   by  removing the list of
  247%   Edges from Graph. Notice that no vertices are deleted. Example:
  248%
  249%   ```
  250%   ?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
  251%                [1-6,2-3,3-2,5-7,3-2,4-5,1-3],
  252%                NL).
  253%   NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
  254%   ```
  255
  256del_edges(Graph, Edges, NewGraph) :-
  257    p_to_s_graph(Edges, G1),
  258    graph_subtract(Graph, G1, NewGraph).
  259
  260%!  graph_subtract(+Set1, +Set2, ?Difference)
  261%
  262%   Is based on ord_subtract
  263
  264graph_subtract(Set1, [], Set1) :- !.
  265graph_subtract([], _, []).
  266graph_subtract([Head1-E1|Tail1], [Head2-E2|Tail2], Difference) :-
  267    compare(Order, Head1, Head2),
  268    graph_subtract(Order, Head1-E1, Tail1, Head2-E2, Tail2, Difference).
  269
  270graph_subtract(=, H-E1,     Tail1, _-E2,     Tail2, [H-E|Difference]) :-
  271    ord_subtract(E1,E2,E),
  272    graph_subtract(Tail1, Tail2, Difference).
  273graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
  274    graph_subtract(Tail1, [Head2|Tail2], Difference).
  275graph_subtract(>, Head1, Tail1, _,     Tail2, Difference) :-
  276    graph_subtract([Head1|Tail1], Tail2, Difference).
  277
  278%!  edges(+Graph, -Edges)
  279%
  280%   Unify Edges with all edges appearing in Graph. Example:
  281%
  282%       ?- edges([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
  283%       L = [1-3, 1-5, 2-4, 4-5]
  284
  285edges(Graph, Edges) :-
  286    s_to_p_graph(Graph, Edges).
  287
  288p_to_s_graph(P_Graph, S_Graph) :-
  289    sort(P_Graph, EdgeSet),
  290    p_to_s_vertices(EdgeSet, VertexBag),
  291    sort(VertexBag, VertexSet),
  292    p_to_s_group(VertexSet, EdgeSet, S_Graph).
  293
  294
  295p_to_s_vertices([], []).
  296p_to_s_vertices([A-Z|Edges], [A,Z|Vertices]) :-
  297    p_to_s_vertices(Edges, Vertices).
  298
  299
  300p_to_s_group([], _, []).
  301p_to_s_group([Vertex|Vertices], EdgeSet, [Vertex-Neibs|G]) :-
  302    p_to_s_group(EdgeSet, Vertex, Neibs, RestEdges),
  303    p_to_s_group(Vertices, RestEdges, G).
  304
  305
  306p_to_s_group([V1-X|Edges], V2, [X|Neibs], RestEdges) :- V1 == V2,
  307    !,
  308    p_to_s_group(Edges, V2, Neibs, RestEdges).
  309p_to_s_group(Edges, _, [], Edges).
  310
  311
  312
  313s_to_p_graph([], []) :- !.
  314s_to_p_graph([Vertex-Neibs|G], P_Graph) :-
  315    s_to_p_graph(Neibs, Vertex, P_Graph, Rest_P_Graph),
  316    s_to_p_graph(G, Rest_P_Graph).
  317
  318
  319s_to_p_graph([], _, P_Graph, P_Graph) :- !.
  320s_to_p_graph([Neib|Neibs], Vertex, [Vertex-Neib|P], Rest_P) :-
  321    s_to_p_graph(Neibs, Vertex, P, Rest_P).
  322
  323%!  transitive_closure(+Graph, -Closure)
  324%
  325%   Generate the graph Closure  as  the   transitive  closure  of Graph.
  326%   Example:
  327%
  328%   ```
  329%   ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
  330%   L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
  331%   ```
  332
  333transitive_closure(Graph, Closure) :-
  334    warshall(Graph, Graph, Closure).
  335
  336warshall([], Closure, Closure) :- !.
  337warshall([V-_|G], E, Closure) :-
  338    memberchk(V-Y, E),      %  Y := E(v)
  339    warshall(E, V, Y, NewE),
  340    warshall(G, NewE, Closure).
  341
  342
  343warshall([X-Neibs|G], V, Y, [X-NewNeibs|NewG]) :-
  344    memberchk(V, Neibs),
  345    !,
  346    ord_union(Neibs, Y, NewNeibs),
  347    warshall(G, V, Y, NewG).
  348warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :-
  349    !,
  350    warshall(G, V, Y, NewG).
  351warshall([], _, _, []).
  352
  353%!  transpose_ugraph(Graph, NewGraph) is det.
  354%
  355%   Unify NewGraph with a new graph obtained from Graph by replacing
  356%   all edges of the form V1-V2 by edges of the form V2-V1. The cost
  357%   is O(|V|*log(|V|)). Notice that an undirected   graph is its own
  358%   transpose. Example:
  359%
  360%     ==
  361%     ?- transpose([1-[3,5],2-[4],3-[],4-[5],
  362%                   5-[],6-[],7-[],8-[]], NL).
  363%     NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
  364%     ==
  365%
  366%   @compat  This  predicate  used  to   be  known  as  transpose/2.
  367%   Following  SICStus  4,  we  reserve    transpose/2   for  matrix
  368%   transposition    and    renamed    ugraph    transposition    to
  369%   transpose_ugraph/2.
  370
  371transpose_ugraph(Graph, NewGraph) :-
  372    edges(Graph, Edges),
  373    vertices(Graph, Vertices),
  374    flip_edges(Edges, TransposedEdges),
  375    vertices_edges_to_ugraph(Vertices, TransposedEdges, NewGraph).
  376
  377flip_edges([], []).
  378flip_edges([Key-Val|Pairs], [Val-Key|Flipped]) :-
  379    flip_edges(Pairs, Flipped).
  380
  381%!  compose(+LeftGraph, +RightGraph, -NewGraph)
  382%
  383%   Compose NewGraph by connecting the  _drains_   of  LeftGraph  to the
  384%   _sources_ of RightGraph. Example:
  385%
  386%       ?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
  387%       L = [1-[4], 2-[1,2,4], 3-[]]
  388
  389compose(G1, G2, Composition) :-
  390    vertices(G1, V1),
  391    vertices(G2, V2),
  392    ord_union(V1, V2, V),
  393    compose(V, G1, G2, Composition).
  394
  395compose([], _, _, []) :- !.
  396compose([Vertex|Vertices], [Vertex-Neibs|G1], G2,
  397        [Vertex-Comp|Composition]) :-
  398    !,
  399    compose1(Neibs, G2, [], Comp),
  400    compose(Vertices, G1, G2, Composition).
  401compose([Vertex|Vertices], G1, G2, [Vertex-[]|Composition]) :-
  402    compose(Vertices, G1, G2, Composition).
  403
  404
  405compose1([V1|Vs1], [V2-N2|G2], SoFar, Comp) :-
  406    compare(Rel, V1, V2),
  407    !,
  408    compose1(Rel, V1, Vs1, V2, N2, G2, SoFar, Comp).
  409compose1(_, _, Comp, Comp).
  410
  411
  412compose1(<, _, Vs1, V2, N2, G2, SoFar, Comp) :-
  413    !,
  414    compose1(Vs1, [V2-N2|G2], SoFar, Comp).
  415compose1(>, V1, Vs1, _, _, G2, SoFar, Comp) :-
  416    !,
  417    compose1([V1|Vs1], G2, SoFar, Comp).
  418compose1(=, V1, Vs1, V1, N2, G2, SoFar, Comp) :-
  419    ord_union(N2, SoFar, Next),
  420    compose1(Vs1, G2, Next, Comp).
  421
  422%!  ugraph_layers(Graph, -Layers) is semidet.
  423%!  top_sort(+Graph, -Sorted) is semidet.
  424%
  425%   Sort vertices topologically. Layers is a   list of lists of vertices
  426%   where there are no edges  from  a   layer  to  an earlier layer. The
  427%   predicate top_sort/2 flattens the layers using append/2.
  428%
  429%   These predicates fail if Graph is cyclic. If Graph is not connected,
  430%   the sub-graphs are individually  sorted,  where   the  root  of each
  431%   subgraph is in the first layer, the  nodes connected to the roots in
  432%   the second, etc.
  433%
  434%   ```
  435%   ?- top_sort([1-[2], 2-[3], 3-[]], L).
  436%   L = [1, 2, 3]
  437%   ```
  438%
  439%   @compat The original version of this  library provided top_sort/3 as
  440%   a _difference list_ version of top_sort/2.   We removed this because
  441%   the argument order was non-standard.  Fixing   causes  hard to debug
  442%   compatibility issues while we expect top_sort/3   was rarely used. A
  443%   backward compatible top_sort/3 can be defined as
  444%
  445%   ```
  446%   top_sort(Graph, Tail, Sorted) :-
  447%       top_sort(Graph, Sorted0),
  448%       append(Sorted0, Tail, Sorted).
  449%   ```
  450%
  451%   The original version returned all vertices   in a _layer_ in reverse
  452%   order. The current one returns  them   in  standard  order of terms,
  453%   i.e., each layer is an _ordered set_.
  454%
  455%   @compat ugraph_layers/2 is a SWI-Prolog   specific  addition to this
  456%   library.
  457
  458top_sort(Graph, Sorted) :-
  459    ugraph_layers(Graph, Layers),
  460    append(Layers, Sorted).
  461
  462ugraph_layers(Graph, Layers) :-
  463    vertices_and_zeros(Graph, Vertices, Counts0),
  464    count_edges(Graph, Vertices, Counts0, Counts1),
  465    select_zeros(Counts1, Vertices, Zeros),
  466    top_sort(Zeros, Layers, Graph, Vertices, Counts1).
  467
  468vertices_and_zeros([], [], []) :- !.
  469vertices_and_zeros([Vertex-_|Graph], [Vertex|Vertices], [0|Zeros]) :-
  470    vertices_and_zeros(Graph, Vertices, Zeros).
  471
  472% Count the number of incomming edges for each vertex
  473
  474count_edges([], _, Counts, Counts) :- !.
  475count_edges([_-Neibs|Graph], Vertices, Counts0, Counts2) :-
  476    incr_list(Neibs, Vertices, Counts0, Counts1),
  477    count_edges(Graph, Vertices, Counts1, Counts2).
  478
  479
  480incr_list([], _, Counts, Counts) :- !.
  481incr_list([V1|Neibs], [V2|Vertices], [M|Counts0], [N|Counts1]) :-
  482    V1 == V2,
  483    !,
  484    N is M+1,
  485    incr_list(Neibs, Vertices, Counts0, Counts1).
  486incr_list(Neibs, [_|Vertices], [N|Counts0], [N|Counts1]) :-
  487    incr_list(Neibs, Vertices, Counts0, Counts1).
  488
  489% get the vertices with 0 incoming edges, i.e., the origins.
  490
  491select_zeros([], [], []) :- !.
  492select_zeros([0|Counts], [Vertex|Vertices], [Vertex|Zeros]) :-
  493    !,
  494    select_zeros(Counts, Vertices, Zeros).
  495select_zeros([_|Counts], [_|Vertices], Zeros) :-
  496    select_zeros(Counts, Vertices, Zeros).
  497
  498%!  top_sort(+Zeros, -Layers, +Graph, +Vertices, +Counts) is semidet.
  499
  500top_sort([], Layers, Graph, _, Counts) :-
  501    !,
  502    vertices_and_zeros(Graph, _, Counts), % verify nothing left
  503    Layers = [].
  504top_sort(Zeros, [Zeros|Layers], Graph, Vertices, Counts1) :-
  505    decr_zero_neighbors(Zeros, Graph, Vertices, Counts1, Counts2, NewZeros, []),
  506    top_sort(NewZeros, Layers, Graph, Vertices, Counts2).
  507
  508decr_zero_neighbors([], _, _, Counts, Counts, Z, Z).
  509decr_zero_neighbors([Zero|Zeros], Graph, Vertices, Counts0, Counts, Z0, Z) :-
  510    graph_memberchk(Zero-Neibs, Graph),
  511    decr_list(Neibs, Vertices, Counts0, Counts1, Z0, Z1),
  512    decr_zero_neighbors(Zeros, Graph, Vertices, Counts1, Counts, Z1, Z).
  513
  514graph_memberchk(Element1-Edges, [Element2-Edges2|_]) :-
  515    Element1 == Element2,
  516    !,
  517    Edges = Edges2.
  518graph_memberchk(Element, [_|Rest]) :-
  519    graph_memberchk(Element, Rest).
  520
  521decr_list([], _, Counts, Counts, Zeros, Zeros) :-
  522    !.
  523decr_list([V1|Neibs], [V2|Vertices], [N|Counts1], [M|Counts2], Z0, Z) :-
  524    V1 == V2,
  525    !,
  526    M is N - 1,
  527    (   M == 0
  528    ->  Z0 = [V1|Z1],
  529        decr_list(Neibs, Vertices, Counts1, Counts2, Z1, Z)
  530    ;   decr_list(Neibs, Vertices, Counts1, Counts2, Z0, Z)
  531    ).
  532decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :-
  533    decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
  534
  535
  536%!  neighbors(+Vertex, +Graph, -Neigbours) is det.
  537%!  neighbours(+Vertex, +Graph, -Neigbours) is det.
  538%
  539%   Neigbours is a sorted list of  the   neighbours  of Vertex in Graph.
  540%   Example:
  541%
  542%   ```
  543%   ?- neighbours(4,[1-[3,5],2-[4],3-[],
  544%                    4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
  545%   NL = [1,2,7,5]
  546%   ```
  547
  548neighbors(Vertex, Graph, Neig) :-
  549    neighbours(Vertex, Graph, Neig).
  550
  551neighbours(V,[V0-Neig|_],Neig) :-
  552    V == V0,
  553    !.
  554neighbours(V,[_|G],Neig) :-
  555    neighbours(V,G,Neig).
  556
  557
  558%!  connect_ugraph(+UGraphIn, -Start, -UGraphOut) is det.
  559%
  560%   Adds Start as an additional vertex that is connected to all vertices
  561%   in UGraphIn. This can be used to   create  an topological sort for a
  562%   not connected graph. Start is before any   vertex in UGraphIn in the
  563%   standard order of terms.  No vertex in UGraphIn can be a variable.
  564%
  565%   Can be used to order a not-connected graph as follows:
  566%
  567%   ```
  568%   top_sort_unconnected(Graph, Vertices) :-
  569%       (   top_sort(Graph, Vertices)
  570%       ->  true
  571%       ;   connect_ugraph(Graph, Start, Connected),
  572%           top_sort(Connected, Ordered0),
  573%           Ordered0 = [Start|Vertices]
  574%       ).
  575%   ```
  576
  577connect_ugraph([], 0, []) :- !.
  578connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
  579    vertices(Graph, Vertices),
  580    Vertices = [First|_],
  581    before(First, Start).
  582
  583%!  before(+Term, -Before) is det.
  584%
  585%   Unify Before to a term that comes   before  Term in the standard
  586%   order of terms.
  587%
  588%   @error instantiation_error if Term is unbound.
  589
  590before(X, _) :-
  591    var(X),
  592    !,
  593    instantiation_error(X).
  594before(Number, Start) :-
  595    number(Number),
  596    !,
  597    Start is Number - 1.
  598before(_, 0).
  599
  600
  601%!  complement(+UGraphIn, -UGraphOut)
  602%
  603%   UGraphOut is a ugraph with an  edge   between  all vertices that are
  604%   _not_ connected in UGraphIn and  all   edges  from UGraphIn removed.
  605%   Example:
  606%
  607%   ```
  608%   ?- complement([1-[3,5],2-[4],3-[],
  609%                  4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
  610%   NL = [1-[2,4,6,7,8],2-[1,3,5,6,7,8],3-[1,2,4,5,6,7,8],
  611%         4-[3,5,6,8],5-[1,2,3,4,6,7,8],6-[1,2,3,4,5,7,8],
  612%         7-[1,2,3,4,5,6,8],8-[1,2,3,4,5,6,7]]
  613%   ```
  614%
  615%   @tbd Simple two-step algorithm. You could be smarter, I suppose.
  616
  617complement(G, NG) :-
  618    vertices(G,Vs),
  619    complement(G,Vs,NG).
  620
  621complement([], _, []).
  622complement([V-Ns|G], Vs, [V-INs|NG]) :-
  623    ord_add_element(Ns,V,Ns1),
  624    ord_subtract(Vs,Ns1,INs),
  625    complement(G, Vs, NG).
  626
  627%!  reachable(+Vertex, +UGraph, -Vertices)
  628%
  629%   True when Vertices is  an  ordered   set  of  vertices  reachable in
  630%   UGraph, including Vertex.  Example:
  631%
  632%       ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
  633%       V = [1, 3, 5]
  634
  635reachable(N, G, Rs) :-
  636    reachable([N], G, [N], Rs).
  637
  638reachable([], _, Rs, Rs).
  639reachable([N|Ns], G, Rs0, RsF) :-
  640    neighbours(N, G, Nei),
  641    ord_union(Rs0, Nei, Rs1, D),
  642    append(Ns, D, Nsi),
  643    reachable(Nsi, G, Rs1, RsF)