2 "Influenced by http://cs.oberlin.edu/~jwalker/tree/ which is Jeffery
3 Walker's description of a sound object-oriented factoring and implementation
4 of binary trees and binary search trees."
6 collections define: #BinaryTree
7 &parents: {LinkedCollection. Association. Mapping}
8 &slots: {#treeParent. #leftChild. #rightChild}.
9 "A Tree with two children, for simplicity."
11 bt@(BinaryTree traits) clear
12 "Reset all the slots."
21 bt@(BinaryTree traits) new
22 "There's no way to pre-allocate trees for a certain size, so this creates
23 a new node and clears it."
28 bt@(BinaryTree traits) isEmpty
33 bt@(BinaryTree traits) rotateLeft
35 parent ::= bt treeParent.
36 child ::= bt rightChild.
37 grandChild ::= child leftChild.
38 child leftChild := bt.
39 bt rightChild := grandChild.
40 parent leftChild == bt
41 ifTrue: [parent leftChild := child]
42 ifFalse: [parent rightChild := child].
43 child treeParent := parent.
44 bt treeParent := child.
45 grandChild treeParent := bt.
49 bt@(BinaryTree traits) rotateRight
51 parent ::= bt treeParent.
52 child ::= bt leftChild.
53 grandChild ::= child rightChild.
54 child rightChild := bt.
55 bt leftChild := grandChild.
56 parent leftChild == bt
57 ifTrue: [parent leftChild := child]
58 ifFalse: [parent rightChild := child].
59 child treeParent := parent.
60 bt treeParent := child.
61 grandChild treeParent := bt.
65 bt@(BinaryTree traits) size
66 "The number of nodes including the target node and its branches recursively."
69 bt leftChild ifNotNilDo: [| :c | size += c size].
70 bt rightChild ifNotNilDo: [| :c | size += c size].
74 bt@(BinaryTree traits) isBalanced
75 "Whether one subtree differs by more than 1 in size from the other's size."
80 ifNotNil: [bt rightChild size <= 1])].
82 [^ (bt leftChild size <= 1)].
83 (bt leftChild size - bt rightChild size) abs <= 1
86 bt@(BinaryTree traits) at: key ifAbsent: block
88 (child ::= bt scanFor: key) key = key
93 bt@(BinaryTree traits) at: key ifPresent: block
95 block applyWith: (bt at: key ifAbsent: [^ Nil])
98 bt@(BinaryTree traits) at: key put: value
100 bt isEmpty ifTrue: [bt key := key. bt value := value. ^ bt].
101 (child ::= bt scanFor: key) key = key
102 ifTrue: [child value := value]
104 [newChild ::= child clone `setting: #{#key. #treeParent. #leftChild. #rightChild. #value}
105 to: {key. bt. Nil. Nil. value}.
107 ifTrue: [child leftChild := newChild]
108 ifFalse: [child rightChild := newChild].
112 bt@(BinaryTree traits) scanFor: key
113 "Recurse through the branches, comparing keys. This method will return a node.
114 Whether the node is directly addressed by the key is exactly the same fact as
115 whether the tree has that key at all."
117 bt isEmpty ifTrue: [^ bt].
120 [bt leftChild ifNil: [bt] ifNotNil: [bt leftChild scanFor: key]]
124 [bt rightChild ifNil: [bt] ifNotNil: [bt rightChild scanFor: key]]
128 bt@(BinaryTree traits) do: block
129 "Recurse through the left and right branches, and apply to the value slots."
131 block applyWith: bt value. "TODO: check for Nil?"
132 bt leftChild ifNotNilDo: #(do: block) `er.
133 bt rightChild ifNotNilDo: #(do: block) `er.
137 bt@(BinaryTree traits) keysAndValuesDo: block
138 "Recurse through the left and right branches, and apply to both slots."
140 block applyWith: bt key with: bt value.
141 bt leftChild ifNotNil: [bt leftChild keysAndValuesDo: block].
142 bt rightChild ifNotNil: [bt rightChild keysAndValuesDo: block].
146 collections define: #BinarySearchTree
147 &parents: {BinaryTree. NoDuplicatesCollection}.
148 "This is a self-balancing binary tree, supporting Extensible protocols."
150 bst@(BinarySearchTree traits) add: obj
154 bst@(BinarySearchTree traits) remove: obj