'Solver Statistics macro
'Solver Statistics Macro
'Version 2.0 (Version 1.1 was in XLM)
'Begun 12/31/97. Last modified 1/13/98
'Copyright 1995, 1998 E. J. Billo
'==============================================================
‘Calculates standard errors for regression coefficients obtained by using the Solver.
'See "Excel for Chemists" by E. J. Billo, Chapter 17.
'Installs new menu command "Solver Statistics... " in Tools menu.
'Known_y's and calc_y's must each be in a single row or column.
'Regression parameters (Solver's Changing Cells) can be in non-adjacent cells.
'SolvStat returns the following array of regression parameters:
'(The regression parameters are not calculated by SolvStat, merely echoed to indicate the order of their selection)
'parm(x) parm(y) ... parm(z)
'std.dev.(x) std.dev.(y) ... std.dev.(z)
'R^2 SE(y)
'================================================================================
Option Base 1 'All arrays begin with array index 1
'================================================================================
Sub SolvStat()
If Left(Application.OperatingSystem, 3) = "Win" Then KeyText = "CTRL" Else KeyText = "COMMAND"
msg1 = Chr(13) & Chr(13) & "(Range must be a single row or column.)"
msg2 = Chr(13) & "(Cells can be non-adjacent, in which case hold down the " & KeyText & _
" key while selecting, or enter a comma between selections.)"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim YObsd(), YCalc(), ParmValu(), PartialDeriv(), Product(), ProdArray()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Read in address of known y's & check for errors
Step1: On Error GoTo InputErrorHandler 'Handle error caused when Cancel button is pressed.
Set known_ys = Application.InputBox("Podaj zakres doświadczalnych wartości Y." & msg1, "SOLVER STATISTICS - STEP 1 OF 4", , , , , , 8)
On Error GoTo 0 'Now OK to turn off error handler.
Rows_ky = known_ys.Rows.Count
Cols_ky = known_ys.Columns.Count
If Rows_ky > 1 And Cols_ky > 1 Then 'Check for bad input.
MsgBox "Doświadczalne wartości Y muszą się znajdować w jednym wierszu lub kolumnie." & Chr(13) & Chr(13) & "Zaznacz ponownie ", 16, "INPUT ERROR"
GoTo Step1
End If
N1 = known_ys.Count
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Read in address of calculated y's & check for errors
Step2: On Error GoTo InputErrorHandler
Set calc_ys = Application.InputBox("Podaj zakres wartości Y obliczonych z modelu." & msg1, "SOLVER STATISTICS - Krok 2 z 4", , , , , , 8)
On Error GoTo 0
Rcy = calc_ys.Row
Ccy = calc_ys.Column
Rows_cy = calc_ys.Rows.Count
Cols_cy = calc_ys.Columns.Count
If Rows_cy > 1 And Cols_cy > 1 Then
MsgBox "Obliczone z modelu wartości Y muszą się znajdować w jednym wierszu lub kolumnie." & Chr(13) & Chr(13) & "Zaznacz ponownie ", 16, "INPUT ERROR"
GoTo Step2
End If
N2 = calc_ys.Count
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'More error checking on known y's and calc y's
If N1 N2 Then
MsgBox "Liczba zaznaczonych doświadczalnych wartości Y musi być równa liczbie zaznaczonych obliczonych wartości Y." & Chr(13) & Chr(13) & _
"Zaznacz ponownie", 16, "INPUT ERROR"
GoTo Step1
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save Y(obsd) and Y(calc) data internally. Check to make sure Y(calc) are formulas
N = N1
ReDim YObsd(N), YCalc(N)
x = 1
For Each F In known_ys '
YObsd(x) = F.Value 'Save the Y(obsd) values in an array.
x = x + 1
Next
x = 1
For Each F In calc_ys
If Left(F.Formula, 1) "=" Then
MsgBox "Obliczone z modelu wartości Y musi być zapisane jako wzór." & Chr(13) & Chr(13) & "Podaj poprawny wzór do obliczania Y", 16, "INPUT ERROR"
GoTo Step2
End If
YCalc(x) = F.Value
x = x + 1
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Read in addresses of parms & check for errors
Step3: On Error GoTo InputErrorHandler:
Set Parms = Application.InputBox("Zaznacz komórki zawierające współczynniki obliczone metodą najmniejszych kwadratów przez Solvera." & msg2, _
"SOLVER STATISTICS – Krok 3 z 4", , , , , , 8)
On Error GoTo 0
N3 = Parms.Count
If N3 >= N Then
MsgBox "Liczba punków doświadczalnych musi być większa niż liczba obliczanych współczynników regresji." & Chr(13) & Chr(13) & _
"Zatrzymanie obliczeń ", 16, "INPUT ERROR"
Exit Sub
End If
ReDim ParmValu(N3), PartialDeriv(N, N3), Product(N, N3, N3), ProdArray(N3, N3)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save parms to internal table. Check to make sure they are not formulas.
x = 1
For Each cell In Parms
If (Not (IsNumeric(cell))) Or cell.Value = "" Then
MsgBox "Jedna lub więcej komórek została zaznaczona niepoprawnie (Niektóre z tych komórek te nie zawierają liczb.)." & Chr(13) & Chr(13) & _
"Wybierz ponownie ", 16, "INPUT ERROR"
GoTo Step3
End If
ParmValu(x) = cell.Value
x = x + 1
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Calculate SS(resid), SS(regression), RMSD and correlation coefficient
Ybar = Application.Average(known_ys)
SSresiduals = 0: SSregression = 0
For x = 1 To N
SSresiduals = SSresiduals + (YCalc(x) - YObsd(x)) ^ 2
SSregression = SSregression + (Ybar - YCalc(x)) ^ 2
Next
CorrelCoeff = SSregression / (SSregression + SSresiduals)
RMSD = Sqr(SSresiduals / (N - N3))
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Calculate table of partial differentials
increment = 0.000001
'1E-6 seems to be optimum value for increment for numerical differentiation.
'1E-3 is too large, 1E-12 is too small. 1E-9 gives results almost identical to 1E-6.
y = 1
For Each parm In Parms
parm.Value = parm * (1 + increment) 'Increase regression coeffs by a small increment.
If parm = 0 Then parm.Value = 1E-100 'If cell contains zero exactly, replace it with very small value
CheckErrorSum = 0
x = 1
For Each cell In calc_ys
PartialDeriv(x, y) = (cell - YCalc(x)) / (parm * increment) 'Partial deriv = delta(function)/delta(parameter)
CheckErrorSum = CheckErrorSum + PartialDeriv(x, y) 'This sum used only for error checking.
x = x + 1
Next cell
parm.Value = ParmValu(y) 'Restore original parameter value
If CheckErrorSum = 0 Then
MsgBox "Błąd w obliczeniach macierzy." & Chr(13) & Chr(13) & "Najpowszechniejsze błędy: " & Chr(13) & Chr(13) & _
"1. Niepoprawny wybór komórek Y(obl)." & Chr(13) & Chr(13) & _
"2. Niepoprawny wybór komórek zawierających współczynniki regresji " & Chr(13) & Chr(13) & "Zatrzymanie programu.", 16, "UNKNOWN ERROR"
Exit Sub
End If
y = y + 1
Next parm
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Calculate table of products of partial differentials. Set up matrix of sums of cross-products.
For y = 1 To N3
For z = y To N3
SumProduct = 0
For x = 1 To N
SumProduct = SumProduct + PartialDeriv(x, y) * PartialDeriv(x, z)
Next x
ProdArray(y, z) = SumProduct
ProdArray(z, y) = SumProduct
Next: Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Invert matrix. Check for errors
On Error GoTo MatInvErrorHandler
InvArray = Application.MInverse(ProdArray)
For j = 1 To N3
If InvArray(j, j) ................
................
In order to avoid copyright disputes, this page is only a partial summary.
To fulfill the demand for quickly locating and searching documents.
It is intelligent file search solution for home and business.
Related download
- iintroduction md anderson cancer center
- analysis of performance metrics from a database
- solver statistics macro
- math grade 6 ratios rates percents model curriculum unit
- paper title use style paper title
- cdesolve numerical simultaneous ode solver
- the quest for linear equation solvers john gustafson
- computer mathematics and the graphing calculator
- 1 esm intranet site