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.)
4 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.
6 665c255d 2023-08-04 jrmu (define (cycle? l)
7 665c255d 2023-08-04 jrmu (let ((traversed '()))
8 665c255d 2023-08-04 jrmu (define (not-all-unique? l)
9 665c255d 2023-08-04 jrmu (cond ((not (pair? l)) #f)
10 665c255d 2023-08-04 jrmu ((memq l traversed) #t)
11 665c255d 2023-08-04 jrmu (else (set! traversed (cons l traversed))
12 665c255d 2023-08-04 jrmu (not-all-unique? (cdr l)))))
13 665c255d 2023-08-04 jrmu (not-all-unique? l)))
15 665c255d 2023-08-04 jrmu (define (test-case actual expected)
17 665c255d 2023-08-04 jrmu (display "Actual: ")
18 665c255d 2023-08-04 jrmu (display actual)
20 665c255d 2023-08-04 jrmu (display "Expected: ")
21 665c255d 2023-08-04 jrmu (display expected)
24 665c255d 2023-08-04 jrmu (define (last-pair x)
25 665c255d 2023-08-04 jrmu (if (null? (cdr x))
27 665c255d 2023-08-04 jrmu (last-pair (cdr x))))
29 665c255d 2023-08-04 jrmu (define (make-cycle x)
30 665c255d 2023-08-04 jrmu (set-cdr! (last-pair x) x)
33 665c255d 2023-08-04 jrmu (define three '(a b c))
34 665c255d 2023-08-04 jrmu (define a-pair (cons '() '()))
35 665c255d 2023-08-04 jrmu (define b-pair (cons a-pair a-pair))
36 665c255d 2023-08-04 jrmu (define four (cons 'a b-pair))
37 665c255d 2023-08-04 jrmu (define seven (cons b-pair b-pair))
38 665c255d 2023-08-04 jrmu (define circular (make-cycle '(a b c)))
40 665c255d 2023-08-04 jrmu (test-case (cycle? three) #f)
41 665c255d 2023-08-04 jrmu (test-case (cycle? four) #f)
42 665c255d 2023-08-04 jrmu (test-case (cycle? seven) #f)
43 665c255d 2023-08-04 jrmu (test-case (cycle? circular) #t)
