sicp-ex-3.19


This is a well studied problem. Robert Floyd came up with an algorithm to solve this in the 1960s. (Yes, the same Floyd of the from the more famous Floyd-Warshall algorithm.) More infomation at: http://en.wikipedia.org/wiki/Cycle_detection

People in the software industry seem to like to use this problem as an interview question. I personally have encountered this problem in at least two separate interviews for software jobs.

The following is an implementation of Floyd's idea:

 (define (contains-cycle? lst) 
   (define (safe-cdr l) 
     (if (pair? l) 
         (cdr l) 
         '())) 
   (define (iter a b) 
     (cond ((not (pair? a)) #f) 
           ((not (pair? b)) #f) 
           ((eq? a b) #t) 
           ((eq? a (safe-cdr b)) #t) 
           (else (iter (safe-cdr a) (safe-cdr (safe-cdr b)))))) 
   (iter (safe-cdr lst) (safe-cdr (safe-cdr lst)))) 
  
  
 ; Tested with mzscheme implementation of R5RS: 
 (define x '(1 2 3 4 5 6 7 8)) 
 (define y '(1 2 3 4 5 6 7 8)) 
 (set-cdr! (cdddr (cddddr y)) (cdddr y)) 
 (define z '(1)) 
 (set-cdr! z z) 
 x ; (1 2 3 4 5 6 7 8) 
 y ; (1 2 3 . #0=(4 5 6 7 8 . #0#)) 
 z ; #0=(1 . #0#) 
 (contains-cycle? x) ; #f 
 (contains-cycle? y) ; #t 
 (contains-cycle? z) ; #t 

This runs in linear time and constant space. Note that the space is constant because the process is iterative and the parameters and a and b are pointers -- (cdr lst) is a pointer to, not a separate copy of the rest of the lst.


Brig Says: How about just change the values in the list to 'X'. Then all you have to do is check if the current value is x or not.

Joe Replies: Your suggestion is incorrect for (list 'a 'b 'c 'X) My solution did leverage a similar idea though, and is correct given the problem description (although it does trash the original list!):

 (define (cycle-p! list) 
   (let ((flag (cons 'doesnt 'matter))) 
     (define (f pair) 
       (cond ((null? pair) #f) 
             ((eq? flag (car pair)) #t) 
             (else (set-car! pair flag) 
                   (f (cdr pair))))) 
     (f list))) 

Solution that doesn't trash the original list:

  (define (cycle? list) 
    (define first list) 
    (define (rec x) 
      (cond ((eq? first x) #t) 
            ((not (pair? x)) #f) 
            (else (rec (cdr x))))) 
    (rec (cdr list))) 

David says: This solution will get stuck in an infinite loop in the first element is not in the cycle. For example

   (define x (list 'a 'b)) 
   (set-cdr! (cdr x) (cdr x)) 
   (cycle? x) ; Does not return 

Solution that will not trash the original list(modified and recovered actually):

 (define (cycle? x) 
   (let ((ret false) (header '(()))) 
     (define (rec lst) 
       (cond ((null? lst) (set! ret false)) 
             ((eq? (cdr lst) header) (set! ret true)) 
             (else 
               (let ((rest (cdr lst))) 
                 (set-cdr! lst header) 
                 (rec rest) 
                 (set-cdr! lst rest))))) 
     (rec x) 
     ret)) 

gws says: I didnt know about Floyd solution and came up with a different algorithm that is correct and constant space but it is less efficient (time-wise) and less elegant:

 (define (cycle-const-space? x) 
   (define (iter x cont elem num) 
     (cond ((null? (cdr x)) false) 
           ((eq? x elem) true) 
           (else (if (= cont num) 
                   (iter (cdr x) 0 x (+ 1 num)) 
                   (iter (cdr x) (+ cont 1) elem num))))) 
   (iter x 0 nil 0)) 

atrika says:

I didn't know about tortoise and hare too and came up with an algorithm similar to the one of gws. It selects a node, than advance n steps. If it didn't find the selected node, it selects the current node and advance n+1 steps. It keeps increasing the number of step until it hits the empty list (no cycle) or a selected element (cycle composed of n+1 elements)

  
 (define (is-cycle? mlist) 
   (define (iter current tested-for remaining-steps max-steps) 
     (cond ((null? current) false) 
           ((eq? current tested-for) true) 
           ((= remaining-steps 0) (iter (mcdr current) current (+ max-steps 1) (+ max-steps 1))) 
           (else (iter (mcdr current) tested-for (- remaining-steps 1) max-steps)))) 
   (iter (mcdr mlist) mlist 1 1)) 

<< Previous exercise (3.18) | Index | Next exercise (3.20) >>