''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''*****************************************'''''''''
''''''''''* *'''''''''
''''''''''* cFunctionValidation *'''''''''
''''''''''* *'''''''''
''''''''''*****************************************'''''''''
'''''''''''''''''''''''''''''''''''''''''''''' © R. de Levie
'''''''''''''''''''''''''''''''''''''''''''''' v 8 Aug. 2008
' Note: these checks of cFunctions use xNumbers.dll, which
' must have been installed before these macros can be run.
Sub xASINH()
' This macro can be used for a single data entry, x in
' one cell, the function F(x) in the cell to its right,
' or for two adjacent columns, the left-most with x, the
' right column with F(x). This is a particularly easy test,
' as Xnumbers already contains the function MP.xASINH(x),
' which therefore can be merely called rather than computed.
Dim MP As Xnumbers
Set MP = New Xnumbers
Dim aInput, DgtMax, InputData, OutputData
Dim F, pE, Term, X, xASINH
Dim r As Integer, rMax As Integer
DgtMax = 200
With MP
InputData = Selection.Value
OutputData = Selection.Value ' dimensioning
rMax = Selection.Rows.Count
aInput = Selection.Address
ReDim X(1 To rMax)
ReDim F(1 To rMax)
ReDim xASINH(1 To rMax)
ReDim pE(1 To rMax)
' Read the input
For r = 1 To rMax
X(r) = InputData(r, 1)
F(r) = InputData(r, 2)
Next r
' Compute pE
For r = 1 To rMax
pE(r) = .xSub(F(r), .xASINH(X(r)))
pE(r) = .xDiv(pE(r), .xASINH(X(r)))
pE(r) = .xAbs(pE(r))
pE(r) = .xLog(pE(r))
pE(r) = .xNeg(pE(r))
If .xComp(pE(r), 14) = 1 Then pE(r) = 14
OutputData(r, 1) = .xCvExp(.xASINH(X(r)))
OutputData(r, 2) = pE(r)
Next r
' Write the output
Selection.Offset(0, 2).Select
Selection.Value = OutputData
' Label the first output column
ActiveCell.Select
ActiveCell.ClearComments
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Shape.Width = 130
ActiveCell.Comment.Shape.Height = 65
ActiveCell.Comment.Text Text:="xASINH v. 8" & Chr(10) _
& Chr(10) & "Input block: " & aInput & Chr(10) _
& "Numberlength: " & DgtMax & Chr(10) _
& "Date: " & Date & Chr(10) & "Time: " & Time
' Clean up and close
End With
Set MP = Nothing
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub xERF()
' This macro can be used for a single data entry, x in
' one cell, the function F(x) in the cell to its right,
' or for two adjacent columns, the left-most with x, the
' right column with F(x). In this case, F(x) is compared
' with MP.xERF(x) where MP.xERF(x) is calculated based on
' the non-alternating series (7.1.6) in Abramowitz & Stegun.
Dim MP As Xnumbers
Set MP = New Xnumbers
Dim aInput, DgtMax, InputData, OutputData
Dim F, Factor, P, pE, Term, X, xERF
Dim n As Integer, m As Integer ' m = 2n+1
Dim r As Integer, rMax As Integer
DgtMax = 200
With MP
P = .xSqr(.xPi())
P = .xDiv(2, P)
InputData = Selection.Value
OutputData = Selection.Value ' dimensioning
rMax = Selection.Rows.Count
aInput = Selection.Address
ReDim X(1 To rMax)
ReDim F(1 To rMax)
ReDim xERF(1 To rMax)
ReDim pE(1 To rMax)
' Read the input
For r = 1 To rMax
X(r) = InputData(r, 1)
F(r) = InputData(r, 2)
Next r
' Compute xErf
For r = 1 To rMax
On Error Resume Next
If InputData(r, 2) = "#NUM!" Or _
InputData(r, 2) = "#VALUE!" Then
OutputData(r, 1) = "-"
OutputData(r, 2) = "-"
ElseIf InputData(r, 1) < -15 Then
OutputData(r, 1) = -1
OutputData(r, 2) = "-"
ElseIf InputData(r, 1) > 15 Then
OutputData(r, 1) = 1
OutputData(r, 2) = "-"
Else
Term = .xPow(X(r), 2)
Term = .xNeg(Term)
Term = .xExp(Term)
Term = .xMult(X(r), Term)
xERF(r) = Term
n = 1
Do
m = 2 * n + 1
Factor = .xPow(X(r), 2)
Factor = .xMult(2, Factor)
Factor = .xDiv(Factor, m)
Term = .xMult(Term, Factor)
xERF(r) = .xAdd(xERF(r), Term)
n = n + 1
Loop Until .xComp(.xAbs(Term), 1E-100) = -1
' Compute pE
xERF(r) = .xMult(P, xERF(r))
xERF(r) = .xCvExp(xERF(r))
pE(r) = .xSub(F(r), xERF(r))
pE(r) = .xDiv(pE(r), xERF(r))
pE(r) = .xAbs(pE(r))
pE(r) = .xLog(pE(r))
pE(r) = .xNeg(pE(r))
If .xComp(pE(r), 14) = 1 Then pE(r) = 14
OutputData(r, 1) = xERF(r)
OutputData(r, 2) = pE(r)
End If
Next r
' Write the output
Selection.Offset(0, 2).Select
Selection.Value = OutputData
' Label the first output column
ActiveCell.Select
ActiveCell.ClearComments
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Shape.Width = 130
ActiveCell.Comment.Shape.Height = 65
ActiveCell.Comment.Text Text:="xERF v. 8" & Chr(10) _
& Chr(10) & "Input block: " & aInput & Chr(10) _
& "Numberlength: " & DgtMax & Chr(10) _
& "Date: " & Date & Chr(10) & "Time: " & Time
' Clean up and close
End With
Set MP = Nothing
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''