sicp-ex-3.19


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

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.

xdavidliu

Takes a range of size m and compares each of the nth-cdr 's with the head. If no conclusions are reached, jump to the end of the range, double m, and start over.

I came up with this algorithm myself, but it appears to be similar, if not the exact same, as Brent's algorithm, which one can read about in the Cycle detection wikipedia article.

 ; 
 ; 
 ; 
 ; 
 (define (cycle? x) 
   (define (iter head next i m) 
     (cond 
      ((null? next) false) ; head is never null 
      ((eq? head next) true) 
      ((< i m) (iter head (cdr next) (1+ i) m)) 
      (else (iter next (cdr next) 1 (* 2 m))))) 
   (if (null? x) 
       false 
       (iter x (cdr x) 1 1))) 
  
 (cycle? '(1 2 3 4 5 6 7 8 9 10)) ; -> #f 
  
 (define (make-cycle x) 
   (set-cdr! (last-pair x) x) 
   x) 
  
 (cycle? (make-cycle '(1 2 3 4 5 6 7 8 9 10))) ; -> #t 
 (cycle? (append '(1 2 3 4 5) (make-cycle '(6 7 8 9 10 11)))) ; -> #t 

Certainly O(1) memory, and also linear time since sum 2^(lg n) = O(n)


HiPhish

The "Turtle and Hare" algorithm won't work for this exercise. If we take the set of nodes (pairs) to be our set S then f: S -> S has to be a function. However, note that both the car and the cdr of a pair can be pointing to to another pair. This means that the "points to" relation cannot be a function from S to S, because a function can only produce one element, not two. This effectively breaks the preconditions of the algorithm and we can no longer assume that it works. In fact, the Turtle and Hare algorithm does not work as I am going to demonstrate.

Let's assume the following structure:

 +---------------+
 |               |
 |        _ _    V _
 |       |0|_|->|1|_|-----+
 |        |      |   _ _  |
 |        |      +->|2|X| |
 |        |               |
 |        |      +--------+
 |        |      |
 | _      V _    V _    _ _
|6|_|<-- |3|_|->|4|_|->|5|_|-+
          ^                  |
          |                  |
          +------------------+

The nodes are numbered for reference, the numbers themselves are irrelevant. Node elements that point to a non-node don't have an arrow and the null element is an X. There is a cycle 3 -> 4 -> 5 -> 3.

The problem starts at the first node 0 already. We can send the turtle and the hare in two directions and obviously it only makes sense to send both in the same direction. Without loss of generality we will perform a car-first search. This means we send both towards 3, at which point we move car-first towards 6, then towards 1 and from there towards 2. At this point the hare would hit a wall and conclude that that path was a dead-end.

However, in order to find the cycle the two animals would have to backtrack to the last node with a fork in the path and resume the race again from there. In other words, the algorithm needs some sort of stack, a non-constant amount of memory. I know that one could have take another order for the search and have found the cycle, but for every order I can find a new graph where the hare will eventually run into a wall and miss the cycle.

The exercise says "Write a procedure that examines a list", so one could argue about what the term "list" in this context exactly means, but considering that the chapter has been referring to forked structures as lists as well I believe we must take forks into account as well. I don't know an about an algorithm that could handle my structure or if such an algorithm even exists. Maybe this was just an oversight by the authors and I'm overthinking the issue.



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)) 

sam says: Another way is to first run (mystery x) on the list. This reversal happens in place per the definition on page256 in the book and hence constant space (that is, no extra space). If there is a cycle, 'x' (after reversal) points to the same pair as the original argument list, else no. If needed,one can recover original list by running (mystery x) again.


joe w

