Object subclass: #DhbCongruentialRandomNumberGenerator instanceVariableNames: 'constant modulus multiplicator seed ' classVariableNames: 'UniqueInstance ' poolDictionaries: ''! Object subclass: #DhbHistogram instanceVariableNames: 'minimum binWidth overflow underflow moments contents freeExtent cacheSize desiredNumberOfBins ' classVariableNames: '' poolDictionaries: ''! Object subclass: #DhbMitchellMooreGenerator instanceVariableNames: 'randoms lowIndex highIndex ' classVariableNames: 'UniqueInstance ' poolDictionaries: ''! Object subclass: #DhbProbabilityDensity instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbAsymptoticChiSquareDistribution instanceVariableNames: 'degreeOfFreedom reducedDOF normalDistribution ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbBetaDistribution instanceVariableNames: 'alpha1 alpha2 gamma1 gamma2 logNorm incompleteBetaFunction ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbCauchyDistribution instanceVariableNames: 'mu beta ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbExponentialDistribution instanceVariableNames: 'beta ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbFisherSnedecorDistribution instanceVariableNames: 'dof1 dof2 norm chiSquareDistribution1 chiSquareDistribution2 incompleteBetaFunction ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbFisherTippettDistribution instanceVariableNames: 'alpha beta ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbGammaDistribution instanceVariableNames: 'alpha beta norm randomCoefficients incompleteGammaFunction ' classVariableNames: '' poolDictionaries: ''! DhbGammaDistribution subclass: #DhbChiSquareDistribution instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbHistogrammedDistribution instanceVariableNames: 'histogram ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbLaplaceDistribution instanceVariableNames: 'mu beta ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbNormalDistribution instanceVariableNames: 'mu sigma nextRandom ' classVariableNames: 'NextRandom ' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbProbabilityDensityWithUnknownDistribution instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensityWithUnknownDistribution subclass: #DhbLogNormalDistribution instanceVariableNames: 'normalDistribution ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbStudentDistribution instanceVariableNames: 'degreeOfFreedom norm chiSquareDistribution incompleteBetaFunction ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbTriangularDistribution instanceVariableNames: 'lowLimit highLimit peak ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbUniformDistribution instanceVariableNames: 'lowLimit highLimit ' classVariableNames: '' poolDictionaries: ''! DhbProbabilityDensity subclass: #DhbWeibullDistribution instanceVariableNames: 'alpha beta norm ' classVariableNames: '' poolDictionaries: ''! Object subclass: #DhbProbabilityDistributionFunction instanceVariableNames: 'probabilityDensity ' classVariableNames: '' poolDictionaries: ''! Object subclass: #DhbScaledProbabilityDensityFunction instanceVariableNames: 'probabilityDensityFunction count binWidth ' classVariableNames: '' poolDictionaries: ''! Object subclass: #DhbStatisticalMoments instanceVariableNames: 'moments ' classVariableNames: '' poolDictionaries: ''! DhbStatisticalMoments subclass: #DhbFastStatisticalMoments instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''! DhbStatisticalMoments subclass: #DhbFixedStatisticalMoments instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''! SubApplication subclass: #DhbStatistics instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''! !DhbAsymptoticChiSquareDistribution class publicMethods ! degreeOfFreedom: anInteger "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " ^super new initialize: anInteger! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " ^'Chi square distribution'! new "Prevent using this message to create instances (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " ^self error: 'Illegal creation message for this class'! ! !DhbAsymptoticChiSquareDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^degreeOfFreedom! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " normalDistribution changeParametersBy: aVector.! confidenceLevel: aNumber "Answer the probability in percent of finding a chi square value distributed according to the receiver larger than aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/3/99 " ^( 1 - ( self distributionValue: aNumber)) *100! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " | x | ^aNumber > 0 ifTrue: [ x := (aNumber * 2) sqrt. ( DhbErfApproximation new value: (x - reducedDOF)) ] ifFalse:[ 0]! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " ^12 / degreeOfFreedom! parameters "Returns an Array containing the parameters of the distribution. It is used to print out the distribution and for fitting. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: degreeOfFreedom! random "Answer a random number distributed accroding to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( DhbNormalDistribution random + reducedDOF) squared / 2! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " ^( 2 / degreeOfFreedom) sqrt * 2! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " | x | ^aNumber > 0 ifTrue: [ x := (aNumber * 2) sqrt. ( DhbErfApproximation new normal: (x - reducedDOF)) / x ] ifFalse:[ 0]! variance "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^degreeOfFreedom * 2! ! !DhbAsymptoticChiSquareDistribution privateMethods ! initialize: anInteger "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " degreeOfFreedom := anInteger. reducedDOF := ( degreeOfFreedom * 2 - 1) sqrt. ^self! ! !DhbBetaDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Beta distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | average variance a b c discr | ( aHistogram minimum < 0 or: [ aHistogram maximum > 1]) ifTrue: [ ^nil]. average := aHistogram average. variance := aHistogram variance. a := ( ( 1 - average) / variance - 1) * average. a > 0 ifFalse:[ ^nil]. b := ( 1 / average - 1) * a. b > 0 ifFalse:[ ^nil]. ^self shape: a shape: b! new "Prevent using this message to create instances (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self error: 'Illegal creation message for this class'! shape: aNumber1 shape: aNumber2 "Create an instance of the receiver with given shape parameters. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 shape: aNumber2! ! !DhbBetaDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^alpha1 / ( alpha1 + alpha2)! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " alpha1 := alpha1 + ( aVector at: 1). alpha2 := alpha2 + ( aVector at: 2). self computeNorm. gamma1 := nil. gamma2 := nil. incompleteBetaFunction := nil.! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " incompleteBetaFunction isNil ifTrue: [ incompleteBetaFunction := DhbIncompleteBetaFunction shape: alpha1 shape: alpha2]. ^incompleteBetaFunction value: aNumber! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^3 * ( alpha1 + alpha2 + 1) * ( (alpha1 + alpha2) squared * 2 + ( ( alpha1 + alpha2 - 6) * alpha1 * alpha2) / ( ( alpha1 + alpha2 + 2) * ( alpha1 + alpha2 + 3) * alpha1 * alpha2)) - 3! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: alpha1 with: alpha2! random "Answer a random number distributed accroding to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | r | r := self firstGammaDistribution random. ^r / ( self secondGammaDistribution random + r)! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^( alpha1 + alpha2 + 1) sqrt * 2 * ( alpha2 - alpha1) / ( ( alpha1 * alpha2) sqrt * ( alpha1 + alpha2 + 2))! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^(aNumber > 0 and: [ aNumber < 1]) ifTrue: [( ( aNumber ln * (alpha1 - 1) ) + ( ( 1 - aNumber) ln * ( alpha2 - 1)) + logNorm) exp] ifFalse: [0]! variance "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^alpha1 * alpha2 / ( ( alpha1 + alpha2) squared * ( alpha1 + alpha2 + 1))! ! !DhbBetaDistribution privateMethods ! computeNorm "Private - Compute the norm of the receiver because its parameters have changed. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " logNorm := (alpha1 + alpha2) logGamma - alpha1 logGamma - alpha2 logGamma.! firstGammaDistribution "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " gamma1 isNil ifTrue: [ gamma1 := DhbGammaDistribution shape: alpha1 scale: 1]. ^gamma1! initialize: aNumber1 shape: aNumber2 "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " (aNumber1 > 0 and: [aNumber2 > 0]) ifFalse: [self error: 'Illegal distribution parameters']. alpha1 := aNumber1. alpha2 := aNumber2. self computeNorm. ^self! secondGammaDistribution "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " gamma2 isNil ifTrue: [ gamma2 := DhbGammaDistribution shape: alpha2 scale: 1]. ^gamma2! ! !DhbCauchyDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Cauchy distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " ^self shape: aHistogram average scale: 4 * aHistogram variance / (Float pi * (aHistogram maximum squared + aHistogram minimum squared)) sqrt! new "Create an instance of the receiver with center 0 and scale 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self shape: 0 scale: 1! shape: aNumber1 scale: aNumber2 "Create an instance of the receiver with given center and scale parameters. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 scale: aNumber2! ! !DhbCauchyDistribution publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed accroding to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. Assumes that the value of the receiver is 0 for x < 0. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self privateAcceptanceBetween: aNumber1 and: aNumber2! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^mu! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " mu := mu + ( aVector at: 1). beta := beta + ( aVector at: 2).! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. Assumes that the value of the receiver is 0 for x < 0. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^(( aNumber - mu) / beta) arcTan / Float pi + (1 / 2)! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: mu with: beta! standardDeviation "The standard deviation of the receiver is not defined. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^nil! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^beta / ( Float pi * ( beta squared + ( aNumber - mu) squared))! valueAndGradient: aNumber "Answers an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | dp denominator | dp := self value: aNumber. denominator := 1 / ( ( aNumber - mu) squared + beta squared). ^Array with: dp with: ( DhbVector with: 2 * dp * ( aNumber - mu) * denominator with: dp * ( 1 / beta - ( 2 * beta * denominator)))! variance "The variance of the receiver is not defined. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^nil! ! !DhbCauchyDistribution privateMethods ! initialize: aNumber1 scale: aNumber2 "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " mu := aNumber1. beta := aNumber2. ^self! privateInverseDistributionValue: aNumber "Private - Answer the number whose acceptance is aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^( ( aNumber - (1 / 2)) * Float pi) tan * beta + mu! ! !DhbChiSquareDistribution class publicMethods ! degreeOfFreedom: anInteger "Create a new instance of the receiver with given degree of freedom. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^anInteger > 40 ifTrue: [ DhbAsymptoticChiSquareDistribution degreeOfFreedom: anInteger] ifFalse:[ super shape: anInteger / 2 scale: 2]! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Chi square distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " | dof | aHistogram minimum < 0 ifTrue: [ ^nil]. dof := aHistogram average rounded. ^dof > 0 ifTrue: [ self degreeOfFreedom: aHistogram average rounded] ifFalse:[ nil]! shape: aNumber1 scale: aNumber2 "Create an instance of the receiver with given shape and scale parameters. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self error: 'Illegal creation message for this class'! ! !DhbChiSquareDistribution publicMethods ! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 13/4/99 " super changeParametersBy: (Array with: aVector first / 2 with: 0).! confidenceLevel: aNumber "Answer the probability in percent of finding a chi square value distributed according to the receiver larger than aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/3/99 " ^( 1 - ( self distributionValue: aNumber)) *100! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: alpha * 2! ! !DhbCongruentialRandomNumberGenerator class publicMethods ! constant: aNumber1 multiplicator: aNumber2 modulus: aNumber3 "Create a new instance of the receiver with given constants. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 multiplicator: aNumber2 modulus: aNumber3! new "Create a new instance of the receiver with D. Knuth's constants. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " UniqueInstance isNil ifTrue: [ UniqueInstance := super new initialize. UniqueInstance setSeed: 1. ]. ^UniqueInstance! seed: aNumber "Create a new instance of the receiver with given seed using D. Knuth's constants. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( super new) initialize; setSeed: aNumber; yourself! ! !DhbCongruentialRandomNumberGenerator publicMethods ! floatValue "Answer the next pseudo-random value between 0 and 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self value asFloat / modulus! integerValue: anInteger "Answer a random integer between 0 and the anInteger. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( self value \\ ( anInteger * 1000)) // 1000! setSeed: aNumber "Set the seed of the receiver to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " seed := aNumber.! value "Answer the next pseudo-random value. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " seed := ( seed * multiplicator + constant) \\ modulus. ^seed! ! !DhbCongruentialRandomNumberGenerator privateMethods ! initialize "Private - Initializes the constants of the receiver with D. Knuth's constants. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " self initialize: 2718281829.0 multiplicator: 3141592653.0 modulus: 4294967296.0.! initialize: aNumber1 multiplicator: aNumber2 modulus: aNumber3 "Private - Initializes the constants needed by the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " constant := aNumber1. modulus := aNumber2. multiplicator := aNumber3. self setSeed: 1.! ! !DhbExponentialDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Exponential distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " | mu | aHistogram minimum < 0 ifTrue: [ ^nil]. mu := aHistogram average. ^mu > 0 ifTrue: [ self scale: aHistogram average] ifFalse:[ nil]! new "Create a new instance of the receiver with scale parameter 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: 1! scale: aNumber "Create a new instance of the receiver with given scale parameter. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber! ! !DhbExponentialDistribution publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed accroding to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. Assumes that the value of the receiver is 0 for x < 0. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self privateAcceptanceBetween: aNumber1 and: aNumber2! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^beta! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " beta := beta + ( aVector at: 1).! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^[1 - ( ( aNumber / beta negated) exp)] when: ExAll do: [ :signal | signal exitWith: 0]! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^6! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: beta! random "Answer a random number distributed accroding to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^DhbMitchellMooreGenerator new floatValue ln * beta negated! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^2! standardDeviation "Answer the standard deviation of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^beta! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^[ ( aNumber / beta) negated exp / beta] when: ExAll do: [ :signal | signal exitWith: 0]! valueAndGradient: aNumber "Answers an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " | dp | dp := self value: aNumber. ^Array with: dp with: ( DhbVector with: ( aNumber / beta - 1) * dp / beta)! ! !DhbExponentialDistribution privateMethods ! initialize: aNumber "Private - Set the scale parameter of the receiver to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " aNumber > 0 ifFalse: [ self error: 'Illegal distribution parameters']. beta := aNumber. ^self! privateInverseDistributionValue: aNumber "Private - Answer the number whose acceptance is aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^(1 - aNumber) ln negated * beta! ! !DhbFastStatisticalMoments publicMethods ! accumulate: aNumber "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " | var | var := 1. 1 to: moments size do: [:n | moments at: n put: (moments at: n) + var. var := var * aNumber]! average "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " self count = 0 ifTrue: [^nil]. ^(moments at: 2) / self count! kurtosis "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " | var x1 x2 x3 x4 kFact kConst n m4 xSquared | n := self count. n < 4 ifTrue: [^nil]. var := self variance. var = 0 ifTrue: [^nil]. x1 := (moments at: 2) / n. x2 := (moments at: 3) / n. x3 := (moments at: 4) / n. x4 := (moments at: 5) / n. xSquared := x1 squared. m4 := x4 - (4 * x1 * x3) + (6 * x2 * xSquared) - (xSquared squared * 3). kFact := n * (n + 1) / (n - 1) / (n - 2) / (n - 3). kConst := 3 * (n - 1) * (n - 1) / (n - 2) / (n - 3). ^kFact * (m4 * n / var squared) - kConst! skewness "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " | x1 x2 x3 n stdev | n := self count. n < 3 ifTrue: [^nil]. stdev := self standardDeviation. stdev = 0 ifTrue: [^nil]. x1 := (moments at: 2) / n. x2 := (moments at: 3) / n. x3 := (moments at: 4) / n. ^(x3 - (3 * x1 * x2) + (2 * x1 * x1 * x1)) * n * n / (stdev squared * stdev * (n - 1) * (n - 2))! variance "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " | n | n := self count. n < 2 ifTrue: [^nil]. ^((moments at: 3) - ((moments at: 2) squared / n)) / (n - 1)! ! !DhbFisherSnedecorDistribution class publicMethods ! degreeOfFreedom: anInteger1 degreeOfFreedom: anInteger2 "Create a new instance of the receiver with given degrees of freedom. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^super new initialize: anInteger1 and: anInteger2! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Fisher-Snedecor distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " | n1 n2 a | aHistogram minimum < 0 ifTrue: [^nil]. n2 := (2 / (1 - (1 / aHistogram average))) rounded. n2 > 0 ifFalse: [^nil]. a := (n2 - 2) * (n2 - 4) * aHistogram variance / (n2 squared * 2). n1 := (0.7 * (n2 - 2) / (1 - a)) rounded. ^n1 > 0 ifTrue: [self degreeOfFreedom: n1 degreeOfFreedom: n2] ifFalse: [nil]! new "Prevent using this message to create instances (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self error: 'Illegal creation message for this class'! test: aStatisticalMoment1 with: aStatisticalMoment2 "Perform a consistency Fisher test (or F-test) on the variances of two statistical moments ( or histograms). Answer the probability of passing the test. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^(self class degreeOfFreedom: aStatisticalMoment1 count degreeOfFreedom: aStatisticalMoment2 count) distributionValue: aStatisticalMoment1 variance / aStatisticalMoment2 variance! ! !DhbFisherSnedecorDistribution publicMethods ! average "Answer the average of the receiver. Undefined if dof2 is smaller than 3. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^dof2 > 2 ifTrue: [ dof2 / ( dof2 - 2)] ifFalse:[ nil]! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " dof1 := ( dof1 + ( aVector at: 1)) max: 1. dof2 := ( dof2 + ( aVector at: 2)) max: 1. self computeNorm. chiSquareDistribution1 := nil. chiSquareDistribution2 := nil. incompleteBetaFunction := nil.! confidenceLevel: aNumber "Answer the probability in percent of finding a value distributed according to the receiver outside of the interval [ 1/aNumber, aNumber]. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/3/99 " aNumber < 0 ifTrue: [ self error: 'Confidence level argument must be positive']. ^( 1- ( self acceptanceBetween: aNumber reciprocal and: aNumber)) * 100 ! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/3/99 " ^1 - ( self incompleteBetaFunction value: ( dof2 / ( aNumber * dof1 + dof2)))! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: dof1 with: dof2! random "Answer a random number distributed according to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " chiSquareDistribution1 isNil ifTrue: [ chiSquareDistribution1 := DhbChiSquareDistribution degreeOfFreedom: dof1. chiSquareDistribution2 := DhbChiSquareDistribution degreeOfFreedom: dof2. ]. ^chiSquareDistribution1 random * dof2 / ( chiSquareDistribution2 random * dof1)! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^aNumber > 0 ifTrue: [ ( norm + ( aNumber ln * ( dof1 / 2 - 1) ) - ( (aNumber * dof1 + dof2) ln * ( ( dof1 + dof2) / 2))) exp] ifFalse:[ 0]! variance "Answer the variance of the receiver. Undefined if dof2 is smaller than 5. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^dof2 > 4 ifTrue: [ dof2 squared * 2 * ( dof1 + dof2 - 2) / ( ( dof2 - 2) squared * dof1 * ( dof2 - 4))] ifFalse:[ nil]! ! !DhbFisherSnedecorDistribution privateMethods ! computeNorm "Private - Compute the norm of the receiver because its parameters have changed. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " norm := ( dof1 ln * ( dof1 / 2) ) + ( dof2 ln * ( dof2 / 2) ) - ( ( dof1 / 2) logBeta: ( dof2 / 2) ).! incompleteBetaFunction "Private - Answers the incomplete beta function used to compute the symmetric acceptance integral of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/3/99 " incompleteBetaFunction isNil ifTrue: [incompleteBetaFunction := DhbIncompleteBetaFunction shape: dof2 / 2 shape: dof1 / 2]. ^incompleteBetaFunction! initialize: anInteger1 and: anInteger2 "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " dof1 := anInteger1. dof2 := anInteger2. self computeNorm. ^self! ! !DhbFisherTippettDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Fisher-Tippett distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " | beta | beta := aHistogram standardDeviation. beta = 0 ifTrue: [^nil]. beta := beta * (6 sqrt / Float pi). ^self shape: aHistogram average - (0.5772156649 * beta) scale: beta! new "Create a standard version of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self shape: 0 scale: 1! shape: aNumber1 scale: aNumber2 "Create an instance of the receiver with given shape and scale parameters. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 scale: aNumber2! ! !DhbFisherTippettDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^0.577256649 * beta + alpha! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " alpha := alpha + ( aVector at: 1). beta := beta + ( aVector at: 2).! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 14/4/99 " | arg | arg := ( aNumber - alpha) / beta. arg := arg < DhbFloatingPointMachine new largestExponentArgument negated ifTrue: [ ^0] ifFalse:[arg negated exp]. ^arg > DhbFloatingPointMachine new largestExponentArgument ifTrue: [ 1] ifFalse:[ arg negated exp]! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^2.4! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: alpha with: beta! random "Answer a random number distributed according to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/4/99 " | t | [ t := DhbMitchellMooreGenerator new floatValue ln negated. t > 0] whileFalse: []. ^t ln negated * beta + alpha! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^1.3! standardDeviation "Answer the standard deviation of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Float pi * beta / ( 6 sqrt)! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " | arg | arg := ( aNumber - alpha) / beta. arg := arg > DhbFloatingPointMachine new largestExponentArgument ifTrue: [ ^0] ifFalse:[arg negated exp + arg]. ^arg > DhbFloatingPointMachine new largestExponentArgument ifTrue: [ 0] ifFalse:[ arg negated exp / beta]! valueAndGradient: aNumber "Answers an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | dp dy y| dp := self value: aNumber. y := ( aNumber - alpha) / beta. dy := ( y negated exp - 1). ^Array with: dp with: ( DhbVector with: dy * dp / beta negated with: dp * ( y * dy + 1) / beta negated)! ! !DhbFisherTippettDistribution privateMethods ! initialize: aNumber1 scale: aNumber2 "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " aNumber2 > 0 ifFalse: [ self error: 'Illegal distribution parameters']. alpha := aNumber1. beta := aNumber2. ^self! integralFrom: aNumber1 to: aNumber2 "Private - Compute the integral of the receiver from aNumber1 to aNumber2. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 14/4/99 " ^( DhbRombergIntegrator new: self from: aNumber1 to: aNumber2) evaluate ! integralUpTo: aNumber "Private - Compute the integral of the receiver from -infinity to aNumber. aNumber must be below 0 (no checking!!). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 14/4/99 " ^( DhbRombergIntegrator new: [ :x | x = 0 ifTrue: [ 0] ifFalse: [ ( self value: 1 / x) / x squared] ] from: 1 / aNumber to: 0) evaluate ! ! !DhbFixedStatisticalMoments class publicMethods ! new "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " ^super new: 4! new: anInteger "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " ^self error: 'Illegal creation message for this class'! ! !DhbFixedStatisticalMoments publicMethods ! accumulate: aNumber "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/6/99 " | correction n n1 c2 c3 | n := moments at: 1. n1 := n + 1. correction := ((moments at: 2) - aNumber) / n1. c2 := correction squared. c3 := c2 * correction. moments at: 5 put: ((moments at: 5) + ((moments at: 4) * correction * 4) + ((moments at: 3) * c2 * 6) + (c2 squared * (n squared * n + 1))) * n / n1; at: 4 put: ((moments at: 4) + ((moments at: 3) * correction * 3) + (c3 * (1 - n squared))) * n / n1; at: 3 put: ((moments at: 3) + (c2 * (1 + n))) * n / n1; at: 2 put: (moments at: 2) - correction; at: 1 put: n1! ! !DhbGammaDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Gamma distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " | alpha beta | aHistogram minimum < 0 ifTrue: [ ^nil]. alpha := aHistogram average. beta := aHistogram variance / alpha. ^[ self shape: alpha / beta scale: beta] when: ExAll do: [ :signal | signal exitWith: nil]! new "Prevent using this message to create instances (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self error: 'Illegal creation message for this class'! shape: aNumber1 scale: aNumber2 "Create an instance of the receiver with given shape and scale parameters. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 scale: aNumber2! ! !DhbGammaDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^alpha * beta! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " alpha := alpha + ( aVector at: 1). beta := beta + ( aVector at: 2). self computeNorm. incompleteGammaFunction := nil. randomCoefficients := nil.! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self incompleteGammaFunction value: aNumber / beta! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^6 / alpha! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: alpha with: beta! random "Answer a random number distributed accroding to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( alpha > 1 ifTrue: [ self randomForLargeAlpha] ifFalse:[ self randomForSmallAlpha]) * beta! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^2 / alpha sqrt! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^aNumber > 0 ifTrue: [ ( aNumber ln * (alpha - 1) - (aNumber / beta) - norm) exp] ifFalse:[ 0].! variance "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^beta squared * alpha! ! !DhbGammaDistribution privateMethods ! computeNorm "Private - Compute the norm of the receiver because its parameters have changed. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " norm := beta ln * alpha + alpha logGamma.! incompleteGammaFunction "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/3/99 " incompleteGammaFunction isNil ifTrue: [incompleteGammaFunction := DhbIncompleteGammaFunction shape: alpha]. ^incompleteGammaFunction! initialize: aNumber1 scale: aNumber2 "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ( aNumber1 > 0 and: [ aNumber2 > 0]) ifFalse: [ self error: 'Illegal distribution parameters']. alpha := aNumber1. beta := aNumber2. self computeNorm. ^self! initializeRandomCoefficientsForLargeAlpha "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " | a b q d | a := 1 / ( 2 * alpha - 1) sqrt. b := alpha - (4 ln). q := 1 / a + alpha. d := 4.5 ln + 1. ^Array with: a with: b with: q with: d! initializeRandomCoefficientsForSmallAlpha "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " | e | e := 1 exp. ^( e + alpha) / e! randomCoefficientsForLargeAlpha "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " randomCoefficients isNil ifTrue: [ randomCoefficients := self initializeRandomCoefficientsForLargeAlpha]. ^randomCoefficients! randomCoefficientsForSmallAlpha "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " randomCoefficients isNil ifTrue: [ randomCoefficients := self initializeRandomCoefficientsForSmallAlpha]. ^randomCoefficients! randomForLargeAlpha "Private - Generate a random number distributed according to the receiver when alpha > 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " [ true] whileTrue: [ | u1 u2 c v y z w| u1 := DhbMitchellMooreGenerator new floatValue. u2 := DhbMitchellMooreGenerator new floatValue. c := self randomCoefficientsForLargeAlpha. v := ( u1 / ( 1 - u1)) ln * (c at: 1). y := v exp * alpha. z := u1 squared * u2. w := ( c at: 3) * v + ( c at: 2) - y. ( c at: 4) + w >= ( 4.5 * z) ifTrue: [ ^y]. z ln <= w ifTrue: [ ^y]. ].! randomForSmallAlpha "Private - Generate a random number distributed according to the receiver when alpha < 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " [ true] whileTrue: [ | p | p := DhbMitchellMooreGenerator new floatValue * self randomCoefficientsForSmallAlpha. p > 1 ifTrue: [ | y | y := ( ( self randomCoefficientsForSmallAlpha - p) / alpha) ln negated. DhbMitchellMooreGenerator new floatValue <= ( y raisedTo: ( alpha - 1)) ifTrue: [ ^y]. ] ifFalse: [ | y | y := p raisedTo: ( 1 / alpha). DhbMitchellMooreGenerator new floatValue <= ( y negated exp) ifTrue: [ ^y]. ]. ].! ! !DhbHistogram class publicMethods ! new "Create a standard new instance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize! ! !DhbHistogram class privateMethods ! defaultCacheSize "Private - Answer the default cache size. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^100! defaultNumberOfBins "Private - Defines the default number of bins for instances of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^50! integerScales "Private - Scales for strict integers" ^#( 2 4 5 8 10)! scales "Private - Scales for any number" ^#( 1.25 2 2.5 4 5 7.5 8 10)! semiIntegerScales "Private - Scales for large integers" ^#( 2 2.5 4 5 7.5 8 10)! ! !DhbHistogram publicMethods ! accumulate: aNumber "Accumulate aNumber into the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | bin | self isCached ifTrue: [ ^self accumulateInCache: aNumber]. bin := self binIndex: aNumber. ( bin between: 1 and: contents size) ifTrue: [ contents at: bin put: ( contents at: bin) + 1. moments accumulate: aNumber. ] ifFalse:[ self processOverflows: bin for: aNumber].! average "Answer the average of the recevier (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments average! binIndex: aNumber "Answers the index of the bin corresponding to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " ^( ( aNumber - minimum) / binWidth) floor + 1! binWidth "Answer the bin width for the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " self isCached ifTrue: [ self flushCache]. ^binWidth! collectIntegralPoints: aBlock "Collects the points needed to display the receiver as an integral. Needed to use polymorphic behavior when plotting the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/4/99 " | answer bin lastContents integral norm x | self isCached ifTrue: [ self flushCache]. answer := OrderedCollection new: ( contents size * 2 + 1). bin := self minimum. answer add: ( aBlock value: bin @ 0). integral := self underflow. norm := self totalCount. contents do: [ :each | integral := integral + each. x := integral / norm. answer add: ( aBlock value: bin @ x). bin := bin + binWidth. answer add: ( aBlock value: bin @ x). ]. answer add: ( aBlock value: bin @ 0). ^answer asArray! collectPoints: aBlock "Collects the points needed to display the receiver. Needed to use polymorphic behavior when plotting the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " | answer bin lastContents | self isCached ifTrue: [ self flushCache]. answer := OrderedCollection new: ( contents size * 2 + 1). bin := self minimum. answer add: ( aBlock value: bin @ 0). contents do: [ :each | answer add: ( aBlock value: bin @ each). bin := bin + binWidth. answer add: ( aBlock value: bin @ each). ]. answer add: ( aBlock value: bin @ 0). ^answer asArray! count "Answer the count of the recevier (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments count! countAt: aNumber "Answer the count in the bin corresponding to aNumber or 0 if outside the limits. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " | n | n := self binIndex: aNumber. ^( n between: 1 and: contents size) ifTrue: [ contents at: n] ifFalse:[ 0]! countsBetween: aNumber1 and: aNumber2 "Computes the events located between aNumber1 and aNumber2. NOTE: This method assumes the two numbers are within the limits of the receiver and that the receiver is not cached. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " | n1 n2 answer | n1 := self binIndex: aNumber1. n2 := self binIndex: aNumber2. answer := ( contents at: n1) * ( ( binWidth * n1 + minimum) - aNumber1) / binWidth. n2 > contents size ifTrue: [ n2 := contents size + 1] ifFalse:[ answer := answer + ( ( contents at: n2) * ( aNumber2 - ( binWidth * ( n2 - 1) + self maximum)) / binWidth)]. ( n1 + 1) to: ( n2 - 1) do: [ :n | answer := answer + ( contents at: n)]. ^answer! countsUpTo: aNumber "Computes the events located up to aNumber. NOTE: This method assumes aNumber is within the limits of the receiver and that the receiver is not cached. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " | n answer | n := self binIndex: aNumber. n > contents size ifTrue: [ ^self count]. answer := ( contents at: n) * ( aNumber - ( binWidth * ( n - 1) + self minimum)) / binWidth. 1 to: ( n - 1) do: [ :m | answer := answer + ( contents at: m)]. ^answer + underflow! errorOnAverage "Answer the error on the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments errorOnAverage! freeExtent: aBoolean "Defines the range of the receiver to be freely adjustable. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ( underflow = 0 and: [ overflow = 0]) ifFalse: [ self error: 'Histogram extent cannot be redefined']. freeExtent := aBoolean.! isEmpty "Always false. Needed to use polymorphic behavior when plotting the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " ^false! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments kurtosis! lowBinLimitAt: anInteger " (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^( anInteger - 1) * binWidth + minimum! maximum "Answer the minimum for the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " self isCached ifTrue: [ self flushCache]. ^contents size * binWidth + minimum! maximumCount "Answer the maximum count of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " self isCached ifTrue: [ self flushCache]. ^contents inject: ( contents isEmpty ifTrue: [ 1] ifFalse:[ contents at: 1]) into: [ :max :each | max max: each]! minimum "Answer the minimum for the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " self isCached ifTrue: [ self flushCache]. ^minimum! overflow "Answer the overflow of the recevier (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^overflow! setDesiredNumberOfBins: anInteger "Defines the desired number of bins. It may be adjusted to a few units later on. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " anInteger > 0 ifFalse:[ self error: 'Desired number of bins must be positive']. desiredNumberOfBins := anInteger.! setRangeFrom: aNumber1 to: aNumber2 bins: anInteger "Defines the range of the receiver by specifying the minimum, maximum and number of bins. Values are adjusted to correspond to a reasonable value for the bin width and the limits. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " self isCached ifFalse: [ self error: 'Histogram limits cannot be redefined']. minimum := aNumber1. self setDesiredNumberOfBins: anInteger; adjustDimensionUpTo: aNumber2.! setWidth: aNumber1 from: aNumber2 bins: anInteger "Defines the range of the receiver by specifying the minimum, bin width and number of bins. Values are adjusted to correspond to a reasonable value for the bin width and the limits. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " self isCached ifFalse: [ self error: 'Histogram limits cannot be redefined']. minimum := aNumber2. self setDesiredNumberOfBins: anInteger; adjustDimensionUpTo: ( aNumber1 * anInteger + aNumber2).! skewness "Answer the skewness of the recevier (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments skewness! standardDeviation "Answer the standardDeviation of the recevier (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments standardDeviation! totalCount "Answer the count of the recevier, inclusing underflow and overflow (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments count + underflow + overflow! underflow "Answer the underflow of the recevier (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^underflow! variance "Answer the variance of the recevier (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^moments variance! ! !DhbHistogram privateMethods ! accumulateInCache: aNumber "Private - Accumulate aNumber inside a cache (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " contents add: aNumber. contents size > cacheSize ifTrue: [ self flushCache].! adjustDimensionUpTo: aNumber "Private - Compute an adequate bin width and adjust the minimum and number of bins accordingly. aNumber is the maximum value to accumulate. The minimum value has already been assigned. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " | maximum | binWidth := self roundToScale: ( aNumber - minimum) / desiredNumberOfBins. minimum := ( minimum / binWidth) floor * binWidth. maximum := ( aNumber / binWidth) ceiling * binWidth. contents := Array new: ( ( maximum - minimum) / binWidth) ceiling. contents atAllPut: 0.! countOverflows: anInteger "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " anInteger > 0 ifTrue: [ overflow := overflow + 1] ifFalse:[ underflow := underflow + 1].! flushCache "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | maximum values | minimum isNil ifTrue: [ minimum := contents isEmpty ifTrue: [ 0] ifFalse:[ contents first]. ]. maximum := minimum. contents do: [ :each | each < minimum ifTrue: [ minimum := each] ifFalse:[ each > maximum ifTrue: [ maximum := each]. ]. ]. maximum = minimum ifTrue: [ maximum := minimum + desiredNumberOfBins]. values := contents. self adjustDimensionUpTo: maximum. values do: [ :each | self accumulate: each]. ! growContents: anInteger "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " anInteger > 0 ifTrue: [ self growPositiveContents: anInteger] ifFalse:[ self growNegativeContents: anInteger].! growNegativeContents: anInteger "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | n newSize newContents | n := 1 - anInteger. newSize := contents size + n. newContents := Array new: newSize. newContents at: 1 put: 1; replaceFrom: 2 to: n withObject: 0; replaceFrom: ( n + 1) to: newSize with: contents. contents := newContents. minimum := ( anInteger - 1) * binWidth + minimum.! growPositiveContents: anInteger "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | n newContents | n := contents size. newContents := Array new: anInteger. newContents replaceFrom: 1 to: n with: contents; replaceFrom: ( n + 1) to: ( anInteger - 1) withObject: 0; at: anInteger put: 1. contents := newContents.! initialize "Private - initializes the receiver with standard settings. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " freeExtent := false. cacheSize := self class defaultCacheSize. desiredNumberOfBins := self class defaultNumberOfBins. contents := OrderedCollection new: cacheSize. moments := DhbFixedStatisticalMoments new. overflow := 0. underflow := 0. ^self! inverseDistributionValue: aNumber "Private - Compute the value which corresponds to a integrated count of aNumber. NOTE: aNumber is assumed to be between 0 and 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 8/3/99 " | count x integral | count := self count * aNumber. x := self minimum. integral := 0. contents do: [ :each | | delta | delta := count - integral. each > delta ifTrue: [ ^self binWidth * delta / each + x]. integral := integral + each. x := self binWidth + x. ]. ^self maximum! isCached "Private - Answer true if the content of the receiver is cached. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^binWidth isNil! processOverflows: anInteger for: aNumber "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " freeExtent ifTrue: [ self growContents: anInteger. moments accumulate: aNumber ] ifFalse:[ self countOverflows: anInteger].! roundToScale: aNumber "Private - Adjust aNumber of the lowest upper scale" | orderOfMagnitude norm scales rValue | orderOfMagnitude := ( aNumber log: 10) floor. scales := self class scales. aNumber isInteger ifTrue: [ orderOfMagnitude < 1 ifTrue: [ orderOfMagnitude := 1]. orderOfMagnitude = 1 ifTrue: [ scales := self class integerScales]. orderOfMagnitude = 2 ifTrue: [ scales := self class semiIntegerScales]. ]. norm := 10 raisedToInteger: orderOfMagnitude. rValue := aNumber / norm. ^( scales detect: [ :each | rValue <= each]) * norm! ! !DhbHistogrammedDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Experimental distribution'! histogram: aHistogram "Create a new instance of the receiver corresponding to a histogram. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " ^super new initialize: aHistogram! new "Prevent using this message to create instances (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self error: 'Illegal creation message for this class'! ! !DhbHistogrammedDistribution publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed according to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( histogram countsBetween: ( aNumber1 max: histogram minimum) and: ( aNumber2 min: histogram maximum) ) / histogram totalCount! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^histogram average! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^aNumber < histogram minimum ifTrue: [ 0] ifFalse:[ aNumber < histogram maximum ifTrue: [ ( histogram countsUpTo: aNumber) / histogram totalCount] ifFalse:[ 1] ]! kurtosis "Answer the kurtosis of the receiver. Undefined. Must be implemented by subclass. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^histogram kurtosis! skewness "Answer the skewness of the receiver. Undefined. Must be implemented by subclass. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^histogram skewness! standardDeviation "Answer the standard deviation of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^histogram standardDeviation! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " ^( aNumber >= histogram minimum and: [ aNumber < histogram maximum]) ifTrue: [ ( histogram countAt: aNumber) / ( histogram totalCount * histogram binWidth)] ifFalse:[ 0]! variance "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^histogram variance! ! !DhbHistogrammedDistribution privateMethods ! initialize: aHistogram "Private - Defines the histogram of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " aHistogram count = 0 ifTrue: [ self error: 'Cannot define probability density on an empty histogram']. histogram := aHistogram. ^self! privateInverseDistributionValue: aNumber "Private - Answer the number whose distribution is aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^histogram inverseDistributionValue: aNumber! ! !DhbLaplaceDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Laplace distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " ^self shape: aHistogram average scale: (aHistogram variance / 2) sqrt! new " (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^self shape: 0 scale: 1! shape: aNumber1 scale: aNumber2 " (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^super new initialize: aNumber1 scale: aNumber2! ! !DhbLaplaceDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^mu! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " mu := mu + ( aVector at: 1). beta := beta + ( aVector at: 2).! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^aNumber > mu ifTrue: [ 1 - ( ( ( aNumber - mu) / beta) negated exp / 2)] ifFalse:[ ( ( ( aNumber - mu) / beta) exp / 2)]! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^3! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: mu with: beta! random "Answer a random number distributed accroding to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | r | r := DhbMitchellMooreGenerator new floatValue ln * beta negated. ^DhbMitchellMooreGenerator new floatValue > 0.5 ifTrue: [ mu + r] ifFalse:[ mu - r]! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^0! standardDeviation "Answer the standard deviation of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^beta * ( 2 sqrt)! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^( ( aNumber - mu) / beta) abs negated exp / ( 2 * beta)! valueAndGradient: aNumber "Answers an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | dp | dp := self value: aNumber. ^Array with: dp with: ( DhbVector with: ( aNumber - mu) sign * dp / beta with: ( ( ( aNumber - mu) abs / beta - 1) * dp / beta))! ! !DhbLaplaceDistribution privateMethods ! initialize: aNumber1 scale: aNumber2 "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " mu := aNumber1. beta := aNumber2. ^self! ! !DhbLogNormalDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Log normal distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " | average variance sigma2 | aHistogram minimum < 0 ifTrue: [ ^nil]. average := aHistogram average. average > 0 ifFalse: [ ^nil]. variance := aHistogram variance. sigma2 := ( variance / average squared + 1) ln. sigma2 > 0 ifFalse: [ ^nil]. ^self new: ( average ln - (sigma2 * 0.5)) sigma: sigma2 sqrt! new "Create a new instance of the receiver with mu=0 and sigma=1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self new: 0 sigma: 1! new: aNumber1 sigma: aNumber2 "Create a new instance of the receiver with given mu and sigma. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 sigma: aNumber2! ! !DhbLogNormalDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( normalDistribution variance * 0.5 + normalDistribution average) exp! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " normalDistribution changeParametersBy: aVector.! kurtosis "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | x | x := normalDistribution variance exp. ^( ( x + 2) * x + 3) * ( x squared) - 6! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^normalDistribution parameters! random "Answer a random number distributed accroding to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^normalDistribution random exp! skewness "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | x | x := normalDistribution variance exp. ^(x - 1) sqrt * (x + 2)! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^aNumber > 0 ifTrue: [ ( normalDistribution value: aNumber ln) / aNumber] ifFalse:[ 0]! variance "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( normalDistribution average * 2 + normalDistribution variance) exp * ( normalDistribution variance exp - 1)! ! !DhbLogNormalDistribution privateMethods ! fourthCentralMoment "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 24/6/99 " | y x | y := normalDistribution average exp. x := normalDistribution variance exp. ^( y squared squared) * ( x squared) * ( ( ( x squared * x - 4) * ( x squared) + 6) * x - 3)! initialize: aNumber1 sigma: aNumber2 "Private - Defines the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " normalDistribution := DhbNormalDistribution new: aNumber1 sigma: aNumber2. ^self! thirdCentralMoment "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 24/6/99 " | y x | y := normalDistribution average exp. x := normalDistribution variance exp. ^( y squared * y) * ( x raisedTo: (3/2)) * ( ( x squared negated + 3) * x - 2)! ! !DhbMitchellMooreGenerator class publicMethods ! constants: anArray lowIndex: anInteger "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/11/00 " ^super new initialize: anArray lowIndex: anInteger! new "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/11/00 " UniqueInstance isNil ifTrue: [ UniqueInstance := self default]. ^UniqueInstance! seed: anInteger "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/18/00 " | congruentialGenerator | congruentialGenerator := DhbCongruentialRandomNumberGenerator seed: anInteger. ^self generateSeeds: congruentialGenerator! ! !DhbMitchellMooreGenerator class privateMethods ! default "Private- (c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/11/00 " | congruentialGenerator | congruentialGenerator := DhbCongruentialRandomNumberGenerator new. ^self generateSeeds: congruentialGenerator! generateSeeds: congruentialGenerator "Private- " ^self constants: ((1 to: 55) collect: [:n | congruentialGenerator floatValue]) lowIndex: 24! ! !DhbMitchellMooreGenerator publicMethods ! floatValue "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/11/00 " | x | x := (randoms at: lowIndex) + (randoms at: highIndex). x < 1.0 ifFalse: [x := x - 1.0]. randoms at: highIndex put: x. highIndex := highIndex + 1. highIndex > randoms size ifTrue: [highIndex := 1]. lowIndex := lowIndex + 1. lowIndex > randoms size ifTrue: [lowIndex := 1]. ^x! integerValue: anInteger "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/11/00 " ^( self floatValue * anInteger) truncated! ! !DhbMitchellMooreGenerator privateMethods ! initialize: anArray lowIndex: anInteger "Private - (c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/11/00 " randoms := anArray. lowIndex := anInteger. highIndex := randoms size. ^self! ! !DhbNormalDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Normal distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " ^self new: aHistogram average sigma: aHistogram standardDeviation! new "Create a new instance of the receiver with mu=0 and sigma=1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self new: 0 sigma: 1! new: aNumber1 sigma: aNumber2 "Create a new instance of the receiver with given mu and sigma. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 sigma: aNumber2! random "Answer a random number distributed according to a (0,1) normal distribution. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | v1 v2 w y | NextRandom isNil ifTrue: [ [ v1 := Number random * 2 - 1. v2 := Number random * 2 - 1. w := v1 squared + v2 squared. w > 1 ] whileTrue: []. y := ( ( w ln * 2 negated) / w) sqrt. v1 := y * v1. NextRandom := y * v2. ] ifFalse:[ v1 :=NextRandom. NextRandom := nil. ]. ^v1! ! !DhbNormalDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^mu! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " mu := mu + ( aVector at: 1). sigma := sigma + ( aVector at: 2).! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^DhbErfApproximation new value: ( ( aNumber - mu) / sigma)! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^0! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: mu with: sigma! random "Answer a random number distributed accroding to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self class random * sigma + mu! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^0! standardDeviation "Answer the standard deviation of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^sigma! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( DhbErfApproximation new normal: (aNumber - mu) / sigma) / sigma! valueAndGradient: aNumber "Answers an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " | dp y | y := ( aNumber - mu) / sigma. dp := ( DhbErfApproximation new normal: y) / sigma. ^Array with: dp with: ( DhbVector with: dp * y / sigma with: dp * ( y squared - 1) / sigma)! ! !DhbNormalDistribution privateMethods ! initialize: aNumber1 sigma: aNumber2 "Private - Defines the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " mu := aNumber1. sigma := aNumber2. ^self! ! !DhbProbabilityDensity class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Unknown distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. Default returns nil (must be implemented by subclass). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " ^nil! ! !DhbProbabilityDensity publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed according to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( self distributionValue: aNumber2) - ( self distributionValue: aNumber1)! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " self subclassResponsibility.! distributionFunction " (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/4/99 " ^DhbProbabilityDistributionFunction density: self! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self subclassResponsibility! inverseDistributionValue: aNumber "Answer the number whose distribution value is aNumber. NOTE: Subclass MUST NOT overwrite this method. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( aNumber between: 0 and: 1) ifTrue: [ self privateInverseDistributionValue: aNumber] ifFalse:[ self error: 'Illegal argument for inverse distribution value']! kurtosis "Answer the kurtosis of the receiver. Undefined. Must be implemented by subclass. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^nil! parameters "Returns an Array containing the parameters of the distribution. It is used to print out the distribution and for fitting. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^self subclassResponsibility! printOn: aStream "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " aStream nextPutAll: self class distributionName. self parameters ifNotNil: [ :params | | first | first := true. aStream nextPut: $(. params do: [ :each | first ifTrue: [ first := false] ifFalse:[ aStream nextPut: $,]. aStream space. each printOn: aStream. ]. aStream nextPut: $). ].! random "Answer a random number distributed according to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self privateInverseDistributionValue: DhbMitchellMooreGenerator new floatValue! skewness "Answer the skewness of the receiver. Undefined. Must be implemented by subclass. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^nil! standardDeviation "Answer the standard deviation of the receiver. NOTE: At least one of the methods variance or standardDeviation must be implemented by the subclass. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self variance sqrt! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " self subclassResponsibility.! valueAndGradient: aNumber "Answers an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " ^self approximatedValueAndGradient: aNumber! variance "Answer the variance of the receiver. NOTE: At least one of the methods variance or standardDeviation must be implemented by the subclass. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self standardDeviation squared! ! !DhbProbabilityDensity privateMethods ! approximatedValueAndGradient: aNumber "Private - gradients an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. The gradient is computed by approximation. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | delta parameters dp gradient n | parameters := self parameters. n := parameters size. dp := self value: aNumber. delta := Array new: n. delta atAllPut: 0. gradient := DhbVector new: n. 1 to: n do: [ :k | delta at: k put: ( parameters at: k) * 0.0001. self changeParametersBy: delta. gradient at: k put: ( ( ( self value: aNumber) - dp) / ( delta at: k)). delta at: k put: ( delta at: k ) negated. k > 1 ifTrue: [ delta at: ( k - 1) put: 0]. ]. self changeParametersBy: delta. ^Array with: dp with: gradient! privateInverseDistributionValue: aNumber "Private - Answer the number whose distribution is aNumber. NOTE: Subclass may overwrite this method for faster computation. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( DhbNewtonZeroFinder function: [ :x | ( self distributionValue: x) - aNumber] derivative: self) initialValue: self average / (1 - aNumber); evaluate! ! !DhbProbabilityDensityWithUnknownDistribution publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed according to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( DhbRombergIntegrator new: self from: aNumber1 to: aNumber2) evaluate! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. This general purpose routine uses numerical integration. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( DhbRombergIntegrator new: self from: self lowestValue to: aNumber) evaluate! lowestValue "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/18/00 " ^0! ! !DhbProbabilityDistributionFunction class publicMethods ! density: aProbabilityDensity "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/4/99 " ^self new initialize: aProbabilityDensity! ! !DhbProbabilityDistributionFunction publicMethods ! value: aNumber "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/4/99 " ^probabilityDensity distributionValue: aNumber! ! !DhbProbabilityDistributionFunction privateMethods ! initialize: aProbabilityDensity "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/4/99 " probabilityDensity := aProbabilityDensity. ^self! ! !DhbScaledProbabilityDensityFunction class publicMethods ! histogram: aHistogram against: aProbabilityDensityFunction "Create a new instance of the receiver with given probability density function and histogram. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " ^self new initialize: aProbabilityDensityFunction binWidth: aHistogram binWidth count: aHistogram totalCount! histogram: aHistogram distributionClass: aProbabilityDensityFunctionClass "Create a new instance of the receiver with given probability density function and histogram. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " ^(aProbabilityDensityFunctionClass fromHistogram: aHistogram) ifNotNil: [:dp | self histogram: aHistogram against: dp]! ! !DhbScaledProbabilityDensityFunction publicMethods ! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " count := count + aVector last. probabilityDensityFunction changeParametersBy: aVector.! distributionFunction "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/4/99 " ^probabilityDensityFunction distributionFunction! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " ^probabilityDensityFunction parameters copyWith: count! printOn: aStream "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/4/99 " super printOn: aStream. aStream nextPut: $[; nextPutAll: probabilityDensityFunction class distributionName; nextPut: $].! setCount: aNumber "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " count := aNumber.! value: aNumber " (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " ^(probabilityDensityFunction value: aNumber) * binWidth * count! valueAndGradient: aNumber "Answers an Array containing the value of the receiver at aNumber and the gradient of the receiver's respective to the receiver's parameters evaluated at aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 11/3/99 " | g temp | g := probabilityDensityFunction valueAndGradient: aNumber. temp := binWidth * count. ^Array with: g first * temp with: ( (g last collect: [:each | each * temp]) copyWith: g first * binWidth)! ! !DhbScaledProbabilityDensityFunction privateMethods ! initialize: aProbabilityDensityFunction binWidth: aNumber count: anInteger "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " probabilityDensityFunction := aProbabilityDensityFunction. binWidth := aNumber. count := anInteger. ^self! ! !DhbStatisticalMoments class publicMethods ! new "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " ^self new: 4! new: anInteger "anInteger is the degree of the highest central moments accumulated within the created instance. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " ^super new initialize: anInteger + 1! ! !DhbStatisticalMoments publicMethods ! accumulate: aNumber "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " | correction n n1 oldSums pascal nTerm cTerm term | n := moments at: 1. n1 := n + 1. correction := ((moments at: 2) - aNumber) / n1. oldSums := moments copyFrom: 1 to: moments size. moments at: 1 put: n1; at: 2 put: (moments at: 2) - correction. pascal := Array new: moments size. pascal atAllPut: 0. pascal at: 1 put: 1; at: 2 put: 1. nTerm := -1. cTerm := correction. n1 := n / n1. n := n negated. 3 to: moments size do: [:k | cTerm := cTerm * correction. nTerm := n * nTerm. term := cTerm * (1 + nTerm). k to: 3 by: -1 do: [:l | pascal at: l put: (pascal at: l - 1) + (pascal at: l). term := (pascal at: l) * (oldSums at: l) + term. oldSums at: l put: (oldSums at: l) * correction]. pascal at: 2 put: (pascal at: 1) + (pascal at: 2). moments at: k put: term * n1]! average "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " self count = 0 ifTrue: [^nil]. ^moments at: 2! centralMoment: anInteger "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/6/99 " ^moments at: anInteger + 1! count "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/6/99 " ^moments at: 1! errorOnAverage "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 02-Jan-00 " ^( self variance / self count) sqrt! kurtosis "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " | n n1 n23 | n := self count. n < 4 ifTrue: [^nil]. n23 := (n - 2) * (n - 3). n1 := n - 1. ^((moments at: 5) * n squared * (n + 1) / (self variance squared * n1) - (n1 squared * 3)) / n23! reset "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " moments atAllPut: 0! skewness "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " | n v | n := self count. n < 3 ifTrue: [^nil]. v := self variance. ^(moments at: 4) * n squared / ((n - 1) * (n - 2) * (v sqrt * v))! standardDeviation "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " ^self variance sqrt! unnormalizedVariance "(c) Copyrights Didier BESSET, 2000, all rights reserved. Initial code: 1/22/00 " ^( self centralMoment: 2) * self count! variance "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " | n | n := self count. n < 2 ifTrue: [ ^nil]. ^self unnormalizedVariance / ( n - 1)! ! !DhbStatisticalMoments privateMethods ! initialize: anInteger "Private - ( anInteger - 1) is the degree of the highest accumulated central moment. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 10/5/99 " moments := Array new: anInteger. self reset. ^self! ! !DhbStudentDistribution class publicMethods ! asymptoticLimit "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/4/99 " ^30! degreeOfFreedom: anInteger "Create a new instance of the receiver with anInteger degrees of freedom. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^anInteger > self asymptoticLimit ifTrue: [DhbNormalDistribution new] ifFalse: [anInteger = 1 ifTrue: [DhbCauchyDistribution shape: 0 scale: 1] ifFalse: [super new initialize: anInteger]]! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Student distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 5/3/99 " | dof var | var := aHistogram variance. var = 0 ifTrue: [ ^nil]. dof := ( 2 / (1 - (1 / aHistogram variance))) rounded max: 1. ^dof > self asymptoticLimit ifTrue: [ nil] ifFalse:[ self degreeOfFreedom: dof]! new "Prevent using this message to create instances (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self error: 'Illegal creation message for this class'! test: aStatisticalMoment1 with: aStatisticalMoment2 "Preform a consistency Student test (or t-test) on the averages of two statistical moments ( or histograms). Answers the probability of failing the test. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " | t | t := ( aStatisticalMoment1 average - aStatisticalMoment2 average) abs. ^1 - ( ( self class degreeOfFreedom: ( aStatisticalMoment1 count + aStatisticalMoment2 count - 2)) acceptanceBetween: t negated and: t)! ! !DhbStudentDistribution publicMethods ! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^0! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " degreeOfFreedom := degreeOfFreedom + ( aVector at: 1). self computeNorm.! confidenceLevel: aNumber "Answer the probability in percent of finding a value distributed according to the receiver with an absolute value larger than aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/3/99 " ^( 1 - ( self symmetricAcceptance: aNumber abs)) * 100! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/3/99 " aNumber = 0 ifTrue: [ ^0.5]. ^( aNumber > 0 ifTrue: [ 2 - ( self symmetricAcceptance: aNumber abs)] ifFalse:[ self symmetricAcceptance: aNumber abs]) / 2! kurtosis "Answer the kurtosis of the receiver. Undefined if the degree of freedom is less than 5. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^degreeOfFreedom > 4 ifTrue: [ 6 / ( degreeOfFreedom - 4)] ifFalse:[ nil]! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: degreeOfFreedom! random "Answer a random number distributed according to the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " ^DhbNormalDistribution random * ( ( (degreeOfFreedom - 1) / self chiSquareDistribution random ) sqrt)! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^0! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( norm - ( ( aNumber squared / degreeOfFreedom + 1) ln * ( ( degreeOfFreedom + 1) / 2))) exp! variance "Answer the variance of the receiver. Undefined if the degree of freedom is less than 3. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^degreeOfFreedom > 2 ifTrue: [ degreeOfFreedom / ( degreeOfFreedom - 2)] ifFalse:[ nil]! ! !DhbStudentDistribution privateMethods ! chiSquareDistribution "Private - Answer the chi square distribution used to generate random numbers for the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " chiSquareDistribution isNil ifTrue: [ chiSquareDistribution := DhbChiSquareDistribution degreeOfFreedom: (degreeOfFreedom - 1)]. ^chiSquareDistribution! computeNorm "Private - Compute the norm of the receiver because its parameters have changed. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " norm := ( ( degreeOfFreedom / 2 logBeta: ( 1 / 2) ) + ( degreeOfFreedom ln / 2)) negated.! incompleteBetaFunction "Private - Answers the incomplete beta function used to compute the symmetric acceptance integral of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/3/99 " incompleteBetaFunction isNil ifTrue: [incompleteBetaFunction := DhbIncompleteBetaFunction shape: degreeOfFreedom / 2 shape: 0.5]. ^incompleteBetaFunction! initialize: anInteger "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " anInteger > 0 ifFalse: [ self error: 'Degree of freedom must be positive']. degreeOfFreedom := anInteger. self computeNorm. ^self! symmetricAcceptance: aNumber "Private - Compute the acceptance of the receiver between -aNumber and aNumber (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/3/99 " ^ self incompleteBetaFunction value: ( degreeOfFreedom / ( aNumber squared + degreeOfFreedom))! ! !DhbTriangularDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Triangular distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. Default returns nil (must be implemented by subclass). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | b c| b := aHistogram standardDeviation * 1.73205080756888 "12 sqrt / 2". b = 0 ifTrue: [ ^nil]. c := aHistogram average. ^self new: c from: ( c - b) to: ( c + b).! new "Create an instance of the receiver with peak at 1/2 and limits 0 and 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^self new: (1 / 2) from: 0 to: 1! new: aNumber1 from: aNumber2 to: aNumber3 "Create an instance of the receiver with peak at aNumber1 and limits aNumber2 and aNumber3. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 from: aNumber2 to: aNumber3! ! !DhbTriangularDistribution publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed accroding to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. Assumes that the value of the receiver is 0 for x < 0. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self privateAcceptanceBetween: aNumber1 and: aNumber2! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^(lowLimit + peak + highLimit) / 3! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " lowLimit := lowLimit + ( aVector at: 1). highLimit := highLimit + ( aVector at: 2). peak := peak + ( aVector at: 3).! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | norm | ^( aNumber between: lowLimit and: highLimit) ifTrue: [ aNumber < peak ifTrue: [ norm := ( highLimit - lowLimit) * ( peak - lowLimit). ( aNumber - lowLimit) squared / norm ] ifFalse:[ aNumber > peak ifTrue: [ norm := ( highLimit - lowLimit) * ( highLimit - peak). 1 - ( ( highLimit - aNumber) squared / norm) ] ifFalse:[ ( peak - lowLimit) / ( highLimit - lowLimit)] ] ] ifFalse:[ 0]! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^(-6/10)! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: lowLimit with: highLimit with: peak! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^(((lowLimit squared * lowLimit + ( peak squared * peak) + ( highLimit squared * highLimit) ) / 135) -(((lowLimit squared * peak) + (lowLimit squared * highLimit) + (peak squared * lowLimit) + (peak squared * highLimit) + (highLimit squared * lowLimit) + (highLimit squared * peak))/90) +( 2 * lowLimit * peak * highLimit / 45)) / ( self standardDeviation raisedToInteger: 3)! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " | norm | ^( aNumber between: lowLimit and: highLimit) ifTrue: [ aNumber < peak ifTrue: [ norm := ( highLimit - lowLimit) * ( peak - lowLimit). 2 * ( aNumber - lowLimit) / norm ] ifFalse:[ aNumber > peak ifTrue: [ norm := ( highLimit - lowLimit) * ( highLimit - peak). 2 * ( highLimit - aNumber) / norm ] ifFalse:[ 2 / ( highLimit - lowLimit)] ] ] ifFalse:[ 0]! variance "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^(lowLimit squared + peak squared + highLimit squared - ( lowLimit * peak) - ( lowLimit * highLimit) - ( peak * highLimit)) / 18! ! !DhbTriangularDistribution privateMethods ! initialize: aNumber1 from: aNumber2 to: aNumber3 "Private - Defines the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ( aNumber2 < aNumber3 and: [ aNumber1 between: aNumber2 and: aNumber3]) ifFalse: [ self error: 'Illegal distribution parameters']. peak := aNumber1. lowLimit := aNumber2. highLimit := aNumber3. ^self! inverseAcceptanceAfterPeak: aNumber "Private - Compute inverse acceptance function in the region after the peak. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^ highLimit - ( ( ( 1 - aNumber) * ( highLimit - lowLimit) * ( highLimit - peak)) sqrt)! inverseAcceptanceBeforePeak: aNumber "Private - Compute inverse acceptance function in the region before the peak. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^ ( aNumber * ( highLimit - lowLimit) * ( peak - lowLimit)) sqrt + lowLimit! privateInverseDistributionValue: aNumber "Private - Answer the number whose acceptance is aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( peak - lowLimit) / ( highLimit - lowLimit) > aNumber ifTrue: [ self inverseAcceptanceBeforePeak: aNumber] ifFalse: [ self inverseAcceptanceAfterPeak: aNumber]! ! !DhbUniformDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Uniform distribution'! from: aNumber1 to: aNumber2 "Create a new instance of the receiver with given limits. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 to: aNumber2! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. Default returns nil (must be implemented by subclass). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | b c| b := aHistogram standardDeviation * 1.73205080756888 "12 sqrt / 2". b = 0 ifTrue: [ ^nil]. c := aHistogram average. ^self from: ( c - b) to: ( c + b).! new "Create a new instance of the receiver with limits 0 and 1. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self from: 0 to: 1! ! !DhbUniformDistribution publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed accroding to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. Assumes that the value of the receiver is 0 for x < 0. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self privateAcceptanceBetween: aNumber1 and: aNumber2! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( highLimit + lowLimit) / 2! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " lowLimit := lowLimit + ( aVector at: 1). highLimit := highLimit + ( aVector at: 2).! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " aNumber < lowLimit ifTrue: [ ^0]. ^aNumber < highLimit ifTrue: [ (aNumber - lowLimit) / ( highLimit - lowLimit)] ifFalse:[ 1]! kurtosis "Answer the kurtosis of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^-12 / 10! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: lowLimit with: highLimit! skewness "Answer the skewness of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 16/2/99 " ^0! standardDeviation "Answer the standard deviation of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( highLimit - lowLimit) / 3.46410161513775 "12 sqrt"! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( aNumber between: lowLimit and: highLimit) ifTrue: [ 1/( highLimit - lowLimit)] ifFalse:[ 0]! variance "Answer the variance of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( highLimit - lowLimit) squared / 12! ! !DhbUniformDistribution privateMethods ! initialize: aNumber1 to: aNumber2 "Private - Defines the limits of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " aNumber1 < aNumber2 ifFalse: [ self error: 'Illegal distribution parameters']. lowLimit := aNumber1. highLimit := aNumber2. ^self! privateInverseDistributionValue: aNumber "Private - Answer the number whose acceptance is aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^(highLimit - lowLimit) * aNumber + lowLimit! ! !DhbWeibullDistribution class publicMethods ! distributionName "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^'Weibull distribution'! fromHistogram: aHistogram "Create an instance of the receiver with parameters estimated from the given histogram using best guesses. This method can be used to find the initial values for a fit. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 3/3/99 " | average xMin xMax accMin accMax | aHistogram minimum < 0 ifTrue: [ ^nil]. average := aHistogram average. xMin := ( aHistogram minimum + average) / 2. accMin := ( aHistogram countsUpTo: xMin) / aHistogram totalCount. xMax := ( aHistogram maximum + average) / 2. accMax := ( aHistogram countsUpTo: xMax) / aHistogram totalCount. ^[self solve: xMin acc: accMin upper: xMax acc: accMax] when: ExAll do: [ :signal | signal exitWith: nil]! new "Prevent using this message to create instances (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self error: 'Illegal creation message for this class'! shape: aNumber1 scale: aNumber2 "Create an instance of the receiver with given shape and scale parameters. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^super new initialize: aNumber1 scale: aNumber2! ! !DhbWeibullDistribution class privateMethods ! solve: lowX acc: lowAcc upper: highX acc: highAcc "Private - (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " | lowLnAcc highLnAcc deltaLnAcc lowLnX highLnX | lowLnAcc := (1 - lowAcc) ln negated ln. highLnAcc := (1 - highAcc) ln negated ln. deltaLnAcc := highLnAcc - lowLnAcc. lowLnX := lowX ln. highLnX := highX ln. ^self shape: deltaLnAcc / (highLnX - lowLnX) scale: ((highLnAcc * lowLnX - (lowLnAcc * highLnX)) / deltaLnAcc) exp! ! !DhbWeibullDistribution publicMethods ! acceptanceBetween: aNumber1 and: aNumber2 "Answers the probability of observing a random variable distributed accroding to the receiver with a value larger than aNumber 1 and lower than or equal to aNumber2. Assumes that the value of the receiver is 0 for x < 0. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^self privateAcceptanceBetween: aNumber1 and: aNumber2! average "Answer the average of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^(1 / alpha) gamma * beta / alpha! changeParametersBy: aVector "Modify the parameters of the receiver by aVector. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " alpha := alpha + ( aVector at: 1). beta := beta + ( aVector at: 2). self computeNorm.! distributionValue: aNumber "Answers the probability of observing a random variable distributed according to the receiver with a value lower than or equal to aNumber. Assumes that the value of the receiver is 0 for x < 0. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^aNumber > 0 ifTrue: [ 1 - ( ( ( aNumber / beta) raisedTo: alpha) negated exp)] ifFalse:[ 0]! parameters "(c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 4/3/99 " ^Array with: alpha with: beta! value: aNumber "Answers the probability that a random variable distributed according to the receiver gives a value between aNumber and aNumber + espilon (infinitesimal interval). (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( ( aNumber / beta) raisedTo: alpha) negated exp * ( aNumber raisedTo: ( alpha - 1)) * norm! variance "Answer the variance of the receiver. NOTE: At least one of the methods variance or standardDeviation must be implemented by the subclass. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( beta squared / alpha) * ( (2 / alpha) gamma * 2 - ( (1 / alpha ) gamma squared / alpha))! ! !DhbWeibullDistribution privateMethods ! computeNorm "Private - Compute the norm of the receiver because its parameters have changed. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 12/3/99 " norm := alpha/ ( beta raisedTo: alpha).! initialize: aNumber1 scale: aNumber2 "Private - Initialize the parameters of the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ( aNumber1 > 0 and: [ aNumber2 > 0]) ifFalse: [ self error: 'Illegal distribution parameters']. alpha := aNumber1. beta := aNumber2. self computeNorm. ^self! privateInverseDistributionValue: aNumber "Private - Answer the number whose acceptance is aNumber. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^( (1 - aNumber) ln negated raisedTo: ( 1 / alpha)) * beta! ! !Integer publicMethods ! random "Answer a random integer between 0 and the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 15/2/99 " ^DhbMitchellMooreGenerator new integerValue: self! ! !Number class publicMethods ! random "Answers a random number between 0 and the receiver (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " ^DhbMitchellMooreGenerator new floatValue! ! !Number publicMethods ! random "Answers a random number distributed between 0 and the receiver. (c) Copyrights Didier BESSET, 1999, all rights reserved. Initial code: 17/2/99 " ^self class random * self! ! DhbCongruentialRandomNumberGenerator initializeAfterLoad! DhbHistogram initializeAfterLoad! DhbMitchellMooreGenerator initializeAfterLoad! DhbProbabilityDensity initializeAfterLoad! DhbAsymptoticChiSquareDistribution initializeAfterLoad! DhbBetaDistribution initializeAfterLoad! DhbCauchyDistribution initializeAfterLoad! DhbExponentialDistribution initializeAfterLoad! DhbFisherSnedecorDistribution initializeAfterLoad! DhbFisherTippettDistribution initializeAfterLoad! DhbGammaDistribution initializeAfterLoad! DhbChiSquareDistribution initializeAfterLoad! DhbHistogrammedDistribution initializeAfterLoad! DhbLaplaceDistribution initializeAfterLoad! DhbNormalDistribution initializeAfterLoad! DhbProbabilityDensityWithUnknownDistribution initializeAfterLoad! DhbLogNormalDistribution initializeAfterLoad! DhbStudentDistribution initializeAfterLoad! DhbTriangularDistribution initializeAfterLoad! DhbUniformDistribution initializeAfterLoad! DhbWeibullDistribution initializeAfterLoad! DhbProbabilityDistributionFunction initializeAfterLoad! DhbScaledProbabilityDensityFunction initializeAfterLoad! DhbStatisticalMoments initializeAfterLoad! DhbFastStatisticalMoments initializeAfterLoad! DhbFixedStatisticalMoments initializeAfterLoad! DhbStatistics initializeAfterLoad!