<< Previous exercise (3.17) | Index | Next exercise (3.19) >>
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. Exercise 3.13 constructed such lists.
Yep this is a good one but not really correct. Look at this example:
(define x '(a b c)) (define y '(d e f)) (set-car! (cdr x) y) (set-car! x (cdr x)) (set-cdr! (last-pair y) (cdr y)) ;list y is now part of x ;here (cycle? x) gives false, but really x is an infinite loop, because it will get stuck in (cadr x) pointer which contains the implicit loop in y, thus (cddr x) will never be evaluated.
If we expect this operation to work on arbitrary list, which may contain nested lists like here, the task becomes lot more difficult. The main function of this algorithm is to find a loop in either car or cdr of the observed object, and the two conditions that satisfy this result are: 1) when either the car-pointer or the cdr-pointer point to some "box" which we've met before (all of them must be contained in a special local storage variable); 2) we can reach the current observed box from that box successively 'cdr-ing' it down; Another issue is a bit more about technical side and concerns our choice of programming style - functional or imperative way in part of organization of that "local storage" for traversed steps, albeit insignificantly change our code, wrong choice may result in a mistake and as a consequence give the wrong answer. The problem is the consequence of the way how we theoretically have to fill our "storage" and what we count as a 'infinite list' -- infinity arises only when the current node points to some predecessor node that is on that level or the level above, if we imagine our lists as a box-and-pointer structure with possibly more than one level, like the one pictured in the book in the figure 3.16. At the point when we reach the end of such "nested" list (the enclosing null pointer), where no cycle was found, we have to continue "walking through" the level above it, but all that stuff accumulated in the "local storage" after walking down the sublist is now a garbage and shall not be referenced anymore, because from now on any of the boxes on the main level can point to any box from that sublist (because it's on lower level and is finite, which means it doesn't contain an infinite loop). In other words, we have to throw into our "local storage" only the pointer to that sublist, not all the items it contains. However, due to the recursive structure of calls to our procedure and the fact that such sublists will also be processed with the same procedure and the same input pointer to the bound "local storage", in case of mutating that storage we will have all named garbage in there, ready for processing in further calls thus giving the wrong result. It's obscure how to deal with it in Scheme in imperative style by now. Probably introducing some additional counter variable would help, but it's so much easier just to write it the functional way. I've implemented this idea in this code and it seems to work correct for various infinite/normal lists:
(define (inf_loop? L)
(define (iter items trav)
(cond ((not (pair? items)) #f)
((eq? (cdr items) items) #t)
((eq? (car items) (cdr items))
(iter (cdr items) trav))
((element-of-set? (car items) trav) #t)
((element-of-set? (cdr items) trav) #t)
(else
(if (not (pair? (car items)))
(iter (cdr items) (cons items trav))
(or (iter (car items) (cons items trav))
(iter (cdr items) (cons items trav)))))))
(iter L '()))
The solutions above all seem a little too complex. After looking at them I had to recheck the question a few times to make sure I'd not missed a requirement to use mutable data structures, but I don't see any such limitation.
(define (has-cycle? l)
(define (detect pair countedList)
(cond ((not (pair? pair)) #f)
((memq pair countedList) #t)
(else (detect (cdr pair) (cons pair countedList)))))
(detect l '()))
I think mbndrk' solution is the only one correct. Other solutions have mainly 2 kinds of error:
1. not consider *car* which actually can lead to loop as well.
2. using ONLY ONE common storage to save pairs met/counted before. e.g. if *car* and *cdr* both point to a pair P. we start by following *car* so P will be save into the common storage, but after that when we follow *cdr* P will be considered already met before so conclude that the list has circle which obviously not correct.
Following is my solution:
(define (has-cycle? seq)
(define (lst-in? lst records)
(cond ((null? records) false)
((eq? (car records) lst) true)
(else (lst-in? lst (cdr records)))))
(define (has-cycle-1? processed lst)
(cond ((not (pair? lst)) false)
((lst-in? lst processed) true)
(else
(or (has-cycle-1? (cons lst processed) (car lst))
(has-cycle-1? (cons lst processed) (cdr lst))))))
(has-cycle-1? '() seq))
It seems to be fubupc is exactly right. The basic idea must be that whenever we branch into the car or the cdr (tree recurse) we equip the search with a "history" of all nodes visited from the root to the nodes we are moving to so that at any point a cycle (a traversal into a node in the history) can be dettected. (Now the difference between 'list' and 'list structure' could be stressed to interpret the question as strictly about loops in successive cdrs in a 'list' but the above solution will more generally detect loops in list structures and therefore to my taste preferable)
(Also note fubups's solution could be simplified by using the library function memq instead of the locally defined lst-in? : Here is a simpler version of her/his solution:
(define (has-loop? lis)
(define (iter searchlist seen)
(cond ((not (pair? searchlist)) #f)
((memq searchlist seen) #t)
(else (or (iter (car searchlist) (cons searchlist seen))
(iter (cdr searchlist) (cons searchlist seen))))))
(iter lis '()))
The exercise only asks us to detect cycle in lists, not list structures. The distinction is made by the author in page 100 (2nd ed). Therefore, the solution should be straight forward:
(define (cycle-in-list? x)
(let ((traversed '()))
(define (traverse x)
(cond ((null? x) #f)
((memq x traversed) #t)
(else (set! traversed (cons x traversed))
(traverse (cdr x)))))
(traverse x)))
I think the code can be simpler.
(define (is-in-it? this seg) (if (null? seg) #f (if (eq? this (car seg)) #t (is-in-it? this (cdr seg))))) (define (is-cycle? x) (define (rec-do x seg) (if (pair? x) (or (is-in-it? x seg) (rec-do (car x) (cons x seg)) (rec-do (cdr x) (cons x seg))) #f)) (rec-do x '()))
For me most intuitive (and rathe concise) is the following: The observation is, that if there's a cycle in the list, it should repeat at some point, so the code checks whether the list repeats itself through checking whether the cdr of the current list is the same as the list itself - if not so it checks whether 1. the cdr of the curr-list repeats itself or 2. the car of the curr-list has a cycle or 3. the cdr of the curr-list has a cycle
(define (cycle? L)
(define (help curr-list)
(if (not (pair? curr-list)) false
(if (eq? (cdr curr-list) L)
true
(or (help (cdr curr-list)) (cycle? (car curr-list)) (cycle? (cdr curr-list))))))
(help L))
I very much respect the amount of effort people here put into this problem but I too interpreted the instructions to mean "detect whether the top-level list cycles, not whether the list contains a cycle. However, I believe my solution can be called recursively on each node of the tree to determine whether there is a cycle at any level. It's quite simple: using count-pairs from the previous exercise, determine the number of distinct pairs in the list, and use that as the upper bound for an iterative search through the list. If we exceed this upper bound then surely we are stuck in a cycle.
(define (cycle? l)
(let ((n (count-pairs l)))
(define (iter items i)
(cond ((null? items) #f)
((> i n) #t)
(else (iter (cdr items) (+ i 1)))))
(iter l 0)))
(define (is-cycle? x) (let ((head x)) (define (iter y) (cond ((eq? y head) #t) ((null? y) #f) (else (iter (cdr y))))) (if (null? x) #f (iter (cdr x))))) (define z1 (make-cycle (list 'a 'b 'c))) (define z2 (list z1 z1)) (is-cycle? z1) ;#t (is-cycle? z2) ;#f
(define (contains-cycle? lst) (let ((encountered (list))) (define (loop lst) (if (not (pair? lst)) false (if (memq lst encountered) true (begin (set! encountered (cons lst encountered)) (or (loop (car lst)) (loop (cdr lst))))))) (loop lst)))anonymous 2
I think the solution above is not correct eg:
(define t1 (cons 'a 'b)) (define t2 (cons t1 t1))(cdr t2) ==> (a . b) (cdr (cdr (t2)) ==> b (contains-cycle? t2)==> #t
(define (contains-cycle? x) (define(inner return) (let((C '())) (define (loop lat) (cond ((not (pair? lat)) (return #f)) (else (if (memq (car lat) C) (return #t) (begin (set! C (cons (car lat) C)) (if(pair? (car lat)) ( or (contains-cycle? (car lat)) (loop (cdr lat))) (loop (cdr lat)))))))) (loop x))) (call/cc inner))mbndrk
fails (goes into infinite loop) when you call (contains-cycle (car lat)) and in that sublist there's a pointer to some pair which was before that call, i. e. you are in pair A, its car points to a symbol (let it be 'a'), then you cons this symbol to the C (another potential mistake when you will eventually synchronize some entry with container C, keep in mind that (eq?) always gives #t for equal symbols since there's no way to mutate a symbol, however it's absolutely legit if any of your next boxes will point to the different 'a', but yours will break and claim it's an infinite loop which is not true), move to next pair B, where car points to the named compound sublist, and now here the (contains-cycle (car lat)) will be evaluated, but nothing accumulated in C will be passed to that call, there will be new separate frame with empty C => infinite loop.
gws
here is a simpler solution
(define (cycle? x) (define visited nil) (define (iter x) (set! visited (cons x visited)) (cond ((null? (cdr x)) false) ((memq (cdr x) visited) true) (else (iter (cdr x))))) (iter x))Rptx
This last one is good. I would just add a clause to check if it is not a pair, to avoid an error on the cdr.