This seems like it works and is pretty straight forward implementation of th tortoise and hare. Uses constant space because cdr gets a list pointer like the explanation at the top says. Used racket.

 #lang sicp 
 (define (last-pair x) 
   (if (null? (cdr x)) 
       x 
       (last-pair (cdr x)))) 
  
 (define (make-cycle x) 
   (set-cdr! (last-pair x) x) 
   x) 
  
 (define z (make-cycle (list 'a 'b 'c))) 
 (define u (make-cycle (list 'a 'b 'c 'd 'e 'f))) 
 (define w (make-cycle (list 'a 'b 'c 'd 'e 'f 'g))) 
 (define t (make-cycle (list 'a 'b 'c 'd 'e 'f 'g 'h))) 
 (define v (make-cycle (list 'a 'b))) 
 (define x (make-cycle (list 'a))) 
 (define y (make-cycle (list '()))) 
 (define a '()) 
 (define b (list 'a)) 
 (define c (list 'a 'b)) 
 (define d (list 'a 'b 'c)) 
  
 (define (contains-cycle? xs) 
   (define (chase tort hare) 
     (cond ((null? hare) #f) 
           ((eq? tort hare) #t) 
           ((null? (cdr hare)) #f)           
           (else (chase (cdr tort) 
                        (cddr hare))))) 
   (and (pair? xs) 
       (chase xs (cdr xs)))) 
  
 (contains-cycle? z) 
 (contains-cycle? v) 
 (contains-cycle? x) 
 (contains-cycle? y) 
 (contains-cycle? u) 
 (contains-cycle? w) 
 (contains-cycle? t) 
 (contains-cycle? a) 
 (contains-cycle? b) 
 (contains-cycle? c) 
 (contains-cycle? d) 

AntonKolobov

Unfortunatelly, all the above solutions cannot find cycles in tree structures.

The point is to implement the DFS traversal with tracking of two periodically updatable node iterators, for finding such i and j that i == j and f1(f2(...fi(root)...) == g1(g2(...gj(root)...), where f gets the next node of DFS traversal and g gets the node after the next.

 (define (has-cycle? tree) 
   ;; Helpers 
   (define (iterator value idx) 
     (cons value idx)) 
   (define (update-iterator it value idx) 
     (set-car! it value) 
     (set-cdr! it idx)) 
   (define (iterator-id it) 
     (cdr it)) 
   (define (iterator-value it) 
     (car it)) 
   (define (iterator-same-pos? it1 it2) 
     (eq? (iterator-id it1) (iterator-id it2))) 
   (define (iterator-eq? it1 it2) 
     (and (iterator-same-pos? it1 it2) 
          (eq? (iterator-value it1) (iterator-value it2)))) 
  
   ;; slow-it - tracks each node (1, 2, 3, 4...) 
   ;; fast-it - tracks only even nodes (2, 4...) 
   (let ((slow-it (iterator tree 0)) 
         (fast-it (iterator '() 0)) 
         (clock-cnt 0)) 
     (define (dfs root) 
       (if (not (pair? root)) 
           false 
           (begin 
             (set! clock-cnt (+ clock-cnt 1)) 
             (if (and (even? clock-cnt) 
                      (iterator-same-pos? slow-it fast-it)) 
                 (update-iterator slow-it root clock-cnt)) 
             (if (even? clock-cnt) 
                 (update-iterator fast-it root 
                                  (+ (iterator-id fast-it) 1))) 
             (if (iterator-eq? slow-it fast-it) 
                 true 
                 (or (dfs (car root)) 
                     (dfs (cdr root))))))) 
     (dfs tree))) 

Sphinxsky

      
  
  
  
 Let's start with a list: 
  
 (define r-inf (list 'a 'b 'c 'd)) 
 (set-cdr! (last-pair r-inf) r-inf) 
  
  
 When the above program runs 
 The position “clock-cnt” where the variable appears is as follows 
  
     a: 1  5  9   13  17  ... 4n+1 
  
     b: 2  6  10  14  18  ... 4n+2 
  
     c: 3  7  11  15  19  ... 4n+3 
  
     d: 4  8  12  16  20  ... 4n+4 
  
 When clock-cnt > 2 : 
  
     ∵ condition: “(even? clock-cnt) ” 
     ∴ fast-it can only be “b” or “d” node 
     and 
         when fast-it is “b” node: 
             fast-it-id: 1 3 5 7 9 ... 2n+1 is odd 
         when fast-it is “d” node: 
             fast-it-id: 2 4 6 8 10 ... 2n+2 is even 
  
     The same reason 
         slow-it can only be “b” or “d” node too. 
         and slow-it-id must be even. 
  
 also ∵ condition: “(and (even? clock-cnt) (iterator-same-pos? slow-it fast-it))”  
        was Satisfied 
             fast-it-id = slow-it-id must be even 
    ∴  After the: 
             "(update-iterator slow-it root clock-cnt)" 
             "(update-iterator fast-it root (+ (iterator-id fast-it) 1))" 
             is executed 
         fast-it-id must be odd. 
         and slow-it-id = clock-cnt = 2 * fast-it-id = 2 * odd 
    ∴    slow-it-id = 2 * odd 
    ∴    slow-it must be “b” node. 
     
 ∴ When slow-it-value = fast-it-value 
     fast-it must be “b” node. 
     ∴  fast-it-id: 1 3 5 7 9 ... 2n+1 is odd. 
     ∵ slow-it-id must be even. 
     ∴ fast-it-id != slow-it-id 
     ∴ condition: "(iterator-eq? slow-it fast-it)" was Satisfied never. 
     ∴ The program falls into infinite recursion when the loop section of the list is an integer multiple of 4. 

aQuaYi.com

Exercise 3.18: Write a procedure that examines a list and determines whether it contains a cycle, that is, whether a program that tried to find the end of the list by taking successive cdrs would go into an infinite loop.

notice: taking successive cdrs

So, we doesn't need to check loop in some car.

So, solution is very simple.

 #lang sicp 
  
 ;;; problem said, just cdr to look for end. 
  
 (define loop '(foo bar baz))  
 (set-cdr! (cddr loop) loop)  
 ;          ,-------------------,  
 ;          |                   |  
 ;          v                   |  
 ; str4 -> ( . ) -> ( . ) -> ( . )  
 ;          |        |        |  
 ;          v        v        v  
 ;         'foo     'bar     'baz 
  
 (define (has-loop? x) 
     (define (check slow fast) 
       (cond ((eq? slow fast) 
              #t) 
             ((or (null? (cdr fast)) (null? (cddr fast))) 
              #f) 
             (else 
              (check (cdr slow) (cddr fast))))) 
     (check x (cdr x))) 
  
 (has-loop? loop) 
  
 (has-loop? (list 'a 'b 'c))