src/core/range.slate

   1
   2 collections define: #Range &parents: {Sequence} &slots: {
   3 #start -> 0. "The number to start from; this is the first value."
   4 #end -> PositiveInfinity. "The number to end with; this may not be the last value, but no number in the Range will exceed it."
   5 #step -> 1  "The interval of stepping. Each successive element will exceed the preceding by exactly this amount."}.
   6 "A Sequence of Numbers with a regular interval and bounding values."
   7
   8 "TODO: find some way to parametrize this on all Comparable types and ensure
   9 that all three parameters of the Range are comparable."
  10
  11 r@(Range traits) new &capacity: n
  12 "Default to a reasonably useful concrete type to make a new Sequence."
  13 [
  14   r arrayType new &capacity: n
  15 ].
  16
  17 r@(Range traits) newFrom: start to: end by: step
  18 [r cloneSettingSlots: #{#start. #end. #step} to: {start. end. step}].
  19
  20 r@(Range traits) newFrom: start to: end
  21 "This method implicitly defines a sensible default stepping value."
  22 [| step |
  23   (step := end <=> start)
  24     isZero ifTrue: [step := 1].
  25   r newFrom: start to: end by: step
  26 ].
  27
  28 s@(Sequence traits) as: r@(Range traits)
  29 [| newR |
  30   s size `cache caseOf: {
  31     0 -> [r newFrom: 0 to: 0 by: 0].
  32     1 -> [r newFrom: s first to: s last]
  33   } otherwise:
  34     [(newR := r newFrom: s first to: s last by: s last - s first // (s size - 1)) = s
  35        ifTrue: [newR]
  36        ifFalse: [error: 'The Sequence is not an arithmetic progression.']]
  37 ].
  38
  39 start@(Number traits) to: end
  40 [
  41   Range newFrom: start to: end
  42 ].
  43
  44 start@(Number traits) to: end by: step
  45 [
  46   Range newFrom: start to: end by: step
  47 ].
  48
  49 start@(Number traits) upTo: end
  50 [
  51   Range newFrom: start to: end
  52 ].
  53
  54 start@(Number traits) below: end
  55 [
  56   Range newFrom: start to: end - 1
  57 ].
  58
  59 start@(Number traits) downTo: end
  60 [
  61   Range newFrom: start to: end
  62 ].
  63
  64 start@(Number traits) above: end
  65 [
  66   Range newFrom: start to: end + 1
  67 ].
  68
  69 start@(Number traits) upTo: end by: step
  70 [
  71   Range newFrom: start to: end by: step
  72 ].
  73
  74 start@(Number traits) below: end by: step
  75 [
  76   Range newFrom: start to: end - 1 by: step
  77 ].
  78
  79 start@(Number traits) downTo: end by: step
  80 [
  81   Range newFrom: start to: end by: step
  82 ].
  83
  84 start@(Number traits) above: end by: step
  85 [
  86   Range newFrom: start to: end + 1 by: step
  87 ].
  88
  89 start@(Number traits) andAbove
  90 [
  91   Range newFrom: start to: PositiveInfinity
  92 ].
  93
  94 end@(Number traits) andBelow
  95 [
  96   Range newFrom: NegativeInfinity to: end
  97 ].
  98
  99 start@(Number traits) andAboveBy: step
 100 [
 101   Range newFrom: start to: PositiveInfinity by: step
 102 ].
 103
 104 end@(Number traits) andBelowBy: step
 105 [
 106   Range newFrom: NegativeInfinity to: end by: step
 107 ].
 108
 109 r1@(Range traits) = r2@(Range traits)
 110 [
 111   r1 start = r2 start
 112    /\ [r1 step = r2 step]
 113    /\ [r1 size = r2 size]
 114 ].
 115
 116 r@(Range traits) hash
 117 [
 118   (r start hash bitShift: 2)
 119     #(bitOr: r end hash)
 120     #(bitShift: 1)
 121     #(bitOr: r size)
 122 ].
 123
 124 r@(Range traits) copy
 125 [
 126   r newFrom: r start to: r end by: r step
 127 ].
 128
 129 r@(Range traits) at: n@(Integer traits)
 130 [
 131   n isZero
 132     ifTrue: [r start]
 133     ifFalse:
 134       [n isPositive /\ [n < r size]
 135          ifTrue: [r step * n + r start]
 136          ifFalse: [n keyNotFoundOn: r]]
 137 ].
 138
 139 r@(Range traits) at: n put: _
 140 [
 141   error: 'Ranges are not mutable.'
 142 ].
 143
 144 r@(Range traits) extent
 145 "Answers the magnitude of the range's extent."
 146 [
 147   r end - r start
 148 ].
 149
 150 r@(Range traits) first
 151 [
 152   r start
 153 ].
 154
 155 r@(Range traits) last
 156 [
 157   r end - (r end - r start \\ r step)
 158 ].
 159
 160 r@(Range traits) rangeIncludes: n
 161 [
 162   r step isNegative
 163     ifTrue: [n between: r end and: r start]
 164     ifFalse: [n between: r start and: r end]
 165 ].
 166
 167 r@(Range traits) includes: n
 168 "Answer whether the number is part of the interval defined by the boundaries,
 169 and then whether it is calculably close to an integer step from the start."
 170 [
 171   (r rangeIncludes: n)
 172    /\ [((n - r start as: Float) / r step) fractionPart isCloseTo: 0.0]
 173 ].
 174
 175 r@(Range traits) isInfinite
 176 "Whether the Range includes an infinite number of elements."
 177 "TODO: guard iteration protocols on this condition."
 178 [
 179   r start isInfinite \/ [r end isInfinite]
 180 ].
 181
 182 r@(Range traits) size
 183 "Check the 'direction' of the Range to make sure that it's possible to have
 184 elements at all."
 185 [
 186   r isInfinite
 187     ifTrue: [PositiveInfinity]
 188     ifFalse: [(r step isNegative xor: r start > r end)
 189       ifTrue: [0]
 190       ifFalse: [r end - r start // r step + 1]]
 191 ].
 192
 193 r@(Range traits) collect: block
 194 "Ensure that an Array is produced of the right size."
 195 [| each |
 196   result ::= r arrayType newSizeOf: r.
 197   each := r start.
 198   0 below: r size do:
 199     [| :i |
 200      result at: i put: (block applyWith: each).
 201      each += r step].
 202   result
 203 ].
 204
 205 r@(Range traits) project: block
 206 "Answer an Array instead of a Dictionary to map the values."
 207 [r project: block into: (Array newSizeOf: r)].
 208
 209 r@(Range traits) do: block
 210 [| each |
 211   each := r start.
 212   r step isNegative
 213     ifTrue: [[r end <= each]
 214                whileTrue: [block applyWith: each. each += r step]]
 215     ifFalse: [[r end >= each]
 216                 whileTrue: [block applyWith: each. each += r step]].
 217   r
 218 ].
 219
 220 r@(Range traits) reverseDo: block
 221 [| each |
 222   each := r start.
 223   r step isNegative
 224     ifTrue: [[r end >= each]
 225                whileTrue: [block applyWith: each. each -= step]]
 226     ifFalse: [[r end <= each]
 227                 whileTrue: [block applyWith: each. each -= step]].
 228   r
 229 ].
 230
 231 r1@(Range traits) intersects: r2@(Range traits)
 232 "Whether the Ranges have overlap in their extents."
 233 [
 234   (r1 start between: r2 start and: r2 end)
 235     \/ [r2 start between: r1 start and: r1 end]
 236 ].
 237
 238 r1@(Range traits) /\ r2@(Range traits)
 239 "Returns the intersection of the two Ranges, or Nil if none."
 240 [
 241   (r1 intersects: r2)
 242     ifTrue:
 243       [r1 step = r2 step
 244          ifTrue: [(r1 start max: r2 start) to: (r1 end min: r2 end) by: r1 step]
 245          ifFalse:
 246            [({r1 step. r2 step} includes: (r1 step gcd: r2 step))
 247               ifTrue: [(r1 start max: r2 start) to: (r1 end min: r2 end) by: (r1 step min: r2 step)]
 248               ifFalse: ["Ranges do not step harmonically."]]]
 249 ].
 250
 251 "Some very basic range math"
 252
 253 r@(Range traits) + n@(Number traits)
 254 "Shift r by n"
 255 [
 256   r start + n to: r end + n by: r step
 257 ].
 258
 259 n@(Number traits) + r@(Range traits)
 260 [
 261   r + n
 262 ].
 263
 264 r@(Range traits) - n@(Number traits)
 265 [
 266   r + n negated
 267 ].
 268
 269 collections define: #LogicRange &parents: {Range}.
 270 "A Range which uses blocks for the end and step aspects."
 271 LogicRange start := 0.
 272 "The starting value."
 273 LogicRange end := [| :x | x > PositiveInfinity].
 274 "A Block which should halt iteration when reaching True."
 275 LogicRange step := [| :x | x + 1].
 276 "A Block returning the next value in the Sequence based on the current one."
 277
 278 r@(LogicRange traits) newFrom: start to: end by: step
 279 "Coerces any numerical parameters into blocks where necessary."
 280 [
 281   goesUp ::= (step is: Number)
 282     ifTrue: [step isPositive]
 283     ifFalse: [(step applyWith: start) > start].
 284   r cloneSettingSlots: #{#start. #end. #step}
 285     to: {start.
 286          (end is: Number)
 287             ifTrue: [goesUp
 288                        ifTrue: [[| :x | x >= end]]
 289                        ifFalse: [[| :x | x <= end]]]
 290             ifFalse: [end].
 291          (step is: Number)
 292             ifTrue: [goesUp
 293                        ifTrue: [[| :x | x + step]]
 294                        ifFalse: [[| :x | x - step]]]
 295             ifFalse: [step]}
 296 ].
 297
 298 start@(Number traits) until: end by: step
 299 "Creates a new LogicRange."
 300 [
 301   LogicRange newFrom: start to: end by: step
 302 ].
 303
 304 start@(Number traits) by: step
 305 "Creates a new LogicRange with the default end."
 306 [
 307   LogicRange newFrom: start to: LogicRange end by: step
 308 ].
 309
 310 start@(Number traits) until: end
 311 "Creates a new LogicRange with the default step."
 312 [
 313   LogicRange newFrom: start to: end by: LogicRange step
 314 ].
 315
 316 r@(LogicRange traits) isEmpty
 317 [
 318   r do: [| :_ | ^ False].
 319   True
 320 ].
 321
 322 r@(LogicRange traits) size
 323 "This should obviously be avoided."
 324 [
 325   r end == LogicRange end
 326     ifTrue: [PositiveInfinity]
 327     ifFalse: [r inject: 0 into: [| :size :_ | size + 1]]
 328 ].
 329
 330 r@(LogicRange traits) at: n
 331 [| result |
 332   result := r start.
 333   0 below: n do:
 334     [| :each |
 335      result := r step applyWith: result.
 336      (r end applyWith: result) ifTrue: [error: 'Subscript out of bounds.']].
 337   result
 338 ].
 339
 340 r@(LogicRange traits) do: block
 341 "Iterates through values from the start until the end-test is satisfied."
 342 [| each |
 343   each := r start.
 344   [r end applyWith: each]
 345     whileFalse: [block applyWith: each.
 346                  each := r step applyWith: each].
 347   r
 348 ].
 349
 350 r@(LogicRange traits) reverseDo: block
 351 "Since the end is defined by a test and not a value, this is ambiguous."
 352 [
 353   notImplementable
 354 ].
 355
 356 r@(LogicRange traits) isAscending
 357 "Whether the Range's progression is positive."
 358 [
 359   (r step applyWith: r start) > r start
 360 ].
 361
 362 r@(LogicRange traits) collect: block
 363 "Collect the Range's elements into a WriteStream of the arrayType."
 364 [
 365   [| :result |
 366    result := r arrayType writer.
 367    r do: [| :each | result nextPut: (block applyWith: each)]
 368   ] writingAs: r arrayType
 369 ].
 370
 371 r@(LogicRange traits) rangeIncludes: n
 372 "Whether the value is in the direction of the Range and between the start
 373 while not exceeding the end test."
 374 [
 375   (r end applyWith: n) not
 376     /\ [r isAscending
 377           ifTrue: [n >= r start]
 378           ifFalse: [n <= r start]]
 379 ].
 380
 381 r@(LogicRange traits) includes: n
 382 "Simply iterate through the values and compare."
 383 [
 384   r do: [| :each | n = each ifTrue: [^ True]].
 385   False
 386 ].