1 665c255d 2023-08-04 jrmu (define (test-case actual expected)
 2 665c255d 2023-08-04 jrmu   (newline)
 3 665c255d 2023-08-04 jrmu   (display "Actual:   ")
 4 665c255d 2023-08-04 jrmu   (display actual)
 5 665c255d 2023-08-04 jrmu   (newline)
 6 665c255d 2023-08-04 jrmu   (display "Expected: ")
 7 665c255d 2023-08-04 jrmu   (display expected)
 8 665c255d 2023-08-04 jrmu   (newline))
 9 665c255d 2023-08-04 jrmu 
10 665c255d 2023-08-04 jrmu (define (wrong-count-pairs x)
11 665c255d 2023-08-04 jrmu   (if (not (pair? x))
12 665c255d 2023-08-04 jrmu       0
13 665c255d 2023-08-04 jrmu       (+ (count-pairs (car x))
14 665c255d 2023-08-04 jrmu          (count-pairs (cdr x))
15 665c255d 2023-08-04 jrmu          1)))
16 665c255d 2023-08-04 jrmu 
17 665c255d 2023-08-04 jrmu (define (last-pair x)
18 665c255d 2023-08-04 jrmu   (if (null? (cdr x))
19 665c255d 2023-08-04 jrmu       x
20 665c255d 2023-08-04 jrmu       (last-pair (cdr x))))
21 665c255d 2023-08-04 jrmu 
22 665c255d 2023-08-04 jrmu (define (make-cycle x)
23 665c255d 2023-08-04 jrmu   (set-cdr! (last-pair x) x)
24 665c255d 2023-08-04 jrmu   x)
25 665c255d 2023-08-04 jrmu 
26 665c255d 2023-08-04 jrmu (define three '(a b c))
27 665c255d 2023-08-04 jrmu (define a-pair (cons '() '()))
28 665c255d 2023-08-04 jrmu (define b-pair (cons a-pair a-pair))
29 665c255d 2023-08-04 jrmu (define four (cons 'a b-pair))
30 665c255d 2023-08-04 jrmu (define seven (cons b-pair b-pair))
31 665c255d 2023-08-04 jrmu (define circular (make-cycle '(a b c)))
32 665c255d 2023-08-04 jrmu 
33 665c255d 2023-08-04 jrmu ;; (test-case (wrong-count-pairs three) 3)
34 665c255d 2023-08-04 jrmu ;; (test-case (wrong-count-pairs four) 4)
35 665c255d 2023-08-04 jrmu ;; (test-case (wrong-count-pairs seven) 7)
36 665c255d 2023-08-04 jrmu ;; (test-case (wrong-count-pairs circular) 'infinite-loop)
37 665c255d 2023-08-04 jrmu 
38 665c255d 2023-08-04 jrmu ;; Devise a correct version of the count-pairs procedure of exercise 3.16 that returns the number of distinct pairs in any structure. (Hint: Traverse the structure, maintaining an auxiliary data structure that is used to keep track of which pairs have already been counted.) 
39 665c255d 2023-08-04 jrmu 
40 665c255d 2023-08-04 jrmu (define (count-pairs x)
41 665c255d 2023-08-04 jrmu   (let ((traversed-pairs '()))
42 665c255d 2023-08-04 jrmu     (define (not-traversed x)
43 665c255d 2023-08-04 jrmu       (cond ((not (pair? x)) 0)
44 665c255d 2023-08-04 jrmu 	    ((memq x traversed-pairs) 0)
45 665c255d 2023-08-04 jrmu 	    (else (set! traversed-pairs (cons x traversed-pairs))
46 665c255d 2023-08-04 jrmu 		  (+ (not-traversed (car x))
47 665c255d 2023-08-04 jrmu 		     (not-traversed (cdr x))
48 665c255d 2023-08-04 jrmu 		     1))))
49 665c255d 2023-08-04 jrmu     (not-traversed x)))
50 665c255d 2023-08-04 jrmu 
51 665c255d 2023-08-04 jrmu (test-case (count-pairs three) 3)
52 665c255d 2023-08-04 jrmu (test-case (count-pairs four) 3)
53 665c255d 2023-08-04 jrmu (test-case (count-pairs seven) 3)
54 665c255d 2023-08-04 jrmu (test-case (count-pairs circular) 3)
55 665c255d 2023-08-04 jrmu