Commit | Line | Data |
---|---|---|
2bd37ef1 MW |
1 | "-*-smalltalk-*- |
2 | ||
3 | Smalltalk implementation of a `same-fringe' solver. | |
4 | ||
5 | Use GNU Smalltalk syntax -- it seems more Emacs-friendly. | |
6 | " | |
7 | ||
8 | Object subclass: Node [ | |
9 | | left right data | | |
10 | ||
11 | <comment: 'I represent simple binary tree nodes. My instances consist of | |
12 | a data object, and left and right subtrees. The leaves of a tree are | |
13 | instances of LeafNode.'> | |
14 | <category: 'Toys-SameFringe'> | |
15 | ||
16 | Node class >> left: aNode data: anObject right: anotherNode [ | |
17 | "Answer a newly tree Node with the given subtrees and data." | |
18 | ||
19 | <category: 'instance creation'> | |
20 | ^self new left: aNode data: anObject right: anotherNode | |
21 | ] | |
22 | ||
23 | Node class >> parse: aString [ | |
24 | "Answer a newly constructed tree, parsed from aString." | |
25 | ||
26 | <category: 'parsing'> | |
27 | | stream tree | | |
28 | stream := ReadStream on: aString. | |
29 | tree := stream parseTree. | |
30 | stream atEnd ifFalse: [self error: 'trailing junk']. | |
31 | ^tree | |
32 | ] | |
33 | ||
34 | left: aNode data: anObject right: anotherNode [ | |
35 | "Initialize a (presumably) new instance." | |
36 | ||
37 | <category: 'initialization'> | |
38 | left := aNode. | |
39 | right := anotherNode. | |
40 | data := anObject. | |
41 | ^self | |
42 | ] | |
43 | ||
44 | left [ | |
45 | "Answer the receiver's left subtree." | |
46 | ||
47 | <category: 'accessing'> | |
48 | ^left | |
49 | ] | |
50 | ||
51 | right [ | |
52 | "Answer the receiver's right subtree." | |
53 | ||
54 | <category: 'accessing'> | |
55 | ^right | |
56 | ] | |
57 | ||
58 | data [ | |
59 | "Answer the receiver's data." | |
60 | ||
61 | <category: 'accessing'> | |
62 | ^data | |
63 | ] | |
64 | ||
65 | isLeaf [ | |
66 | "Answer false, becase the receiver is not a leaf." | |
67 | ||
68 | <category: 'testing'> | |
69 | ^false | |
70 | ] | |
71 | ||
72 | iterator [ | |
73 | "Answer a new iterator to walk this node." | |
74 | ||
75 | <category: 'iteration'> | |
76 | ^NodeIterator for: self | |
77 | ] | |
78 | ||
79 | inorderTell: aBlock tell: aNodeIterator [ | |
80 | "This is the hairy part of the iteration protocol. | |
81 | ||
82 | The algorithm works like this. We're meant to wander as far down | |
83 | the left of the tree as we can; once we're there, we call | |
84 | aNodeIterator with the data we found and a block which will continue | |
85 | the iteration over the rest of the tree and finally invoke aBlock. | |
86 | ||
87 | Observe that there are no explicit conditionals here. It's all done | |
88 | with object dispatch. And smoke. And mirrors. | |
89 | ||
90 | Also note that this is tail-recursive. The `stack' is built up in | |
91 | the hairy block constructions, which all go on the heap." | |
92 | ||
93 | <category: 'private iteration'> | |
94 | left | |
95 | inorderTell: | |
96 | [aNodeIterator | |
97 | found: data | |
98 | then: [right inorderTell: aBlock tell: aNodeIterator]] | |
99 | tell: aNodeIterator | |
100 | ] | |
101 | ||
102 | sameFringeAs: aNode [ | |
103 | "Answer whether traversing the receiver inorder yields the same | |
104 | objects as traversing aNode." | |
105 | ||
106 | <category: 'comparison'> | |
107 | | ia ib | | |
108 | ia := self iterator. | |
109 | ib := aNode iterator. | |
110 | [ia atEnd] whileFalse: | |
111 | [ib atEnd ifTrue: [^false]. | |
112 | (ia next = ib next) ifFalse: [^false]]. | |
113 | ^ib atEnd | |
114 | ] | |
115 | ||
116 | displayOn: aStream [ | |
117 | "Write a simple representation of self to the stream." | |
118 | ||
119 | <category: 'printing'> | |
120 | aStream nextPut: $(; | |
121 | display: left; | |
122 | display: data; | |
123 | display: right; | |
124 | nextPut: $) | |
125 | ] | |
126 | ||
127 | Node class >> main: anArray [ | |
128 | "Noddy script main program." | |
129 | ||
130 | <category: 'command line'> | |
131 | [(Dictionary new | |
132 | at: 1 put: | |
133 | [(self parse: (anArray at: 1)) iterator do: | |
134 | [:char | FileStream stdout nextPut: char]. | |
135 | FileStream stdout nl]; | |
136 | at: 2 put: | |
137 | [FileStream stdout display: | |
138 | (((self parse: (anArray at: 1)) | |
139 | sameFringeAs: (self parse: (anArray at: 2))) | |
140 | ifTrue: ['match'] | |
141 | ifFalse: ['no match']); | |
142 | nl ]; | |
143 | at: anArray size ifAbsent: [self error: 'bad args']) | |
144 | value] | |
145 | on: Error do: | |
146 | [:error | | |
147 | FileStream stderr | |
148 | nextPutAll: 'smalltalk-fringe: '; | |
149 | nextPutAll: error messageText; | |
150 | nl. | |
151 | ^1]. | |
152 | ^0 | |
153 | ] | |
154 | ] | |
155 | ||
156 | PositionableStream extend [ | |
157 | parseTree [ | |
158 | "Answer a newly constructed tree, parsed from the receiver. | |
159 | ||
160 | The syntax is very simple: | |
161 | ||
162 | tree ::= empty | `(' tree char tree `)' | |
163 | ||
164 | where char is any character. Ambiguity is resolved by deciding that | |
165 | something beginning with `(' where a tree is expected really is a | |
166 | tree and not an empty tree followed by the char `('." | |
167 | ||
168 | <category: 'parsing'> | |
169 | | left data right | | |
170 | ||
171 | self peek = $( ifFalse: [^LeafNode instance]. | |
172 | self next. | |
173 | left := self parseTree. | |
174 | self atEnd ifTrue: [self error: 'no data']. | |
175 | data := self next. | |
176 | right := self parseTree. | |
177 | self next = $) ifFalse: [self error: 'missing )']. | |
178 | ^Node left: left data: data right: right | |
179 | ] | |
180 | ] | |
181 | ||
182 | Object subclass: LeafNode [ | |
183 | <comment: 'I represent the leaves of a tree of Nodes. I don''t hold any | |
184 | kind of interesting state. My methods provide the base cases for some of the | |
185 | recursive protocols used to handle Nodes.'> | |
186 | <category: 'Toys-SameFringe'> | |
187 | ||
188 | instance := LeafNode new. | |
189 | ||
190 | displayOn: aStream [ | |
191 | "Write a simple representation of self to the stream." | |
192 | ||
193 | <category: 'printing'> | |
194 | "Nothing to do!" | |
195 | ] | |
196 | ||
197 | isLeaf [ | |
198 | "Answer true, because the receiver is a leaf node." | |
199 | ||
200 | <category: 'testing'> | |
201 | ^true | |
202 | ] | |
203 | ||
204 | iterator [ | |
205 | "Return a new iterator to walk this node." | |
206 | ||
207 | <category: 'iteration'> | |
208 | ^NodeIterator for: self | |
209 | ] | |
210 | ||
211 | inorderTell: aBlock tell: aNodeIterator [ | |
212 | "This is the hairy part of the iteration protocol. | |
213 | ||
214 | But in this case it's simple. We've overshot the end, so we just | |
215 | need to call aBlock to persuade our parent to announce itself to the | |
216 | iterator." | |
217 | ||
218 | <category: 'private iteration'> | |
219 | aBlock value | |
220 | ] | |
221 | ||
222 | LeafNode class >> instance [ | |
223 | "Return the unique instance of the leaf node." | |
224 | ||
225 | <category: 'singleton'> | |
226 | ^instance | |
227 | ] | |
228 | ] | |
229 | ||
230 | Stream subclass: NodeIterator [ | |
231 | | item rest | | |
232 | ||
233 | <comment: 'I hold the state for external iteration of trees of Nodes and | |
234 | (halfheartedly) implement the Stream protocol.'> | |
235 | <category: 'Toys-SameFringe'> | |
236 | ||
237 | found: anObject then: aBlock [ | |
238 | "Stash the newly found item from the hairy iteration protocol. | |
239 | ||
240 | When the iteration protocol decides on the next leftmost item to | |
241 | return, it gives us anObject that it found, and aBlock which will | |
242 | continue until it finds the next object." | |
243 | ||
244 | <category: 'private iteration'> | |
245 | item := anObject. | |
246 | rest := aBlock. | |
247 | ] | |
248 | ||
249 | NodeIterator class >> for: aNode [ | |
250 | "Answer a new iterator for the tree starting at aNode." | |
251 | ||
252 | <category: 'instance creation'> | |
253 | ^self new walk: aNode | |
254 | ] | |
255 | ||
256 | walk: aNode [ | |
257 | "Start walking a subtree starting at aNode. | |
258 | ||
259 | We get the node to iterate itself and finally tell us that it's | |
260 | finished." | |
261 | ||
262 | <category: 'initialization'> | |
263 | aNode inorderTell: [rest := nil] tell: self | |
264 | ] | |
265 | ||
266 | next [ | |
267 | "Answer the next element from the tree, or nil if we've hit the end." | |
268 | ||
269 | <category: 'reading'> | |
270 | | it | | |
271 | rest ifNil: [^nil]. | |
272 | it := item. | |
273 | rest value. | |
274 | ^it | |
275 | ] | |
276 | ||
277 | peek [ | |
278 | "Answer the next element without removing it." | |
279 | ||
280 | <category: 'reading'> | |
281 | rest ifNil: [^nil] ifNotNil: [^item] | |
282 | ] | |
283 | ||
284 | atEnd [ | |
285 | "Answer whether we have reached the end of the iteration." | |
286 | ||
287 | <category: 'testing'> | |
288 | ^rest isNil | |
289 | ] | |
290 | ] |