ArithmeticValue.st
author Claus Gittinger <cg@exept.de>
Sat, 13 Apr 1996 14:35:23 +0200
changeset 1172 b135d4ae4bf2
parent 701 a309e3ef7faf
child 1200 cc16f7a00b52
permissions -rw-r--r--
checkin from browser

"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Magnitude subclass:#ArithmeticValue
	instanceVariableNames:''
	classVariableNames:'DivisionByZeroSignal DomainErrorSignal OverflowSignal
		UnderflowSignal ArithmeticSignal AnyArithmeticSignal
		UnorderedSignal'
	poolDictionaries:''
	category:'Magnitude-Numbers'
!

!ArithmeticValue class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    ArithmeticValue is an abstract superclass for all things responding to
    arithmetic messages. It was inserted into the hierarchy, to allow objects
    like matrices, functions etc. to share the arithmetic methods defined here.

    class variables:
	ArithmeticSignal        <Signal>        parent of all arithmetic signals
						(never raised itself)

	DomainErrorSignal       <Signal>        raised upon float errors
						(for example range in trigonometric)

	DivisionByZeroSignal    <Signal>        raised when division by 0 is attempted

	OverflowSignal          <Signal>        raised on overflow/underflow conditions
	UnderflowSignal                         in float arithmetic. 
						Notice: some OperatingSystems do not 
						provide enough information for ST/X to 
						extract the real reason for the floatException
						thus raising DomainErrorSignal in these cases.
"
! !

!ArithmeticValue class methodsFor:'initialization'!

initialize
    "setup the signals"

    DomainErrorSignal isNil ifTrue:[
	ArithmeticSignal := ErrorSignal newSignalMayProceed:false.
	ArithmeticSignal nameClass:self message:#arithmeticSignal.
	ArithmeticSignal notifierString:'arithmetic error'.

	DomainErrorSignal := ArithmeticSignal newSignalMayProceed:false.
	DomainErrorSignal nameClass:self message:#domainErrorSignal.
	DomainErrorSignal notifierString:'domain error'.

	DivisionByZeroSignal := ArithmeticSignal newSignalMayProceed:false.
	DivisionByZeroSignal nameClass:self message:#divisionByZeroSignal.
	DivisionByZeroSignal notifierString:'division by zero'.

	OverflowSignal := ArithmeticSignal newSignalMayProceed:false.
	OverflowSignal nameClass:self message:#overflowSignal.
	OverflowSignal notifierString:'overflow'.

	UnderflowSignal := ArithmeticSignal newSignalMayProceed:false.
	UnderflowSignal nameClass:self message:#underflowSignal.
	UnderflowSignal notifierString:'underflow'.

	UnorderedSignal := ArithmeticSignal newSignalMayProceed:false.
	UnorderedSignal nameClass:self message:#unorderedSignal.
	UnorderedSignal notifierString:'unordered'.

	AnyArithmeticSignal := SignalSet with:DomainErrorSignal
					 with:DivisionByZeroSignal
					 with:OverflowSignal
					 with:UnderflowSignal
					 with:UnorderedSignal.
    ]
! !

!ArithmeticValue class methodsFor:'Signal constants'!

anyArithmeticSignal
    "return a signalSet with all possible arithmetic signals.
     OBSOLETE: this will vanish, since starting with 2.10.3, signal parents
	       have been added."

    ^ AnyArithmeticSignal
!

arithmeticSignal
    "return the parent of all arithmetic signals"

    ^ ArithmeticSignal
!

divisionByZeroSignal
    "return the signal which is raised on division by zero"

    ^ DivisionByZeroSignal
!

domainErrorSignal
    "return the signal which is raised on math errors
     (such as log of 0 etc.)"

    ^ DomainErrorSignal
!

overflowSignal
    "return the signal which is raised on overflow conditions (in floats)"

    ^ OverflowSignal
!

underflowSignal
    "return the signal which is raised on underflow conditions (in floats)"

    ^ UnderflowSignal
!

unorderedSignal
    "return the signal which is raised when numbers are compared, 
     for which no ordering is defined (for example: complex numbers)"

    ^ UnderflowSignal
! !

!ArithmeticValue methodsFor:'arithmetic'!

* something
    "return the product of the receiver and the argument"

    ^ self subclassResponsibility
!

+ something
    "return the sum of the receiver and the argument"

    ^ self subclassResponsibility
!

- something
    "return the difference of the receiver and the argument"

    ^ self subclassResponsibility
!

/ something
    "return the quotient of the receiver and the argument"

    ^ self subclassResponsibility
!

// something
    "return the integer quotient of the receiver and the argument"

    "/ changed: the code below may lead to infinite recursion

    ^ self subclassResponsibility
"/    ^ (self / something) floor

    "Modified: 13.4.1996 / 14:35:03 / cg"
!

