<< 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.
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)
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.
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)
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)))
I only checked the top solution and "cannot find cycles in tree structures" is right for at least that.
---
"Floyd's tortoise and hare" can be combined with DFS for tree since if there is one subtree which is the loop, then keeping car or cdr there must go back to one location in the loop.
IGNORE THIS WRONG PARAGRAGH: Although here step counting is not strictly right (i.e. (dfs (cdr root)) will count the steps in (dfs (car root)) but the former doesn't work through car at all), we can actually restructure the tree by letting all the former counted car or cdr subtrees be the parents sequentially of the loop substree which doesn't influence the existence of loop. On the other hand, if there is no loop, then even (eq? (iterator-value it1) (iterator-value it2)) can't be met. So the wrong counting of steps doesn't influence this case also.
---
Your solution is right IMHO and works for ";; all tests" in http://community.schemewiki.org/?sicp-ex-3.18 and (cycle? cycle-1). Here you let the minimal step be 2 clock-cnt's (i.e. what f does in wikipedia). This works from mathematical view since
1. We can prove the condition "Floyd's tortoise and hare" is the sufficient and necessary condition for having cycle.
cycle with $k,\lambda,\mu$ definitions <-> $x_i=x_{i+k\lambda},\forall i\ge\mu$ (i.e. we keep following the cycle.) -> $\exists i=k\lambda\ge\mu$ since k can be arbitrarily large (<- based on "cycle with $k,\lambda,\mu$ definitions") -> $x_i=x_{2i}$ (<- should be based on "$x_i=x_{i+k\lambda},\forall i\ge\mu$").
2. Then we have
x_i=x_{2i} -> x_{2i}=x_{4i}, so if x_{2i}!=x_{4i} -> x_i!=x_{2i} -> not have cycle.
And trivially x_{2i}=x_{4i} -> have cycle.
---
Correction to "WRONG PARAGRAGH": My "restructure" may work but may need one very long iteration. The above codes fail for the cycle in http://community.schemewiki.org/?sicp-ex-3.23 wtative's deq with ";Aborting!: maximum recursion depth exceeded". Since we use DFS, we should make all local variables in stack which can be done by iteration naturally (i.e. just as wikipedia shows, here we consider one 1D path instead of 2D tree for step counting). So my correction for dfs is as the following:
(define (dfs root slow-it fast-it clock-cnt) (displayln (list "clock-cnt" clock-cnt)) (if (not (pair? root)) ; leaf as the base case. false (let* ((clock-cnt-updated (+ 1 clock-cnt)) ; put first to ensure the first set is when clock-cnt-updated=2 instead of clock-cnt=0. (slow-it-updated (if (and (even? clock-cnt-updated) (iterator-same-pos? slow-it fast-it)) (begin (displayln "update slow-it") (iterator root clock-cnt-updated)) slow-it)) (fast-it-updated (if (even? clock-cnt-updated) (iterator root (+ (iterator-id fast-it) 1)) fast-it)) ) (if (iterator-eq? slow-it fast-it) true (or (dfs (car root) slow-it-updated fast-it-updated clock-cnt-updated) (dfs (cdr root) slow-it-updated fast-it-updated clock-cnt-updated)))))) (trace dfs) (dfs tree (iterator tree 0) (iterator '() 0) 0)
This works for both the above ";; all tests" plus (cycle? cycle-1) and deq.
Trivially iteration without using outer variables have space complexity \Theta(1).
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.
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))
IMHO following https://en.wikipedia.org/wiki/Cycle_detection#Floyd's_tortoise_and_hare python codes, we only needs:
(cond ((not (pair? b)) #f) ((eq? a b) #t) (else (iter (safe-cdr a) (safe-cdr (safe-cdr b)))))
since we want to check "x_i = x_2i". (not (pair? b)) will be matched when having no loop since we must iterate through all elements at some time.
---
The above only considers the pattern of keeping cdr-ing down. See AntonKolobov's comment which IMHO may be the only right solution here if AntonKolobov's check of other comments is right.