Skip to content

Commit 770e4eb

Browse files
ws-garciaws-garcia
committed
Update VBAexpressions.cls
1 parent 4df2aee commit 770e4eb

File tree

1 file changed

+112
-112
lines changed

1 file changed

+112
-112
lines changed

‎src/VBAexpressions.cls‎

Lines changed: 112 additions & 112 deletions
Original file line numberDiff line numberDiff line change
@@ -3763,6 +3763,14 @@ Private Function GetPowerSymbolPos(ByRef expression As String) As Long
37633763
GetPowerSymbolPos = tmpResult
37643764
End Function
37653765

3766+
Private Function GetPrecisionResult(p2 As Double) As Double
3767+
If p2 <> 0 Then
3768+
GetPrecisionResult = RoundToPrecision(p2, Precision_(p2))
3769+
Else
3770+
GetPrecisionResult = 0
3771+
End If
3772+
End Function
3773+
37663774
Private Sub GetRootedTree(ByRef SubExpression As String, ByRef tmpReplacement As String, _
37673775
ByRef OperationIndex As Long, ByRef outBuffer As ClusterTree)
37683776
Dim vToken As token
@@ -5090,116 +5098,6 @@ Private Function MAX_(ParamArray aList() As Variant) As Double
50905098
MAX_ = tmpResult
50915099
End Function
50925100

5093-
Private Function method1(t As Double, r As Double) As Double
5094-
Dim e As Double, h As Double
5095-
Dim f As Double, i As Double
5096-
Dim inp1 As Double, inp2 As Double
5097-
Dim inp3 As Double, inp4 As Double
5098-
Dim inp5 As Double, inp6 As Double
5099-
Dim inp7 As Double, inp9 As Double
5100-
5101-
If (0 >= r Or r >= 1) Then
5102-
method1 = 0: Exit Function
5103-
End If
5104-
If (0.5 > r) Then
5105-
method1 = -method1(t, 1 - r): Exit Function
5106-
End If
5107-
e = method3(r)
5108-
inp1 = e ^ 2
5109-
inp2 = (27 * inp1 + 339) * inp1 + 930
5110-
inp2 = inp2 * inp1 - 1782
5111-
inp2 = ((inp2 * inp1 - 765) * inp1 + 17955) / 368640
5112-
inp3 = (79 * inp1 + 776) * inp1 + 1482
5113-
inp3 = inp3 * inp1 - 1920
5114-
inp3 = (inp3 * inp1 - 945) / 92160
5115-
inp4 = (((3 * inp1 + 19) * inp1 + 17) * inp1 - 15) / 384
5116-
inp6 = ((5 * inp1 + 16) * inp1 + 3) / 96
5117-
inp5 = (inp1 + 1) / 4
5118-
inp7 = inp3 + inp2 / t
5119-
inp7 = (inp6 + (inp4 + inp7 / t) / t)
5120-
inp7 = e * (1 + (inp5 + inp7 / t) / t)
5121-
If (t <= (Log10(r) ^ 2) + 3) Then
5122-
Do
5123-
f = method11(t, inp7)
5124-
inp9 = t + 1
5125-
i = Log(inp9 / (t + inp7 * inp7))
5126-
i = i + Log(t / inp9 / 2 / pi) - 1 + (1 / inp9 - 1 / t)
5127-
i = (f - r) / Exp((inp9 * i / 6) / 2)
5128-
inp7 = inp7 + i
5129-
h = method6(i, Abs(Fix(Log10(Abs(inp7)) - 6)))
5130-
Loop While (inp7 And 0 <> h)
5131-
End If
5132-
method1 = inp7
5133-
End Function
5134-
5135-
Private Function method11(y1 As Double, y2 As Double) As Double
5136-
Dim e As Double, rt1 As Double
5137-
Dim L As Double, n As Double
5138-
Dim s As Double, rt2 As Double
5139-
5140-
L = Atn((y2 / Sqr(y1)) / 1)
5141-
n = Cos(L) ^ 2: s = 1
5142-
For rt2 = y1 - 2 To 2 Step -2
5143-
s = 1 + (rt2 - 1) / rt2 * n * s
5144-
Next rt2
5145-
If REM_(y1, 2) = 0 Then
5146-
e = 0.5
5147-
rt1 = Sin(L) / 2
5148-
method11 = rt1
5149-
Else
5150-
e = 0.5 + L / pi
5151-
If 1 = y1 Then
5152-
rt1 = 0
5153-
Else
5154-
rt1 = Cos(L) * Sin(L) / pi
5155-
End If
5156-
method11 = MAX_(0, 1 - e - rt1 * s)
5157-
End If
5158-
End Function
5159-
5160-
Private Function method12(p2 As Double) As Double
5161-
If p2 <> 0 Then
5162-
method12 = method6(p2, method22(p2))
5163-
Else
5164-
method12 = 0
5165-
End If
5166-
End Function
5167-
5168-
Private Function method2(x1 As Double, x2 As Double) As Variant
5169-
If ((0 >= x1 Or Abs(x1) - Abs(Fix(x1)) <> 0) Or (0 >= x2 Or x2 >= 1)) Then
5170-
method2 = False
5171-
Else
5172-
method2 = method12(method1(x1, x2))
5173-
End If
5174-
End Function
5175-
5176-
Private Function method22(p5 As Double) As Double
5177-
method22 = Abs(Fix(Log10(Abs(p5)) - 7))
5178-
End Function
5179-
5180-
Private Function method3(p3 As Double) As Double
5181-
Dim p4 As Double
5182-
Dim e As Double
5183-
5184-
p4 = -Log(4 * p3 * (1 - p3))
5185-
e = -3.231081277E-09 + p4 * (3.657763036E-11 + 6.936233982E-13 * p4)
5186-
e = -0.00000104527497 + p4 * (8.360937017E-08 + p4 * e)
5187-
e = 0.000006841218299 + p4 * (0.000005824238515 + p4 * e)
5188-
e = -0.0008364353589 + p4 * (-0.0002250947176 + p4 * e)
5189-
e = Sqr(p4 * (1.570796288 + p4 * (0.03706987906 + p4 * e)))
5190-
If p3 > 0.5 Then
5191-
e = -e
5192-
End If
5193-
method3 = e
5194-
End Function
5195-
5196-
Private Function method6(t As Double, r As Double) As Double
5197-
Dim tmpResult As Double
5198-
5199-
tmpResult = t * 10 ^ r
5200-
method6 = Round(tmpResult) / (10 ^ r)
5201-
End Function
5202-
52035101
Private Function Mid_(ByRef expression As String, ByRef fName As String) As String
52045102
Dim argsCount As Long
52055103
Dim tmpData() As String
@@ -6364,6 +6262,10 @@ err_handler:
63646262
d_lParenthesis & err.Description & d_rParenthesis
63656263
End Function
63666264

