1 ;; Exercise 3.19.  Redo exercise 3.18 using an algorithm that takes only a constant amount of space. (This requires a very clever idea.) 
2 
3 ;; 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. 
4 
5 ;; (define (cycle? l)
6 ;;   (let ((traversed '()))
7 ;;     (define (not-all-unique? l)
8 ;;       (cond ((not (pair? l)) #f)
9 ;; 	    ((memq l traversed) #t)
10 ;; 	    (else (set! traversed (cons l traversed))
11 ;; 		  (not-all-unique? (cdr l)))))
12 ;;     (not-all-unique? l)))
13 
14 ;; (define (cycle? l)
15 ;;   (define (iter single double)
16 ;;     (if (eq? single double)
17 ;; 	#t
18 ;; 	(if (and (pair? double)
19 ;; 		 (pair? (cdr double)))
20 ;; 	    (iter (cdr single) (cddr double))
21 ;; 	    #f)))
22 ;;   (if (pair? l)
23 ;;       (iter l (cdr l))
24 ;;       #f))
25 
26 (define (cycle? l)
27   (define (loop? single double)
28     (or (eq? single double)
29 	(and (pair? double)
30 	     (pair? (cdr double))
31 	     (loop? (cdr single) (cddr double)))))
32   (and (pair? l)
33        (loop? l (cdr l))))
34 
35 (define (test-case actual expected)
36   (newline)
37   (display "Actual:   ")
38   (display actual)
39   (newline)
40   (display "Expected: ")
41   (display expected)
42   (newline))
43 
44 (define (last-pair x)
45   (if (null? (cdr x))
46       x
47       (last-pair (cdr x))))
48 
49 (define (make-cycle x)
50   (set-cdr! (last-pair x) x)
51   x)
52 
53 (define three '(a b c))
54 (define a-pair (cons '() '()))
55 (define b-pair (cons a-pair a-pair))
56 (define four (cons 'a b-pair))
57 (define seven (cons b-pair b-pair))
58 (define circular (make-cycle '(a b c)))
59 (define circular-car (cons circular '()))
60 (define circular-cdr (cons '() circular))
61 
62 (test-case (cycle? three) #f)
63 (test-case (cycle? four) #f)
64 (test-case (cycle? seven) #f)
65 (test-case (cycle? circular) #t)
66 (test-case (cycle? circular-car) #f) ;; because you can cdr to the end
67 (test-case (cycle? circular-cdr) #t)