src/core/set.slate

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