src/core/set.slate

   1
   2 "An Unordered, Extensible Collection of elements without duplicates. Being
   3 a duplicate is determined by a binary comparison and associated hash
   4 function on each object."
   5
   6 collections define: #Set &parents: {NoDuplicatesCollection} &slots: {
   7   #tally -> 0.
   8   #contents -> (Array newSize: 10).
   9   #containsNil -> False.
  10   #hashBlock -> (#hash `er) .
  11   #equalsBlock -> (#= `er) .
  12 }.
  13
  14 collections IdentitySet ::=
  15   Set cloneSettingSlots: #{#hashBlock. #equalsBlock} to: {#identityHash`er. #==`er}.
  16 "IdentitySets specialize their behavior to compare solely by object identity."
  17
  18 c@(Set traits) new &capacity: n
  19 [
  20   c clone `>>
  21     [contents := c contents new &capacity: ((n ifNil: [0]) max: 1). tally := 0. ]
  22 ].
  23
  24 c@(Set traits) = d@(Set traits)
  25 "Comparison is by iteration over each element in the Sets. This is avoided
  26 when possible by making very cheap comparisons first."
  27 [
  28   c == d
  29     \/ [c size = d size
  30           /\ [c containsNil eqv: d containsNil]
  31           /\ [c allSatisfy: [| :each | d includes: each]]]
  32 ].
  33
  34 c@(Set traits) copy
  35 [c clone `>> [contents := c contents copy. ]].
  36
  37 c@(Set traits) size
  38 "The number of elements, the conceptual size of the Set."
  39 [
  40   c tally + (c containsNil ifTrue: [1] ifFalse: [0])
  41 ].
  42
  43 c@(Set traits) capacity
  44 "How large the Set can be without requiring a new Array of larger size."
  45 [
  46   c contents size
  47 ].
  48
  49 c@(Set traits) clear
  50 [
  51   c contents clear.
  52   c tally := 0.
  53   c containsNil := False.
  54 ].
  55
  56 c@(Set traits) atRandomBy: random
  57 "Collaborate with a RandomStream to provide one of the elements at random."
  58 [
  59   c emptyCheck.
  60   (randomIndex ::= random next \\ c contents size) below: c contents size do:
  61     [| :i | (c contents at: i) ifNotNilDo: [| :obj | ^ obj]].
  62   0 below: randomIndex do:
  63     [| :i | (c contents at: i) ifNotNilDo: [| :obj | ^ obj]].
  64 ].
  65
  66 c@(Set traits) include: obj
  67 "Ensure that the object is a member of the Set by adding it if not found."
  68 [
  69   (c contents at: (index ::= c scanFor: obj))
  70    ifNil: [c atNewIndex: index put: obj].
  71   obj
  72 ].
  73
  74 c@(Set traits) include: _@Nil [c containsNil := True. ].
  75
  76 c@(Set traits) remove: obj ifAbsent: block
  77 [
  78   (c contents at: (index ::= c scanFor: obj))
  79     ifNil: [block do]
  80     ifNotNil:
  81       [c contents at: index put: Nil.
  82        c tally -= 1.
  83        c fixCollisionsFrom: index.
  84        obj]
  85 ].
  86
  87 c@(Set traits) remove: _@Nil ifAbsent: block
  88 [
  89   c containsNil
  90     ifTrue: [c containsNil := False. ]
  91     ifFalse: [block do]
  92 ].
  93
  94 c@(Set traits) collect: block
  95 [
  96   result ::= c newSameSize.
  97   c do: [| :each | result include: (block apply*, each)].
  98   result
  99 ].
 100
 101 c@(Set traits) do: block
 102 [
 103   c containsNil ifTrue: [block apply*, Nil].
 104   c tally = 0 ifFalse:
 105     [c contents do:
 106        [| :each | each ifNotNil: [block apply*, each]]].
 107 ].
 108
 109 c@(Set traits) doWithIndex: block
 110 "Allow for iterating through the elements with a notional indexing."
 111 [| index |
 112   index := -1.
 113   c do: [| :item |
 114          item ifNotNil: [block apply*, item, (index += 1)]].
 115 ].
 116
 117 c@(Set traits) atNewIndex: index put: obj
 118 "A method which does not check for consistency, and merely inserts the
 119 object and updates the size. Only trusted methods should call this."
 120 [
 121   c contents at: index put: obj.
 122   c tally += 1.
 123   c fullCheck.
 124 ].
 125
 126 c@(Set traits) fixCollisionsFrom: index
 127 "The element at index has been removed and replaced by Nil.
 128 This moves forward from there, relocating any entries that were
 129 placed below due to collisions with this one."
 130 [| oldIndex newIndex element |
 131   c capacity `cache.
 132   oldIndex := index.
 133   [(oldIndex += 1) >= c capacity
 134      ifTrue: [oldIndex := 1].
 135    (element := c keyAt: oldIndex) isNil]
 136     whileFalse:
 137       [(newIndex := c scanFor: element) = oldIndex
 138          ifFalse: [c swap: oldIndex with: newIndex]].
 139 ].
 140
 141 c@(Set traits) fullCheck
 142 "Keep the array at least 1/4 free for decent hash behavior."
 143 [
 144   c contents size - c tally < (c contents size // 4 max: 1)
 145     ifTrue: [c grow].
 146 ].
 147
 148 c@(Set traits) growSize
 149 "The default amount to grow by, either doubling the size or a minimum."
 150 [
 151   c contents size max: 4
 152 ].
 153
 154 c@(Set traits) growBy: growthAmount
 155 "Replace the array with a new one larger by growthAmount, and copy over the
 156 elements with the non-checking method."
 157 [
 158   oldElems ::= c contents.
 159   c contents := c contents new &capacity: c contents size + growthAmount.
 160   c tally := 0.
 161   oldElems do: [| :each |
 162     each ifNotNil: [c noCheckAdd: each]].
 163   c
 164 ].
 165
 166 c@(Set traits) grow
 167 "Grow the default amount."
 168 [
 169   c growBy: c growSize
 170 ].
 171
 172 c@(Set traits) keyAt: index
 173 "Subclasses can override this to make fixCollisionsFrom: work."
 174 [
 175   c contents at: index
 176 ].
 177
 178 c@(Set traits) swap: index1 with: index2
 179 "Subclasses can override this to make fixCollisionsFrom: work."
 180 [
 181   c contents swap: index1 with: index2.
 182 ].
 183
 184 c@(Set traits) noCheckAdd: obj
 185 "Obviously, this method is faster by avoiding a consistency check, and so
 186 should only be called by trusted methods."
 187 [
 188   c contents at: (c scanFor: obj) put: obj.
 189   c tally += 1.
 190 ].
 191
 192 c@(Set traits) noCheckAdd: _@Nil
 193 [
 194   c containsNil := True.
 195 ].
 196
 197 c@(Set traits) rehash
 198 "Use a cloned Set to re-calculate and place the objects in the array, and
 199 then simply re-use that Set's array."
 200 [
 201   tempSet ::= c newSameSize.
 202   c do: #(tempSet noCheckAdd: _) `er.
 203   c contents := tempSet contents.
 204 ].
 205
 206 c@(Set traits) scanFor: obj
 207 "Scan the array for the first slot containing either a Nil or an element
 208 matching the object. Answer the index of that slot or 0 if no slot is
 209 found. Override this to provide different matching criteria."
 210 [| element |
 211   end ::= c contents size.
 212   start ::= (c hashBlock apply*, obj) \\ end.
 213   block ::=
 214     [| :index |
 215      (element := c contents at: index) isNil
 216        \/ [c equalsBlock apply*, element, obj]
 217        ifTrue: [^ index]].
 218   "Search from the hash MOD size to the end."
 219   start below: end do: block.
 220   "Search from the beginning."
 221   0 below: start do: block.
 222   Nil
 223 ].
 224
 225 c@(Set traits) like: obj
 226 "Answer an object in the Set that compares correctly to the given object, or
 227 Nil if none such is found."
 228 [
 229   (c scanFor: obj) ifNotNilDo: [| :index | c contents at: index]
 230 ].
 231
 232 c@(Set traits) includes: obj
 233 "Check the index determined by the hash, and return true whether the array
 234 slot isn't empty."
 235 [
 236   (c scanFor: obj)
 237     ifNil: [False]
 238     ifNotNilDo: [| :index | (c contents at: index) isNotNil]
 239 ].
 240
 241 c@(Set traits) includes: _@Nil [c containsNil].
 242
 243 c@(Collection traits) copyWithoutDuplicates &comparison: equalsBlock
 244 "Iterate through the Collection, creating a new one where only the first
 245 element (encountered by do:) distinct according to the comparison is included."
 246 [
 247   seen ::= Set new.
 248   equalsBlock ifNotNil: [seen equalsBlock := equalsBlock].
 249   [| :result |
 250    c do: [| :each | (seen includes: each)
 251                       ifFalse: [result nextPut: (seen include: each)]]
 252    ] writingAs: c
 253 ].