Quantity Model in Smalltalk

by Joseph Yoder on January 14, 2010

Object subclass: #Quantity
    instanceVariableNames: 'amount unit '
    classVariableNames: ''
    poolDictionaries: ''!

!Quantity class publicMethods !

amount: aValue unit: aUnit 
	^(self new)
		amount: aValue;
		unit: aUnit;
		yourself
!

amount: aValue unitNamed: aUnitName 
	^self amount: aValue unit: (self unitFromName: aUnitName asSymbol)
!

roundingValue
	^0.00005
!

unitFromName: aUnitName 
	^UnitSystem unitFromName: aUnitName
! !

!Quantity publicMethods !

= aQuantity 
	^aQuantity species = self species 
		and: [aQuantity amount = self amount and: [aQuantity unit = self unit]]
!

amount
	^amount!

amount: aNumber 
	amount := aNumber
!

amountExpressedOnUnit: aUnitName 
	| factor |
	factor := self unit conversionFactorTo: aUnitName.
	^self amount * factor!

create
	self isValid ifFalse: [^self].
	self assignUniqueKey.
	super create!

displayOnUnit: aUnitName 
	| outStream |
	outStream := WriteStream with: String new.
	(self expressOnUnit: aUnitName) displayOn: outStream.
	^outStream contents
!

displayOnUnits: unitNames 
	| outStream |
	outStream := WriteStream with: String new.
	(self expressOnUnits: unitNames) printOn: outStream.
	^outStream contents
!

expressOnUnit: aUnitName 
	| factor |
	factor := self unit conversionFactorTo: aUnitName.
	^self class amount: self amount * factor unitNamed: aUnitName!

expressOnUnits: aUnitNameCollection 
	| unitsDecorator |
	unitsDecorator := MultiUnitsQuantityDecorator with: self.
	^self expressOnUnits: aUnitNameCollection using: unitsDecorator!

expressOnUnits: aUnitNameCollection using: unitsDecorator 
	| conversionAmount factorCollection |
	conversionAmount := self amount.
	factorCollection := self unit conversionFactorsTo: aUnitNameCollection.
	1 to: factorCollection size - 1
		do: 
			[:index | 
			| currentFactor |
			currentFactor := factorCollection at: index.
			conversionAmount := conversionAmount * currentFactor 
						roundTo: self class roundingValue.
			unitsDecorator addUnitNamed: (aUnitNameCollection at: index)
				withValue: (conversionAmount truncateTo: 1).
			conversionAmount := conversionAmount rem: 1].
	unitsDecorator addUnitNamed: aUnitNameCollection last
		withValue: (conversionAmount * factorCollection last 
				roundTo: self class roundingValue).
	^unitsDecorator!

isValid
	^true!

printOn: aStream 
	self amount printOn: aStream.
	aStream space.
	self unit printOn: aStream
!

unit
	^unit!

unit: aUnit 
	unit := aUnit
!

unitSystem
	^self unit unitSystem
!

Quantity initializeAfterLoad!


Object subclass: #SiblingUnit
    instanceVariableNames: 'subject conversionFactor '
    classVariableNames: ''
    poolDictionaries: ''!

!SiblingUnit class publicMethods !

unit: anUnit targetUnitSystem: targetUnitSystem 
	| unitFamily |
	unitFamily := targetUnitSystem unitFamily.
	^(self new)
		subject: anUnit;
		computeConversionFactor: (unitFamily factorForSystem: anUnit unitSystem) 
											 / (unitFamily factorForSystem: targetUnitSystem);
		yourself
! !

!SiblingUnit publicMethods !

computeConversionFactor: conversionFactorBetweenSystems 
	conversionFactor := conversionFactorBetweenSystems 
				* self subject baseFactor!

conversionFactor
	^conversionFactor
!

subject
	^subject!

subject: anObject
	subject := anObject! !

SiblingUnit initializeAfterLoad!


Object subclass: #Unit
    instanceVariableNames: 'name unitSystem '
    classVariableNames: ''
    poolDictionaries: ''!

!Unit publicMethods !

= anObject 
	^anObject species = self species and: [anObject name = self name]
!

baseFactor
	^self unitSystem baseFactorFor: self
!

conversionFactorsTo: unitNames 
	| lastUnit |
	lastUnit := self.
	^unitNames collect: 
			[:each | 
			| factor |
			factor := lastUnit conversionFactorTo: each.
			lastUnit := lastUnit unitFromName: each.
			factor]
!

