Finding Cycles in an Undirected Graph

Question

It is necessary to implement a swi-prolog program that implements the search for all cycles in an undirected graph and outputs the result without repetitions. Example:

?-find_cycles([a-[b,c,d],b-[a,c],c-[a,b,d],d-[a,c]])

Result:

Cycle = [a,b,c]
Cycle = [a,d,c]
Cycle = [a,b,c,d]

I tried to implement the dfs algorithm but it did not work

Answer 1

I think this is what you want, or at least it's a starting point:

find_cycle(Conns, Cycle) :-
    member(Start-_, Conns),
    find_cycle_(Cycle, Conns, Start, Start, [Start]).
    
find_cycle_([Pos|Cycle0], Conns, Start, Pos, Seen) :-
    can_move(Conns, Pos, Pos1),
    (   Pos1 == Start
    % Found end of a cycle
    ->  Cycle0 = []
    % Avoid revisiting a position
    ;   \+ memberchk(Pos1, Seen),
        find_cycle_(Cycle0, Conns, Start, Pos1, [Pos1|Seen])
    ).

can_move(Conns, Pos, Pos1) :-
    member(Pos-L, Conns),
    member(Pos1, L).

Results in swi-prolog:

?- find_cycle([a-[b,c,d],b-[a,c],c-[a,b,d],d-[a,c]], C).
C = [a, b] ;
C = [a, b, c] ;
C = [a, b, c, d] ;
C = [a, c] ;
C = [a, c, b] ;
C = [a, c, d] ;
C = [a, d] ;
C = [a, d, c] ;
C = [a, d, c, b] ;
C = [b, a] ;
C = [b, a, c] ;
C = [b, a, d, c] ;
C = [b, c, a] ;
C = [b, c] ;
C = [b, c, d, a] ;
C = [c, a, b] ;
C = [c, a] ;
C = [c, a, d] ;
C = [c, b, a] ;
C = [c, b, a, d] ;
C = [c, b] ;
C = [c, d, a, b] ;
C = [c, d, a] ;
C = [c, d] ;
C = [d, a, b, c] ;
C = [d, a, c] ;
C = [d, a] ;
C = [d, c, a] ;
C = [d, c, b, a] ;
C = [d, c] ;
false.

Answer 2

By using the definition of path/4 and by setting double quotes syntax to chars the following definition is possible:

:- meta_predicate(mincycle(2,?)).

mincycle(R_2, CPath) :-
   path(R_2, CPath, X,Y),
   dif(X,Y),
   call(R_2, Y,X).

connected(Conns, Pos, Pos1) :-
    member(Pos-L, Conns),
    member(Pos1, L).

:- set_prolog_flag(double_quotes, chars).

?- mincycle(connected([a-[b,c,d],b-[a,c],c-[a,b,d],d-[a,c]]), CPath).
   CPath = "ab"
;  CPath = "abc"
;  CPath = "abcd"
;  CPath = "ac"
;  CPath = "acb"
;  CPath = "acd"
;  CPath = "ad"
;  CPath = "adc"
;  CPath = "adcb"
;  CPath = "ba"
;  CPath = "bac"
;  CPath = "badc"
;  CPath = "bc"
;  CPath = "bca"
;  CPath = "bcda"
;  CPath = "ca"
;  CPath = "cab"
;  CPath = "cad"
;  CPath = "cb"
;  CPath = "cba"
;  CPath = "cbad"
;  CPath = "cd"
;  CPath = "cda"
;  CPath = "cdab"
;  CPath = "da"
;  CPath = "dabc"
;  CPath = "dac"
;  CPath = "dc"
;  CPath = "dca"
;  CPath = "dcba"
;  false.

Note that this definition is even correct, when you keep the graph partially undefined.

?- mincycle(connected([A-[B,C],B-[X]]), CPath).
   A = X, CPath = [A,B], dif:dif(B,A)
;  A = X, B = C, CPath = [A,B], dif:dif(B,A)
;  A = X, CPath = [B,A], dif:dif(A,B)
;  A = X, B = C, CPath = [B,A], dif:dif(A,B)
;  false.

Answer 3

In an undirected graph, the edge to the parent of a node should not be counted as a back edge

So, a cycle is a path with at least three nodes (and the next node after the last node of the path must be the start node of the path).

To avoid duplicate cycles, a list representing a cycle is normalized by rotating its smallest node to the beginning of the list, followed by its nearest neighbor in the cycle (according to the order of its labels). For example, both lists [3,2,1] and [2,3,1] are normalized to [1,2,3].

find_cycles(Graph, Cycles) :-
    setof(Cycle, Graph^find_cycle(Graph, Cycle), Cycles).

find_cycle(Graph, Cycle) :-
    find_cycle([Start], Start, Graph, Cycle).

find_cycle([Node|Path], Start, Graph, Cycle) :-
    member(Node-Neighbors, Graph),
    member(Next, Neighbors),
    (   memberchk(Next, Path)                     % back edge
    ->  Next == Start,
        Path = [_,_|_],                           % at least two more nodes
        normalize_cycle([Node|Path], Cycle)
    ;   Next @> Start,                            % Start is the smallest node of the cycle
        find_cycle([Next,Node|Path], Start, Graph, Cycle) ).

normalize_cycle([End|Path], Normalized) :-
    reverse([End|Path], [Start,Next|Rest]),
    (   Next @< End
        ->  Normalized = [Start,Next|Rest]
        ;   reverse([Next|Rest], Reversed),
            Normalized = [Start|Reversed] ).

graph(0, [a-[b,c,d], b-[a,c], c-[a,b,d], d-[a,c]]).
graph(1, [a-[b,c,d], b-[a,c], c-[a,b,d], d-[a,c], e-[f,g], f-[e,g], g-[e,f]]).
graph(2, [1-[2,3,4], 2-[1,3,5], 3-[1,2,4], 4-[1,3,5], 5-[2,4], 6-[7,8], 7-[6,8], 8-[6,7]]).

Examples:

?- graph(0, G), find_cycles(G, Cs).
G = [a-[b, c, d], b-[a, c], c-[a, b, d], d-[a, c]],
Cs = [[a, b, c], [a, b, c, d], [a, c, d]].

?- graph(1, G), find_cycles(G, Cs).
G = [a-[b, c, d], b-[a, c], c-[a, b, d], d-[a, c], e-[f, g], f-[e, g], g-[e|...]],
Cs = [[a, b, c], [a, b, c, d], [a, c, d], [e, f, g]].

?- graph(2, G), find_cycles(G, Cs), maplist(writeln, Cs).
[1,2,3]
[1,2,3,4]
[1,2,5,4]
[1,2,5,4,3]
[1,3,2,5,4]
[1,3,4]
[2,3,4,5]
[6,7,8]
G = [1-[2, 3, 4], 2-[1, 3, 5], 3-[1, 2, 4], 4-[1, 3, 5], 5-[2, 4], 6-[7, 8], 7-[6|...], 8-[...|...]],
Cs = [[1, 2, 3], [1, 2, 3, 4], [1, 2, 5, 4], [1, 2, 5, 4, 3], [1, 3, 2, 5|...], [1, 3, 4], [2, 3|...], [6|...]]