Gary
Guest
|
 Posted: Wed Oct 08, 2008 12:35 pm Post subject: A one-way ANOVA for Ability Spreadsheet |
 |
|
Sub Oneway()
'One-way ANOVA with unbalanced treatment groups
'Data are expected to be organized as variables in columns
' rows - cases
'The first row of the selected data block should be text = names of
treatments
Dim IntRawDatRows
Dim IntRawDatCols
set RawDat = Selection
intRawDatRows = GetnumRows(RawDat.Address)
intRawDatCols = RawDat.Count / intRawDatRows
Redim dblDat(intRawDatCols, intRawDatRows - 1)
Redim strTreatNam(intRawDatCols)
Redim dblReplicates(intRawDatCols)
Redim dblMeans(intRawDatCols)
Redim dblStdErrors(intRawDatCols)
Redim dblResiduals(intRawDatCols, IntRawDatRows - 1)
Redim StrOWRowLables(5)
Redim StrOWColLables(6)
Redim StrOWTreatLables(3)
Dim intTreatments
intTreatments = intRawDatCols
Dim intN 'total number of cases
intN = 0
Dim dblTotal
dblTotal = 0
Dim dblTestN
dblTestN = 0
Dim dblGrandMean
dblGrandMean = 0
Dim dblTreatSS
dblTreatSS = 0
Dim dblResidualSS
dblResidualSS = 0
Dim intTreatDF
intTreatDF = 0
Dim intResidualDF
intResidualDF = 0
Dim dbltreatMS
dblTreatMS = 0
dim dblResidualMS
dblResidualMS = 0
dim dblF
dblF = 0
dim dblProbFVal
dblProbFVal = 0
dim strSigF
strSigF = ""
Dim i, j, k, temp, l, t1, t2, w
i = 0: j = 0: k = 0: l = 0
t1 = 0: t2 = 0: w = 0
For i = 1 to intRawDatCols
dblReplicates(i) = 0
next
k = 1
For i = 1 to intRawDatRows
For j = 1 to intRawDatCols
if i = 1 then
strTreatNam(j) = RawDat(k).Value
else
temp = i - 1
if Isnumeric(RawDat(k).Value) then
if isEmpty(RawDat(k).Value) then
'
else
dblDat(j,temp) = RawDat(k).Value
dblReplicates(j) = dblReplicates(j) + 1
intN = intN + 1
end if
end if
end if
k = k + 1
next
next
'Calculate Means
For i = 1 to intTreatments
t1 = 0
for j = 1 to dblReplicates(i)
t1 = t1 + dblDat(i,j)
next
dblMeans(i) = t1/dblReplicates(i)
dblTotal = dblTotal + t1
dblTestN = dblTestN + dblReplicates(i)
next
dblGrandMean = dblTotal/intN
'Calculate Sums of Squares
for i = 1 to intTreatments
t2 = 0
for j = 1 to dblReplicates(i)
w = dblDat(i,j) - dblmeans(i)
t2 = t2 + w * w
dblresiduals(i,j) = w
next
dblResidualSS = dblResidualSS + t2
w = dblMeans(i) - dblGrandMean
dblTreatSS = dblTreatSS + dblReplicates(i) * w * w
next
intTreatDF = intTreatments - 1
intResidualDF = intN - intTreatments
dblTreatMS = dblTreatSS / intTreatDF
dblResidualMS = dblResidualSS / intResidualDF
dblF = dblTreatMS / dblResidualMS ' F - value
dblProbFVal = 1 - FDist(dblF, intTreatDF, intResidualDF) 'Probability
of F-value
if dblProbFVal < 0.01 then
strSigF = "Significant at 1% level"
elseif dblProbFVal < 0.05 then
strSigF = "Significant at 5% level"
else
strSigF = "Not Significant"
end if
'Calculate standard errors
For i = 1 to intTreatments
dblStdErrors(i) = Sqr(dblResidualSS/(dblReplicates(i) *
intResidualDF))
next
'Output
StrOWRowLables(1) = "SOURCE"
StrOWRowLables(2) = ""
StrOWRowLables(3) = "Treatments"
StrOWRowLables(4) = "Residual"
StrOWRowLables(5) = "TOTAL"
Set OneWayOutput = RawDat.cells(1, intRawdatCols + 3)
For i = 1 To 5
OneWayOutput.cells(i,1).Value = StrOWRowLables(i)
Next
StrOWColLables(1) = "SS"
StrOWColLables(2) = "df"
StrOWColLables(3) = "MS"
StrOWColLables(4) = "F"
StrOWColLables(5) = "p"
StrOWColLables(6) = "Significance"
For j = 1 To 6
i = j + 1
OneWayOutput.cells(1,i).Value = StrOWColLables(j)
Next
OneWayOutput.cells(3,2).Value = Round(dblTreatSS,5)
OneWayOutput.cells(4,2).Value = Round(dblResidualSS,5)
OneWayOutput.cells(5,2).Value = Round(dblTreatSS + dblResidualSS,5)
OneWayOutput.cells(3,3).Value = intTreatDF
OneWayOutput.cells(4,3).Value = intResidualDF
OneWayOutput.cells(5,3).Value = intN - 1
OneWayOutput.cells(3,4).Value = Round(dblTreatMS,5)
OneWayOutput.cells(4,4).Value = Round(dblResidualMS,5)
OneWayOutput.cells(3,5).Value = Round(dblF,5)
OneWayOutput.cells(3,6).Value = Round(dblProbFVal,5)
OneWayOutput.cells(3,7).Value = strSigF
StrOWTreatLables(1) = "Treatment"
StrOWTreatLables(2) = "Mean"
StrOWTreatLables(3) = "Std Error"
For i = 1 To 3
OneWayOutput.cells(7,i).Value = StrOWTreatLables(i)
Next
For j = 1 To intTreatments
i = j + 7
OneWayOutput.cells(i,1).Value = strTreatNam(j)
Next
For j = 1 To intTreatments
i = j + 7
OneWayOutput.cells(i,2).Value = Round(dblMeans(j),5)
Next
For j = 1 To intTreatments
i = j + 7
OneWayOutput.cells(i,3).Value = Round(dblStdErrors(j),5)
Next
end sub
Function Normal(z)
'Normal distribution - approximation
dim a1, a2, a3, a4, prob, w
prob = 0
w = 0
a1 = 0.196854
a2 = 0.115194
a3 = 0.000344
a4 = 0.019527
w = abs(z)
prob = 1 + w * (a1 + w * (a2 + w * (a3 + w * a4)))
prob = prob^4
prob = 1 - 0.5 / prob
prob = 0.5 + (prob - 0.5) * sgn(z)
Normal = prob
end function
Function FDist(F, df1, df2)
'F-distribution Function Approximation
dim a1, a2, w, w1, w2, z, prob
prob = 0 : w = 0 : w2 = 0: a1 = 0 : a2 = 0 : z = 0
a1 = 2/(9 * df1)
a2 = 2/(9 * df2)
w = F^(1/3)
w1 = w + a1 - w * a2 - 1
w2 = a2 * w * w + a1
z = w1/sqr(w2)
If df2 > 3 then
FDist = Normal(z)
else
z = z * (1 + 0.08 * (z^4)/(df2^3))
FDist = Normal(z)
end if
End Function
Function GetNumRows(r)
StartRow = GetNum(r, 2)
i = InStr(r, ".") + 3
EndRow = GetNum(r, i)
GetNumRows = EndRow - StartRow + 1
End Function
Function GetNum(r, i)
x = Mid(r, i, 1)
If (IsNumeric(x) = False) Then
i = i + 1
x = Mid(r, i, 1)
End If
y = ""
While (IsNumeric(x))
y = y & x
i = i + 1
x = Mid(r, i, 1)
Wend
GetNum = y
End Function |
|
