src/lib/dimensioned.slate

   1 numerics ensureNamespace: #units &delegate: True.
   2 "Based on the Squeak Units code at http://home.netsurf.de/helge.horch/squeak/units.html"
   3
   4 numerics define: #Dimension &parents: {Cloneable}.
   5
   6 d1@(Dimension traits) isConsistentWith: d2@(Dimension traits) [d1 isSameAs: d2].
   7
   8 numerics define: #Length &parents: {Dimension}.
   9
  10 numerics define: #Time &parents: {Dimension}.
  11
  12 numerics define: #Mass &parents: {Dimension}.
  13
  14 numerics define: #Temperature &parents: {Dimension}.
  15
  16 numerics define: #Count &parents: {Dimension}.
  17
  18 numerics define: #ElectricalCharge &parents: {Dimension}.
  19
  20 numerics define: #Unit.
  21
  22 u1@(Unit traits) isConsistentWith: u2@(Unit traits) [u1 dimension isConsistentWith: u2 dimension].
  23
  24 u1@(Unit traits) * u2@(Unit traits)
  25 [| unitDict units expons scratch |
  26   unitDict := Dictionary new.
  27   u1 unitsAndExponentsDo: [| :unit :expon | (unitDict includesKey: unit)
  28     ifTrue: [unitDict at: unit := (unitDict at: unit) + expon]
  29     ifFalse: [unitDict at: unit := expon]].
  30   u2 unitsAndExponentsDo: [| :unit :expon | (unitDict includesKey: unit)
  31     ifTrue: [unitDict at: unit := (unitDict at: unit) + expon]
  32     ifFalse: [unitDict at: unit := expon]].
  33   units := ExtensibleArray new.
  34   expons := ExtensibleArray new.
  35   (unitDict keySet sortBy:
  36     [| :left :right |
  37       (left abbrev lexicographicallyCompare: right abbrev) < 0])
  38     do: [| :unit |
  39       scratch := unitDict at: unit.
  40       scratch isZero ifFalse: [units add: unit. expons add: scratch]].
  41   units size = 1 /\ [expons first = 1]
  42     ifTrue: [^ units first].
  43   ComplexUnit units: units exponents: expons
  44 ].
  45
  46 u1@(Unit traits) / u2@(Unit traits)
  47 [u1 * u2 reciprocal].
  48
  49 u1@(Unit traits) per: u2@(Unit traits)
  50 [u1 / u2].
  51
  52 u@(Unit traits) raisedTo: expon
  53 [
  54   ComplexUnit units: {u} exponents: {expon}
  55 ].
  56
  57 u@(Unit traits) reciprocal
  58 [
  59   ComplexUnit units: {u} exponents: {-1}
  60 ].
  61
  62 u@(Unit traits) squared
  63 [u * u].
  64
  65 u1@(Unit traits) factor: u2@(Unit traits)
  66 [
  67   u2 * (u1 bases / u2 bases)
  68 ].
  69
  70 u@(Unit traits) unitsAndExponentsDo: block
  71 "Evaluate the block once for each unit/exponent pair in u, defaulting to this."
  72 [block applyWith: u with: 1].
  73
  74 u@(Unit traits) conversionFactorTo: v@(Unit traits)
  75 "Assuming u and v are consistent, return the numerical answer to u*X=v."
  76 [u conversionFactor / v conversionFactor].
  77
  78 u@(Unit traits) additiveFactor
  79 "The value of the base level of the scale - usually 0; the only thing that
  80 has a real standard non-zero value is Temperatures (by old convention)."
  81 [0].
  82
  83 _@(Unit traits) consistentWith: _@(Unit traits)
  84 [False].
  85
  86 numerics define: #ObjectUnit &parents: {Unit}
  87 "A Unit used to describe/count Slate objects."
  88   &slots: {#object -> Nil.
  89 "The object/exemplar on which the Unit is based."
  90 #comparisonBlock -> #isSameAs: `er.
  91 "How to tell if units are compatible; the caller needs to consider this."}.
  92
  93 u@(ObjectUnit traits) isConsistentWith: v@(ObjectUnit traits)
  94 [u comparisonBlock apply*, u object, v object].
  95
  96 u@(ObjectUnit traits) printOn: s@(PrettyPrinterMixin traits)
  97 [s ; 'of: ' ; (RootedPath from: here to: u object) printString].
  98
  99 u@(ObjectUnit traits) printFullOn: s@(PrettyPrinterMixin traits) plural: p
 100 [
 101   p ifTrue: [s ; u object printName plural]
 102     ifFalse: [s ; u object printName]
 103 ].
 104
 105 numerics define: #UnitValue &parents: {Number} &slots: {#unit. #value}.
 106
 107 uv@(UnitValue traits) unit: unit value: value
 108 [uv clone `setting: #{#unit. #value} to: {unit. value}].
 109
 110 uv@(UnitValue traits) dimension [uv unit dimension].
 111
 112 uv@(UnitValue traits) printOn: s@(PrettyPrinterMixin traits) &full
 113 [
 114   uv value printOn: s.
 115   s ; ' '.
 116   (full ifNil: [True])
 117     ifTrue: [uv unit printFullOn: s plural: uv value ~= 1]
 118     ifFalse: [uv unit printOn: s].
 119   uv
 120 ].
 121
 122 x@(Number traits) as: uv@(UnitValue traits)
 123 [
 124   UnitValue unit: CompoundUnit null value: x
 125 ].
 126
 127 uv@(UnitValue traits) as: x@(Number traits)
 128 [uv value].
 129
 130 uv@(UnitValue traits) convertTo: u@(Unit traits)
 131 "Convert the value to have the same units as u, using scaling factors."
 132 [
 133   (uv unit isConsistentWith: u) ifTrue:
 134     [uv unit: u value: (uv value - uv unit additiveFactor) * (uv unit conversionFactorTo: u) - u additiveFactor]
 135 ].
 136
 137 uv@(UnitValue traits) in: u@(Unit traits)
 138 "Alias of convertTo:."
 139 [uv convertTo: u].
 140
 141 uv@(UnitValue traits) bases
 142 "Return the reduction of uv to base units."
 143 [
 144   uv convertTo: uv unit baseUnits
 145 ].
 146
 147 uv@(UnitValue traits) as: u@(Unit traits)
 148 [
 149   uv convertTo: u
 150 ].
 151
 152 x@(Number traits) of: u@(Unit traits)
 153 [
 154   UnitValue unit: u value: x
 155 ].
 156
 157 x@(Number traits) of: obj &comparison
 158 [| u |
 159   u := ObjectUnit `>> [object := obj. comparisonBlock ?= comparison. ].
 160   UnitValue unit: u value: x
 161 ].
 162
 163 x@(Number traits) as: u@(Unit traits)
 164 [
 165   x of: u
 166 ].
 167
 168 x@(UnitValue traits) isConsistentWith: y@(UnitValue traits)
 169 [
 170   x unit isConsistentWith: y unit
 171 ].
 172
 173 x@(UnitValue traits) + y@(UnitValue traits)
 174 [| sum |
 175   (x isConsistentWith: y) ifFalse: [^ Nil].
 176   "TODO: construct sum!"
 177   (x as: y) `>> [value := sum value + y value. reduced]
 178 ].
 179
 180 x@(UnitValue traits) + y
 181 [
 182   x value + y as: x unit
 183 ].
 184
 185 x + y@(UnitValue traits)
 186 [
 187   y + x
 188 ].
 189
 190 x@(UnitValue traits) - y@(UnitValue traits)
 191 [
 192   x + y negated
 193 ].
 194
 195 x@(UnitValue traits) - y
 196 [
 197   x value - y as: x unit
 198 ].
 199
 200 x - y@(UnitValue traits)
 201 [
 202   x - y value as: x unit
 203 ].
 204
 205 x@(UnitValue traits) * y@(UnitValue traits)
 206 [
 207   (x unit: x unit * y unit value: x value * y value) reduced
 208 ].
 209
 210 x@(UnitValue traits) * y
 211 [
 212   x value * y as: x unit
 213 ].
 214
 215 x * y@(UnitValue traits)
 216 [
 217   y * x
 218 ].
 219
 220 x@(UnitValue traits) / y@(UnitValue traits)
 221 [
 222   (y unit: x unit / y unit value: x value / y value) reduced
 223 ].
 224
 225 x@(UnitValue traits) / y
 226 [
 227   x value / y as: x unit
 228 ].
 229
 230 x / y@(UnitValue traits)
 231 [
 232   x / y value as: x unit
 233 ].
 234
 235 x@(UnitValue traits) = y@(UnitValue traits)
 236 [
 237   (x isConsistentWith: y) /\ [y value = (x as: y) value]
 238 ].
 239
 240 x@(UnitValue traits) < y@(UnitValue traits)
 241 [
 242   (x isConsistentWith: y) /\ [x value < (y as: x unit) value]
 243 ].
 244
 245 uv@(UnitValue traits) negated
 246 [uv value negated as: uv unit].
 247
 248 uv@(UnitValue traits) reduced
 249 "Answer the scalar part if the units have 'vanished'."
 250 [
 251   uv unit units isEmpty ifTrue: [uv value] ifFalse: [uv]
 252 ].
 253
 254 uv1@(UnitValue traits) factor: uv2@(UnitValue traits)
 255 "Factor with respect to another unit or unitValue."
 256 [
 257   uv1 factor: uv2 unit
 258 ].
 259
 260 uv@(UnitValue traits) factor: u@(Unit traits)
 261 [
 262   uv as: (uv unit factor: u).
 263 ].
 264
 265 uv@(UnitValue traits) raisedTo: expon
 266 [
 267   uv unit: (uv unit raisedTo: expon) value: (uv value raisedTo: expon)
 268 ].
 269
 270 uv@(UnitValue traits) reciprocal
 271 [uv raisedTo: -1].
 272
 273 uv@(UnitValue traits) sqrt
 274 [
 275   uv unit: (uv unit raisedTo: 1 / 2) value: (uv value sqrt)
 276 ].
 277
 278 uv@(UnitValue traits) ceiling
 279 [
 280   uv value ceiling as: uv unit
 281 ].
 282
 283 uv@(UnitValue traits) floor
 284 [
 285   uv value floor as: uv unit
 286 ].
 287
 288 uv@(UnitValue traits) roundTo: x
 289 [
 290   (uv value roundTo: x) as: uv unit
 291 ].
 292
 293 uv@(UnitValue traits) roundUpTo: x
 294 [
 295   (uv value roundUpTo: x) as: uv unit
 296 ].
 297
 298 uv@(UnitValue traits) truncateTo: x
 299 [
 300   (uv value truncateTo: x) as: uv unit
 301 ].
 302
 303 uv@(UnitValue traits) rounded
 304 [
 305   (uv value rounded) as: uv unit
 306 ].
 307
 308 numerics define: #CompoundUnit &parents: {Unit} &slots: {#units. #exponents}.
 309
 310 CompoundUnit traits compareAndHashUsingSlots: #{#units. #exponents}.
 311
 312 cu@(CompoundUnit traits) reciprocal
 313 [
 314   cu units: cu units
 315      exponents: (cu exponents collect: #negated `er)
 316 ].
 317
 318 cu@(CompoundUnit traits) raisedTo: expon
 319 [
 320   cu units: cu units
 321      exponents: (cu exponents collect: #(* expon) `er)
 322 ].
 323
 324 cu@(CompoundUnit traits) unitsAndExponentsDo: block
 325 [
 326   cu units with: cu exponents do: block
 327 ].
 328
 329 cu@(CompoundUnit traits) conversionFactor
 330 [1].
 331
 332 cu@(CompoundUnit traits) printOn: s@(PrettyPrinterMixin traits)
 333 [| first any count |
 334   first := True.
 335   any := False.
 336   cu unitsAndExponentsDo: [| :unit :expon |
 337     expon isPositive
 338       ifTrue: [any := True.
 339         first ifFalse: [s nextPut: $*].
 340         first := False.
 341         unit printOn: s.
 342         expon ~= 1 ifTrue: [s nextPut: $^. expon printOn: s]]].
 343   count := cu exponents inject: 0 into: [| :c :each |
 344     each isNegative ifTrue: [c + 1] ifFalse: [c]].
 345   count isPositive
 346     ifTrue: [any ifFalse: [s nextPut: $1].
 347       s nextPut: $/.
 348       count > 1 ifTrue: [s nextPut: $(].
 349       first := True.
 350       cu unitsAndExponentsDo: [| :unit :expon |
 351         expon ~= 1 ifTrue: [first ifFalse: [s nextPut: $*].
 352         first := False.
 353         unit printOn: s.
 354         expon < -1 ifTrue: [s nextPut: $^. expon negated printOn: s]]].
 355       count > 1 ifTrue: [s nextPut: $)]].
 356   cu
 357 ].
 358
 359 cu@(CompoundUnit traits) printFullOn: s@(PrettyPrinterMixin traits) plural: b
 360 [| pos neg |
 361   pos := cu exponents anySatisfy: #isPositive `er.
 362   neg := cu exponents anySatisfy: #isNegative `er.
 363   pos ifTrue: [cu printUnitsWhereExponent: #isPositive `er
 364                   on: s plural: b].
 365   neg /\ pos ifTrue: [s nextPut: $\s].
 366   neg ifTrue: [s ; 'per '.
 367     cu printUnitsWhereExponent: #isNegative `er on: s plural: b].
 368   cu
 369 ].
 370
 371 cu@(CompoundUnit traits) printUnitsWhereExponent: block on: s plural: plural
 372 [| power first count index thisPlural |
 373   first := True.
 374   count := cu exponents count: block.
 375   index := 0.
 376   cu unitsAndExponentsDo: [| :unit :expon |
 377     (block applyWith: expon)
 378       ifTrue: [first ifTrue: [first := False] ifFalse: [s nextPut: $\s].
 379         index += 1.
 380         thisPlural := plural /\ [index = count].
 381         power := expon abs.
 382         (power is: Integer) /\ [power <= 3]
 383           ifTrue: [power = 2 ifTrue: [s ; 'square '].
 384             power = 3 ifTrue: [s ; 'cubic ']].
 385         unit printFullOn: s plural: plural.
 386         power > 3 \/ [(power is: Integer) not] ifTrue:
 387           [s nextPut: $^. power printOn: s]]].
 388   cu
 389 ].
 390
 391 cu1@(CompoundUnit traits) isConsistentWith: cu2@(CompoundUnit traits)
 392 [
 393   cu1 units = cu2 units /\ [cu1 bases = cu2 bases]
 394 ].
 395
 396 cu@(CompoundUnit traits) dimension
 397 [
 398   cu unitsAndExponentsDo: [| :unit :expon |
 399     "TODO: assemble/return a compound dimension"
 400   ].
 401 ].
 402
 403 numerics define: #ComplexUnit &parents: {CompoundUnit}
 404   &slots: {#conversionFactor. #cachedBases}.
 405
 406 cu@(ComplexUnit traits) units: units exponents: expons
 407 [| newCU |
 408   newCU := cu clone `setting: #{#units. #exponents. #conversionFactor}
 409     to: {units. expons. 1}.
 410   newCU units with: newCU exponents do: [| :unit :expon |
 411     newCU conversionFactor: newCU conversionFactor
 412       * (unit conversionFactor raisedTo: expon)].
 413   newCU
 414 ].
 415
 416 cu@(ComplexUnit traits) bases
 417 "Calculating bases is expensive, so the values are cached."
 418 [
 419   cu cachedBases ifNil: [cu cachedBases := cu calculateBases]
 420 ].
 421
 422 cu@(ComplexUnit traits) calculateBases
 423 [| bases unitDict newUs newExpons scratch |
 424   cu unitsAndExponentsDo: [| :unit :expon |
 425     bases := unit bases.
 426     bases unitsAndExponentsDo: [| :subunit :subexpon |
 427       scratch := subexpon * expon.
 428       (unitDict includesKey: subunit)
 429         ifTrue: [unitDict at: subunit := (unitDict at: subunit) + scratch]
 430         ifFalse: [unitDict at: subunit := scratch]]].
 431   newUs := ExtensibleArray new.
 432   newExpons := ExtensibleArray new.
 433   (unitDict keySet sortedBy: [| :l :r | l abbrev < r abbrev])
 434     do: [| :unit |
 435       scratch := unitDict at: unit.
 436       scratch isZero ifFalse: [newUs add: unit. newExpons add: scratch]].
 437   CompoundUnit units: newUs exponents: newExpons
 438 ].
 439
 440 cu1@(ComplexUnit traits) isConsistentWith: cu2@(ComplexUnit traits)
 441 [
 442   cu1 bases isConsistentWith: cu2 bases
 443 ].
 444
 445 numerics define: #ModifiedUnit &parents: {Unit} &slots: {#base. #modification}.
 446
 447 "A base unit with a modification that makes it incompatible with anything
 448 not having the same modification, good for domain-specific use.
 449 e.g. 1.6 moles -> 1.6 moles of sulfuric acid. (Strings not required)"
 450
 451 mu@(ModifiedUnit traits) base: u modification: mod
 452 [mu clone `setting: #{#base. #modification} to: {u. mod}].
 453
 454 ModifiedUnit traits compareAndHashUsingSlots: #{#base. #modification}.
 455
 456 mu@(ModifiedUnit traits) bases
 457 [
 458   mu
 459 ].
 460
 461 mu@(ModifiedUnit traits) conversionFactor
 462 [
 463   mu base conversionFactor
 464 ].
 465
 466 mu@(ModifiedUnit traits) modify: mod
 467 [
 468   mu base: mu modification: mod
 469 ].
 470
 471 mu@(ModifiedUnit traits) printOn: s@(PrettyPrinterMixin traits)
 472 [| mod |
 473   mu base printOn: s.
 474   s ; '('.
 475   ((mod := mu modification) is: String)
 476     ifTrue: [s ; mod]
 477     ifFalse: [mod printOn: s].
 478   s ; ')'.
 479   mu
 480 ].
 481
 482 mu@(ModifiedUnit traits) printFullOn: s@(PrettyPrinterMixin traits) plural: plural
 483 [| mod |
 484   mu base printFullOn: s plural: plural.
 485   s ; '( of '.
 486   ((mod := mu modification) is: String)
 487     ifTrue: [s ; mod]
 488     ifFalse: [mod printOn: s].
 489   s ; ')'.
 490   mu
 491 ].
 492
 493 mu@(ModifiedUnit traits) isConsistentWith: cu@(ComplexUnit traits)
 494 [
 495   mu isConsistentWith: cu bases
 496 ].
 497
 498 mu1@(ModifiedUnit traits) isConsistentWith: mu2@(ModifiedUnit traits)
 499 [
 500   mu1 base = mu2 base /\ [mu1 modification = mu2 modification]
 501 ].
 502
 503 numerics define: #PrefixedUnit &parents: {Unit} &slots: {#base. #prefix}.
 504
 505 "A Unit with an SI Prefix attached."
 506
 507 pu@(PrefixedUnit traits) prefix: prefix base: unit
 508 [pu clone `setting: #{#prefix. #base} to: {prefix. unit}].
 509
 510 pu@(PrefixedUnit traits) prefixedBy: prefix
 511 "Combine the prefixes."
 512 [pu clone `setting: #{#prefix} to: {newPU prefix * prefix}].
 513
 514 pu@(PrefixedUnit traits) dimension [pu base dimension].
 515
 516 pu@(PrefixedUnit traits) isConsistentWith: u@(Unit traits)
 517 [
 518   pu base isConsistentWith: u
 519 ].
 520
 521 u@(Unit traits) isConsistentWith: pu@(PrefixedUnit traits)
 522 [
 523   pu base isConsistentWith: u
 524 ].
 525
 526 pu@(PrefixedUnit traits) conversionFactor
 527 [
 528   pu prefix scalingFactor * pu base conversionFactor
 529 ].
 530
 531 pu@(PrefixedUnit traits) printOn: s@(PrettyPrinterMixin traits)
 532 [
 533   s ; pu prefix abbrev.
 534   pu base printOn: s.
 535   pu
 536 ].
 537
 538 pu@(PrefixedUnit traits) printFullOn: s@(PrettyPrinterMixin traits) plural: plural
 539 [
 540   s ; pu prefix prefixName.
 541   pu base printFullOn: s plural: plural.
 542   pu
 543 ].
 544
 545 numerics define: #SIPrefix &parents: {Cloneable}
 546   &slots: {#abbrev. #prefixName. #scalingFactor}.
 547 "SI Prefixes:
 548  http://physics.nist.gov/cuu/Units/prefixes.html
 549  http://www.bipm.org/en/si/prefixes.html
 550 Main SI site:
 551  http://www.bipm.org/en/si/
 552 A Standard interchange format for SI units and numbers
 553  http://swiss.csail.mit.edu/~jaffer/MIXF/"
 554
 555 units ensureNamespace: #Prefixes.
 556 units Prefixes ensureNamespace: #ByName &delegate: True.
 557 units Prefixes ensureNamespace: #ByAbbrev &delegate: True.
 558
 559 sip@(SIPrefix traits) name: name abbrev: abbrev scalingFactor: n
 560 [| newSIP |
 561   newSIP := sip clone `setting: #{#abbrev. #prefixName. #scalingFactor}
 562     to: {abbrev. name. n}.
 563   units Prefixes ByName addImmutableSlot: name intern valued: newSIP.
 564   units Prefixes ByAbbrev addImmutableSlot: abbrev intern valued: newSIP.
 565   newSIP
 566 ].
 567
 568 sip@(SIPrefix traits) named: name
 569 [
 570   units SIPrefixesByName at: name intern
 571 ].
 572
 573 sip@(SIPrefix traits) abbrev: name
 574 [
 575   units SIPrefixesByAbbrev at: name intern
 576 ].
 577
 578 u@(Unit traits) prefixedBy: prefix@(SIPrefix traits)
 579 [
 580   PrefixedUnit prefix: prefix base: u
 581 ].
 582
 583 p1@(SIPrefix traits) * p2@(SIPrefix traits)
 584 [| scalingFactor newSIP |
 585   scalingFactor := p1 scalingFactor * p2 scalingFactor.
 586   units SIPrefixesByName keysAndValuesDo: [| :key :value |
 587     value scalingFactor = scalingFactor ifTrue: [^ value]].
 588   Nil
 589 ].
 590
 591 SIPrefix name: 'yotta' abbrev: 'Y' scalingFactor: (10 raisedTo: 24).
 592 SIPrefix name: 'zetta' abbrev: 'Z' scalingFactor: (10 raisedTo: 21).
 593 SIPrefix name: 'exa' abbrev: 'E' scalingFactor: (10 raisedTo: 18).
 594 SIPrefix name: 'peta' abbrev: 'P' scalingFactor: (10 raisedTo: 15).
 595 SIPrefix name: 'tera' abbrev: 'T' scalingFactor: (10 raisedTo: 12).
 596 SIPrefix name: 'giga' abbrev: 'G' scalingFactor: (10 raisedTo: 9).
 597 SIPrefix name: 'mega' abbrev: 'M' scalingFactor: (10 raisedTo: 6).
 598 SIPrefix name: 'kilo' abbrev: 'k' scalingFactor: (10 raisedTo: 3).
 599 SIPrefix name: 'hecto' abbrev: 'h' scalingFactor: (10 raisedTo: 2).
 600 SIPrefix name: 'deca' abbrev: 'da' scalingFactor: (10 raisedTo: 1).
 601 SIPrefix name: 'deci' abbrev: 'd' scalingFactor: (10 raisedTo: -1).
 602 SIPrefix name: 'centi' abbrev: 'c' scalingFactor: (10 raisedTo: -2).
 603 SIPrefix name: 'milli' abbrev: 'm' scalingFactor: (10 raisedTo: -3).
 604 SIPrefix name: 'micro' abbrev: 'u' scalingFactor: (10 raisedTo: -6).
 605 SIPrefix name: 'nano' abbrev: 'n' scalingFactor: (10 raisedTo: -9).
 606 SIPrefix name: 'pico' abbrev: 'p' scalingFactor: (10 raisedTo: -12).
 607 SIPrefix name: 'atto' abbrev: 'a' scalingFactor: (10 raisedTo: -15).
 608 SIPrefix name: 'femto' abbrev: 'f' scalingFactor: (10 raisedTo: -18).
 609 SIPrefix name: 'zepto' abbrev: 'z' scalingFactor: (10 raisedTo: -21).
 610 SIPrefix name: 'yocto' abbrev: 'y' scalingFactor: (10 raisedTo: -24).
 611
 612 numerics define: #NamedUnit &parents: {Unit}
 613   &slots: {#abbrev. #unitName. #pluralName}.
 614
 615 nu@(NamedUnit traits) name: n1 abbrev: ab &plural: np
 616 [nu clone `setting: #{#abbrev. #unitName. #pluralName}
 617     to: {ab. n1. np ifNil: [n1 plural]}].
 618
 619 nu@(NamedUnit traits) printOn: s@(PrettyPrinterMixin traits)
 620 [
 621   s ; nu abbrev.
 622   nu
 623 ].
 624
 625 nu@(NamedUnit traits) printFullOn: s@(PrettyPrinterMixin traits) plural: plural
 626 [
 627   plural ifTrue: [s ; nu unitName] ifFalse: [s ; nu pluralName].
 628   nu
 629 ].
 630
 631 numerics define: #BaseUnit &parents: {NamedUnit}.
 632
 633 "Defines core SI units and allows for basic extension."
 634
 635 bu@(BaseUnit traits) modify: mod
 636 [
 637   ModifiedUnit base: bu modification: mod
 638 ].
 639
 640 bu@(BaseUnit traits) bases
 641 [bu].
 642
 643 bu@(BaseUnit traits) conversionFactor
 644 [1].
 645
 646 bu1@(BaseUnit traits) isConsistentWith: bu2@(BaseUnit traits)
 647 [bu1 == bu2].
 648
 649 x@(UnitValue traits) / y@(Unit traits)
 650 [x / (1 of: y)].
 651
 652 bu@(BaseUnit traits) isConsistentWith: cu@(ComplexUnit traits)
 653 [bu isConsistentWith: cu bases].
 654
 655 cu@(CompoundUnit traits) isConsistentWith: cu2@(BaseUnit traits)
 656 "Compound units always have a non-trivial set of units."
 657 [False].
 658
 659 mu@(ModifiedUnit traits) isConsistentWith: bu@(BaseUnit traits)
 660 [False].
 661
 662 bu@(BaseUnit traits) isConsistentWith: mu@(ModifiedUnit traits)
 663 [False].
 664
 665 _@(ModifiedUnit traits) is: _@(BaseUnit traits)
 666 "Modified units are effectively new bases."
 667 [True].
 668
 669 units ensureNamespace: #SI &delegate: True.
 670 units SI ensureNamespace: #ByName &delegate: True.
 671 units SI ensureNamespace: #ByAbbrev &delegate: True.
 672 units SI ensureNamespace: #ByPluralName &delegate: True.
 673
 674 bu@(BaseUnit traits) name: n1 abbrev: ab dimension: dimension &plural: np
 675 [| newBU n1s nps abs |
 676   np `defaultsTo: n1 plural.
 677   newBU := bu name: n1 abbrev: ab &plural: np.
 678   [| :n | n of: newBU] asMethod: n1 intern on: {Number traits}.
 679   [| :n | n of: newBU] asMethod: ab intern on: {Number traits}.
 680   newBU traits addImmutableSlot: #dimension valued: dimension.
 681   units SI ByName addImmutableSlot: n1 intern valued: newBU.
 682   units SI ByAbbrev addImmutableSlot: ab intern valued: newBU.
 683   units SI ByPluralName addImmutableSlot: np intern valued: newBU.
 684   newBU
 685 ].
 686
 687 BaseUnit name: 'gram' abbrev: 'g' dimension: Mass.
 688 BaseUnit name: 'meter' abbrev: 'm' dimension: Length.
 689 BaseUnit name: 'second' abbrev: 's' dimension: Time.
 690 BaseUnit name: 'candela' abbrev: 'c' dimension: Count &plural: 'candela'.
 691 BaseUnit name: 'mole' abbrev: 'mol' dimension: Count.
 692 BaseUnit name: 'kelvin' abbrev: 'K' dimension: Temperature &plural: 'kelvin'.
 693
 694 bu@(BaseUnit traits) named: name
 695 [
 696   name intern sendTo: {units SI ByName}
 697 ].
 698
 699 bu@(BaseUnit traits) abbrev: name
 700 [
 701   name intern sendTo: {units SI ByAbbrev}
 702 ].
 703
 704 bu@(BaseUnit traits) pluralNamed: name
 705 [
 706   name intern sendTo: {units SI ByPluralName}
 707 ].
 708
 709 cu@(ComplexUnit traits) isConsistentWith: bu@(BaseUnit traits)
 710 [bu isConsistentWith: cu bases].
 711
 712 numerics define: #DerivedUnit &parents: {NamedUnit} &slots: {#unitValue}.
 713
 714 d@(DerivedUnit traits) dimension [d unitValue dimension].
 715
 716 "This defines a unit in terms of powers of other units, plus a scalar."
 717
 718 units ensureNamespace: #ByName &delegate: True.
 719 units ensureNamespace: #ByAbbrev &delegate: True.
 720 units ensureNamespace: #ByPluralName &delegate: True.
 721
 722 du@(DerivedUnit traits) name: n1 abbrev: ab value: val &plural: np
 723 [| newU |
 724   np `defaultsTo: n1 plural.
 725   newU := du name: n1 abbrev: ab &plural: np.
 726   newU unitValue := val.
 727   [| :n | n of: newU] asMethod: n1 intern on: {Number traits}.
 728   [| :n | n of: newU] asMethod: ab intern on: {Number traits}.
 729   units ByName addImmutableSlot: n1 intern valued: newU.
 730   units ByAbbrev addImmutableSlot: ab intern valued: newU.
 731   units ByPluralName addImmutableSlot: np intern valued: newU.
 732   newU
 733 ].
 734
 735 du@(DerivedUnit traits) unit
 736 [
 737   du unitValue unit
 738 ].
 739
 740 du@(DerivedUnit traits) dimension
 741 [
 742   du unitValue dimension
 743 ].
 744
 745 du@(DerivedUnit traits) bases
 746 [
 747   du unitValue unit bases
 748 ].
 749
 750 du@(DerivedUnit traits) conversionFactor
 751 [
 752   du unitValue value * du unitValue unit conversionFactor
 753 ].
 754
 755 du@(DerivedUnit traits) isConsistentWith: bu@(BaseUnit traits)
 756 [
 757   bu isConsistentWith: du unit
 758 ].
 759
 760 bu@(BaseUnit traits) isConsistentWith: du@(DerivedUnit traits)
 761 [
 762   bu isConsistentWith: du unit
 763 ].
 764
 765 DerivedUnit
 766   name: 'centimeter'
 767   abbrev: 'cm'
 768   value: (1 of: (units m prefixedBy: units Prefixes c)).
 769
 770 DerivedUnit
 771   name: 'kilometer'
 772   abbrev: 'km'
 773   value: (1 of: (units m prefixedBy: units Prefixes k)).
 774
 775 DerivedUnit
 776   name: 'kilogram'
 777   abbrev: 'kg'
 778   value: (1 of: (units g prefixedBy: units Prefixes k)).
 779
 780 DerivedUnit
 781   name: 'inch'
 782   abbrev: 'in'
 783   value: (2.54 of: units cm).
 784
 785 DerivedUnit
 786   name: 'foot'
 787   abbrev: 'ft'
 788   value: (12 of: units in)
 789   &plural: 'feet'.
 790
 791 DerivedUnit
 792   name: 'yard'
 793   abbrev: 'yd'
 794   value: (3 of: units ft).
 795
 796 DerivedUnit
 797   name: 'mile'
 798   abbrev: 'mi'
 799   value: (5280 of: units ft).
 800
 801 DerivedUnit
 802   name: 'acre'
 803   abbrev: 'acre'
 804   value: (4046.87260987 of: units m squared).
 805
 806 DerivedUnit
 807   name: 'newton'
 808   abbrev: 'N'
 809   value: (1 of: units kg * units m / units s squared)
 810   &plural: 'newtons'.
 811
 812 DerivedUnit
 813   name: 'minute'
 814   abbrev: 'min'
 815   value: (60 of: units s).
 816
 817 DerivedUnit
 818   name: 'hour'
 819   abbrev: 'h'
 820   value: (60 of: units min).
 821
 822 DerivedUnit
 823   name: 'day'
 824   abbrev: 'd'
 825   value: (24 of: units h).
 826
 827 DerivedUnit
 828   name: 'year'
 829   abbrev: 'yr'
 830   value: (365.242198781 of: units d).
 831
 832 DerivedUnit
 833   name: 'hertz'
 834   abbrev: 'Hz'
 835   value: ((1 of: units s) raisedTo: -1)
 836   &plural: 'hertz'.
 837
 838 numerics define: #TemperatureUnit &parents: {DerivedUnit}
 839   &slots: {#additiveFactor}.
 840
 841 tu@(TemperatureUnit traits) name: n1 abbrev: ab value: val additiveFactor: af &plural: np
 842 [
 843   (tu name: n1 abbrev: ab value: val &plural: np) `>> [additiveFactor := af. ]
 844 ].
 845
 846 TemperatureUnit
 847   name: 'degree Rankine'
 848   abbrev: 'R'
 849   value: (5 / 9 of: units K)
 850   additiveFactor: 0
 851   &plural: 'degrees Rankine'.
 852
 853 TemperatureUnit
 854   name: 'degree Fahrenheit'
 855   abbrev: 'F'
 856   value: (5 / 9 of: units K)
 857   additiveFactor: -459.67
 858   &plural: 'degrees Fahrenheit'.
 859
 860 TemperatureUnit
 861   name: 'degree Celsius'
 862   abbrev: 'C'
 863   value: (1 of: units K)
 864   additiveFactor: -273.15
 865   &plural: 'degrees Celsius'.