(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)))
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) (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 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.
<< Previous exercise (3.17) | Index | Next exercise (3.19) >>