\\ something
    "return the integer modulu of the receiver and the argument"

    ^ self - ((self // something) * something)
!

abs
    "return the absolute value of the receiver"

    (self negative) ifTrue:[^ self negated].
    ^ self
!

negated
    "return the receiver negated"

    ^ self class zero - self
!

quo:something
    "Return the integer quotient of dividing the receiver by the argument
     with truncation towards zero."

    ^ (self / something) truncated
!

reciprocal
    "return the receivers reciprocal"

    ^ self class unity / self
!

rem:something
    "Return the integer remainder of dividing the receiver by the argument
     with truncation towards zero.
     The remainder has the same sign as the receiver."

    ^ self - ((self quo:something) * something)
! !

!ArithmeticValue methodsFor:'comparing'!

< something
    "return true, if the argument is greater than the receiver"

    ^ self subclassResponsibility
!

<= something
    "return true, if the argument is greater or equal than the receiver"

    ^ (something < self) not
!

> something
    "return true, if the argument is less than the receiver"

    ^ something < self
!

>= something
    "return true, if the argument is less or equal than the receiver"

    ^ (self < something) not
!

compare:arg ifLess:lessBlock ifEqual:equalBlock ifGreater:greaterBlock
    "three-way compare - thanks to Self for this idea.
     Can be redefined in subclasses to do it with a single comparison if
     comparison is expensive."

    self < arg ifTrue:[
	^ lessBlock value
    ].
    self = arg ifTrue:[
	^ equalBlock value
    ].
    ^ greaterBlock value
! !

!ArithmeticValue methodsFor:'converting'!

asFloat
    "return a float with same value"

   ^ self subclassResponsibility
!

asFraction
    "return a fraction with same value"

   ^ self subclassResponsibility
!

asInteger
    "return an integer with same value - might truncate"

    ^ self truncated
!

coerce:aNumber
    "convert aNumber into an instance of the receivers class and return it."

    ^ self subclassResponsibility
!

degreesToRadians
    "interpreting the receiver as radians, return the degrees"

    ^ self asFloat degreesToRadians
!

generality
    "return a number giving the receivers generality, that number is
     used to convert one of the arguments in a mixed expression. 
     The generality has to be defined in subclasses,
     such that gen(a) > gen(b) iff, conversion of b into a's class 
     does not cut precision. For example, Integer has 40, Float has 80,
     meaning that if we convert a Float to an Integer, some precision may
     be lost. The generality is used by ArithmeticValue>>retry:cuercing:"
      
    ^ self subclassResponsibility
!

radiansToDegrees
    "interpreting the receiver as degrees, return the radians"

    ^ self asFloat radiansToDegrees
!

retry:aSymbol coercing:aNumber
    "arithmetic represented by the binary operator, aSymbol,
    could not be performed with the receiver and the argument, aNumber, 
    because of the differences in representation.  
    Coerce either the receiver or the argument, depending on which has higher 
    generality, and try again.  
    If the operation is compare for same value (=), return false if
    the argument is not a Number. 
    If the generalities are the same, create an error message, since this
    means that a subclass has not been fully implemented."

    |myGenerality otherGenerality|

    (aSymbol == #=) ifTrue:[
	(aNumber respondsTo:#generality) ifFalse:[^ false]
    ] ifFalse:[
	(aNumber respondsTo:#generality) ifFalse:[
	    self error:'retry:coercing: argument is not a number'.
	    ^ self
	]
    ].
    myGenerality := self generality.
    otherGenerality := aNumber generality.
    (myGenerality > otherGenerality) ifTrue:[
	^ self perform:aSymbol with:(self coerce:aNumber)
    ].
    (myGenerality < otherGenerality) ifTrue:[
	^ (aNumber coerce:self) perform:aSymbol with:aNumber
    ].
    self error:'retry:coercing: oops - same generality'
! !

!ArithmeticValue methodsFor:'double dispatching'!

differenceFromFloat:aFloat
    "the receiver does not know how to subtract from a float -
     retry the operation by coercing to higher generality"

    ^ aFloat retry:#- coercing:self
!

differenceFromFraction:aFraction
    "the receiver does not know how to subtract from a fraction -
     retry the operation by coercing to higher generality"

    ^ aFraction retry:#- coercing:self
!

differenceFromInteger:anInteger
    "the receiver does not know how to subtract from an integer -
     retry the operation by coercing to higher generality"

    ^ anInteger retry:#- coercing:self
!

lessFromFloat:aFloat
    "the receiver does not know how to compare to a float -
     retry the operation by coercing to higher generality"

    ^ aFloat retry:#< coercing:self
!

lessFromFraction:aFraction
    "the receiver does not know how to compare to a fraction -
     retry the operation by coercing to higher generality"

    ^ aFraction retry:#< coercing:self
!

lessFromInteger:anInteger
    "the receiver does not know how to compare to an integer -
     retry the operation by coercing to higher generality"

    ^ anInteger retry:#< coercing:self
!

productFromFloat:aFloat
    "the receiver does not know how to multiply a float -
     retry the operation by coercing to higher generality"

    ^ aFloat retry:#* coercing:self
!

productFromFraction:aFraction
    "the receiver does not know how to multiply a fraction -
     retry the operation by coercing to higher generality"

    ^ aFraction retry:#* coercing:self
!

productFromInteger:anInteger
    "the receiver does not know how to multiply an integer -
     retry the operation by coercing to higher generality"

    ^ anInteger retry:#* coercing:self
!

quotientFromFloat:aFloat
    "the receiver does not know how to divide a float -
     retry the operation by coercing to higher generality"

    ^ aFloat retry:#/ coercing:self
!

quotientFromFraction:aFraction
    "the receiver does not know how to divide a fraction -
     retry the operation by coercing to higher generality"

    ^ aFraction retry:#/ coercing:self
!

quotientFromInteger:anInteger
    "the receiver does not know how to divide an integer -
     retry the operation by coercing to higher generality"

    ^ anInteger retry:#/ coercing:self
!

sumFromFloat:aFloat
    "the receiver does not know how to add a float -
     retry the operation by coercing to higher generality"

    ^ aFloat retry:#+ coercing:self
!

sumFromFraction:aFraction
    "the receiver does not know how to add a fraction -
     retry the operation by coercing to higher generality"

    ^ aFraction retry:#+ coercing:self
!

sumFromInteger:anInteger
    "the receiver does not know how to add an integer -
     retry the operation by coercing to higher generality"

    ^ anInteger retry:#+ coercing:self
! !

!ArithmeticValue methodsFor:'misc math'!

exp
    "return e ^ receiver"

    ^ self asFloat exp
!

floorLog:radix
    "return the logarithm truncated as an integer"

    ^ (self log:radix) floor
!

ln
    "return the natural logarithm of the receiver"

    ^ self asFloat ln
!

log
    "return log base 10 of the receiver"

    ^ self log:10
!

log:aNumber
    "return log base aNumber of the receiver"

    ^ self ln / aNumber ln
!

raisedTo:aNumber
    "return the receiver raised to aNumber"

    aNumber = 0 ifTrue:[^ 1].
    aNumber = 1 ifTrue:[^ self].
    aNumber isInteger ifTrue:[
	^ self raisedToInteger:aNumber
    ].
    ^ self asFloat raisedTo:aNumber
!

raisedToInteger:anInteger
    "return the receiver raised to anInteger"

    |count result|

    result := self coerce:1.
    count := anInteger abs.
    count timesRepeat:[result := result * self].
    (anInteger < 0) ifTrue:[
	^ 1 / result
    ].
    ^ result
!

sqrt
    "return the square root of the receiver"

    ^ self asFloat sqrt
!

squared
    "return receiver * receiver"

    ^ self * self
! !

!ArithmeticValue methodsFor:'queries'!

respondsToArithmetic
    "return true, if the receiver responds to arithmetic messages"

    ^ true
! !

!ArithmeticValue methodsFor:'testing'!

denominator
    "return the denominator of the receiver"

    ^ 1
!

even
    "return true if the receiver is divisible by 2"

    ^ self truncated asInteger even
!

negative
    "return true, if the receiver is < 0"

    " this would lead to infinite recursion ...
    ^ (self < 0)
    "
    ^ self subclassResponsibility
!

numerator
    "return the numerator of the receiver."

    ^ self
!

odd
    "return true if the receiver is not divisible by 2"

    ^ self even not
!

positive
    "return true, if the receiver is >= 0"

    ^ self negative not
!

sign
    "return the sign of the receiver"

    (self < 0) ifTrue:[^ -1].
    (self > 0) ifTrue:[^ 1].
    ^ 0
!

strictlyPositive
    "return true, if the receiver is > 0"

    ^ (self > 0)
! !

!ArithmeticValue methodsFor:'trigonometric'!

arcCos
    "return the arccosine of the receiver (in radians)"

    ^ self asFloat arcCos
!

arcSin
    "return the arcsine of the receiver (in radians)"

    ^ self asFloat arcSin
!

arcTan
    "return the arctangens of the receiver (in radians)"

    ^ self asFloat arcTan
!

cos
    "return the cosine of the receiver (interpreted as radians)"

    ^ self asFloat cos
!

sin
    "return the sine of the receiver (interpreted as radians)"

    ^ self asFloat sin
!

tan
    "return the tangens of the receiver (interpreted as radians)"

    ^ self asFloat tan
! !

!ArithmeticValue methodsFor:'truncation & rounding'!

ceiling
    "return the integer nearest the receiver towards positive infinity."

    |anInteger|

    anInteger := self // 1.       "truncates towards negative infinity"
    anInteger = self ifTrue:[^ anInteger].
    ^ anInteger + 1
!

floor
    "return the receiver truncated towards negative infinity"

    ^ self // 1
!

roundTo:aNumber
    "return the receiver rounded to multiples of aNumber"

    ^ (self / aNumber) rounded * aNumber
!

rounded
    "return the integer nearest the receiver"

    ^ (self + 0.5) floor
!

truncateTo:aNumber
    "return the receiver truncated to multiples of aNumber"

    ^ ((self / aNumber) floor * aNumber) asInteger
!

truncated
    "return the receiver truncated towards zero"

    self negative ifTrue:[
	^ self ceiling
    ].
    ^ self floor
! !

!ArithmeticValue class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.18 1996-04-13 12:35:23 cg Exp $'
! !
ArithmeticValue initialize!