Разрывный график в прологе

Question

Я борюсь с логическим программированием. У меня есть эта проблема, и я надеюсь, что некоторые из вас помогут мне в этом. Разрывный график представлен фактами следующим образом:

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

Таким образом, существуют два отдельных графика. Я хотел бы, чтобы все отдельные компоненты на выходе были представлены списком. Поэтому, если на графике есть три отдельных компонента, будет три списка. Для данного примера выше ожидаемый результат равен [[0,1,2],[3,4,5]].

Answer 1

В ответ мы используем ugraphs — широко доступны библиотека для обработки у nweighted график с.

 
:- use_module (library (ugraphs)). 

Во-первых, мы должны получить данные в форму, которая совместима с library(ugraphs):

 
relation2_ugraph(R_2, G) :- 
    findall (X-Y, call (R_2,X,Y), Es0), 
    ( ground (Es0) 
    ->sort (Es0, Es),      % remove duplicates (if any) 
     vertices_edges_to_ugraph ([], Es, G) 
    ; throw (error (instantiation_error ,_)) 
    ). 

Затем мы можем использовать reachable/3 и del_vertices/3 для нахождения всех подключенных компонентов:

 
ugraph_components([])  --> [] . 
ugraph_components([V-Es|VEs])  --> 
    { reachable(V, [V-Es|VEs], Vs), 
    del_vertices([V-Es|VEs], Vs, G)  } , 
    [ Vs ] , 
    ugraph_components(G). 

Пример запроса с использованием SICStus Prolog 4.3.2:

 
| ?- relation2_ugraph(symm (h), G), 
     phrase (ugraph_components(G), CCs). 
G = [0-[1],1-[0,2],2-[1],3-[4,5],4-[3],5-[3]], 
CCs = [[0,1,2],[3,4,5]] ? ;    % Non-determinism?! Don't worry2! 
no 

Точно ответ OP нужен!

---

^{Сноска 1:library(ugraphs) предлагается вне коробки по SICStus Prolog, SWI-Prolog и YAP Prolog.
Сноска 2: Цели do преуспеть детерминистически. This ingenious way использует call_cleanup/2, чтобы показать его.}

Answer 2

В этом модуле рассчитываются сильно подключенные компоненты - я получил его от 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) считается излишним, мы можем снизить - с изобретательностью - код на пару строк, вычисления неподвижной опоры, специально с учетом высокого уровня Характеристика позволили современным Пролог - SWI-Prolog с библиотекой (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]].