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