[squeak-dev] 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 Squeak-dev mailing list