Blob


1 (define (test-case actual expected)
2 (newline)
3 (display "Actual: ")
4 (display actual)
5 (newline)
6 (display "Expected: ")
7 (display expected)
8 (newline))
10 (define (wrong-count-pairs x)
11 (if (not (pair? x))
12 0
13 (+ (count-pairs (car x))
14 (count-pairs (cdr x))
15 1)))
17 (define (last-pair x)
18 (if (null? (cdr x))
19 x
20 (last-pair (cdr x))))
22 (define (make-cycle x)
23 (set-cdr! (last-pair x) x)
24 x)
26 (define three '(a b c))
27 (define a-pair (cons '() '()))
28 (define b-pair (cons a-pair a-pair))
29 (define four (cons 'a b-pair))
30 (define seven (cons b-pair b-pair))
31 (define circular (make-cycle '(a b c)))
33 ;; (test-case (wrong-count-pairs three) 3)
34 ;; (test-case (wrong-count-pairs four) 4)
35 ;; (test-case (wrong-count-pairs seven) 7)
36 ;; (test-case (wrong-count-pairs circular) 'infinite-loop)
38 ;; 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.)
40 (define (count-pairs x)
41 (let ((traversed-pairs '()))
42 (define (not-traversed x)
43 (cond ((not (pair? x)) 0)
44 ((memq x traversed-pairs) 0)
45 (else (set! traversed-pairs (cons x traversed-pairs))
46 (+ (not-traversed (car x))
47 (not-traversed (cdr x))
48 1))))
49 (not-traversed x)))
51 (test-case (count-pairs three) 3)
52 (test-case (count-pairs four) 3)
53 (test-case (count-pairs seven) 3)
54 (test-case (count-pairs circular) 3)