在Prolog中获取图形的连接组件

时间:2016-01-16 20:32:08

标签: graph prolog connected-components

我正在努力进行逻辑编程。我有这个问题,我希望你们中的一些人可以帮助我。不连续图以这种方式由事实表示:

h(0,1).
h(1,2).
h(3,4).
h(3,5).

因此有两个独立的图形组件。我希望输出中的所有单独组件都由列表表示。因此,如果图表中有三个单独的组件,则会有三个列表。对于上面给出的示例,预期输出为[[0,1,2],[3,4,5]]

2 个答案:

答案 0 :(得分:4)

这个模块计算了强连通组件 - 我是从Markus Triska site得到的。

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   Strongly connected components of a graph.
   Written by Markus Triska (triska@gmx.at), 2011, 2015
   Public domain code.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- module(scc, [nodes_arcs_sccs/3]).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

   Usage:

   nodes_arcs_sccs(+Ns, +As, -SCCs)

   where:

   Ns is a list of nodes. Each node must be a ground term.
   As is a list of arc(From,To) terms where From and To are nodes.
   SCCs is a list of lists of nodes that are in the same strongly
        connected component.

   Running time is O(|V| + log(|V|)*|E|).

   Example:

   %?- nodes_arcs_sccs([a,b,c,d], [arc(a,b),arc(b,a),arc(b,c)], SCCs).
   %@ SCCs = [[a,b],[c],[d]].

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- use_module(library(assoc)).

nodes_arcs_sccs(Ns, As, Ss) :-
        must_be(list(ground), Ns),
        must_be(list(ground), As),
        catch((maplist(node_var_pair, Ns, Vs, Ps),
               list_to_assoc(Ps, Assoc),
               maplist(attach_arc(Assoc), As),
               scc(Vs, successors),
               maplist(v_with_lowlink, Vs, Ls0),
               keysort(Ls0, Ls1),
               group_pairs_by_key(Ls1, Ss0),
               pairs_values(Ss0, Ss),
               % reset all attributes
               throw(scc(Ss))),
              scc(Ss),
              true).

% Associate a fresh variable with each node, so that attributes can be
% attached to variables that correspond to nodes.

node_var_pair(N, V, N-V) :- put_attr(V, node, N).

v_with_lowlink(V, L-N) :-
        get_attr(V, lowlink, L),
        get_attr(V, node, N).

successors(V, Vs) :-
        (   get_attr(V, successors, Vs) -> true
        ;   Vs = []
        ).

attach_arc(Assoc, arc(X,Y)) :-
        get_assoc(X, Assoc, VX),
        get_assoc(Y, Assoc, VY),
        successors(VX, Vs),
        put_attr(VX, successors, [VY|Vs]).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   Tarjan's strongly connected components algorithm.

   DCGs are used to implicitly pass around the global index, stack
   and the predicate relating a vertex to its successors.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

scc(Vs, Succ) :- phrase(scc(Vs), [s(0,[],Succ)], _).

scc([])     --> [].
scc([V|Vs]) -->
        (   vindex_defined(V) -> scc(Vs)
        ;   scc_(V), scc(Vs)
        ).

scc_(V) -->
        vindex_is_index(V),
        vlowlink_is_index(V),
        index_plus_one,
        s_push(V),
        successors(V, Tos),
        each_edge(Tos, V),
        (   { get_attr(V, index, VI),
              get_attr(V, lowlink, VI) } -> pop_stack_to(V, VI)
        ;   []
        ).

vindex_defined(V) --> { get_attr(V, index, _) }.

vindex_is_index(V) -->
        state(s(Index,_,_)),
        { put_attr(V, index, Index) }.

vlowlink_is_index(V) -->
        state(s(Index,_,_)),
        { put_attr(V, lowlink, Index) }.

index_plus_one -->
        state(s(I,Stack,Succ), s(I1,Stack,Succ)),
        { I1 is I+1 }.

s_push(V)  -->
        state(s(I,Stack,Succ), s(I,[V|Stack],Succ)),
        { put_attr(V, in_stack, true) }.

vlowlink_min_lowlink(V, VP) -->
        { get_attr(V, lowlink, VL),
          get_attr(VP, lowlink, VPL),
          VL1 is min(VL, VPL),
          put_attr(V, lowlink, VL1) }.

successors(V, Tos) --> state(s(_,_,Succ)), { call(Succ, V, Tos) }.

pop_stack_to(V, N) -->
        state(s(I,[First|Stack],Succ), s(I,Stack,Succ)),
        { del_attr(First, in_stack) },
        (   { First == V } -> []
        ;   { put_attr(First, lowlink, N) },
            pop_stack_to(V, N)
        ).

each_edge([], _) --> [].
each_edge([VP|VPs], V) -->
        (   vindex_defined(VP) ->
            (   v_in_stack(VP) ->
                vlowlink_min_lowlink(V, VP)
            ;   []
            )
        ;   scc_(VP),
            vlowlink_min_lowlink(V, VP)
        ),
        each_edge(VPs, V).

v_in_stack(V) --> { get_attr(V, in_stack, true) }.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   DCG rules to access the state, using semicontext notation.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

state(S), [S] --> [S].

state(S0, S), [S] --> [S0].

现在我们需要将它与您的格式对接。首先断言事实:

?- [user].
h(0,1).
h(1,2).
h(3,4).
h(3,5).
|: (^D here)

现在查询 - 请注意,必须在两个'方向'中检索使图形无向边:

?- setof(N, X^(h(N,X);h(X,N)), Ns), findall(arc(X,Y), (h(X,Y);h(Y,X)), As), nodes_arcs_sccs(Ns,As,SCCs).
Ns = [0, 1, 2, 3, 4, 5],
As = [arc(0, 1), arc(1, 2), arc(3, 4), arc(3, 5), arc(1, 0), arc(2, 1), arc(4, 3), arc(5, 3)],
SCCs = [[0, 1, 2], [3, 4, 5]].

值得定义服务谓词connected(X,Y) :- h(X,Y) ; h(Y,X). ...

修改

当然,如果在模块(scc)中发现的高度优化的实现被认为是过度的,我们可以通过独创性将代码减少到几行,计算一个修复点,特别考虑现代允许的高级功能Prolog - SWI-Prolog with library(yall),在这种情况下:

gr(Gc) :- h(X,Y), gr([X,Y], Gc).
gr(Gp, Gc) :-
    maplist([N,Ms]>>setof(M,(h(N,M);h(M,N)),Ms), Gp, Cs),
    append(Cs, UnSorted),
    sort(UnSorted, Sorted),
    ( Sorted \= Gp -> gr(Sorted, Gc) ; Gc = Sorted ).

被称为

?- setof(G,gr(G),L).
L = [[0, 1, 2], [3, 4, 5]].

答案 1 :(得分:2)

使用iwhen/2我们可以像这样定义binrel_connected/2

:- use_module(library(ugraphs)).
:- use_module(library(lists)).

binrel_connected(R_2, CCs) :-
   findall(X-Y, call(R_2,X,Y), Es),
   iwhen(ground(Es), ( vertices_edges_to_ugraph([],Es,G0),
                       reduce(G0,G),
                       keys_and_values(G,CCs,_) )).

SICStus Prolog 4.5.0上的示例查询symm/2symmetric closure

| ?- binrel_connected(symm(h), CCs).
CCs = [[0,1,2],[3,4,5]] ? ;
no