(define (contains-cycle? lst) 
   (let ((encountered (list))) 
     (define (loop lst) 
       (if (not (pair? lst)) 
           (if (memq lst encountered) 
               (begin (set! encountered (cons lst encountered)) 
                      (or (loop (car lst)) 
                          (loop (cdr lst))))))) 
     (loop lst))) 

I think the solution ablove 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) 
            ((not (pair? lat)) (return #f)) 
             (if (memq (car lat) C) 
                 (return #t) 
                   (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 says: 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.


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

<< Previous exercise (3.17) | Index | Next exercise (3.19) >>