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

There's many examples if you search, e.g. https://stackoverflow.com/search?q=%5Bprolog%5D+undirected+graph — brebs, Apr 30 '23 at 16:34
I have looked at these threads. There are only a couple of them close to my task, but they do not fit. — Slave, Apr 30 '23 at 17:36
How would [a,b,c] and [a,d,c] be the only 2 "cycles", how are "cycles" defined? — brebs, Apr 30 '23 at 18:59

score 1 · Answer 1 · answered May 02 '23 at 07:02

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.

This implementation of the program looks interesting. How can the problem of duplicates be solved in your opinion?(For example: [a,b,c];[b,c,a];[c,a,b]) — Slave, May 02 '23 at 08:32
I do not see this as a problem. For a cycle of length n, there will be 2n solutions (both directions). That's harmless (Prolog-wise, we would get nervous would there be n! redundant solutions). If you want to "solve" this, you are solving a different problem. You would need to say that one of those is better. Say, the one that **starts with the smallest name**, and then, the next element is smaller than the last one. — false, May 02 '23 at 18:28

score 0 · Answer 2 · answered Apr 30 '23 at 18:57

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.

Thank you. There are a couple of questions: 1) Is it possible to make it so that results with two dots are not displayed? 2) Is it possible to make sure that identical results are not displayed? (For example: [a, b, c] ;[a, c, b] ;) They are the same. — Slave, Apr 30 '23 at 21:34
"Two dots" - where exactly do you see two dots? What exactly is your definition of "identical"? Edit your question with the necessary clarifications. — brebs, Apr 30 '23 at 21:45
"Two dots": [a, b] ; [a, c] ; [c, b] etc. To avoid such results. I apologize for my explanation. — Slave, Apr 30 '23 at 22:03
@brebs,With two dots, I solved by limiting the minimum indication. What can be done with similar cycles? — Slave, May 01 '23 at 10:02

slago · Answer 3 · 2023-05-05T21:02:22.543

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|...]]

Finding Cycles in an Undirected Graph

3 Answers3