6265+
Private Function Precision_(p5 As Double) As Double
6266+
Precision_ = Abs(Fix(Log10(Abs(p5)) - 7))
6267+
End Function
6268+
63676269
Private Function PV_(ByRef expression As String, ByRef fName As String) As String
63686270
Dim argsCount As Long
63696271
Dim tmpData() As String
@@ -6903,6 +6805,13 @@ err_handler:
69036805
d_lParenthesis & err.Description & d_rParenthesis
69046806
End Function
69056807

6808+
Private Function RoundToPrecision(t As Double, r As Double) As Double
6809+
Dim tmpResult As Double
6810+
6811+
tmpResult = t * 10 ^ r
6812+
RoundToPrecision = Round(tmpResult) / (10 ^ r)
6813+
End Function
6814+
69066815
Private Function ROUND_(aNumber As Double, Optional aDigits As Double = 0) As Double
69076816
ROUND_ = Round(aNumber, aDigits)
69086817
End Function
@@ -7300,6 +7209,97 @@ Private Function STUDT_(ByVal t As Double, n As Double) As Double
73007209
End If
73017210
End Function
73027211

7212+
Private Function subTINV_(x1 As Double, x2 As Double) As Variant
7213+
If ((0 >= x1 Or Abs(x1) - Abs(Fix(x1)) <> 0) Or (0 >= x2 Or x2 >= 1)) Then
7214+
subTINV_ = False
7215+
Else
7216+
subTINV_ = GetPrecisionResult(subt_(x1, x2))
7217+
End If
7218+
End Function
7219+
7220+
Private Function subtprob_(y1 As Double, y2 As Double) As Double
7221+
Dim e As Double, rt1 As Double
7222+
Dim L As Double, n As Double
7223+
Dim s As Double, rt2 As Double
7224+
7225+
L = Atn((y2 / Sqr(y1)) / 1)
7226+
n = Cos(L) ^ 2: s = 1
7227+
For rt2 = y1 - 2 To 2 Step -2
7228+
s = 1 + (rt2 - 1) / rt2 * n * s
7229+
Next rt2
7230+
If REM_(y1, 2) = 0 Then
7231+
e = 0.5
7232+
rt1 = Sin(L) / 2
7233+
subtprob_ = rt1
7234+
Else
7235+
e = 0.5 + L / pi
7236+
If 1 = y1 Then
7237+
rt1 = 0
7238+
Else
7239+
rt1 = Cos(L) * Sin(L) / pi
7240+
End If
7241+
subtprob_ = MAX_(0, 1 - e - rt1 * s)
7242+
End If
7243+
End Function
7244+
7245+
Private Function subt_(t As Double, r As Double) As Double
7246+
Dim e As Double, h As Double
7247+
Dim f As Double, i As Double
7248+
Dim inp1 As Double, inp2 As Double
7249+
Dim inp3 As Double, inp4 As Double
7250+
Dim inp5 As Double, inp6 As Double
7251+
Dim inp7 As Double, inp9 As Double
7252+
7253+
If (0 >= r Or r >= 1) Then
7254+
subt_ = 0: Exit Function
7255+
End If
7256+
If (0.5 > r) Then
7257+
subt_ = -subt_(t, 1 - r): Exit Function
7258+
End If
7259+
e = subu_(r)
7260+
inp1 = e ^ 2
7261+
inp2 = (27 * inp1 + 339) * inp1 + 930
7262+
inp2 = inp2 * inp1 - 1782
7263+
inp2 = ((inp2 * inp1 - 765) * inp1 + 17955) / 368640
7264+
inp3 = (79 * inp1 + 776) * inp1 + 1482
7265+
inp3 = inp3 * inp1 - 1920
7266+
inp3 = (inp3 * inp1 - 945) / 92160
7267+
inp4 = (((3 * inp1 + 19) * inp1 + 17) * inp1 - 15) / 384
7268+
inp6 = ((5 * inp1 + 16) * inp1 + 3) / 96
7269+
inp5 = (inp1 + 1) / 4
7270+
inp7 = inp3 + inp2 / t
7271+
inp7 = (inp6 + (inp4 + inp7 / t) / t)
7272+
inp7 = e * (1 + (inp5 + inp7 / t) / t)
7273+
If (t <= (Log10(r) ^ 2) + 3) Then
7274+
Do
7275+
f = subtprob_(t, inp7)
7276+
inp9 = t + 1
7277+
i = Log(inp9 / (t + inp7 * inp7))
7278+
i = i + Log(t / inp9 / 2 / pi) - 1 + (1 / inp9 - 1 / t)
7279+
i = (f - r) / Exp((inp9 * i / 6) / 2)
7280+
inp7 = inp7 + i
7281+
h = RoundToPrecision(i, Abs(Fix(Log10(Abs(inp7)) - 6)))
7282+
Loop While (inp7 And 0 <> h)
7283+
End If
7284+
subt_ = inp7
7285+
End Function
7286+
7287+
Private Function subu_(p3 As Double) As Double
7288+
Dim p4 As Double
7289+
Dim e As Double
7290+
7291+
p4 = -Log(4 * p3 * (1 - p3))
7292+
e = -3.231081277E-09 + p4 * (3.657763036E-11 + 6.936233982E-13 * p4)
7293+
e = -0.00000104527497 + p4 * (8.360937017E-08 + p4 * e)
7294+
e = 0.000006841218299 + p4 * (0.000005824238515 + p4 * e)
7295+
e = -0.0008364353589 + p4 * (-0.0002250947176 + p4 * e)
7296+
e = Sqr(p4 * (1.570796288 + p4 * (0.03706987906 + p4 * e)))
7297+
If p3 > 0.5 Then
7298+
e = -e
7299+
End If
7300+
subu_ = e
7301+
End Function
7302+
73037303
Private Function Switch_(ByRef expression As String, ByRef fName As String) As String
73047304
Dim argsCount As Long
73057305
Dim idx As Long
@@ -7492,10 +7492,10 @@ Private Function TINV_(confidence As Double, dof As Double, _
74927492
End If
74937493
p = (1 - confidence)
74947494
If tOption = 1 Then
7495-
TINV_ = method2(dof, p)
7495+
TINV_ = subTINV_(dof, p)
74967496
Else
74977497
If tOption = 2 Then
7498-
TINV_ = method2(dof, p / 2)
7498+
TINV_ = subTINV_(dof, p / 2)
74997499
End If
75007500
End If
75017501
End Function

0 commit comments

Comments
 (0)