-
Notifications
You must be signed in to change notification settings - Fork 1
/
Exercise 3.17 correct count-pairs.rkt
148 lines (130 loc) · 2.97 KB
/
Exercise 3.17 correct count-pairs.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
#lang racket
; Exercise 3.17. 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.)
; S O L U T I O N
(require rnrs/mutable-pairs-6)
(require compatibility/mlist)
(define (count-mpairs structure)
; List data structure to keep track of which pairs have already been visited
; during the counting process
(define visited-pairs '())
(define (count-mpairs-internal x)
(if (not (mpair? x))
0
(begin
(if (visited? x)
; do not double-count
0
(begin
(record-mpair x)
(+
(count-mpairs-internal (mcar x))
(count-mpairs-internal (mcdr x))
1
)
)
)
)
)
)
(define (record-mpair x)
; add x to the visited-pair list
(if (null? visited-pairs)
(set! visited-pairs (mcons x '()))
; insert the new pair at front of the list
; so the insertion is fast
(set! visited-pairs (mcons x visited-pairs))
)
)
; This procedure looks for the supplied pair in the visited-pairs list
; and if it finds x, it returns true. Otherwise it returns false.
(define (visited? x)
(define (present-in-list? l i)
(if (null? l)
false
(if (eq? (mcar l) i)
true
(present-in-list? (mcdr l) i)
)
)
)
(present-in-list? visited-pairs x)
)
(count-mpairs-internal structure)
)
; Test Driver
(define (run-test proc . args)
(define (print-item-list items first-time?)
(cond
((not (pair? items)) (void))
(else
(if (not first-time?)
(display ", ")
(void)
)
(print (car items))
(print-item-list (cdr items) false)
)
)
)
; (display "Running Test: ") (display (cons proc args)) (display " ")
; (newline)
(display "Applying ")
(display proc)
(display " on: ")
(print-item-list args true)
(newline)
(let ((result (apply proc args)))
(display "Result: ")
(display result)
(newline)
(print result)
(newline)
)
(newline)
)
; Tests
(define A (mcons 'u 'v))
(define B (mcons 'w 'x))
(define C (mcons 'y 'z))
(define M (mcons 'u 'b))
(define N (mcons 'v 'c))
(define O (mcons 'w 'd))
(define P (mcons 'd 'e))
(define Q (mcons 'x 'f))
(define R (mcons 'y 'g))
(define S (mcons 'z 'h))
; Test Results
Welcome to DrRacket, version 6.11 [3m].
Language: racket, with debugging; memory limit: 512 MB.
> (set-mcdr! A B)
> (set-mcdr! B C)
> (count-mpairs A)
3
> (set-mcar! B C)
> (count-mpairs A)
3
> (set-mcar! A B)
> (count-mpairs A)
3
> (set-mcdr! A B)
> (set-mcdr! B C)
> (set-mcdr! C A)
> (set-mcar! A 'u)
> (set-mcar! B 'w)
> (set-mcar! C 'y)
> (count-mpairs A)
3
> (set-mcdr! M N)
(set-mcdr! N O)
(set-mcdr! O P)
(set-mcdr! P M)
(set-mcar! P Q)
(set-mcdr! Q R)
(set-mcdr! R S)
(set-mcdr! S M)
(count-mpairs M)
7
>