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