Blame


1 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.
2 665c255d 2023-08-04 jrmu
3 665c255d 2023-08-04 jrmu (define (test-case actual expected)
4 665c255d 2023-08-04 jrmu (newline)
5 665c255d 2023-08-04 jrmu (display "Actual: ")
6 665c255d 2023-08-04 jrmu (display actual)
7 665c255d 2023-08-04 jrmu (newline)
8 665c255d 2023-08-04 jrmu (display "Expected: ")
9 665c255d 2023-08-04 jrmu (display expected)
10 665c255d 2023-08-04 jrmu (newline))
11 665c255d 2023-08-04 jrmu
12 665c255d 2023-08-04 jrmu (define (last-pair x)
13 665c255d 2023-08-04 jrmu (if (null? (cdr x))
14 665c255d 2023-08-04 jrmu x
15 665c255d 2023-08-04 jrmu (last-pair (cdr x))))
16 665c255d 2023-08-04 jrmu
17 665c255d 2023-08-04 jrmu (define (make-cycle x)
18 665c255d 2023-08-04 jrmu (set-cdr! (last-pair x) x)
19 665c255d 2023-08-04 jrmu x)
20 665c255d 2023-08-04 jrmu
21 665c255d 2023-08-04 jrmu (define (count-pairs x)
22 665c255d 2023-08-04 jrmu (if (not (pair? x))
23 665c255d 2023-08-04 jrmu 0
24 665c255d 2023-08-04 jrmu (+ (count-pairs (car x))
25 665c255d 2023-08-04 jrmu (count-pairs (cdr x))
26 665c255d 2023-08-04 jrmu 1)))
27 665c255d 2023-08-04 jrmu
28 665c255d 2023-08-04 jrmu (define three '(a b c))
29 665c255d 2023-08-04 jrmu (define a-pair (cons '() '()))
30 665c255d 2023-08-04 jrmu (define b-pair (cons a-pair a-pair))
31 665c255d 2023-08-04 jrmu (define four (cons 'a b-pair))
32 665c255d 2023-08-04 jrmu (define seven (cons b-pair b-pair))
33 665c255d 2023-08-04 jrmu (define circular (make-cycle '(a b c)))
34 665c255d 2023-08-04 jrmu
35 665c255d 2023-08-04 jrmu (test-case (count-pairs three) 3)
36 665c255d 2023-08-04 jrmu (test-case (count-pairs four) 4)
37 665c255d 2023-08-04 jrmu (test-case (count-pairs seven) 7)
38 665c255d 2023-08-04 jrmu (test-case (count-pairs circular) 'infinite-loop)