Big Number Arithmetic with Strings

Visual Basic for Applications · Wikibooks

0%

Contents

    Text

    Size
    100%
    Theme
    Typeface
    Line length
    Spacing

    From Wikibooks, under CC BY-SA 4.0, as the source states it. This page at Wikibooks.

    Big Number Arithmetic with Strings

    Summary

    • This VBA module is intended for Microsoft Excel but can run with minor changes in any of the MS Office applications with a VBA editor.
    • The data types of VBA prevent big number calculations. That is to say, beyond twenty or thirty digits, and even then much care is needed to avoid overflow. Strings have few such restrictions, being limited in most cases to the size of the memory space of the application.
    • The code module below includes most of the basic arithmetic functions without any size restriction.
    • The work is not by this author, but credit should be given to Rebecca Gabriella's String Math Module notes at Big Integer Library. This author has made only cosmetic changes to the work, and added a test procedure to illustrate its use.

    Code Notes

    • The module includes functions for the following: Addition, subtraction, multiplication, and division, all using integer strings. Also included are conversion functions to restore base10 from some other base, and to produce a new base from some existing base10 input. Other support functions such as RealMod() are also included.
    • No output code to the sheet has been provided. Owing to Excel's habit of truncating numbers, even if they are strings, users who want to use the worksheet should concatenate an apostrophe before the display string to prevent this happening. The apostrophe will not be displayed. It is unclear how else this device affects the subsequent use of the numbers.
    • A remainder after division is produced. It can be found as sLastRemainder, and is public.
    • Users who install code in MS Access should change the Option Compare Text to Option Compare DataBase. The former is intended for MS Excel.

    The VBA String Math Module

    Option Explicit
    Option Compare Text 'Database for Access
    '--------------------------------------------------------------------------------------------------------------
    'https://cosxoverx.livejournal.com/47220.html
    'Credit to Rebecca Gabriella's String Math Module (Big Integer Library) for VBA (Visual Basic for Applications)
    ' Minor edits made with comments and other.
    '--------------------------------------------------------------------------------------------------------------
    
    Public Type PartialDivideInfo
        Quotient As Integer
        Subtrahend As String
        Remainder As String
    End Type
    
    Public sLastRemainder As String
    Private Const Alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
    Private Sub TestMultAndDiv()
        'Run this to test multiplication and division with integer strings
        'Open immediate window in View or with ctrl-g to see results
        
        Dim sP1 As String, sP2 As String, sRes1 As String, sRes2 As String
        
        sP1 = "6864797660130609714981900799081393217269" & _
              "4353001433054093944634591855431833976560" & _
              "5212255964066145455497729631139148085803" & _
              "7121987999716643812574028291115057151"         '157 digits and prime
        sP2 = "162259276829213363391578010288127"             '33 digits and also prime
    
        'multiply these two as integer strings
        sRes1 = Multiply(sP1, sP2)
        Debug.Print sP1
        Debug.Print "Length of 1st number : " & Len(sP1)
        Debug.Print sP2
        Debug.Print "Length of 2nd number : " & Len(sP2)
        Debug.Print "Product : " & sRes1
        Debug.Print "Length of product : " & Len(sRes1)
        Debug.Print " "
    
        'then divide the product by sP1 obtains sP2 again
        sRes2 = Divide(sRes1, sP1)
        Debug.Print sRes1
        Debug.Print "Length of 1st number : " & Len(sRes1)
        Debug.Print sP1
        Debug.Print "Length of 2nd number : " & Len(sP1)
        Debug.Print "Integer Quotient : " & sRes2
        Debug.Print "Length of quotient : " & Len(sRes2)
        Debug.Print "Remainder after integer division : " & sLastRemainder
        Debug.Print " "
    
        'Notes:
        'Clear immediate window with ctrl-g, then ctrl-a, then delete
        'If sending long integer strings to the worksheet, prefix with apostrophe before output
        'or it will be truncated by Excel.  Needs consideration also on pickup from sheet.
        'Alternatively use a textbox in a userform for error free display.  Ctrl-C to copy out.
    
    End Sub
    
    Private Function Compare(ByVal sA As String, ByVal sB As String) As Integer
        'Parameters are string integers of any length, for example "-345...", "973..."
        'Returns an integer that represents one of three states
        'sA > sB returns 1, sA < sB returns -1, and sA = sB returns 0
        'Credit to Rebecca Gabriella's String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
        
        Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
        Dim i As Integer, iA As Integer, iB As Integer
        
        'handle any early exits on basis of signs
        bAN = (Left(sA, 1) = "-")
        bBN = (Left(sB, 1) = "-")
        If bAN Then sA = Mid(sA, 2)
        If bBN Then sB = Mid(sB, 2)
        If bAN And bBN Then
            bRN = True
        ElseIf bBN Then
            Compare = 1
            Exit Function
        ElseIf bAN Then
            Compare = -1
            Exit Function
        Else
            bRN = False
        End If
        
        'remove any leading zeros
        Do While Len(sA) > 1 And Left(sA, 1) = "0"
            sA = Mid(sA, 2) 'starting at pos 2
        Loop
        Do While Len(sB) > 1 And Left(sB, 1) = "0"
            sB = Mid(sB, 2) 'starting at pos 2
        Loop
        
        'then decide size first on basis of length
        If Len(sA) < Len(sB) Then
            Compare = -1
        ElseIf Len(sA) > Len(sB) Then
            Compare = 1
        Else 'unless they are the same length
            Compare = 0
            'then check each digit by digit
            For i = 1 To Len(sA)
                iA = CInt(Mid(sA, i, 1))
                iB = CInt(Mid(sB, i, 1))
                If iA < iB Then
                    Compare = -1
                    Exit For
                ElseIf iA > iB Then
                    Compare = 1
                    Exit For
                Else 'defaults zero
                End If
            Next i
        End If
        
        'decide about any negative signs
        If bRN Then
            Compare = -Compare
        End If
    
    End Function
    
    Public Function Add(ByVal sA As String, ByVal sB As String) As String
        'Parameters are string integers of any length, for example "-345...", "973..."
        'Returns sum of sA and sB as string integer in Add()
        'Credit to Rebecca Gabriella's String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
        
        Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
        Dim iA As Integer, iB As Integer, iCarry As Integer
           
        'test for empty parameters
        If Len(sA) = 0 Or Len(sB) = 0 Then
            MsgBox "Empty parameter in Add()"
            Exit Function
        End If
            
        'handle some negative values with Subtract()
        bAN = (Left(sA, 1) = "-")
        bBN = (Left(sB, 1) = "-")
        If bAN Then sA = Mid(sA, 2)
        If bBN Then sB = Mid(sB, 2)
        If bAN And bBN Then 'both negative
            bRN = True      'set output reminder
        ElseIf bBN Then     'use subtraction
            Add = Subtract(sA, sB)
            Exit Function
        ElseIf bAN Then     'use subtraction
            Add = Subtract(sB, sA)
            Exit Function
        Else
            bRN = False
        End If
        
        'add column by column
        iA = Len(sA)
        iB = Len(sB)
        iCarry = 0
        Add = ""
        Do While iA > 0 And iB > 0
            iCarry = iCarry + CInt(Mid(sA, iA, 1)) + CInt(Mid(sB, iB, 1))
            Add = CStr(iCarry Mod 10) + Add
            iCarry = iCarry \ 10
            iA = iA - 1
            iB = iB - 1
        Loop
        
        'Assuming param sA is longer
        Do While iA > 0
            iCarry = iCarry + CInt(Mid(sA, iA, 1))
            Add = CStr(iCarry Mod 10) + Add
            iCarry = iCarry \ 10
            iA = iA - 1
        Loop
        'Assuming param sB is longer
        Do While iB > 0
            iCarry = iCarry + CInt(Mid(sB, iB, 1))
            Add = CStr(iCarry Mod 10) + Add
            iCarry = iCarry \ 10
            iB = iB - 1
        Loop
        Add = CStr(iCarry) + Add
        
        'remove any leading zeros
        Do While Len(Add) > 1 And Left(Add, 1) = "0"
            Add = Mid(Add, 2)
        Loop
        
        'decide about any negative signs
        If Add <> "0" And bRN Then
            Add = "-" + Add
        End If
    
    End Function
    
    Private Function RealMod(ByVal iA As Integer, ByVal iB As Integer) As Integer
        'Returns iA mod iB in RealMod() as an integer. Good for small values.
        'Normally Mod takes on the sign of iA but here
        'negative values are increased by iB until result is positive.
        'Credit to Rebecca Gabriella's String Math Module with added edits.
        'https://cosxoverx.livejournal.com/47220.html
            
        If iB = 0 Then
            MsgBox "Divide by zero in RealMod()"
            Exit Function
        End If
        
        If iA Mod iB = 0 Then
            RealMod = 0
        ElseIf iA < 0 Then
            RealMod = iB + iA Mod iB 'increase till pos
        Else
            RealMod = iA Mod iB
        End If
    
    End Function
    
    Private Function RealDiv(ByVal iA As Integer, ByVal iB As Integer) As Integer
        'Returns integer division iA divided by iB in RealDiv().Good for small values.
        'Credit to Rebecca Gabriella's String Math Module with added edits.
        'https://cosxoverx.livejournal.com/47220.html
        
        If iB = 0 Then
            MsgBox "Divide by zero in RealDiv()"
            Exit Function
        End If
        
        If iA Mod iB = 0 Then
            RealDiv = iA \ iB
        ElseIf iA < 0 Then
            RealDiv = iA \ iB - 1 'round down
        Else
            RealDiv = iA \ iB
        End If
    
    End Function
    
    Public Function Subtract(ByVal sA As String, ByVal sB As String) As String
        'Parameters are string integers of any length, for example "-345...", "973..."
        'Returns sA minus sB as string integer in Subtract()
        'Credit to Rebecca Gabriella's String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
        
        Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
        Dim iA As Integer, iB As Integer, iComp As Integer
        
        'test for empty parameters
        If Len(sA) = 0 Or Len(sB) = 0 Then
            MsgBox "Empty parameter in Subtract()"
            Exit Function
        End If
            
        'handle some negative values with Add()
        bAN = (Left(sA, 1) = "-")
        bBN = (Left(sB, 1) = "-")
        If bAN Then sA = Mid(sA, 2)
        If bBN Then sB = Mid(sB, 2)
        If bAN And bBN Then
            bRN = True
        ElseIf bBN Then
            Subtract = Add(sA, sB)
            Exit Function
        ElseIf bAN Then
            Subtract = "-" + Add(sA, sB)
            Exit Function
        Else
            bRN = False
        End If
        
        'get biggest value into variable sA
        iComp = Compare(sA, sB)
        If iComp = 0 Then     'parameters equal in size
            Subtract = "0"
            Exit Function
        ElseIf iComp < 0 Then 'sA < sB
            Subtract = sA     'so swop sA and sB
            sA = sB           'to ensure sA >= sB
            sB = Subtract
            bRN = Not bRN     'and reverse output sign
        End If
        iA = Len(sA)          'recheck lengths
        iB = Len(sB)
        iComp = 0
        Subtract = ""
            
        'subtract column by column
        Do While iA > 0 And iB > 0
            iComp = iComp + CInt(Mid(sA, iA, 1)) - CInt(Mid(sB, iB, 1))
            Subtract = CStr(RealMod(iComp, 10)) + Subtract
            iComp = RealDiv(iComp, 10)
            iA = iA - 1
            iB = iB - 1
        Loop
        'then assuming param sA is longer
        Do While iA > 0
            iComp = iComp + CInt(Mid(sA, iA, 1))
            Subtract = CStr(RealMod(iComp, 10)) + Subtract
            iComp = RealDiv(iComp, 10)
            iA = iA - 1
        Loop
        
        'remove any leading zeros from result
        Do While Len(Subtract) > 1 And Left(Subtract, 1) = "0"
            Subtract = Mid(Subtract, 2)
        Loop
        
        'decide about any negative signs
        If Subtract <> "0" And bRN Then
            Subtract = "-" + Subtract
        End If
    
    End Function
    
    Public Function Multiply(ByVal sA As String, ByVal sB As String) As String
        'Parameters are string integers of any length, for example "-345...", "973..."
        'Returns sA times sB as string integer in Multiply()
        'Credit to Rebecca Gabriella's String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
        
        Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
        Dim m() As Long, iCarry As Long
        Dim iAL As Integer, iBL As Integer, iA As Integer, iB As Integer
            
        'test for empty parameters
        If Len(sA) = 0 Or Len(sB) = 0 Then
            MsgBox "Empty parameter in Multiply()"
            Exit Function
        End If
            
        'handle any negative signs
        bAN = (Left(sA, 1) = "-")
        bBN = (Left(sB, 1) = "-")
        If bAN Then sA = Mid(sA, 2)
        If bBN Then sB = Mid(sB, 2)
        bRN = (bAN <> bBN)
        iAL = Len(sA)
        iBL = Len(sB)
        
        'perform long multiplication without carry in notional columns
        ReDim m(1 To (iAL + iBL - 1)) 'expected length of product
        For iA = 1 To iAL
            For iB = 1 To iBL
                m(iA + iB - 1) = m(iA + iB - 1) + CLng(Mid(sA, iAL - iA + 1, 1)) * CLng(Mid(sB, iBL - iB + 1, 1))
            Next iB
        Next iA
        iCarry = 0
        Multiply = ""
        
        'add up column results with carry
        For iA = 1 To iAL + iBL - 1
            iCarry = iCarry + m(iA)
            Multiply = CStr(iCarry Mod 10) + Multiply
            iCarry = iCarry \ 10
        Next iA
        Multiply = CStr(iCarry) + Multiply
        
        'remove any leading zeros
        Do While Len(Multiply) > 1 And Left(Multiply, 1) = "0"
            Multiply = Mid(Multiply, 2)
        Loop
        
        'decide about any negative signs
        If Multiply <> "0" And bRN Then
            Multiply = "-" + Multiply
        End If
    
    End Function
    
    Public Function PartialDivide(ByVal sA As String, ByVal sB As String) As PartialDivideInfo
        'Called only by Divide() to assist in fitting trials for long division
        'All of Quotient, Subtrahend, and Remainder are returned as elements of type PartialDivideInfo
        'Credit to Rebecca Gabriella's String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
            
        For PartialDivide.Quotient = 9 To 1 Step -1                                'propose a divisor to fit
            PartialDivide.Subtrahend = Multiply(sB, CStr(PartialDivide.Quotient))  'test by multiplying it out
            If Compare(PartialDivide.Subtrahend, sA) <= 0 Then                     'best fit found
                PartialDivide.Remainder = Subtract(sA, PartialDivide.Subtrahend)   'get remainder
                Exit Function                                                      'exit with best fit details
            End If
        Next PartialDivide.Quotient
        
        'no fit found, divisor too big
        PartialDivide.Quotient = 0
        PartialDivide.Subtrahend = "0"
        PartialDivide.Remainder = sA
    
    End Function
    
    Public Function Divide(ByVal sA As String, ByVal sB As String) As String
        'Parameters are string integers of any length, for example "-345...", "973..."
        'Returns sA divided by sB as string integer in Divide()
        'The remainder is available as sLastRemainder at Module level
        'Credit to Rebecca Gabriella's String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
        
        Dim bAN  As Boolean, bBN As Boolean, bRN As Boolean
        Dim iC As Integer
        Dim s As String
        Dim d As PartialDivideInfo
        
        'test for empty parameters
        If Len(sA) = 0 Or Len(sB) = 0 Then
            MsgBox "Empty parameter in Divide()"
            Exit Function
        End If
        
        bAN = (Left(sA, 1) = "-") 'true for neg
        bBN = (Left(sB, 1) = "-")
        If bAN Then sA = Mid(sA, 2) 'take two charas if neg
        If bBN Then sB = Mid(sB, 2)
        bRN = (bAN <> bBN)
        If Compare(sB, "0") = 0 Then
            Err.Raise 11
            Exit Function
        ElseIf Compare(sA, "0") = 0 Then
            Divide = "0"
            sLastRemainder = "0"
            Exit Function
        End If
        iC = Compare(sA, sB)
        If iC < 0 Then
            Divide = "0"
            sLastRemainder = sA
            Exit Function
        ElseIf iC = 0 Then
            If bRN Then
                Divide = "-1"
            Else
                Divide = "1"
            End If
            sLastRemainder = "0"
            Exit Function
        End If
        Divide = ""
        s = ""
        
        'Long division method
        For iC = 1 To Len(sA)
            'take increasing number of digits
            s = s + Mid(sA, iC, 1)
            d = PartialDivide(s, sB) 'find best fit
            Divide = Divide + CStr(d.Quotient)
            s = d.Remainder
        Next iC
        
        'remove any leading zeros
        Do While Len(Divide) > 1 And Left(Divide, 1) = "0"
            Divide = Mid(Divide, 2)
        Loop
        
        'decide about the signs
        If Divide <> "0" And bRN Then
            Divide = "-" + Divide
        End If
        
        sLastRemainder = s 'string integer remainder
    
    End Function
    
    Public Function LastModulus() As String
        LastModulus = sLastRemainder
    End Function
    
    Public Function Modulus(ByVal sA As String, ByVal sB As String) As String
        Divide sA, sB
        Modulus = sLastRemainder
    End Function
    
    Public Function BigIntFromString(ByVal sIn As String, ByVal iBaseIn As Integer) As String
        'Returns base10 integer string from sIn of different base (iBaseIn).
        'Example for sIn = "1A" and iBaseIn = 16, returns the base10 result 26.
        'Credit to Rebecca Gabriella's String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
                
        Dim bRN As Boolean
        Dim sBS As String
        Dim iP As Integer, iV As Integer
        
        'test for empty parameters
        If Len(sIn) = 0 Or iBaseIn = 0 Then
            MsgBox "Bad parameter in BigIntFromString()"
            Exit Function
        End If
            
        'handle negative signs
        If Left(sIn, 1) = "-" Then
            bRN = True
            sIn = Mid(sIn, 2)
        Else
            bRN = False
        End If
        sBS = CStr(iBaseIn)
        
        BigIntFromString = "0"
        For iP = 1 To Len(sIn)
            'use constant list position and base for conversion
            iV = InStr(Alphabet, UCase(Mid(sIn, iP, 1)))
            If iV > 0 Then 'accumulate
                BigIntFromString = Multiply(BigIntFromString, sBS)
                BigIntFromString = Add(BigIntFromString, CStr(iV - 1))
            End If
        Next iP
        
        'decide on any negative signs
        If bRN Then
            BigIntFromString = "-" + BigIntFromString
        End If
    
    End Function
    
    Public Function BigIntToString(ByVal sIn As String, ByVal iBaseOut As Integer) As String
        'Returns integer string of specified iBaseOut (iBaseOut) from base10 (sIn) integer string.
        'Example for sIn = "26" and iBaseOut = 16, returns the output "1A".
        'Credit to Rebecca Gabriella'sIn String Math Module with added edits
        'https://cosxoverx.livejournal.com/47220.html
                
        Dim bRN As Boolean
        Dim sB As String
        Dim iV As Integer
        
        'test for empty parameters
        If Len(sIn) = 0 Or iBaseOut = 0 Then
            MsgBox "Bad parameter in BigIntToString()"
            Exit Function
        End If
        
        'handle negative signs
        If Left(sIn, 1) = "-" Then
            bRN = True
            sIn = Mid(sIn, 2)
        Else
            bRN = False
        End If
        sB = CStr(iBaseOut)
        
        BigIntToString = ""
        Do While Compare(sIn, "0") > 0
            sIn = Divide(sIn, sB)
            iV = CInt(LastModulus())
            'locates appropriate alphabet character
            BigIntToString = Mid(Alphabet, iV + 1, 1) + BigIntToString
        Loop
        
        'decide on any negative signs
        If BigIntToString = "" Then
            BigIntToString = "0"
        ElseIf BigIntToString <> "0" And bRN Then
            BigIntToString = "-" + BigIntToString
        End If
    
    End Function
    

    Added Big Math Fuctions

    • Factorial() makes use of Multiply() and other integer math functions of the main module. It is of course fairly slow but is not otherwise limited in any practical way. The code has been arbitrarily limited to calculating values up to 1000!, but this can be adjusted by the user. DoEvents is important here, since it allows breaking the run if an unwise attempt is made. Reciprocal factorials and negative factorials are not handled here.
    • IntStrByExp() raises integer strings to an exponent. Again, negative exponents cannot yet be handled in this procedure, though the number to raise can take a negative value.
    Sub testFactorial()
       'Run this to test factorial
          
       Dim sIn As Integer, sOut As String
       
       sIn = "400"
       sOut = Factorial(sIn)
       
       'output Immediate Window
       Debug.Print sIn & "!" & vbCrLf & _
                   sOut & vbCrLf & _
                   Len(sOut) & " digits" & vbCrLf
       
       'output message box - short output
       'MsgBox sIn & "!" & vbcrlf & _
               sOut & vbCrLf & _
               Len(sOut) &  " digits" & vbCrLf
    
    End Sub
    
    Function Factorial(ByVal sA As String) As String
        'Returns integer string factorial for integer string parameter sA
        '2000! in 30 secs (5736 digits); 1000! in six seconds (2568 digits)
        '400! in one second (869 digits);100! pdq (158 digits).
        'Arbitrarily set max sA = "1000"
        
        Dim iC As Integer
            
        'avoid excessively long runs
        If CInt(sA) >= 1000 Then
            MsgBox "Run time too long - closing."
            Factorial = "Error - Run time too long"
            Exit Function
        End If
            
        iC = CInt(sA)
        Factorial = "1"
        
        'run factorial loop
        Do Until iC <= 0
            DoEvents 'permits break key use
            Factorial = Multiply(Factorial, iC)
            iC = iC - 1
        Loop
    
    End Function
    
    Sub testIntStrByExp()
       'Run this to test IntStrByExp
          
       Dim sIn As String, sOut As String, iExp As Integer, bA As Boolean
       Dim nL As Integer
       
       
       sIn = "-123456789123456789"
       iExp = 7
       
       sOut = IntStrByExp(sIn, iExp)
       nL = Len(sOut)
       If Left(sOut, 1) = "-" Then
       nL = nL - 1
       End If
       
       'output Immediate Window
       Debug.Print sIn & "^" & iExp & " equals" & vbCrLf & _
                   sOut & vbCrLf & _
                   nL & " digits out" & vbCrLf
       
       'output message box - short output
       MsgBox sIn & "^" & iExp & " equals" & vbCrLf & _
                   sOut & vbCrLf & _
                   nL & " digits out" & vbCrLf
    
    End Sub
    
    Function IntStrByExp(ByVal sA As String, ByVal iExp As Integer) As String
        'Returns integer string raised to exponent iExp as integer string
        'Assumes posiive exponent, and pos or neg string integer
        
        Dim bA As Boolean, bR As Boolean
        
        'check parameter
        If iExp < 0 Then
            MsgBox "Cannot handle negative powers yet"
            Exit Function
        End If
        
        'handle any negative signs
        bA = (Left(sA, 1) = "-")
        If bA Then sA = Mid(sA, 2) Else sA = Mid(sA, 1)
        If bA And RealMod(iExp, 2) <> 0 Then bR = True
        
        'run multiplication loop
        IntStrByExp = "1"
        Do Until iExp <= 0
            DoEvents 'permits break key use
            IntStrByExp = Multiply(IntStrByExp, sA)
            iExp = iExp - 1
        Loop
    
        'remove any leading zeros
        Do While Len(IntStrByExp) > 1 And Left(IntStrByExp, 1) = "0"
            IntStrByExp = Mid(IntStrByExp, 2)
        Loop
        
        'decide on any signs
        If IntStrByExp <> "0" And bR Then
           IntStrByExp = "-" & IntStrByExp
        End If
    
    End Function
    

    See Also