ArithVal.st
changeset 1 a27a279701f8
child 3 24d81bf47225
equal deleted inserted replaced
0:aa2498ef6470 1:a27a279701f8
       
     1 "
       
     2  COPYRIGHT (c) 1993 by Claus Gittinger
       
     3               All Rights Reserved
       
     4 
       
     5  This software is furnished under a license and may be used
       
     6  only in accordance with the terms of that license and with the
       
     7  inclusion of the above copyright notice.   This software may not
       
     8  be provided or otherwise made available to, or used by, any
       
     9  other person.  No title to or ownership of the software is
       
    10  hereby transferred.
       
    11 "
       
    12 
       
    13 Magnitude subclass:#ArithmeticValue
       
    14        instanceVariableNames:''
       
    15        classVariableNames:'DivisionByZeroSignal DomainErrorSignal
       
    16                            OverflowSignal UnderflowSignal
       
    17 			   AnyArithmeticSignal'
       
    18        poolDictionaries:''
       
    19        category:'Magnitude-Numbers'
       
    20 !
       
    21 
       
    22 ArithmeticValue comment:'
       
    23 
       
    24 COPYRIGHT (c) 1993 by Claus Gittinger
       
    25               All Rights Reserved
       
    26 
       
    27 ArithmeticValue is an abstract superclass for all things responding to
       
    28 arithmetic messages. It was inserted into the hierarchy, to allow things
       
    29 like matrices, functions etc. share the arithmetic methods defined here.
       
    30 
       
    31 (In the old hierarchy these had to be Numbers to do that 
       
    32  - which is not quite correct)
       
    33 
       
    34 %W% %E%
       
    35 '!
       
    36 
       
    37 !ArithmeticValue class methodsFor:'initialization' !
       
    38 
       
    39 initialize
       
    40     "setup the signals"
       
    41 
       
    42     DomainErrorSignal := (Signal new) mayProceed:false.
       
    43     DomainErrorSignal notifierString:'domain error'.
       
    44 
       
    45     DivisionByZeroSignal := (Signal new) mayProceed:false.
       
    46     DivisionByZeroSignal notifierString:'division by zero'.
       
    47 
       
    48     OverflowSignal := (Signal new) mayProceed:false.
       
    49     OverflowSignal notifierString:'overflow'.
       
    50 
       
    51     UnderflowSignal := (Signal new) mayProceed:false.
       
    52     UnderflowSignal notifierString:'underflow'.
       
    53 
       
    54     AnyArithmeticSignal := SignalSet with:DomainErrorSignal
       
    55 				     with:DivisionByZeroSignal
       
    56 				     with:OverflowSignal
       
    57 				     with:UnderflowSignal.
       
    58 ! !
       
    59 
       
    60 !ArithmeticValue class methodsFor:'signal access' !
       
    61 
       
    62 domainErrorSignal
       
    63     "return the signal which is raised on math errors
       
    64      (such as log of 0 etc.)"
       
    65 
       
    66     ^ DomainErrorSignal
       
    67 !
       
    68 
       
    69 divisionByZeroSignal
       
    70     "return the signal which is raised on division by zero"
       
    71 
       
    72     ^ DivisionByZeroSignal
       
    73 !
       
    74 
       
    75 overflowSignal
       
    76     "return the signal which is raised on overflow conditions (in floats)"
       
    77 
       
    78     ^ OverflowSignal
       
    79 !
       
    80 
       
    81 underflowSignal
       
    82     "return the signal which is raised on underflow conditions (in floats)"
       
    83 
       
    84     ^ UnderflowSignal
       
    85 !
       
    86 
       
    87 anyArithmeticSignal
       
    88     "return a signalSet with all possible arithmetic signals"
       
    89 
       
    90     ^ AnyArithmeticSignal
       
    91 ! !
       
    92 
       
    93 !ArithmeticValue methodsFor:'converting' !
       
    94 
       
    95 degreesToRadians
       
    96     "interpreting the receiver as radians, return the degrees"
       
    97 
       
    98     ^ self asFloat degreesToRadians
       
    99 !
       
   100 
       
   101 radiansToDegrees
       
   102     "interpreting the receiver as degrees, return the radians"
       
   103 
       
   104     ^ self asFloat radiansToDegrees
       
   105 !
       
   106 
       
   107 asInteger
       
   108     "return an integer with same value - might truncate"
       
   109 
       
   110     ^ self truncated
       
   111 !
       
   112 
       
   113 asFloat
       
   114     "return a float with same value"
       
   115 
       
   116    ^ self subclassResponsibility
       
   117 !
       
   118 
       
   119 asFraction
       
   120     "return a fraction with same value"
       
   121 
       
   122    ^ self subclassResponsibility
       
   123 !
       
   124 
       
   125 coerce:aNumber
       
   126     "convert aNumber into an instance of the receivers class and return it."
       
   127 
       
   128     ^ self subclassResponsibility
       
   129 !
       
   130 
       
   131 generality
       
   132     "return a number giving the receivers generality, that number is
       
   133      used to convert one of the arguments in a mixed expression. 
       
   134      The generality has to be defined in subclasses,
       
   135      such that gen(a) > gen(b) iff, conversion of b into a's class 
       
   136      does not cut precision. For example, Integer has 40, Float has 80,
       
   137      meaning that if we convert a Float to an Integer, some precision may
       
   138      be lost. The generality is used by ArithmeticValue>>retry:cuercing:"
       
   139       
       
   140     ^ self subclassResponsibility
       
   141 !
       
   142 
       
   143 retry:aSymbol coercing:aNumber
       
   144     "arithmetic represented by the binary operator, aSymbol,
       
   145     could not be performed with the receiver and the argument, aNumber, 
       
   146     because of the differences in representation.  
       
   147     Coerce either the receiver or the argument, depending on which has higher 
       
   148     generality, and try again.  
       
   149     If the operation is compare for same value (=), return false if
       
   150     the argument is not a Number. 
       
   151     If the generalities are the same, create an error message, since this
       
   152     means that a subclass has not been fully implemented."
       
   153 
       
   154     |myGenerality otherGenerality|
       
   155 
       
   156     (aSymbol == #=) ifTrue:[
       
   157         (aNumber respondsTo:#generality) ifFalse:[^ false]
       
   158     ] ifFalse:[
       
   159         (aNumber respondsTo:#generality) ifFalse:[
       
   160             self error:'retry:coercing: argument is not a number'.
       
   161             ^ self
       
   162         ]
       
   163     ].
       
   164     myGenerality := self generality.
       
   165     otherGenerality := aNumber generality.
       
   166     (myGenerality > otherGenerality) ifTrue:[
       
   167         ^ self perform:aSymbol with:(self coerce:aNumber)
       
   168     ].
       
   169     (myGenerality < otherGenerality) ifTrue:[
       
   170         ^ (aNumber coerce:self) perform:aSymbol with:aNumber
       
   171     ].
       
   172     self error:'retry:coercing: oops - same generality'
       
   173 ! !
       
   174 
       
   175 !ArithmeticValue methodsFor:'queries' !
       
   176 
       
   177 respondsToArithmetic
       
   178     "return true, if the receiver responds to arithmetic messages"
       
   179 
       
   180     ^ true
       
   181 ! !
       
   182 
       
   183 !ArithmeticValue methodsFor:'arithmetic' !
       
   184 
       
   185 + something
       
   186     "return the sum of the receiver and the argument"
       
   187 
       
   188     ^ self subclassResponsibility
       
   189 !
       
   190 
       
   191 - something
       
   192     "return the difference of the receiver and the argument"
       
   193 
       
   194     ^ self subclassResponsibility
       
   195 !
       
   196 
       
   197 * something
       
   198     "return the product of the receiver and the argument"
       
   199 
       
   200     ^ self subclassResponsibility
       
   201 !
       
   202 
       
   203 / something
       
   204     "return the quotient of the receiver and the argument"
       
   205 
       
   206     ^ self subclassResponsibility
       
   207 !
       
   208 
       
   209 // something
       
   210     "return the integer quotient of the receiver and the argument"
       
   211 
       
   212     ^ (self / something) floor
       
   213 !
       
   214 
       
   215 \\ something
       
   216     "return the integer modulu of the receiver and the argument"
       
   217 
       
   218     ^ self - ((self // something) * something)
       
   219 !
       
   220 
       
   221 quo:something
       
   222     "Return the integer quotient of dividing the receiver by the argument
       
   223      with truncation towards zero."
       
   224 
       
   225     ^ (self / something) truncated
       
   226 !
       
   227 
       
   228 rem:something
       
   229     "Return the integer remainder of dividing the receiver by the argument
       
   230      with truncation towards zero.
       
   231      The remainder has the same sign as the receiver."
       
   232 
       
   233     ^ self - ((self quo:something) * something)
       
   234 !
       
   235 
       
   236 abs
       
   237     "return the absolute value of the receiver"
       
   238 
       
   239     (self negative) ifTrue:[^ self negated].
       
   240     ^ self
       
   241 !
       
   242 
       
   243 negated
       
   244     "return the receiver negated"
       
   245 
       
   246     ^ self class zero - self
       
   247 !
       
   248 
       
   249 reciprocal
       
   250     "return the receivers reciprocal"
       
   251 
       
   252     ^ self class unity / self
       
   253 ! !
       
   254 
       
   255 !ArithmeticValue methodsFor:'comparing'!
       
   256 
       
   257 >= something
       
   258     "return true, if the argument is less or equal than the receiver"
       
   259 
       
   260     ^ (self < something) not
       
   261 !
       
   262 
       
   263 > something
       
   264     "return true, if the argument is less than the receiver"
       
   265 
       
   266     ^ something < self
       
   267 !
       
   268 
       
   269 <= something
       
   270     "return true, if the argument is greater or equal than the receiver"
       
   271 
       
   272     ^ (something < self) not
       
   273 !
       
   274 
       
   275 < something
       
   276     "return true, if the argument is greater than the receiver"
       
   277 
       
   278     ^ self subclassResponsibility
       
   279 !
       
   280 
       
   281 compare:arg ifLess:lessBlock ifEqual:equalBlock ifGreater:greaterBlock
       
   282     "three-way compare - thanks to Self for this idea.
       
   283      Can be redefined in subclasses to do it with a single comparison if
       
   284      comparison is expensive."
       
   285 
       
   286     self < arg ifTrue:[
       
   287         ^ lessBlock value
       
   288     ].
       
   289     self = arg ifTrue:[
       
   290         ^ equalBlock value
       
   291     ].
       
   292     ^ greaterBlock value
       
   293 ! !
       
   294 
       
   295 !ArithmeticValue methodsFor:'truncation and rounding'!
       
   296 
       
   297 ceiling
       
   298     "return the integer nearest the receiver towards positive infinity."
       
   299 
       
   300     |anInteger|
       
   301 
       
   302     anInteger := self // 1.       "truncates towards negative infinity"
       
   303     anInteger = self ifTrue:[^ anInteger].
       
   304     ^ anInteger + 1
       
   305 !
       
   306 
       
   307 floor
       
   308     "return the receiver truncated towards negative infinity"
       
   309 
       
   310     ^ self // 1
       
   311 !
       
   312 
       
   313 truncated
       
   314     "return the receiver truncated towards zero"
       
   315 
       
   316     ^ self floor asInteger
       
   317 !
       
   318 
       
   319 truncateTo:aNumber
       
   320     "return the receiver truncated to multiples of aNumber"
       
   321 
       
   322     ^ ((self / aNumber) floor * aNumber) asInteger
       
   323 !
       
   324 
       
   325 rounded
       
   326     "return the integer nearest the receiver"
       
   327 
       
   328     ^ (self + 0.5) floor asInteger
       
   329 !
       
   330 
       
   331 roundTo:aNumber
       
   332     "return the receiver rounded to multiples of aNumber"
       
   333 
       
   334     ^ (self / aNumber) rounded * aNumber
       
   335 ! !
       
   336 
       
   337 !ArithmeticValue methodsFor:'double dispatching'!
       
   338 
       
   339 sumFromInteger:anInteger
       
   340     "the receiver does not know how to add an integer -
       
   341      retry the operation by coercing to higher generality"
       
   342 
       
   343     ^ anInteger retry:#+ coercing:self
       
   344 !
       
   345 
       
   346 sumFromFloat:aFloat
       
   347     "the receiver does not know how to add a float -
       
   348      retry the operation by coercing to higher generality"
       
   349 
       
   350     ^ aFloat retry:#+ coercing:self
       
   351 !
       
   352 
       
   353 sumFromFraction:aFraction
       
   354     "the receiver does not know how to add a fraction -
       
   355      retry the operation by coercing to higher generality"
       
   356 
       
   357     ^ aFraction retry:#+ coercing:self
       
   358 !
       
   359 
       
   360 differenceFromInteger:anInteger
       
   361     "the receiver does not know how to subtract from an integer -
       
   362      retry the operation by coercing to higher generality"
       
   363 
       
   364     ^ anInteger retry:#- coercing:self
       
   365 !
       
   366 
       
   367 differenceFromFloat:aFloat
       
   368     "the receiver does not know how to subtract from a float -
       
   369      retry the operation by coercing to higher generality"
       
   370 
       
   371     ^ aFloat retry:#- coercing:self
       
   372 !
       
   373 
       
   374 differenceFromFraction:aFraction
       
   375     "the receiver does not know how to subtract from a fraction -
       
   376      retry the operation by coercing to higher generality"
       
   377 
       
   378     ^ aFraction retry:#- coercing:self
       
   379 !
       
   380 
       
   381 productFromInteger:anInteger
       
   382     "the receiver does not know how to multiply an integer -
       
   383      retry the operation by coercing to higher generality"
       
   384 
       
   385     ^ anInteger retry:#* coercing:self
       
   386 !
       
   387 
       
   388 productFromFloat:aFloat
       
   389     "the receiver does not know how to multiply a float -
       
   390      retry the operation by coercing to higher generality"
       
   391 
       
   392     ^ aFloat retry:#* coercing:self
       
   393 !
       
   394 
       
   395 productFromFraction:aFraction
       
   396     "the receiver does not know how to multiply a fraction -
       
   397      retry the operation by coercing to higher generality"
       
   398 
       
   399     ^ aFraction retry:#* coercing:self
       
   400 !
       
   401 
       
   402 quotientFromInteger:anInteger
       
   403     "the receiver does not know how to divide an integer -
       
   404      retry the operation by coercing to higher generality"
       
   405 
       
   406     ^ anInteger retry:#/ coercing:self
       
   407 !
       
   408 
       
   409 quotientFromFloat:aFloat
       
   410     "the receiver does not know how to divide a float -
       
   411      retry the operation by coercing to higher generality"
       
   412 
       
   413     ^ aFloat retry:#/ coercing:self
       
   414 !
       
   415 
       
   416 quotientFromFraction:aFraction
       
   417     "the receiver does not know how to divide a fraction -
       
   418      retry the operation by coercing to higher generality"
       
   419 
       
   420     ^ aFraction retry:#/ coercing:self
       
   421 !
       
   422 
       
   423 lessFromInteger:anInteger
       
   424     "the receiver does not know how to compare to an integer -
       
   425      retry the operation by coercing to higher generality"
       
   426 
       
   427     ^ anInteger retry:#< coercing:self
       
   428 !
       
   429 
       
   430 lessFromFloat:aFloat
       
   431     "the receiver does not know how to compare to a float -
       
   432      retry the operation by coercing to higher generality"
       
   433 
       
   434     ^ aFloat retry:#< coercing:self
       
   435 !
       
   436 
       
   437 lessFromFraction:aFraction
       
   438     "the receiver does not know how to compare to a fraction -
       
   439      retry the operation by coercing to higher generality"
       
   440 
       
   441     ^ aFraction retry:#< coercing:self
       
   442 ! !
       
   443 
       
   444 !ArithmeticValue methodsFor:'misc math'!
       
   445 
       
   446 squared
       
   447     "return receiver * receiver"
       
   448 
       
   449     ^ self * self
       
   450 !
       
   451 
       
   452 exp
       
   453     "return e ^ receiver"
       
   454 
       
   455     ^ self asFloat exp
       
   456 !
       
   457 
       
   458 ln
       
   459     "return the natural logarithm of the receiver"
       
   460 
       
   461     ^ self asFloat ln
       
   462 !
       
   463 
       
   464 log
       
   465     "return log base 10 of the receiver"
       
   466 
       
   467     ^ self log:10
       
   468 !
       
   469 
       
   470 log:aNumber
       
   471     "return log base aNumber of the receiver"
       
   472 
       
   473     ^ self ln / aNumber ln
       
   474 !
       
   475 
       
   476 sqrt
       
   477     "return the square root of the receiver"
       
   478 
       
   479     ^ self asFloat sqrt
       
   480 !
       
   481 
       
   482 floorLog:radix
       
   483     "return the logarithm truncated as an integer"
       
   484 
       
   485     ^ (self log:radix) floor
       
   486 !
       
   487 
       
   488 raisedTo:aNumber
       
   489     "return the receiver raised to aNumber"
       
   490 
       
   491     aNumber = 0 ifTrue:[^ 1].
       
   492     aNumber = 1 ifTrue:[^ self].
       
   493     aNumber isInteger ifTrue:[
       
   494         ^ self raisedToInteger:aNumber
       
   495     ].
       
   496     ^ self asFloat raisedTo:aNumber
       
   497 !
       
   498 
       
   499 raisedToInteger:anInteger
       
   500     "return the receiver raised to anInteger"
       
   501 
       
   502     |count result|
       
   503 
       
   504     result := self coerce:1.
       
   505     count := anInteger abs.
       
   506     count timesRepeat:[result := result * self].
       
   507     (anInteger < 0) ifTrue:[
       
   508         ^ 1 / result
       
   509     ].
       
   510     ^ result
       
   511 ! !
       
   512 
       
   513 !ArithmeticValue methodsFor:'trigonometric'!
       
   514 
       
   515 sin
       
   516     "return the sine of the receiver (interpreted as radians)"
       
   517 
       
   518     ^ self asFloat sin
       
   519 !
       
   520 
       
   521 cos
       
   522     "return the cosine of the receiver (interpreted as radians)"
       
   523 
       
   524     ^ self asFloat cos
       
   525 !
       
   526 
       
   527 tan
       
   528     "return the tangens of the receiver (interpreted as radians)"
       
   529 
       
   530     ^ self asFloat tan
       
   531 !
       
   532 
       
   533 arcCos
       
   534     "return the arccosine of the receiver (in radians)"
       
   535 
       
   536     ^ self asFloat arcCos
       
   537 !
       
   538 
       
   539 arcSin
       
   540     "return the arcsine of the receiver (in radians)"
       
   541 
       
   542     ^ self asFloat arcSin
       
   543 !
       
   544 
       
   545 arcTan
       
   546     "return the arctangens of the receiver (in radians)"
       
   547 
       
   548     ^ self asFloat arcTan
       
   549 ! !
       
   550 
       
   551 !ArithmeticValue methodsFor:'error handling'!
       
   552 
       
   553 divideByZeroError
       
   554     "report a division by zero error"
       
   555 
       
   556     DivisionByZeroSignal raise
       
   557     "self error:'division by zero'"
       
   558 ! !
       
   559 
       
   560 !ArithmeticValue methodsFor:'testing'!
       
   561 
       
   562 negative
       
   563     "return true, if the receiver is < 0"
       
   564 
       
   565     " this would lead to infinite recursion ...
       
   566     ^ (self < 0)
       
   567     "
       
   568     ^ self subclassResponsibility
       
   569 !
       
   570 
       
   571 positive
       
   572     "return true, if the receiver is >= 0"
       
   573 
       
   574     ^ self negative not
       
   575 !
       
   576 
       
   577 strictlyPositive
       
   578     "return true, if the receiver is > 0"
       
   579 
       
   580     ^ (self > 0)
       
   581 !
       
   582 
       
   583 sign
       
   584     "return the sign of the receiver"
       
   585 
       
   586     (self < 0) ifTrue:[^ -1].
       
   587     (self > 0) ifTrue:[^ 1].
       
   588     ^ 0
       
   589 !
       
   590 
       
   591 even
       
   592     "return true if the receiver is divisible by 2"
       
   593 
       
   594     ^ self truncated asInteger even
       
   595 !
       
   596 
       
   597 odd
       
   598     "return true if the receiver is not divisible by 2"
       
   599 
       
   600     ^ self even not
       
   601 !
       
   602 
       
   603 denominator
       
   604     "return the denominator of the receiver"
       
   605 
       
   606     ^ 1
       
   607 !
       
   608 
       
   609 numerator
       
   610     "return the numerator of the receiver."
       
   611 
       
   612     ^ self
       
   613 ! !