]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex3_17.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / ex3_17.rkt
1 #lang r5rs
2
3 (define (traverse-tree! x)
4   (cond 
5     ((not (pair? x)) x)
6     ((eqv? (car x) 'traversed)
7      (cons (traverse-tree! (car (cdr x)))
8            (traverse-tree! (cdr (cdr x)))))
9     (else 
10      (begin
11        (set! x (cons 'traversed (cons (car x) (cdr x))))
12        (traverse-tree! x)))))
13
14 (define (count-tree x)
15   (cond
16     ((not (pair? x)) 0)
17     ((traversed? x) (+ (count-tree (left x))
18                        (count-tree (right x))))
19     (else 
20      (begin
21        (set-car! x (traverse x))
22        (+ (count-tree (left x))
23           (count-tree (right x))
24           1)))))
25
26 (define (traversed? x)
27   (if (pair? (car x))
28       (eqv? (car (car x)) 'traversed)
29       #f))
30
31 (define (left x)
32   (if (traversed? x)
33       (cdr (car x))
34       (car x)))
35
36 (define (right x)
37   (cdr x))
38
39 (define (traverse x)
40   (cons 'traversed 
41         (car x)))
42
43 (define x (list 'a 'b))
44 (define z (cons x x))