src/lib/tree.slate

   1 collections define: #OrderedTree
   2   &parents: {LinkedCollection. ExtensibleSequence}
   3   &slots: {#treeParent. "The parent node, Nil for top-level nodes."
   4            #children -> ExtensibleArray new "The sub-nodes."}.
   5 "A Tree node, linking to its parent node and storing its children in a
   6 Sequence."
   7
   8 ot@(OrderedTree traits) clear
   9 [
  10   ot children := ot children new.
  11   ot
  12 ].
  13
  14 ot@(OrderedTree traits) new &capacity: n
  15 [ot clone `setting: #{#children} to: {ot children new &capacity: n}].
  16
  17 ot@(OrderedTree traits) newFor: obj &capacity: n
  18 [(ot new &capacity: n) `>> [add: obj]].
  19
  20 ot@(OrderedTree traits) newForAll: c@(Collection traits)
  21 [ot clone `setting: #{#children} to: {c as: ot children}].
  22
  23 ot@(OrderedTree traits) size [ot children size].
  24
  25 ot@(OrderedTree traits) do: block [ot children do: block].
  26
  27 ot@(OrderedTree traits) at: index [ot children at: index].
  28
  29 ot@(OrderedTree traits) iterator
  30 [ot children iterator].
  31
  32 ot@(OrderedTree traits) reader
  33 [ot children reader].
  34
  35 ot@(OrderedTree traits) writer
  36 "NOTE: If the children object is not Extensible. Otherwise, a new structure
  37 may be constructed which is not placed into the slot implicitly."
  38 [ot children writer].
  39
  40 ot@(OrderedTree traits) siblings
  41 "Return all children of the node's parent, excepting the original node.
  42 Answer Nil if there is no parent or the wrong parent."
  43 [
  44   ot treeParent
  45     ifNil: [ExtensibleArray new]
  46     ifNotNilDo: [| :p | p children copy `>> [remove: ot ifAbsent: [^ Nil]. ]]
  47 ].
  48
  49 ot@(OrderedTree traits) previousSibling
  50 [ot treeParent ifNotNilDo: [| :p | p children before: ot]].
  51
  52 ot@(OrderedTree traits) nextSibling
  53 [ot treeParent ifNotNilDo: [| :p | p children after: ot]].
  54
  55 ot@(OrderedTree traits) raise
  56 "Moves this tree element to the first in the collection list of the parent -
  57 relies on being able to directly manipulate that collection."
  58 [
  59   ot treeParent children move: ot to: ot children indexFirst.
  60 ].
  61
  62 ot@(OrderedTree traits) bury
  63 "Moves this tree element to the last in the children list of the parent -
  64 relies on being able to directly manipulate that collection."
  65 [| siblings |
  66   (siblings := ot treeParent children) move: ot to: siblings indexLast.
  67 ].
  68
  69 ch@(OrderedTree traits) reparentTo: ot
  70 "Handle the aspect of unsetting any parent link and backlink as necessary.
  71 Avoid adding to the new parent, since the position matters."
  72 [
  73   ch treeParent ifNotNilDo: #(remove: ch) `er.
  74   ch treeParent := ot.
  75 ].
  76
  77 obj reparentTo: ot@(OrderedTree traits)
  78 [].
  79
  80 ot@(OrderedTree traits) isLeaf: child
  81 "Answer whether the given element would not count as a sub-tree of the
  82 tree if it were a child of it - if it's anything but a tree itself."
  83 [(child is: ot) not].
  84
  85 ot@(OrderedTree traits) at: index put: ch
  86 [
  87   ch reparentTo: ot.
  88   ot children at: index put: ch.
  89   ot
  90 ].
  91
  92 ot@(OrderedTree traits) addFirst: ch
  93 [
  94   ch reparentTo: ot.
  95   ot children addFirst: ch.
  96   ot
  97 ].
  98
  99 ot@(OrderedTree traits) addLast: ch
 100 "Add a tree node as a child, and set the parent back-link."
 101 [
 102   ch reparentTo: ot.
 103   ot children addLast: ch.
 104   ot
 105 ].
 106
 107 ot@(OrderedTree traits) remove: ch
 108 "Remove the tree node as a child, making sure to remove the parent link."
 109 [
 110   ot children remove: ch ifAbsent: [^ Nil].
 111   ch reparentTo: Nil.
 112   ot
 113 ].
 114
 115 ot@(OrderedTree traits) remove: ch ifAbsent: block
 116 [
 117   ot children remove: ch ifAbsent: [block do]
 118 ].
 119
 120 collections define: #Trie
 121             &parents: {OrderedTree. NoDuplicatesCollection. Mapping} &slots: {#element}.
 122 "A trie is a Set of Sequences encoded as a left-to-right element search tree.
 123 At nodes whose path represents a Sequence that is an element, the node is
 124 tagged with the element. To use a Trie as a Set, the element should be the
 125 Sequence itself, handled by the add:/remove: protocol; otherwise it can be
 126 used as a Dictionary."
 127 "element: Records the element that the trie node encodes, if it does at all. The
 128 element should consist of the sequence of all the keys used in order to access
 129 the given node. As a result, trie nodes must be root-aware."
 130 Trie children := IdentityDictionary new.
 131 "Uses a Mapping of Sequence elements to the next Node."
 132
 133 t@(Trie traits) new &capacity: n
 134 "Tries are generally 'narrow' Trees."
 135 [n ifNil: [n := 3]. resend].
 136
 137 t@(Trie traits) acceptsKey: _
 138 [False].
 139
 140 t@(Trie traits) acceptsKey: _@(Sequence traits)
 141 "This is not quite true, since any key will work that responds to at:
 142 appropriately when given 0..n of integers and has a size."
 143 [True].
 144
 145 t@(Trie traits) includes: s@(Sequence traits)
 146 "Treat the trie as a set of its keys. Searching for values is more expensive."
 147 [
 148   (t at: s) isNotNil
 149 ].
 150
 151 t@(Trie traits) size
 152 [
 153   t children
 154     inject: t children size
 155     into: [| :sum :each | sum + each size]
 156 ].
 157
 158 t@(Trie traits) nodeFor: seq
 159 "Returns the Trie node for the given Sequence."
 160 [| node |
 161   node := t.
 162   seq do: [| :each | node := node children at: each ifAbsent: []].
 163   node
 164 ].
 165
 166 t@(Trie traits) at: s@(Sequence traits)
 167 "Search from here each of the elements of the sequence in turn."
 168 [
 169   (t nodeFor: s) ifNotNilDo: #element `er
 170 ].
 171
 172 t@(Trie traits) nearestNodeFor: seq
 173 "Returns the Trie node that completes the greatest part of the Sequence."
 174 [| node next cursor |
 175   node := t.
 176   next := t.
 177   cursor := 0.
 178   [next isNil] whileFalse:
 179     [(next := node children at: (seq at: cursor) ifAbsent: [])
 180        ifNotNil: [node := next. cursor += 1]].
 181   node
 182 ].
 183
 184 t@(Trie traits) at: s@(Sequence traits) put: obj
 185 "Traverse down the Trie, adding nodes once an element isn't found.
 186 Annotate the final node with the given element."
 187 [| node next cursor |
 188   node := t.
 189   next := t.
 190   cursor := 0.
 191   [next isNil \/ [cursor = s size]] whileFalse:
 192     [(next := node children at: (s at: cursor) ifAbsent: [])
 193        ifNotNil: [node := next. cursor += 1]].
 194   "node is now at the last existing relevant Trie node.
 195   cursor is the index within the Sequence of the next element to add."
 196   cursor below: s size do:
 197     [| :index |
 198       next := t new.
 199       node children at: (s at: index) put: next.
 200       next treeParent := node.
 201       node := next].
 202   node element := obj.
 203   obj
 204 ].
 205
 206 t@(Trie traits) add: s@(Sequence traits)
 207 "Treat the trie as a Set."
 208 [
 209   t at: s put: s
 210 ].
 211
 212 t@(Trie traits) remove: s@(Sequence traits)
 213 "Search the trie for the sequence, stop at the last found, then recursively
 214   delete nodes with no element but the argument and move back up the tree.
 215   This returns the keyed value if there is one."
 216 [| next node lastPoint temp |
 217   node := t.
 218   next := t.
 219   lastPoint := 0.
 220   [next isNil] whileFalse:
 221     [s doWithIndex:
 222        [| :each :index |
 223         next := node children at: each ifAbsent: [].
 224         next ifNotNil: [lastPoint := index. node := next]]].
 225   node element := Nil.
 226   [node element isNil /\ [node children size <= 1]] whileTrue:
 227     [temp := node.
 228      (node := node treeParent) ifNil: [^ s] ifNotNil:
 229        [node children keysAndValuesRemove:
 230           [| :key :value | value == temp].
 231         temp treeParent := Nil]].
 232   s
 233 ].