Longest Cycle in a Graph

Question

Given a directed graph, output the longest cycle.

Rules

• Any reasonable input format is allowed (e.g. list of edges, connectivity matrix).
• The labels are not important, so you may impose any restrictions on the labels that you need and/or desire, so long as they do not contain additional information not given in the input (e.g. you can't require that the nodes in cycles are labeled with integers, and other nodes are labeled with alphabetic strings).
• A cycle is a sequence of nodes that are all connected, and no node is repeated, other than the node that is the start and end of the cycle ([1, 2, 3, 1] is a cycle, but [1, 2, 3, 2, 1] is not).
• If the graph is acyclic, the longest cycle has length 0, and thus should yield an empty output (e.g. empty list, no output at all).
• Repeating the first node at the end of the list of nodes in the cycle is optional ([1, 2, 3, 1] and [1, 2, 3] denote the same cycle).
• If there are multiple cycles of the same length, any one or all of them may be output.
• Builtins are allowed, but if your solution uses one, you are encouraged to include an alternate solution that does not use trivializing builtins (e.g. a builtin that outputs all cycles). However, the alternate solution will not count towards your score at all, so it is entirely optional.

Test Cases

In these test cases, input is given as a list of edges (where the first element is the source node and the second element is the destination node), and the output is a list of nodes without repetition of the first/last node.

[(0, 0), (0, 1)] -> [0]
[(0, 1), (1, 2)] -> []
[(0, 1), (1, 0)] -> [0, 1]
[(0, 1), (1, 2), (1, 3), (2, 4), (4, 5), (5, 1)] -> [1, 2, 4, 5]
[(0, 1), (0, 2), (1, 3), (2, 4), (3, 0), (4, 6), (6, 8), (8, 0)] -> [0, 2, 4, 6, 8]
[(0, 0), (0, 8), (0, 2), (0, 3), (0, 9), (1, 0), (1, 1), (1, 6), (1, 7), (1, 8), (1, 9), (2, 1), (2, 3), (2, 4), (2, 5), (3, 8), (3, 1), (3, 6), (3, 7), (4, 1), (4, 3), (4, 4), (4, 5), (4, 6), (4, 8), (5, 0), (5, 8), (5, 4), (6, 0), (6, 1), (6, 2), (6, 3), (6, 4), (6, 5), (6, 6), (6, 7), (6, 9), (7, 0), (7, 1), (7, 2), (7, 3), (7, 4), (7, 5), (7, 8), (7, 9), (8, 0), (8, 1), (8, 2), (8, 5), (8, 9), (9, 1), (9, 2), (9, 3), (9, 4), (9, 5), (9, 6)] -> [0, 9, 6, 7, 8, 2, 5, 4, 3, 1]
[(0, 0), (0, 2), (0, 4), (0, 5), (0, 7), (0, 9), (0, 11), (1, 2), (1, 4), (1, 5), (1, 8), (1, 9), (1, 10), (2, 0), (2, 1), (2, 3), (2, 4), (2, 5), (2, 6), (3, 0), (3, 1), (3, 5), (3, 6), (3, 7), (3, 8), (3, 9), (3, 11), (4, 1), (4, 3), (4, 7), (4, 8), (4, 9), (4, 10), (4, 11), (5, 0), (5, 4), (5, 6), (5, 7), (5, 8), (5, 11), (6, 0), (6, 8), (6, 10), (6, 3), (6, 9), (7, 8), (7, 9), (7, 2), (7, 4), (7, 5), (8, 8), (8, 9), (8, 2), (8, 4), (8, 7), (9, 0), (9, 1), (9, 2), (9, 3), (9, 6), (9, 10), (9, 11), (10, 8), (10, 3), (10, 5), (10, 6), (11, 2), (11, 4), (11, 5), (11, 9), (11, 10), (11, 11)] -> [0, 11, 10, 6, 9, 3, 8, 7, 5, 4, 1, 2]

Answer 1

Mathematica, 80 58 bytes

Saved a whopping 22 bytes thanks to JungHwan Min

(FindCycle[#,∞,All]/.{}->{Cases[#,v_v_]})[[-1,;;,1]]&

 is the three byte private use character U+F3D5 representing \[DirectedEdge]. Pure function with first argument # expected to be a list of directed edges. Finds All cycles of length at most Infinity in Graph@#, then replaces the empty list with the list of self-loops. Cycles are represented as lists of edges and sorted by length, so we take the last such cycle, then from all of its edges we take the first argument so that we get a list of vertices in the specified output format.

If only Mathematica treated loops as a cycle of length 1 (AcyclicGraphQ @ CycleGraph[1, DirectedEdges -> True] gives True, seriously), then we could save another 26 bytes:

FindCycle[#,∞,All][[-1,;;,1]]&

Answer 2

Haskell, 157 154 150 bytes

import Data.List
g#l=nub[last$(e:d):[d|p==last q||e`elem`init d]|d@(p:q)<-l,[e,f]<-g,p==f]
h g=snd$maximum$((,)=<<length)<$>[]:until((==)=<<(g#))(g#)g

Try it online!

Thanks @Laikoni and @Zgrab for saving a bunch of bytes!

This is a very inefficient program:

The first function # takes a list of paths l (a list of lists of numbers) and tries to extend the elements of l by prepending every possible edge (a list of length 2) of g to each element of l. This happens only if the element of l isn't already a cycle and if the new node that would be prepended is not already contained in the element of l. If it is already a cycle, we do not prepend anything but add it again to the new list of paths, if we can extend it, we add the extended path to the new list, otherwise we don't add it to the new list.

Now the function h repeatedly tries to extend those paths (starting with the list of edges itself) until we reach a fixed point, i.e. we cannot extend any path any further. At this point we only have cycles in our list. Then it is just a matter of picking the longest cycle. Obviously the cycles appear multiple times in this list since every possible cyclic rotation of a cycle is again a cycle.

Answer 3

Pyth, 20 bytes

eMefqhMT.>{eMT1s.pMy

Test suite

Takes a list of edges, like in the examples.

Explanation:

eMefqhMT.>{eMT1s.pMy
eMefqhMT.>{eMT1s.pMyQ    Variable introduction
                   yQ    Take all subsets of the input, ordered by length
                .pM      Reorder the subsets in all possible ways
               s         Flatten
                         (This should be a built in, I'm going to make it one.)
   f                     Filter on (This tests that we've found a cycle)
    qhMT                 The list of first elements of edges equals
           eMT           The last elements
         .>   1          Rotated right by 1
        {                Deduplicated (ensures no repeats, which would not be a
                         simple cycle)
  e                      Take the last element, which will be the longest one.
eM                       Take the last element of each edge, output.

Answer 4

Bash + bsdutils, 129 bytes

sed 's/^\(.*\) \1$/x \1 \1 x/'|sort|(tsort -l>&-)|&tr c\\n '
 '|sed 's/x //g'|awk 'm<NF{m=NF;gsub(/[^0-9 ] ?/,"");print}'|tail -1

tsort does all the heavy lifting, but its output format is rather unique and it doesn't detect cycles of length 1. Note that this doesn't work with GNU tsort.

Verification

--- t1 ---
0
--- t2 ---
--- t3 ---
0 1
--- t4 ---
1 2 4 5
--- t5 ---
0 2 4 6 8
--- t6 ---
0 2 1 6 3 7 4 8 9 5
--- t7 ---
0 11 10 3 1 2 4 7 5 8 9 6

Answer 5

JavaScript (ES6), 173 163 156 145 139 bytes

Saved 5 bytes thanks to @Neil

f=(a,m,b=[])=>a.map(z=>!([x,y]=z,m&&x-m.slice(-1))&&b.length in(c=(n=m||[x],q=n.indexOf(y))?~q?b:f(a.filter(q=>q!=z),[...n,y]):n)?b=c:0)&&b

Test snippet

f=(a,m,b=[])=>a.map(z=>!([x,y]=z,m&&x-m.slice(-1))&&b.length in(c=(n=m||[x],q=n.indexOf(y))?~q?b:f(a.filter(q=>q!=z),[...n,y]):n)?b=c:0)&&b

g=a=>console.log("Input:",JSON.stringify(a),"Output:",JSON.stringify(f(a)))

g([[0,0]])
g([[0,1],[1,2]])
g([[0,1],[1,0]])
g([[0,1],[1,2],[2,0]])
g([[0,1],[1,2],[1,3],[2,4],[4,5],[5,1]])
g([[0,1],[0,2],[1,3],[2,4],[3,0],[4,6],[6,8],[8,0]])

Answer 6

Haskell, 109 108 bytes

import Data.List
f g=last$[]:[b|n<-[1..length g],e:c<-mapM(\_->g)[1..n],b<-[snd<$>e:c],b==nub(fst<$>c++[e])]

A brute force solution: generate all lists of edges of increasing lengths until the length of the input, keep those that are cycles, return the last one. Takes the graph in the format [(1,2),(2,3),(2,4),(4,1)]. Try it online!

Explanation

f g=                    -- Define function f on input g as
  last$                 -- the last element of the following list
  []:                   -- (or [], if the list is empty):
  [b|                   --  lists of vertices b where
   n<-[1..length g],    --  n is between 1 and length of input,
   e:c<-                --  list of edges with head e and tail c is drawn from
    mapM(\_->g)[1..n],  --  all possible ways of choosing n edges from g,
   b<-[snd<$>e:c],      --  b is the list of second elements in e:c,
   b==                  --  and b equals
    nub(fst<$>c++[e])]  --  the de-duplicated list of first elements
                        --  in the cyclic shift of e:c.

Answer 7

MATLAB, 291 260 bytes

Takes an adjecency matrix A where an edge (i,j) is denoted by a 1 in A(i,j), and A is zero in all other entries. The output is a list of a longest cycle. The list is empty if there is no cycle at all, and the list includes start and endpoint if there is a cycle. It uses 1-based indexing.

This solution does not use any built-in functions related to graphs.

function c=f(A);N=size(A,1);E=eye(N);c=[];for j=1:N;l=g(j);if numel(l)>numel(c);c=l;end;end;function p=g(p)if ~any(find(p(2:end)==p(1)))e=E(p(end),:)Q=find(e*A)k=[];for q=Q;if ~ismember(q,p(2:end))n=g([p,q]);if numel(n)>numel(k);k=n;end;end;end;p=k;end;end;end

Unfortunately this does not run in TryItOnline as it uses a function within a function, which is recursive. A little bit of modification allows you to try it on octave-online.net.

For the very last test case I found an alternative longest cycle [0 2 1 4 3 5 7 8 9 11 10 6 0] (this notation uses 0-based indexing)

Explanation

The basic approach here is that we perform a BFS from every node and take care that we do not visit any of the intermediate nodes again except the start node. With that idea we can collect all possible cycles, and easily pick the longest one.

function c=f(A);
N=size(A,1);
E=eye(N);
c=[]; % current longest cycle
for j=1:N;                                      % iterate over all nodes
    l=getLongestCycle(j);                       % search the longest cycle through the current node
    if numel(l)>numel(c);                       % if we find a longer cycle, update our current longest cycle
        c=l;
    end;
    
end;

    function p=getLongestCycle(p);              % get longest cycle from p(1) using recursion
        if ~any(find(p(2:end)==p(1)));          % if we just found a cycle, return the cycle do nothing else, OTHERWISE:
            e=E(p(end),:);                      % from the last node, compute all outgoing edges
            Q=find(e*A);                        
            k=[];                               
            for q=Q;                            % iterate over all outogoin edges
                if ~ismember(q,p(2:end));       % if we haven't already visited this edge,
                    n=getLongestCycle([p,q]);   % recursively search from the end node of this edge
                    if numel(n)>numel(k);       % if this results in a longer cycle, update our current longest cycle
                        k=n;
                    end;
                end;
            end;
            p=k;
        end;
    end; 
end