Once upon a time I found myself at the library learning about different techniques for performing multi-precision floating point arithmetic.
The idea is to break a long number in two more numbers, and repeating cyclic operations with them. The two most popular methods use the string (NUMERICAL RECIPES in C – The Art of Scientific Computing”, Cambridge University Press, 1992, pp. 920-928) conversion and the packing (TRANSACTIONS ON MATHEMATICAL SOFTWARE”, Vol. 19, No. 3, SEPTEMBER, 1993, pp. 286-317).
For example, lets try to compute the following operation:
90000000002341 x 8067 = 726030000018884847
Any 32-bit machine cannot perform this calculation. It always gives the approximate result 726030000018885000, with a difference of +153. Even if you try to calculate the difference, +153, Excel gives you = 0.
The next example shows all the 250 digits of 1.000.000!
MP_FACT_FUNC(1000000,250)= 8.26393168833124006237664610317266629113534797896387304516777
5885563379611035645084446530511311463973351606804210878588541
4647469506478361823012109754232995901156417462491737988838926
9193414176545783239319872802472198939643654445521615339205835
1993879E+5565708
Wolfram|Alpha – factorial 1000000.
CODES:
Adapted by Rafael Nicolas Fermin for the “math trader” @ Nuclear Phynance
-
Option ExplicitPrivate Const PUB_ERROR_STR As String = "–"
Private Const PUB_BASE_VAL = 6
Private Const PUB_DM_VAL = 10 ^ PUB_BASE_VAL
Private Const PUB_DIGITS_VAL As Long = 30
Private PUB_DEC_SEP_CHR As String
Private Const PUB_DIGITS_LIMIT_VAL = 250Private Type XNUM_OBJ
sign As String * 1
dgt(0 To 94) As Double
esp As Long
ndgt As Integer
End TypeFunction TEST_FUNC(v, n, d)
TEST_FUNC = MP_DIVISION_FUNC(MP_FACT_FUNC(v, d), MP_PRODUCT_FUNC(MP_POWER_FUNC(v,
n, d), _
MP_FACT_FUNC(v – n, d), d), d)
End FunctionFunction MP_PRODUCT_FUNC(ByVal STR1_VAL As Variant, _
ByVal STR2_VAL As Variant, _
Optional ByVal DIGITS_MAX_VAL As Long = 0)
Dim V1_OBJ As XNUM_OBJ
Dim V2_OBJ As XNUM_OBJ
Dim V3_OBJ As XNUM_OBJOn Error GoTo ERROR_LABEL
If DIGITS_MAX_VAL = 0 Then DIGITS_MAX_VAL = DEFAULT_DIGITS_FUNC
If STR1_VAL = PUB_ERROR_STR Or STR2_VAL = PUB_ERROR_STR Then MP_PRODUCT_FUNC =
PUB_ERROR_STR: Exit Function
If STR1_VAL = "" Then STR1_VAL = "0"
If STR2_VAL = "" Then STR2_VAL = "0"
If STR1_VAL = "0" Or STR2_VAL = "0" Then MP_PRODUCT_FUNC = "0": Exit FunctionV1_OBJ = MP_CONVERT_STRING_NUMBER_FUNC(STR1_VAL, DIGITS_MAX_VAL)
V2_OBJ = MP_CONVERT_STRING_NUMBER_FUNC(STR2_VAL, DIGITS_MAX_VAL)
V3_OBJ = MP_MULT_FUNC(V1_OBJ, V2_OBJ, DIGITS_MAX_VAL)MP_PRODUCT_FUNC = MP_CONVERT_NUMBER_STRING_FUNC(V3_OBJ, DIGITS_MAX_VAL)
Exit Function
ERROR_LABEL:
MP_PRODUCT_FUNC = PUB_ERROR_STR
End FunctionFunction MP_DIVISION_FUNC(ByVal STR1_VAL As Variant, _
ByVal STR2_VAL As Variant, _
Optional ByVal DIGITS_MAX_VAL As Long = 0)Dim V1_OBJ As XNUM_OBJ
Dim V2_OBJ As XNUM_OBJ
Dim V3_OBJ As XNUM_OBJOn Error GoTo ERROR_LABEL
If DIGITS_MAX_VAL = 0 Then DIGITS_MAX_VAL = DEFAULT_DIGITS_FUNC
If STR1_VAL = PUB_ERROR_STR Or STR2_VAL = PUB_ERROR_STR Then MP_DIVISION_FUNC =
PUB_ERROR_STR: Exit Function
If STR1_VAL = "" Then STR1_VAL = "0"
If STR2_VAL = "" Then STR2_VAL = "0"
If STR2_VAL = "0" Then MP_DIVISION_FUNC = PUB_ERROR_STR: Exit Function
If STR1_VAL = "0" Then MP_DIVISION_FUNC = "0": Exit FunctionV1_OBJ = MP_CONVERT_STRING_NUMBER_FUNC(STR1_VAL, DIGITS_MAX_VAL)
V2_OBJ = MP_CONVERT_STRING_NUMBER_FUNC(STR2_VAL, DIGITS_MAX_VAL)
V3_OBJ = MP_DIV_FUNC(V1_OBJ, V2_OBJ, DIGITS_MAX_VAL)MP_DIVISION_FUNC = MP_CONVERT_NUMBER_STRING_FUNC(V3_OBJ, DIGITS_MAX_VAL)
Exit Function
ERROR_LABEL:
MP_DIVISION_FUNC = PUB_ERROR_STR
End FunctionFunction MP_POWER_FUNC(ByVal X_VAL As Variant, _
ByVal EXPONENT As Double, _
Optional ByVal DIGITS_MAX_VAL As Long = 0)Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As LongDim P_VAL As Variant
Dim Y_VAL As VariantDim P_OBJ As XNUM_OBJ
Dim Y_OBJ As XNUM_OBJDim U_ARR(0 To 30) As Long
Dim W_ARR(0 To 30) As LongOn Error GoTo ERROR_LABEL
If DIGITS_MAX_VAL = 0 Then DIGITS_MAX_VAL = DEFAULT_DIGITS_FUNC
If X_VAL = "1" Then MP_POWER_FUNC = "1": Exit Function
If X_VAL = "0" And EXPONENT <= 0 Then MP_POWER_FUNC = PUB_ERROR_STR: Exit
Function
If X_VAL = "0" Then MP_POWER_FUNC = "0": Exit Function
If EXPONENT = 0 Then MP_POWER_FUNC = "1": Exit Function
m = EXPONENT
If EXPONENT < 0 Then m = -EXPONENT
W_ARR(0) = 1
For i = 1 To 30: W_ARR(i) = 2 * W_ARR(i – 1): Next i
l = m
j = Int(Log(m) / Log(2))
For i = j To 0 Step -1
If l >= W_ARR(i) Then
l = l – W_ARR(i)
U_ARR(i) = 1
Else
U_ARR(i) = 0
End If
Next i
k = DIGITS_MAX_VAL + PUB_BASE_VAL
P_VAL = X_VAL: Y_VAL = 1
P_OBJ = MP_CONVERT_STRING_NUMBER_FUNC(P_VAL, DIGITS_MAX_VAL)
Y_OBJ = MP_CONVERT_INTERGER_FUNC(1)
For i = 0 To j
If U_ARR(i) <> 0 Then Y_OBJ = MP_MULT_FUNC(Y_OBJ, P_OBJ, k)
P_OBJ = MP_MULT_FUNC(P_OBJ, P_OBJ, k)
Next i
Y_VAL = MP_CONVERT_NUMBER_STRING_FUNC(Y_OBJ, DIGITS_MAX_VAL)
If EXPONENT < 0 Then Y_VAL = MP_DIVISION_FUNC(1, Y_VAL, DIGITS_MAX_VAL)
MP_POWER_FUNC = Y_VALExit Function
ERROR_LABEL:
MP_POWER_FUNC = PUB_ERROR_STR
End Function'// PERFECT
Function MP_FACT_FUNC(ByVal N_VAL As Double, _
Optional ByVal DIGITS_MAX_VAL As Long = 0)'————————————————————————-
' 200 (DIGITS) 75 (N)
' 250 (DIGITS) 94 (N)
' 300 (DIGITS) 113 (N)
' 400 (DIGITS) 150 (N)
'————————————————————————-Dim i As Long
Dim j As Long
Dim k As Long 'dgt_max
Dim l As Long
Dim NROWS As LongDim P_VAL As Double
Dim P_OBJ As XNUM_OBJOn Error GoTo ERROR_LABEL
If DIGITS_MAX_VAL = 0 Then DIGITS_MAX_VAL = DEFAULT_DIGITS_FUNC
If N_VAL < 0 Then MP_FACT_FUNC = PUB_ERROR_STR: Exit Function
P_VAL = 1
l = Int(N_VAL)
NROWS = MINIMUM_FUNC(l, 20)
For i = 1 To NROWS: P_VAL = P_VAL * i: Next i
k = DIGITS_MAX_VAL + PUB_BASE_VAL
P_OBJ = MP_CONVERT_STRING_NUMBER_FUNC(P_VAL, k)
For j = i To l: P_OBJ = MP_MULT_FUNC(P_OBJ, MP_CONVERT_INTERGER_FUNC(j), k):
Next j
MP_FACT_FUNC = MP_CONVERT_NUMBER_STRING_FUNC(P_OBJ, DIGITS_MAX_VAL)Exit Function
ERROR_LABEL:
MP_FACT_FUNC = PUB_ERROR_STR
End Function'returns the double-step factorial
Function MP_DOUBLE_FACT_FUNC(ByVal N_VAL As Double, _
Optional ByVal DIGITS_MAX_VAL As Long = 0, _
Optional ByVal LIMIT_VAL As Long = 27)
'LIMIT_VAL = limits the 32-bit precision computation'————————————————————————-
' 200 (DIGITS) 75 (N)
' 250 (DIGITS) 94 (N)
' 300 (DIGITS) 113 (N)
' 400 (DIGITS) 150 (N)
'————————————————————————-Dim i As Long
Dim j As Long
Dim k As Long 'dgt_max
Dim SROW As Long
Dim NROWS As Long
Dim P_VAL As DoubleDim P_OBJ As XNUM_OBJ
On Error GoTo ERROR_LABEL
If DIGITS_MAX_VAL = 0 Then DIGITS_MAX_VAL = DEFAULT_DIGITS_FUNC
'If N_VAL = "-1" Or N_VAL = "0" Then MP_DOUBLE_FACT_FUNC = "0": Exit Function
If N_VAL < 0 Then MP_DOUBLE_FACT_FUNC = PUB_ERROR_STR: Exit Function
P_VAL = 1
l = Int(N_VAL)
NROWS = MINIMUM_FUNC(l, LIMIT_VAL)
SROW = 2 + N_VAL Mod 2For i = SROW To NROWS Step 2: P_VAL = P_VAL * i: Next i
k = DIGITS_MAX_VAL + PUB_BASE_VAL
P_OBJ = MP_CONVERT_STRING_NUMBER_FUNC(P_VAL, k)
For j = i To l Step 2: P_OBJ = MP_MULT_FUNC(P_OBJ, MP_CONVERT_LONG_FUNC(j), k):
Next j
MP_DOUBLE_FACT_FUNC = MP_CONVERT_NUMBER_STRING_FUNC(P_OBJ, DIGITS_MAX_VAL)Exit Function
ERROR_LABEL:
MP_DOUBLE_FACT_FUNC = PUB_ERROR_STR
End FunctionPrivate Function MP_MULT_FUNC(ByRef V1_OBJ As XNUM_OBJ, _
ByRef V2_OBJ As XNUM_OBJ, _
Optional ByVal DIGITS_MAX_VAL As Long = 0) As XNUM_OBJDim i As Long
Dim j As Long
Dim k As LongDim S_VAL As Double
Dim Z_VAL As DoubleDim V3_OBJ As XNUM_OBJ
On Error GoTo ERROR_LABEL
If DIGITS_MAX_VAL = 0 Then DIGITS_MAX_VAL = DEFAULT_DIGITS_FUNC
If V1_OBJ.ndgt = 0 Or V2_OBJ.ndgt = 0 Then
MP_MULT_FUNC.ndgt = 0
Exit Function
End If
For k = 0 To V1_OBJ.ndgt + V2_OBJ.ndgt
S_VAL = 0 'accumulatore
For i = 0 To V2_OBJ.ndgt – 1
j = k – i
If 0 <= j And j < V1_OBJ.ndgt Then
Z_VAL = V1_OBJ.dgt(j) * V2_OBJ.dgt(i)
S_VAL = S_VAL + Z_VAL
End If
Next i
If S_VAL <> 0 Then
V3_OBJ.dgt(k) = S_VAL
V3_OBJ.ndgt = k + 1
End If
Next k
V3_OBJ.esp = V1_OBJ.esp + V2_OBJ.esp
Call MP_REARRANGING_FUNC(V3_OBJ)
If V1_OBJ.sign = V2_OBJ.sign Then
V3_OBJ.sign = ""
Else
V3_OBJ.sign = "-"
End If
Call MP_SCALE_NUMBER_FUNC(V3_OBJ, DIGITS_MAX_VAL)
MP_MULT_FUNC = V3_OBJExit Function
ERROR_LABEL:
End FunctionPrivate Function MP_DIV_FUNC(ByRef V1_OBJ As XNUM_OBJ, _
ByRef V2_OBJ As XNUM_OBJ, _
Optional ByVal DIGITS_MAX_VAL As Long = 0) As XNUM_OBJDim i As Long
Dim j As Long
Dim k As Long
Dim l As LongDim m As Long
Dim n As LongDim ii As Long
Dim jj As Long
Dim kk As LongDim Q_VAL As Double
Dim R_VAL As Double
Dim X_VAL As Double
Dim Y_VAL As DoubleDim V3_OBJ As XNUM_OBJ
Dim D_ARR(0 To 100) As Double
Dim R_ARR(0 To 100) As Double
Dim Q_ARR(0 To 100) As Double
Dim T_ARR(0 To 100) As Double
Dim ZERO_FLAG As Boolean
Dim DIV_FLAG As BooleanOn Error GoTo ERROR_LABEL
l = 0
If DIGITS_MAX_VAL = 0 Then DIGITS_MAX_VAL = DEFAULT_DIGITS_FUNC
k = Int(DIGITS_MAX_VAL / PUB_BASE_VAL) + 2
If V2_OBJ.ndgt = 1 And V2_OBJ.dgt(0) = 1 And V2_OBJ.esp = 0 Then
MP_DIV_FUNC = V1_OBJ
If V1_OBJ.sign = V2_OBJ.sign Then
MP_DIV_FUNC.sign = ""
Else
MP_DIV_FUNC.sign = "-"
End If
Exit Function
End If
If V1_OBJ.ndgt = 0 Then MP_DIV_FUNC = V1_OBJ: Exit Function
If V2_OBJ.ndgt = 0 Then MP_DIV_FUNC.sign = PUB_ERROR_STR: Exit Function
m = V1_OBJ.ndgt – 1
n = V2_OBJ.ndgt – 1
kk = n + 1
For i = kk – 1 To 0 Step -1
j = m – n + i
If j < 0 Then
D_ARR(i) = 0
V3_OBJ.esp = V3_OBJ.esp – PUB_BASE_VAL
Else
D_ARR(i) = V1_OBJ.dgt(j)
End If
Next
ii = j
jj = 0
Do
l = l + 1
Y_VAL = D_ARR(kk) * PUB_DM_VAL + D_ARR(kk – 1) + 1
X_VAL = V2_OBJ.dgt(n)
If n > 0 Then X_VAL = X_VAL + V2_OBJ.dgt(n – 1) / PUB_DM_VAL
Q_VAL = Int(Y_VAL / X_VAL)
Do
l = l + 1
For i = 0 To kk
T_ARR(i) = R_ARR(i)
Next
ZERO_FLAG = True
For i = 0 To kk
R_ARR(i) = D_ARR(i) – V2_OBJ.dgt(i) * Q_VAL
If R_ARR(i) <> 0 Then ZERO_FLAG = False
Next i
If ZERO_FLAG = True Then Exit Do
R_VAL = 0
For i = 0 To kk
R_ARR(i) = R_ARR(i) + R_VAL
If R_ARR(i) < 0 Then
X_VAL = Int(R_ARR(i) / PUB_DM_VAL)
R_ARR(i) = R_ARR(i) – PUB_DM_VAL * X_VAL
R_VAL = X_VAL
Else
R_VAL = 0
End If
Next i
If R_VAL <> 0 Then
Q_VAL = Q_VAL – 1
For i = 0 To kk: R_ARR(i) = T_ARR(i): Next i
End If
Loop While R_VAL <> 0 And l < 10000
Q_ARR(jj) = Q_VAL
jj = jj + 1
ii = ii – 1
If ZERO_FLAG = True And ii < 0 Then DIV_FLAG = True
If jj > k Then DIV_FLAG = True
If DIV_FLAG = False Then
For i = kk – 1 To 0 Step -1
D_ARR(i + 1) = R_ARR(i)
Next
If ii < 0 Then
D_ARR(0) = 0
V3_OBJ.esp = V3_OBJ.esp – PUB_BASE_VAL
Else
D_ARR(0) = V1_OBJ.dgt(ii)
End If
End If
Loop Until DIV_FLAG = True Or l > 10000V3_OBJ.ndgt = jj
For i = 0 To V3_OBJ.ndgt – 1: V3_OBJ.dgt(i) = Q_ARR(jj – i – 1): Next i
V3_OBJ.esp = V3_OBJ.esp + V1_OBJ.esp – V2_OBJ.esp
Call MP_REARRANGING_FUNC(V3_OBJ)
Call MP_SCALE_NUMBER_FUNC(V3_OBJ, DIGITS_MAX_VAL)
If V1_OBJ.sign = V2_OBJ.sign Then
V3_OBJ.sign = ""
Else
V3_OBJ.sign = "-"
End If
MP_DIV_FUNC = V3_OBJExit Function
ERROR_LABEL:
End Function'Converts a short integer n into multi precission number
Function MP_CONVERT_INTERGER_FUNC(ByVal N_VAL As Double) As XNUM_OBJ
'-999999< n < +999999On Error GoTo ERROR_LABEL
If N_VAL = 0 Then
MP_CONVERT_INTERGER_FUNC.ndgt = 0
MP_CONVERT_INTERGER_FUNC.sign = ""
Else
MP_CONVERT_INTERGER_FUNC.dgt(0) = Abs(N_VAL)
MP_CONVERT_INTERGER_FUNC.esp = 0
MP_CONVERT_INTERGER_FUNC.ndgt = 1
MP_CONVERT_INTERGER_FUNC.sign = ""
If N_VAL < 0 Then MP_CONVERT_INTERGER_FUNC.sign = "-"
End IfExit Function
ERROR_LABEL:
End Function'converts a long into an xnumber
Function MP_CONVERT_LONG_FUNC(ByVal j As Long) As XNUM_OBJ
Dim x0, x1, x2, x3
On Error GoTo ERROR_LABEL
If j > 0 Then
MP_CONVERT_LONG_FUNC.sign = ""
ElseIf j < 0 Then
MP_CONVERT_LONG_FUNC.sign = "-"
Else
MP_CONVERT_LONG_FUNC.ndgt = 0
MP_CONVERT_LONG_FUNC.sign = ""
Exit Function
End If
x2 = j * 10 ^ -PUB_BASE_VAL
x1 = Int(x2)
If x1 = 0 Then
MP_CONVERT_LONG_FUNC.ndgt = 1
MP_CONVERT_LONG_FUNC.dgt(0) = Abs(j)
Else
MP_CONVERT_LONG_FUNC.ndgt = 2
MP_CONVERT_LONG_FUNC.dgt(1) = Abs(x1)
x0 = (x2 – x1) * 10 ^ PUB_BASE_VAL
x3 = Round(x0, 0)
MP_CONVERT_LONG_FUNC.dgt(0) = Abs(x0)
End If
MP_CONVERT_LONG_FUNC.esp = 0Exit Function
ERROR_LABEL:
End FunctionPrivate Function MP_REARRANGING_FUNC(ByRef X_OBJ As XNUM_OBJ)
Dim i As Long
Dim R_VAL As Double
Dim D_VAL As DoubleOn Error GoTo ERROR_LABEL
R_VAL = 0
For i = 0 To X_OBJ.ndgt – 1
D_VAL = X_OBJ.dgt(i) + R_VAL
R_VAL = Int(D_VAL / PUB_DM_VAL)
If R_VAL <> 0 Then
X_OBJ.dgt(i) = D_VAL – R_VAL * PUB_DM_VAL
Else
X_OBJ.dgt(i) = D_VAL
End If
Next
If R_VAL > 0 Then
X_OBJ.dgt(X_OBJ.ndgt) = R_VAL
X_OBJ.ndgt = X_OBJ.ndgt + 1
X_OBJ.sign = ""
ElseIf R_VAL < 0 Then
MP_COMPLEMENT_NUMBER_FUNC X_OBJ
X_OBJ.sign = "-"
Else
X_OBJ.sign = ""
End If
MP_REARRANGING_FUNC = True
Exit Function
ERROR_LABEL:
MP_REARRANGING_FUNC = False
End Function
Private Function MP_COMPLEMENT_NUMBER_FUNC(ByRef X_OBJ As XNUM_OBJ)Dim i As Long
Dim d As Long
Dim k As LongOn Error GoTo ERROR_LABEL
d = 10 ^ PUB_BASE_VAL
k = 0
Do While X_OBJ.dgt(k) = 0: k = k + 1: Loop
If k >= X_OBJ.ndgt Then Exit Function
X_OBJ.dgt(k) = d – X_OBJ.dgt(k)
For i = k + 1 To X_OBJ.ndgt – 1
X_OBJ.dgt(i) = d – 1 – X_OBJ.dgt(i)
Next i
MP_COMPLEMENT_NUMBER_FUNC = TrueExit Function
ERROR_LABEL:
MP_COMPLEMENT_NUMBER_FUNC = False
End FunctionPrivate Function MP_CONVERT_STRING_NUMBER_FUNC(ByVal NUMBER_STR As String, _
ByVal k As Long) As XNUM_OBJ
'k = dgt_maxDim i As Long
Dim p1 As Long
Dim p2 As Long
Dim p3 As LongDim A_OBJ As XNUM_OBJ
Dim TEMP_STR As String
Dim TEMP_VAL As VariantOn Error GoTo ERROR_LABEL
If PUB_DEC_SEP_CHR = "" Then PUB_DEC_SEP_CHR = DECIMAL_POINT_FUNC
TEMP_STR = Trim(NUMBER_STR)
If k > PUB_DIGITS_LIMIT_VAL Then k = PUB_DIGITS_LIMIT_VAL
If Left(TEMP_STR, 1) = "-" Then
p1 = 2: A_OBJ.sign = "-"
ElseIf Left(TEMP_STR, 1) = "+" Then
p1 = 2: A_OBJ.sign = ""
Else
p1 = 1: A_OBJ.sign = ""
End If
p3 = InStr(1, TEMP_STR, "E", vbTextCompare)
If p3 = 0 Then
p3 = Len(TEMP_STR)
A_OBJ.esp = 0
Else
A_OBJ.esp = Right(TEMP_STR, Len(TEMP_STR) – p3)
p3 = p3 – 1
End If
p2 = InStr(1, TEMP_STR, PUB_DEC_SEP_CHR)
If p2 = 0 Then
TEMP_VAL = Mid(TEMP_STR, p1, p3 – p1 + 1)
Else
TEMP_VAL = Mid(TEMP_STR, p1, p2 – p1) + Mid(TEMP_STR, p2 + 1, p3 – p2)
A_OBJ.esp = A_OBJ.esp – (p3 – p2)
End If
If TEMP_VAL = "0" Then
MP_CONVERT_STRING_NUMBER_FUNC = A_OBJ
Exit Function
End If
Do While Left(TEMP_VAL, 1) = "0"
TEMP_VAL = Right(TEMP_VAL, Len(TEMP_VAL) – 1)
Loop
Do While Right(TEMP_VAL, 1) = "0"
TEMP_VAL = Left(TEMP_VAL, Len(TEMP_VAL) – 1)
A_OBJ.esp = A_OBJ.esp + 1
Loop
If Len(TEMP_VAL) > k Then
A_OBJ.esp = A_OBJ.esp + Len(TEMP_VAL) – k
TEMP_VAL = Left(TEMP_VAL, k)
End If
A_OBJ.ndgt = Int((Len(TEMP_VAL) – 1) / PUB_BASE_VAL) + 1
For i = 0 To A_OBJ.ndgt – 1
p2 = Len(TEMP_VAL) – i * PUB_BASE_VAL
p1 = p2 – PUB_BASE_VAL + 1
If p1 < 1 Then
A_OBJ.dgt(i) = Mid(TEMP_VAL, 1, p2)
Else
A_OBJ.dgt(i) = Mid(TEMP_VAL, p1, PUB_BASE_VAL)
End If
Next
MP_CONVERT_STRING_NUMBER_FUNC = A_OBJExit Function
ERROR_LABEL:
End FunctionPrivate Function MP_CONVERT_NUMBER_STRING_FUNC(ByRef V_OBJ As XNUM_OBJ, _
ByVal k As Long)'k = dgt_max
Dim i As Long
Dim j As Long 'esp
Dim p1 As Long
Dim p2 As LongDim E_VAL As Variant
Dim R_VAL As Variant
Dim S_VAL As Variant
Dim TEMP_VAL As Variant
Dim X_OBJ As XNUM_OBJOn Error GoTo ERROR_LABEL
X_OBJ = V_OBJ
If PUB_DEC_SEP_CHR = "" Then PUB_DEC_SEP_CHR = DECIMAL_POINT_FUNC
'check zero
If X_OBJ.ndgt = 0 Then
MP_CONVERT_NUMBER_STRING_FUNC = "0"
Exit Function
End If
If X_OBJ.ndgt = 1 And X_OBJ.dgt(0) = 0 Then
MP_CONVERT_NUMBER_STRING_FUNC = "0"
Exit Function
End If
TEMP_VAL = ""
'numdgt = 0
If X_OBJ.ndgt > 1 Then
For i = 0 To X_OBJ.ndgt – 2
S_VAL = LTrim(Str(X_OBJ.dgt(i)))
'numdgt = numdgt + Len(S_VAL)
If Len(S_VAL) < PUB_BASE_VAL Then S_VAL = String(PUB_BASE_VAL – Len(S_VAL), "0")
+ S_VAL
TEMP_VAL = S_VAL + TEMP_VAL
Next
End If
TEMP_VAL = LTrim(Str(X_OBJ.dgt(X_OBJ.ndgt – 1))) + TEMP_VAL
Do While Left(TEMP_VAL, 1) = 0
TEMP_VAL = Right(TEMP_VAL, Len(TEMP_VAL) – 1)
If TEMP_VAL = "" Then MP_CONVERT_NUMBER_STRING_FUNC = "0": Exit Function
Loop
If Len(TEMP_VAL) > k Then
X_OBJ.esp = X_OBJ.esp + Len(TEMP_VAL) – k
TEMP_VAL = Left(TEMP_VAL, k)
End If
Do While Right(TEMP_VAL, 1) = "0"
TEMP_VAL = Left(TEMP_VAL, Len(TEMP_VAL) – 1)
X_OBJ.esp = X_OBJ.esp + 1
Loop
If X_OBJ.esp > 0 Then
If Len(TEMP_VAL) + X_OBJ.esp > k Then
' formato 1,234540567E+5
j = Len(TEMP_VAL) + X_OBJ.esp – 1
E_VAL = "E+" + LTrim(Str(j))
R_VAL = Right(TEMP_VAL, Len(TEMP_VAL) – 1)
If R_VAL <> "" Then
TEMP_VAL = Left(TEMP_VAL, 1) + PUB_DEC_SEP_CHR + R_VAL + E_VAL
Else
TEMP_VAL = Left(TEMP_VAL, 1) + E_VAL
End If
Else
' formato 123456000
TEMP_VAL = TEMP_VAL + String(X_OBJ.esp, "0")
End If
ElseIf X_OBJ.esp < 0 Then
If Abs(X_OBJ.esp) > k Then
' formato 1,234551436E-6
j = Len(TEMP_VAL) + X_OBJ.esp – 1
E_VAL = "E" + LTrim(Str(j))
R_VAL = Right(TEMP_VAL, Len(TEMP_VAL) – 1)
If R_VAL <> "" Then
TEMP_VAL = Left(TEMP_VAL, 1) + PUB_DEC_SEP_CHR + R_VAL + E_VAL
Else
TEMP_VAL = Left(TEMP_VAL, 1) + E_VAL
End If
Else
If Len(TEMP_VAL) > Abs(X_OBJ.esp) Then
'formato 123,42526
p1 = Len(TEMP_VAL) – Abs(X_OBJ.esp)
p2 = Abs(X_OBJ.esp)
R_VAL = Right(TEMP_VAL, p2)
If R_VAL <> "" Then
TEMP_VAL = Left(TEMP_VAL, p1) + PUB_DEC_SEP_CHR + R_VAL
Else
TEMP_VAL = Left(TEMP_VAL, p1)
End If
Else
'formato 0,00023456
p1 = Abs(X_OBJ.esp) – Len(TEMP_VAL)
TEMP_VAL = "0" + PUB_DEC_SEP_CHR + String(p1, "0") + TEMP_VAL
End If
End If
End IfMP_CONVERT_NUMBER_STRING_FUNC = Trim(X_OBJ.sign) + TEMP_VAL
Exit Function
ERROR_LABEL:
MP_CONVERT_NUMBER_STRING_FUNC = Err.Number
End FunctionPrivate Function MP_SCALE_NUMBER_FUNC(ByRef X_OBJ As XNUM_OBJ, _
ByVal DIGITS_MAX_VAL As Long)Dim i As Long
Dim j As Long
Dim k As Long 'No DigitsOn Error GoTo ERROR_LABEL
Do While X_OBJ.dgt(X_OBJ.ndgt – 1) = 0
X_OBJ.ndgt = X_OBJ.ndgt – 1
If X_OBJ.ndgt = 0 Then Exit Do
Loop
k = Int(DIGITS_MAX_VAL / PUB_BASE_VAL) + 2
j = X_OBJ.ndgt – k
If j > 0 Then
For i = 0 To X_OBJ.ndgt – j – 1: X_OBJ.dgt(i) = X_OBJ.dgt(i + j): Next i
For i = X_OBJ.ndgt – j To X_OBJ.ndgt – 1: X_OBJ.dgt(i) = 0: Next i
X_OBJ.ndgt = X_OBJ.ndgt – j
X_OBJ.esp = X_OBJ.esp + j * PUB_BASE_VAL
End If
MP_SCALE_NUMBER_FUNC = TrueExit Function
ERROR_LABEL:
MP_SCALE_NUMBER_FUNC = False
End FunctionPrivate Function DECIMAL_POINT_FUNC()
DECIMAL_POINT_FUNC = Mid(CStr(1 / 2), 2, 1)
End Function
Private Function MINIMUM_FUNC(a, b)
MINIMUM_FUNC = a: If b < a Then MINIMUM_FUNC = b
End Function
Private Function DEFAULT_DIGITS_FUNC()
DEFAULT_DIGITS_FUNC = PUB_DIGITS_VAL
End Function
Reference
http://digilander.libero.it/foxes/MultiPrecision.htm