End User Modeling

The Richard Ivey School of Business

September 18th, 2009

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.

In the following spreadsheet I adapted some routines to perform the factorial of n in extended precision.

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


  1. Option Explicit

    Private 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 = 250

    Private Type XNUM_OBJ
    sign As String * 1
    dgt(0 To 94) As Double
    esp As Long
    ndgt As Integer
    End Type

    Function 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 Function

    Function 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_OBJ

    On 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 Function

    V1_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 Function

    Function 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_OBJ

    On 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 Function

    V1_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 Function

    Function 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 Long

    Dim P_VAL As Variant
    Dim Y_VAL As Variant

    Dim P_OBJ As XNUM_OBJ
    Dim Y_OBJ As XNUM_OBJ

    Dim U_ARR(0 To 30) As Long
    Dim W_ARR(0 To 30) As Long

    On 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_VAL

    Exit 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 Long

    Dim P_VAL As Double
    Dim 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 < 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 Double

    Dim 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 2

    For 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 Function

    Private 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_OBJ

    Dim i As Long
    Dim j As Long
    Dim k As Long

    Dim S_VAL As Double
    Dim Z_VAL As Double

    Dim 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_OBJ

    Exit Function
    ERROR_LABEL:
    End Function

    Private 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_OBJ

    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long

    Dim m As Long
    Dim n As Long

    Dim ii As Long
    Dim jj As Long
    Dim kk As Long

    Dim Q_VAL As Double
    Dim R_VAL As Double
    Dim X_VAL As Double
    Dim Y_VAL As Double

    Dim 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 Boolean

    On 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 > 10000

    V3_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_OBJ

    Exit 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 < +999999

    On 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 If

    Exit 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 = 0

    Exit Function
    ERROR_LABEL:
    End Function

    Private Function MP_REARRANGING_FUNC(ByRef X_OBJ As XNUM_OBJ)

    Dim i As Long
    Dim R_VAL As Double
    Dim D_VAL As Double

    On 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 Long

    On 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 = True

    Exit Function
    ERROR_LABEL:
    MP_COMPLEMENT_NUMBER_FUNC = False
    End Function

    Private Function MP_CONVERT_STRING_NUMBER_FUNC(ByVal NUMBER_STR As String, _
    ByVal k As Long) As XNUM_OBJ
    'k = dgt_max

    Dim i As Long
    Dim p1 As Long
    Dim p2 As Long
    Dim p3 As Long

    Dim A_OBJ As XNUM_OBJ
    Dim TEMP_STR As String
    Dim TEMP_VAL As Variant

    On 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_OBJ

    Exit Function
    ERROR_LABEL:
    End Function

    Private 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 Long

    Dim E_VAL As Variant
    Dim R_VAL As Variant
    Dim S_VAL As Variant
    Dim TEMP_VAL As Variant
    Dim X_OBJ As XNUM_OBJ

    On 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 If

    MP_CONVERT_NUMBER_STRING_FUNC = Trim(X_OBJ.sign) + TEMP_VAL

    Exit Function
    ERROR_LABEL:
    MP_CONVERT_NUMBER_STRING_FUNC = Err.Number
    End Function

    Private 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 Digits

    On 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 = True

    Exit Function
    ERROR_LABEL:
    MP_SCALE_NUMBER_FUNC = False
    End Function

    Private 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

Leave a Reply

You must be logged in to post a comment.