36
   37:- module(ugraphs,
   38          [ add_edges/3,                   39            add_vertices/3,                40            complement/2,                  41            compose/3,                     42            del_edges/3,                   43            del_vertices/3,                44            edges/2,                       45            neighbors/3,                   46            neighbours/3,                  47            reachable/3,                   48            top_sort/2,                    49            ugraph_layers/2,               50            transitive_closure/2,          51            transpose_ugraph/2,            52            vertices/2,                    53            vertices_edges_to_ugraph/3,    54            ugraph_union/3,                55            connect_ugraph/3               56          ]).   57
   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
   90
   91vertices([], []) :- !.
   92vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
   93    vertices(Graph, Vertices).
   94
   95
  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
  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
  175
  176del_vertices(Graph, Vertices, NewGraph) :-
  177    sort(Vertices, V1),               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
  216
  217add_edges(Graph, Edges, NewGraph) :-
  218    p_to_s_graph(Edges, G1),
  219    ugraph_union(Graph, G1, NewGraph).
  220
  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
  255
  256del_edges(Graph, Edges, NewGraph) :-
  257    p_to_s_graph(Edges, G1),
  258    graph_subtract(Graph, G1, NewGraph).
  259
  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
  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
  332
  333transitive_closure(Graph, Closure) :-
  334    warshall(Graph, Graph, Closure).
  335
  336warshall([], Closure, Closure) :- !.
  337warshall([V-_|G], E, Closure) :-
  338    memberchk(V-Y, E),        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
  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
  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
  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
  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
  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
  499
  500top_sort([], Layers, Graph, _, Counts) :-
  501    !,
  502    vertices_and_zeros(Graph, _, Counts),   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
  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
  576
  577connect_ugraph([], 0, []) :- !.
  578connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
  579    vertices(Graph, Vertices),
  580    Vertices = [First|_],
  581    before(First, Start).
  582
  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
  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
  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)