conversionFactorTo: aUnitName 
	^self unitSystem conversionFactorFrom: self
		to: (self unitSystem unitFromName: aUnitName)
!

name
	^name!

name: aString 
	name := aString
!

printOn: aStream 
	aStream
		nextPutAll: self name asString;
		space
!

unitFromName: aUnitName 
	^self unitSystem unitFromName: aUnitName!

unitSystem
	^unitSystem!

unitSystem: aUnitSystem
	unitSystem := aUnitSystem
! !

Unit initializeAfterLoad!


Object subclass: #UnitFamily
    instanceVariableNames: 'name factors baseSystem '
    classVariableNames: ''
    poolDictionaries: ''!

!UnitFamily class publicMethods !

dimensionUnitFamily
	| aUnitFamily |
	aUnitFamily := self new.
	aUnitFamily name: #dimensionUnitFamily.
	aUnitFamily addBaseSystem: UnitSystem dimensionMetric.
	aUnitFamily addSystem: UnitSystem dimensionUS factor: 1.094.
	^aUnitFamily
!

initializeAfterLoad
	super initializeAfterLoad.
	UnitSystem resetUnitSystems.
	self dimensionUnitFamily.
	self massUnitFamily.
	self timeUnitFamily.
	
!

massUnitFamily
	| aUnitFamily |
	aUnitFamily := self new.
	aUnitFamily name: #massUnitFamily.
	aUnitFamily addBaseSystem: UnitSystem massMetric.
	aUnitFamily addSystem: UnitSystem massUS factor: 0.0022046226.
	^aUnitFamily
!

timeUnitFamily
	| aUnitFamily |
	aUnitFamily := self new.
	aUnitFamily name: #timeUnitFamily.
	aUnitFamily addBaseSystem: UnitSystem time.
	^aUnitFamily
! !

!UnitFamily publicMethods !

addBaseSystem: aSystem 
	self addSystem: aSystem factor: 1.
	self baseSystem: aSystem
!

addSystem: aSystem factor: aNumber 
	aSystem unitFamily: self.
	self factors at: aSystem put: aNumber
!

baseSystem
	^baseSystem!

baseSystem: anObject
	baseSystem := anObject!

factorForSystem: aUnitSystem 
	^self factors at: aUnitSystem
!

factors
	^factors isNil ifTrue: [factors := Dictionary new] ifFalse: [factors]
!

includedSystems
	^factors keys!

name
	^name!

name: aSymbol
	name := aSymbol
!

printOn: aStream 
	aStream nextPutAll: self name asString
!

siblingSystemsFor: aUnitSystem 
	| siblings |
	siblings := self factors keys.
	siblings remove: aUnitSystem.
	^siblings!

siblingUnitNamed: aUnitName for: aUnitSystem 
	| originUnitSystem |
	originUnitSystem := self factors keys 
				detect: [:each | each definesUnitNamed: aUnitName].
	^SiblingUnit unit: (originUnitSystem unitFromName: aUnitName)
		targetUnitSystem: aUnitSystem
!

unitSystemFromName: aSystemName 
	^self factors keys detect: [:each | each name = aSystemName]
! !

UnitFamily initializeAfterLoad!


Object subclass: #UnitSystem
    instanceVariableNames: 'name unitFamily factors baseUnit '
    classVariableNames: 'UnitSystems '
    poolDictionaries: ''!

!UnitSystem class publicMethods !

dimensionMetric
	| aSystem |
	aSystem := self unitSystemNamed: #dimensionMetric.
	aSystem defineBaseUnit: #meters.
	aSystem defineUnit: #decimeters factor: 10.
	aSystem defineUnit: #centimeters factor: 100.
	aSystem defineUnit: #millimeters factor: 1000.
	aSystem defineUnit: #micrometers factor: 10000.
	aSystem defineUnit: #nanometers factor: 100000.
	aSystem defineUnit: #picometers factor: 1000000.
	aSystem defineUnit: #dekameters factor: 0.1.
	aSystem defineUnit: #hectometers factor: 0.01.
	aSystem defineUnit: #kilometers factor: 0.001.
	aSystem defineUnit: #megameters factor: 0.0001.
	aSystem defineUnit: #gigameters factor: 0.00001.
	^aSystem
!

dimensionUS
	| aSystem |
	aSystem :=  self unitSystemNamed: #dimensionUS.
	aSystem defineBaseUnit: #yards.
	aSystem defineUnit: #miles factor: 1 / 1760.
	aSystem defineUnit: #fathoms factor: 0.5.
	aSystem defineUnit: #feet factor: 3.
	aSystem defineUnit: #inches factor: 36.
	aSystem defineUnit: #mils factor: 36000.
	^aSystem
