[Pkg] The Trunk: Kernel-nice.571.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Apr 23 00:40:29 UTC 2011
Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.571.mcz
==================== Summary ====================
Name: Kernel-nice.571
Author: nice
Time: 23 April 2011, 2:39:41.455 am
UUID: 2bd91b82-067a-49c9-a7a7-61771de27b3b
Ancestors: Kernel-nice.570
Connect the new DomainError
Correct (-1 copySignTo: 0.0) to return a negativeZero.
Add hyperbolic and inverse hyperbolic functions
Add plenty of Complex missing methods and few mathematical functions:
i (multiply by 1 i)
raisedTo:
conjugated
sqrt
squaredNorm
arcSin arcCos arcTan arcTan:
sinh cosh tanh arSinh arCosh arTanh
Speed up a few complex functions by using #real:imaginary: directly rather than intermediate arithmetic operations.
=============== Diff against Kernel-nice.570 ===============
Item was changed:
----- Method: Complex class>>abs:arg: (in category 'instance creation') -----
abs: aNumber1 arg: aNumber2
+ ^self
+ real: aNumber1 * aNumber2 cos
+ imaginary: aNumber1 * aNumber2 sin!
- | real imaginary |
- real := aNumber1 * aNumber2 cos.
- imaginary := aNumber1 * aNumber2 sin.
- ^ real + imaginary i!
Item was added:
+ ----- Method: Complex class>>one (in category 'instance creation') -----
+ one
+ ^ self real: 1 imaginary: 0!
Item was added:
+ ----- Method: Complex class>>zero (in category 'instance creation') -----
+ zero
+ ^ self real: 0 imaginary: 0!
Item was added:
+ ----- Method: Complex>>absSecure (in category 'arithmetic') -----
+ absSecure
+ "Answer the distance of the receiver from zero (0 + 0 i).
+ Try avoiding overflow and/or underflow"
+
+ | scale |
+ scale := real abs max: imaginary abs.
+ ^scale isZero
+ ifTrue: [scale]
+ ifFalse: [(self class real: real / scale imaginary: imaginary / scale) squaredNorm sqrt * scale]!
Item was added:
+ ----- Method: Complex>>arCosh (in category 'mathematical functions') -----
+ arCosh
+ "Answer receiver's area hyperbolic cosine.
+ That is the inverse function of cosh."
+
+ "Some possible implementation:
+
+ ^imaginary > 0
+ ifTrue: [(self + (self * self - 1) sqrt) ln]
+ ifFalse: [(self + (self * self - 1) sqrt) ln negated]"
+
+ ^self arcCos i negated!
Item was added:
+ ----- Method: Complex>>arSinh (in category 'mathematical functions') -----
+ arSinh
+ "Answer receiver's area hyperbolic sine.
+ That is the inverse function of sinh."
+
+ "Some possible implementation:
+
+ ^imaginary * real < 0
+ ifTrue: [(self + (self * self + 1) sqrt) ln]
+ ifFalse: [(self - (self * self + 1) sqrt) ln]"
+
+ ^self i arcSin i negated!
Item was added:
+ ----- Method: Complex>>arTanh (in category 'mathematical functions') -----
+ arTanh
+ "Answer receiver's area hyperbolic tangent.
+ That is the inverse function of tanh."
+
+ "Some other possible implementation:
+
+ ^((1 + self) / (1 - self)) ln / 2"
+
+ ^self i arcTan i negated!
Item was added:
+ ----- Method: Complex>>arcCos (in category 'mathematical functions') -----
+ arcCos
+ "Answer the arc cosine of the receiver.
+ This is the inverse function of cos."
+
+ | x y tmp sh2y shy delta ch2y chy |
+ imaginary = 0 ifTrue: [real abs > 1
+ ifTrue:
+ [x := real < 0
+ ifTrue: [Float pi]
+ ifFalse: [0].
+ y := real abs arCosh.
+ ^self class real: x imaginary: y]
+ ifFalse: [^self class real: real arcCos imaginary: 0]].
+ tmp := self squaredNorm - 1 / 2.
+ delta := tmp squared + imaginary squared.
+ sh2y := tmp + delta sqrt.
+ shy := sh2y sqrt.
+ ch2y := 1 + sh2y.
+ chy := ch2y sqrt.
+ y := imaginary copySignTo: shy arSinh.
+ x := (real / chy) arcCos.
+ ^self class real: x imaginary: y!
Item was added:
+ ----- Method: Complex>>arcSin (in category 'mathematical functions') -----
+ arcSin
+ "Answer the arc sine of the receiver.
+ This is the inverse function of sin."
+
+ | x y tmp delta sh2y shy ch2y chy |
+ imaginary = 0
+ ifTrue:
+ [real abs > 1
+ ifTrue:
+ [x := Float pi / 2 * real sign.
+ y := real abs arCosh * real sign.
+ ^self class real: x imaginary: y]
+ ifFalse: [^self class real arcSin imaginary: 0]].
+ tmp := (self squaredNorm - 1) / 2.
+ delta := tmp squared + imaginary squared.
+ sh2y := tmp + delta sqrt.
+ shy := sh2y sqrt.
+ ch2y := 1 + sh2y.
+ chy := ch2y sqrt.
+ y := imaginary copySignTo: shy arSinh.
+ x := (real / chy) arcSin.
+ ^self class real: x imaginary: y!
Item was added:
+ ----- Method: Complex>>arcTan (in category 'mathematical functions') -----
+ arcTan
+ "Answer the arc tangent of the receiver.
+ This is the inverse function of tan."
+
+ | r2 |
+ r2 := self squaredNorm.
+ ^self class
+ real: (real * 2 arcTan: 1 - r2) / 2
+ imaginary: ((r2 + (imaginary * 2) + 1) / (r2 - (imaginary * 2) + 1)) ln / 4!
Item was added:
+ ----- Method: Complex>>arcTan: (in category 'mathematical functions') -----
+ arcTan: denominator
+ "Answer the four quadrants arc tangent of receiver over denominator."
+
+ ^denominator isZero
+ ifTrue:
+ [self isZero
+ ifTrue:
+ ["shouldn't it be an error ? ^DomainError signal: '0 arcTan: 0'"
+ ^self class real: 0 imaginary: 0]
+ ifFalse:
+ [self class
+ real: Float pi / (real copySignTo: 2)
+ imaginary: 0]]
+ ifFalse:
+ [| res |
+ res := (self / denominator) arcTan.
+ denominator real < 0 ifTrue: [res := res + Float pi].
+ res real > Float pi
+ ifTrue: [res := res - (Float pi * 2)].
+ res]!
Item was changed:
----- Method: Complex>>arg (in category 'arithmetic') -----
arg
"Answer the argument of the receiver."
self isZero ifTrue: [self error: 'zero has no argument.'].
+ ^imaginary arcTan: real!
- 0 < real ifTrue: [^ (imaginary / real) arcTan].
- 0 = real ifTrue:
- [0 < imaginary
- ifTrue: [^ Float pi / 2]
- ifFalse: [^ (Float pi / 2) negated]].
- real < 0 ifTrue:
- [0 <= imaginary
- ifTrue: [^ (imaginary / real) arcTan + Float pi]
- ifFalse: [^ (imaginary / real) arcTan - Float pi]]!
Item was added:
+ ----- Method: Complex>>conjugated (in category 'arithmetic') -----
+ conjugated
+ "Return the complex conjugate of this complex number."
+
+ ^self class real: real imaginary: imaginary negated!
Item was changed:
----- Method: Complex>>cos (in category 'mathematical functions') -----
cos
"Answer receiver's cosine."
+ ^self i cosh!
- | iself |
- iself := 1 i * self.
- ^ (iself exp + iself negated exp) / 2!
Item was changed:
----- Method: Complex>>exp (in category 'mathematical functions') -----
exp
"Answer the exponential of the receiver."
+ ^ real exp * (imaginary cos + imaginary sin i)!
- ^ real exp * (imaginary cos + (1 i * imaginary sin))!
Item was added:
+ ----- Method: Complex>>i (in category 'arithmetic') -----
+ i
+ "Answer the result of multiplying the receiver with pure imaginary.
+ ^self * 1 i
+ This is an obvious extension of method i implemented in Number."
+
+ ^self class real: imaginary negated imaginary: real!
Item was changed:
----- Method: Complex>>isZero (in category 'testing') -----
isZero
+ ^ real isZero and: [imaginary isZero]!
- ^ self = 0!
Item was changed:
----- Method: Complex>>ln (in category 'mathematical functions') -----
ln
"Answer the natural log of the receiver."
+ ^ self abs ln + self arg i!
- ^ self abs ln + (1 i * self arg)!
Item was changed:
----- Method: Complex>>negated (in category 'arithmetic') -----
negated
"Answer a Number that is the negation of the receiver."
+ ^self class real: real negated imaginary: imaginary negated!
- ^0 - self!
Item was added:
+ ----- Method: Complex>>raisedTo: (in category 'mathematical functions') -----
+ raisedTo: aNumber
+ "Answer the receiver raised to aNumber."
+
+ aNumber isInteger ifTrue:
+ ["Do the special case of integer power"
+ ^ self raisedToInteger: aNumber].
+
+ 0 = aNumber ifTrue: [^ self class one]. "Special case of exponent=0"
+ 1 = aNumber ifTrue: [^ self]. "Special case of exponent=1"
+ 0 = self ifTrue: [ "Special case of self = 0"
+ aNumber < 0
+ ifTrue: [^ (ZeroDivide dividend: self) signal]
+ ifFalse: [^ self]].
+ ^ (aNumber * self ln) exp "Otherwise use logarithms"!
Item was added:
+ ----- Method: Complex>>raisedToInteger: (in category 'mathematical functions') -----
+ raisedToInteger: operand
+ "Answer the receiver raised to the power operand, an Integer."
+
+ "implementation note: this code is copied from Number.
+ This suggest that both Number and Complex should have an
+ ArithmeticValue common superclass like in Visualworks.
+ Or maybe should it be a Traits (a property of fields ?)"
+
+ | count result |
+ operand isInteger ifFalse: [^ ArithmeticError signal: 'parameter is not an Integer'].
+ operand = 0 ifTrue: [^ self class one].
+ operand = 1 ifTrue: [^ self].
+ operand < 0 ifTrue: [^ (self raisedToInteger: operand negated) reciprocal].
+ count := 1 bitShift: (operand-1) highBit.
+ result := self class one.
+ [count > 0]
+ whileTrue:
+ [result := result * result.
+ (operand bitAnd: count)
+ = 0 ifFalse: [result := result * self].
+ count := count bitShift: -1].
+ ^ result!
Item was changed:
----- Method: Complex>>sin (in category 'mathematical functions') -----
sin
"Answer receiver's sine."
+ ^self i sinh i negated!
- | iself |
- iself := 1 i * self.
- ^ (iself exp - iself negated exp) / 2 i!
Item was added:
+ ----- Method: Complex>>sqrt (in category 'mathematical functions') -----
+ sqrt
+ "Return the square root of the receiver with a positive imaginary part."
+
+ | u v |
+ (imaginary = 0 and: [real >= 0])
+ ifTrue: [^self class real: real sqrt imaginary: 0].
+ v := (self abs - real / 2) sqrt.
+ u := imaginary / 2 / v.
+ ^self class real: u imaginary: v!
Item was added:
+ ----- Method: Complex>>squaredNorm (in category 'arithmetic') -----
+ squaredNorm
+ "Answer the square of receiver norm."
+
+ ^real * real + (imaginary * imaginary)!
Item was added:
+ ----- Method: Complex>>tanh (in category 'mathematical functions') -----
+ tanh
+ "Answer receiver's hyperbolic tangent."
+
+ "Some possible implementation are:
+
+ ^self sinh / self cosh
+
+ | tr ti |
+ tr := real tanh.
+ ti := imaginary tan i.
+ ^(tr + ti) / (tr * ti + 1)"
+
+ ^self i tan i negated!
Item was added:
+ ----- Method: Float>>arCosh (in category 'mathematical functions') -----
+ arCosh
+ "Answer receiver's area hyperbolic cosine.
+ That is the inverse function of cosh."
+
+ self < 1
+ ifTrue:
+ [^DomainError signal: 'Receiver must be greater or equal to 1'].
+ ^self + 1 = self
+ ifTrue: [self abs ln + 2 ln]
+ ifFalse: [((self squared - 1) sqrt + self) ln]!
Item was added:
+ ----- Method: Float>>arSinh (in category 'mathematical functions') -----
+ arSinh
+ "Answer receiver's area hyperbolic sine.
+ That is the inverse function of sinh."
+
+ self = 0.0 ifTrue: [^self]. "Handle negativeZero"
+ ^self + 1 = self
+ ifTrue: [(self abs ln + 2 ln) * self sign]
+ ifFalse: [((self squared + 1) sqrt + self) ln]!
Item was added:
+ ----- Method: Float>>arTanh (in category 'mathematical functions') -----
+ arTanh
+ "Answer receiver's area hyperbolic tangent.
+ That is the inverse function of tanh."
+
+ self = 0.0 ifTrue: [^self]. "Handle negativeZero"
+ self abs >= 1
+ ifTrue:
+ [^DomainError signal: 'Receiver must be strictly between 1.0 and -1.0'].
+ ^((1 + self) / (1 - self)) ln / 2!
Item was changed:
----- Method: Float>>arcSin (in category 'mathematical functions') -----
arcSin
"Answer the angle in radians."
+ ((self < -1.0) or: [self > 1.0]) ifTrue: [DomainError signal: 'arcSin only takes values between -1 and 1'].
- ((self < -1.0) or: [self > 1.0]) ifTrue: [self error: 'Value out of range'].
((self = -1.0) or: [self = 1.0])
ifTrue: [^ Halfpi * self]
ifFalse: [^ (self / (1.0 - (self * self)) sqrt) arcTan]!
Item was changed:
----- Method: Float>>copySignTo: (in category 'mathematical functions') -----
copySignTo: aNumber
"Return a number with same magnitude as aNumber and same sign as self.
Implementation note: take care of Float negativeZero, which is considered as having a negative sign."
+ (self > 0.0 or: [(self at: 1) = 0]) ifTrue: [^ aNumber abs].
+ ^aNumber withNegativeSign!
- (self > 0 or: [(self at: 1) = 0]) ifTrue: [^ aNumber abs].
- ^aNumber abs negated!
Item was added:
+ ----- Method: Float>>cosh (in category 'mathematical functions') -----
+ cosh
+ "Answer receivers hyperbolic cosine."
+
+ | ex |
+ ex := self abs exp.
+ ^(ex + ex reciprocal) / 2!
Item was changed:
----- Method: Float>>ln (in category 'mathematical functions') -----
ln
"Answer the natural logarithm of the receiver.
Optional. See Object documentation whatIsAPrimitive."
| expt n mant x div pow delta sum eps |
<primitive: 58>
"Taylor series"
+ self <= 0.0 ifTrue: [DomainError signal: 'ln is only defined for x > 0.0'].
- self <= 0.0 ifTrue: [self error: 'ln is only defined for x > 0.0'].
"get a rough estimate from binary exponent"
expt := self exponent.
n := Ln2 * expt.
mant := self timesTwoPower: 0 - expt.
"compute fine correction from mantinssa in Taylor series"
"mant is in the range [0..2]"
"we unroll the loop to avoid use of abs"
x := mant - 1.0.
div := 1.0.
pow := delta := sum := x.
x := x negated. "x <= 0"
eps := Epsilon * (n abs + 1.0).
[delta > eps] whileTrue: [
"pass one: delta is positive"
div := div + 1.0.
pow := pow * x.
delta := pow / div.
sum := sum + delta.
"pass two: delta is negative"
div := div + 1.0.
pow := pow * x.
delta := pow / div.
sum := sum + delta].
^ n + sum
"2.718284 ln 1.0"!
Item was added:
+ ----- Method: Float>>sinh (in category 'mathematical functions') -----
+ sinh
+ "Answer receivers hyperbolic sine"
+
+ | ex |
+ ex := self abs exp.
+ ^self copySignTo: (ex - ex reciprocal) / 2!
Item was changed:
----- Method: Float>>sqrt (in category 'mathematical functions') -----
sqrt
"Answer the square root of the receiver.
Optional. See Object documentation whatIsAPrimitive."
| exp guess eps delta |
<primitive: 55>
#Numeric.
"Changed 200/01/19 For ANSI <number> support."
"Newton-Raphson"
self <= 0.0
ifTrue: [self = 0.0
ifTrue: [^ 0.0]
ifFalse: ["v Chg"
+ ^ DomainError signal: 'sqrt undefined for number less than zero.']].
- ^ FloatingPointException signal: 'undefined if less than zero.']].
"first guess is half the exponent"
exp := self exponent // 2.
guess := self timesTwoPower: 0 - exp.
"get eps value"
eps := guess * Epsilon.
eps := eps * eps.
delta := self - (guess * guess) / (guess * 2.0).
[delta * delta > eps]
whileTrue:
[guess := guess + delta.
delta := self - (guess * guess) / (guess * 2.0)].
^ guess!
Item was added:
+ ----- Method: Float>>tanh (in category 'mathematical functions') -----
+ tanh
+ "Answer hyperbolic tangent of receiver.
+ Trivial implementation is:
+ ^self sinh/self cosh
+ This implementation takes care not to overflow."
+
+ | ex emx |
+ self = 0.0 ifTrue: [^self]. "Handle negativeZero"
+ self > 20.0 ifTrue: [^1.0].
+ self < -20.0 ifTrue: [^-1.0].
+ ex := self exp.
+ emx := ex reciprocal.
+ ^(ex - emx) / (ex + emx)!
Item was added:
+ ----- Method: Float>>withNegativeSign (in category 'converting') -----
+ withNegativeSign
+ "Same as super, but handle the subtle case of Float negativeZero"
+
+ self = 0.0 ifTrue: [^self class negativeZero].
+ ^super withNegativeSign!
Item was changed:
----- Method: Fraction>>ln (in category 'mathematical functions') -----
ln
"This function is defined because super ln might overflow.
Note that < 1 is tested before converting to float in order to avoid precision loss due to gradual underflow."
| res int |
self < 1 ifTrue: [^self reciprocal ln negated].
+ self <= 0 ifTrue: [DomainError signal: 'ln is only defined for x > 0'].
- self <= 0 ifTrue: [self error: 'ln is only defined for x > 0'].
res := super ln.
res isFinite ifTrue: [^res].
int := self integerPart.
^int ln + (self / int) ln!
Item was changed:
----- Method: Fraction>>log (in category 'mathematical functions') -----
log
"This function is defined because super log might overflow.
Note that < 1 is tested before converting to float in order to avoid precision loss due to gradual underflow."
| res int |
self < 1 ifTrue: [^self reciprocal log negated].
+ self <= 0 ifTrue: [DomainError signal: 'log is only defined for x > 0'].
- self <= 0 ifTrue: [self error: 'log is only defined for x > 0'].
res := super log.
res isFinite ifTrue: [^res].
int := self integerPart.
^int log + (self / int) log!
Item was changed:
----- Method: Integer>>ln (in category 'mathematical functions') -----
ln
"This function is defined because super ln might overflow."
| res h |
+ self <= 0 ifTrue: [DomainError signal: 'ln is only defined for x > 0'].
- self <= 0 ifTrue: [self error: 'ln is only defined for x > 0'].
res := super ln.
res isFinite ifTrue: [^res].
h := self highBit.
^2 ln * h + (self / (1 << h)) asFloat ln!
Item was changed:
----- Method: Integer>>log (in category 'mathematical functions') -----
log
"This function is defined because super log might overflow."
| res h |
+ self <= 0 ifTrue: [DomainError signal: 'log is only defined for x > 0'].
- self <= 0 ifTrue: [self error: 'log is only defined for x > 0'].
res := super log.
res isFinite ifTrue: [^res].
h := self highBit.
^2 log * h + (self / (1 << h)) asFloat log!
Item was added:
+ ----- Method: Number>>arCosh (in category 'mathematical functions') -----
+ arCosh
+ "Answer receiver's area hyperbolic cosine.
+ That is the inverse function of cosh."
+
+ ^self asFloat arCosh!
Item was added:
+ ----- Method: Number>>arSinh (in category 'mathematical functions') -----
+ arSinh
+ "Answer receiver's area hyperbolic sine.
+ That is the inverse function of sinh."
+
+ ^self asFloat arSinh!
Item was added:
+ ----- Method: Number>>arTanh (in category 'mathematical functions') -----
+ arTanh
+ "Answer receiver's area hyperbolic tangent.
+ That is the inverse function of tanh."
+
+ ^self asFloat arTanh!
Item was changed:
----- Method: Number>>copySignTo: (in category 'mathematical functions') -----
copySignTo: aNumber
"Return a number with same magnitude as aNumber and same sign as self."
^ self positive
ifTrue: [aNumber abs]
+ ifFalse: [aNumber withNegativeSign].!
- ifFalse: [aNumber abs negated].!
Item was added:
+ ----- Method: Number>>cosh (in category 'mathematical functions') -----
+ cosh
+ "Answer receivers hyperbolic cosine."
+
+ ^self asFloat cosh!
Item was added:
+ ----- Method: Number>>sinh (in category 'mathematical functions') -----
+ sinh
+ "Answer receivers hyperbolic sine"
+
+ ^self asFloat sinh!
Item was added:
+ ----- Method: Number>>tanh (in category 'mathematical functions') -----
+ tanh
+ "Answer receivers hyperbolic tangent"
+
+ ^self asFloat tanh!
Item was added:
+ ----- Method: Number>>withNegativeSign (in category 'converting') -----
+ withNegativeSign
+ "Answer a number with same magnitude than receiver and negative sign."
+ ^self abs negated!
More information about the Packages
mailing list