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