!

massMetric
	| aSystem |
	aSystem := self unitSystemNamed: #massMetric.
	aSystem defineBaseUnit: #grams.
	aSystem defineUnit: #decigrams factor: 10.
	aSystem defineUnit: #centigrams factor: 100.
	aSystem defineUnit: #milligrams factor: 1000.
	aSystem defineUnit: #micrograms factor: 10000.
	aSystem defineUnit: #nanograms factor: 100000.
	aSystem defineUnit: #picograms factor: 1000000.
	aSystem defineUnit: #dekagrams factor: 0.1.
	aSystem defineUnit: #hectograms factor: 0.01.
	aSystem defineUnit: #kilograms factor: 0.001.
	^aSystem
!

massUS
	| aSystem |
	aSystem := self unitSystemNamed: #massUS.
	aSystem defineBaseUnit: #lbs.
	aSystem defineUnit: #oz factor: 16.
	aSystem defineUnit: #drams factor: 256.
	^aSystem
!

resetUnitSystems
	UnitSystems := OrderedCollection new!

time
	| aSystem |
	aSystem := self unitSystemNamed: #time.
	aSystem defineBaseUnit: #Weeks.
	aSystem defineUnit: #Days factor: 7.
	aSystem defineUnit: #Hours factor: 168.
	aSystem defineUnit: #Minutes factor: 10080.
	aSystem defineUnit: #Seconds factor: 604800.
	^aSystem
!

unitFromName: aUnitName 
	| aUnitSystem |
   (aUnitName isNil or:[aUnitName isEmpty]) ifTrue:[^nil].
	aUnitSystem := UnitSystems 
				detect: [:each | each  includesUnitNamed: aUnitName].
	^aUnitSystem unitFromName: aUnitName
!

unitSystemNamed: aSymbol 
	| instance |
	^UnitSystems detect: [:each | each name = aSymbol]
		ifNone: 
			[instance := super new.
			instance name: aSymbol.
			UnitSystems add: instance.
			instance]
! !

!UnitSystem publicMethods !

baseFactorFor: aUnit 
	^self factors at: aUnit
!

baseUnit
	^baseUnit!

baseUnit: anUnit 
	baseUnit := anUnit
!

conversionFactorFrom: aUnit to: anotherUnit 
	| fromFactor toFactor |
	fromFactor := self factors at: aUnit
				ifAbsent: 
					[self error: 'Unable to find the unit definition into its UnitSystem'].
	toFactor := self factors at: anotherUnit
				ifAbsent: 
					[self 
						error: 'Unable to find the external unit definition into the UnitSystem'].
	^toFactor / fromFactor
!

defineBaseUnit: aUnitName 
	self baseUnit: (self defineUnit: aUnitName factor: 1).
	^self baseUnit
!

definedUnits
	^((self factors keys select: [:each | each unitSystem = self]) 
		asSortedCollection: [:a :b | (self baseFactorFor: a) > (self baseFactorFor: b)]) 
			asOrderedCollection!

definesUnitNamed: aSymbol 
	^self definedUnits contains: [:each | each name = aSymbol asSymbol]
!

defineUnit: aUnitName factor: aNumber 
	| aUnit |
	aUnit := (Unit new)
				name: aUnitName;
				unitSystem: self;
				yourself.
	self factors at: aUnit put: aNumber.
	^aUnit
!

factors
	^factors isNil ifTrue: [factors := Dictionary new] ifFalse: [factors]
!

includesUnitNamed: aSymbol 
	^self factors keys contains: [:each | each name = aSymbol asSymbol]
!

name
	^name!

name: aSymbol 
	name := aSymbol
!

printOn: aStream 
	aStream nextPutAll: self name asString
!

siblingUnitSystems
	^self unitFamily siblingSystemsFor: self!

unitFamily
	^unitFamily!

unitFamily: anUnitFamily
	unitFamily := anUnitFamily
!

unitFromName: aUnitName 
	^self factors keys detect: [:each | each name = aUnitName asSymbol]
		ifNone: 
			[| siblingUnit |
			siblingUnit := self unitFamily siblingUnitNamed: aUnitName for: self.
			self factors at: siblingUnit subject put: siblingUnit conversionFactor.
			siblingUnit subject]! !

UnitSystem initializeAfterLoad!