Object subclass: #Regression
instanceVariableNames: ''
classVariableNames: 'RSquared '
poolDictionaries: ''
category: 'Regression'!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Regression class
instanceVariableNames: ''!
!Regression class methodsFor: 'accessor' stamp: 'CMR 7/17/2000 17:03'!
RSquared
"return r-squared statistic"
^RSquared.! !
!Regression class methodsFor: 'accessor' stamp: 'CMR 7/17/2000 17:03'!
RSquared: aNumber
"Assign the r-squared statistic"
^RSquared := aNumber! !
!Regression class methodsFor: 'regression functions' stamp: 'CMR 7/17/2000 17:03'!
equationSolve: rawCollection equationFormat: eqForm
| n a b term ysquare xpower coef ss xaverage yaverage |
"initialize the variables"
n := (eqForm size).
a := Array new:n.
b := Array new:n.
term := Array new:n.
(1 to: n) do: [:i |
a at:i put:(Array new:n).
(1 to: n) do: [:j | (a at:i) at:j put:0].
b at:i put:0.
term at:i put:0.
].
ysquare := 0.
"step through each raw data entry"
(1 to: (rawCollection size)) do: [:i |
"sum the y values"
b at:1 put:((b at:1) + ((rawCollection at:i) at:1)).
ysquare := ysquare +
(((rawCollection at:i) at:1) * ((rawCollection at:i) at:1)).
"sum the x power values"
(1 to: n) do: [:j |
xpower := (eqForm at:j) value:(rawCollection at:i) value:j.
term at:j put:xpower.
(a at:1) at:j put:(((a at:1) at:j) + xpower).
].
" now set up the rest of the rows in the matrix"
(2 to: n) do: [:j |
b at:j put:((b at:j) + (((rawCollection at:i) at:1) * (term at:j))).
(1 to: n) do: [:k |
(a at:j) at:k put:(((a at:j) at:k) + ((term at:j) * (term at:k))).
].
].
].
"solve for the coefficients"
coef := Regression gaussAMatrix:a gaussBMatrix:b.
"calculate the r-squared statistic"
ss := 0.
yaverage := (b at:1) / (rawCollection size).
(1 to: n) do: [:i |
xaverage := ((a at:1) at:i) / (rawCollection size).
ss := ss + ((coef at:i) *
((b at:i) - ((rawCollection size) * xaverage * yaverage)))
].
Regression RSquared: ss /
(ysquare - ((rawCollection size) * yaverage * yaverage)).
^coef.! !
!Regression class methodsFor: 'regression functions' stamp: 'CMR 7/17/2000 17:03'!
equationSolve: rawCollection equationOrder: nOrder
| eqForm |
eqForm := Array new:(nOrder+1).
(1 to: (nOrder+1)) do: [:i |
eqForm at:i put:[:data :coefNum | (data at:2) raisedTo:(coefNum-1)].
].
^Regression
equationSolve: rawCollection
equationFormat: eqForm.! !
!Regression class methodsFor: 'regression functions' stamp: 'CMR 7/17/2000 17:03'!
gaussAMatrix: aMatrix gaussBMatrix: bMatrix
"matrix solution for |c| where |a| = |b| * |c|"
| a b pivot mult top n coef |
"initialize the local variables"
n := bMatrix size.
coef := Array new:n.
1 to: n do: [:i | coef at:i put:0].
"copy over the matrix values - inplace solution"
a := aMatrix deepCopy.
b := bMatrix deepCopy.
(1 to: (n-1)) do: [:j |
pivot := ((a at:j) at:j).
((j+1) to: n) do: [:i |
mult := ((a at:i) at:j) / pivot.
((j+1) to: n) do: [:k |
(a at:i) at:k put:(((a at:i) at:k) - (mult * ((a at:j) at:k))).
].
b at:i put:((b at:i) - (mult * (b at:j))).
].
].
coef at:n put:((b at:n) / ((a at:n) at:n)).
(1 to: (n-1)) reverseDo: [:i |
top := b at:i.
((i+1) to: n) do: [:k |
top := top - (((a at:i) at:k) * (coef at:k)).
].
coef at:i put:(top / ((a at:i) at:i)).
].
^coef! !
!Regression class methodsFor: 'printing' stamp: 'CMR 7/17/2000 17:03'!
printEquation: coef
(1 to: (coef size)) do: [:i |
Transcript
show:
((i = 1)
ifTrue: ['Y = ']
ifFalse: [' + ']);
show: (coef at: i) printString;
show: '*X^';
show: (i-1) printString.
].
Transcript
show: ' [r^2 = ';
show: (Regression RSquared printString);
show: ']';
cr.! !
!Regression class methodsFor: 'testing' stamp: 'CMR 7/17/2000 17:03'!
test
"Test the regression routines: Regression test."
| myCoefficients rawCollection temp eqForm |
"do a simple equation: Y = 1 + 2X"
myCoefficients := Regression equationSolve:#((1 0) (3 1) (5 2)) equationOrder:1.
Regression printEquation: myCoefficients.
rawCollection := Array new:100.
(1 to: (rawCollection size)) do: [:i | rawCollection at:i put:(Array new:2)].
"second order equation: Y = 1 + 2X + 3X^2"
(1 to: (rawCollection size)) do: [:i |
(rawCollection at:i) at:1 put:(1 + (2*i) + (3*i*i)).
(rawCollection at:i) at:2 put:i.
].
myCoefficients := Regression equationSolve:rawCollection equationOrder:2.
Regression printEquation: myCoefficients.
"third order equation: Y = 4 + 3X + 2X^2 + 1X^3"
(1 to: (rawCollection size)) do: [:i |
(rawCollection at:i) at:1 put:(4 + (3*i) + (2*i*i) + (1*i*i*i)).
(rawCollection at:i) at:2 put:i.
].
myCoefficients := Regression equationSolve:rawCollection equationOrder:3.
Regression printEquation: myCoefficients.
"do a multivariate regression: Y = 6 + 5X + 4X^2 + 3XZ + 2Z + 1Z^2"
(1 to: (rawCollection size)) do: [:i | rawCollection at:i put:(Array new:3)].
(1 to: (rawCollection size)) do: [:i |
temp := 100 atRandom.
(rawCollection at:i) at:1 put:(6 + (5*i) + (4*i*i) + (3*i*temp) +
(2*temp) + (1*temp*temp)).
(rawCollection at:i) at:2 put:i.
(rawCollection at:i) at:3 put:temp.
].
eqForm := Array new:6.
eqForm at:1 put:[:data :coefNum | 1].
eqForm at:2 put:[:data :coefNum | (data at:2)].
eqForm at:3 put:[:data :coefNum | (data at:2) raisedTo:2].
eqForm at:4 put:[:data :coefNum | (data at:2) * (data at:3)].
eqForm at:5 put:[:data :coefNum | (data at:3)].
eqForm at:6 put:[:data :coefNum | (data at:3) raisedTo:2].
myCoefficients := Regression equationSolve:rawCollection equationFormat:eqForm.
Transcript show: myCoefficients printString; cr.
Transcript show: 'r^2 = '.
Transcript show: (Regression RSquared) printString.! !