src/lib/binaryTree.slate

   1
   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."
   5
   6 collections define: #BinaryTree
   7   &parents: {LinkedCollection. Association. Mapping}
   8   &slots: {#treeParent. #leftChild. #rightChild}.
   9 "A Tree with two children, for simplicity."
  10
  11 bt@(BinaryTree traits) clear
  12 "Reset all the slots."
  13 [
  14   bt leftChild := Nil.
  15   bt rightChild := Nil.
  16   bt key := Nil.
  17   bt value := Nil.
  18   bt
  19 ].
  20
  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."
  24 [
  25   bt clone clear
  26 ].
  27
  28 bt@(BinaryTree traits) isEmpty
  29 [
  30   bt key isNil
  31 ].
  32
  33 bt@(BinaryTree traits) rotateLeft
  34 [
  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.
  46   child
  47 ].
  48
  49 bt@(BinaryTree traits) rotateRight
  50 [
  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.
  62   child
  63 ].
  64
  65 bt@(BinaryTree traits) size
  66 "The number of nodes including the target node and its branches recursively."
  67 [| size |
  68   size := 1.
  69   bt leftChild ifNotNilDo: [| :c | size += c size].
  70   bt rightChild ifNotNilDo: [| :c | size += c size].
  71   size
  72 ].
  73
  74 bt@(BinaryTree traits) isBalanced
  75 "Whether one subtree differs by more than 1 in size from the other's size."
  76 [
  77   bt leftChild ifNil:
  78     [^ (bt rightChild
  79           ifNil: [True]
  80           ifNotNil: [bt rightChild size <= 1])].
  81   bt rightChild ifNil:
  82     [^ (bt leftChild size <= 1)].
  83   (bt leftChild size - bt rightChild size) abs <= 1
  84 ].
  85
  86 bt@(BinaryTree traits) at: key ifAbsent: block
  87 [
  88   (child ::= bt scanFor: key) key = key
  89     ifTrue: [child value]
  90     ifFalse: [block do]
  91 ].
  92
  93 bt@(BinaryTree traits) at: key ifPresent: block
  94 [
  95   block applyWith: (bt at: key ifAbsent: [^ Nil])
  96 ].
  97
  98 bt@(BinaryTree traits) at: key put: value
  99 [
 100   bt isEmpty ifTrue: [bt key := key. bt value := value. ^ bt].
 101   (child ::= bt scanFor: key) key = key
 102     ifTrue: [child value := value]
 103     ifFalse:
 104       [newChild ::= child clone `setting: #{#key. #treeParent. #leftChild. #rightChild. #value}
 105          to: {key. bt. Nil. Nil. value}.
 106        key < child key
 107          ifTrue: [child leftChild := newChild]
 108          ifFalse: [child rightChild := newChild].
 109        newChild]
 110 ].
 111
 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."
 116 [
 117   bt isEmpty ifTrue: [^ bt].
 118   key < bt key
 119     ifTrue:
 120       [bt leftChild ifNil: [bt] ifNotNil: [bt leftChild scanFor: key]]
 121     ifFalse: [
 122       bt key < key
 123         ifTrue:
 124           [bt rightChild ifNil: [bt] ifNotNil: [bt rightChild scanFor: key]]
 125         ifFalse: [bt]]
 126 ].
 127
 128 bt@(BinaryTree traits) do: block
 129 "Recurse through the left and right branches, and apply to the value slots."
 130 [
 131   block applyWith: bt value. "TODO: check for Nil?"
 132   bt leftChild ifNotNilDo: #(do: block) `er.
 133   bt rightChild ifNotNilDo: #(do: block) `er.
 134   bt
 135 ].
 136
 137 bt@(BinaryTree traits) keysAndValuesDo: block
 138 "Recurse through the left and right branches, and apply to both slots."
 139 [
 140   block applyWith: bt key with: bt value.
 141   bt leftChild ifNotNil: [bt leftChild keysAndValuesDo: block].
 142   bt rightChild ifNotNil: [bt rightChild keysAndValuesDo: block].
 143   bt
 144 ].
 145
 146 collections define: #BinarySearchTree
 147   &parents: {BinaryTree. NoDuplicatesCollection}.
 148 "This is a self-balancing binary tree, supporting Extensible protocols."
 149
 150 bst@(BinarySearchTree traits) add: obj
 151 [
 152 ].
 153
 154 bst@(BinarySearchTree traits) remove: obj
 155 [
 156 ].