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