Option Explicit
[b]'' Mathematical Constants
''[/b]
Const Pi As Single = 3.14159265358979
Const e As Single = 2.71828182845905
[b]'' Number Theory Related
''
'' IsDivisor, RecursiveGCD, IterativeGCD,
'' EulerPhi, NextPrimeDivisor, IsPrime
''[/b]
Public Function isDivisor(ByVal nDenominator As Long, ByVal nNumerator As Long) As Boolean
isDivisor = ((nNumerator Mod nDenominator) = 0)
End Function
Public Function recursiveGCD(ByVal num1 As Long, ByVal num2 As Long) As Long
If (num1 = 1) Or (num2 = 1) Then
recursiveGCD = 1
Else
If (num1 = num2) Then
recursiveGCD = num1
Else
If (num1 > num2) Then
recursiveGCD = recursiveGCD(num1 - num2, num2)
Else
recursiveGCD = recursiveGCD(num2 - num1, num1)
End If
End If
End If
End Function
Public Function iterativeGCD(ByVal num1 As Long, ByVal num2 As Long) As Long
If (num1 <> 0) And (num2 <> 0) Then
If num1 = 1 Or num2 = 1 Then iterativeGCD = 1
Dim i As Long, j As Long, n As Long, largestGCD As Long
Dim divisors1() As Long, divisors2() As Long
ReDim divisors1(0), divisors2(0)
For i = 1 To num1
If IsDivisor(i, num1) Then
divisors1(UBound(divisors1)) = i
ReDim Preserve divisors1(UBound(divisors1) + 1)
End If
Next
For i = 1 To num2
If IsDivisor(i, num2) Then
divisors2(UBound(divisors2)) = i
ReDim Preserve divisors2(UBound(divisors2) + 1)
End If
Next
n = IIf(UBound(divisors1) > UBound(divisors2), num2, num1)
For i = 0 To UBound(divisors1)
For j = 0 To UBound(divisors2)
If (divisors1(i) = divisors2(j)) Then If divisors1(i) > largestGCD Then largestGCD = divisors1(i)
Next
Next
iterativeGCD = largestGCD
Else
iterativeGCD = -1
End If
End Function
Public Function eulerPhi(ByVal nX As Long) As Long
Dim i As Long
For i = 1 To nX
If (GCD(i, nX) = 1) Then
eulerPhi = eulerPhi + 1
End If
Next i
End Function
Public Function nextPrimeDivisor(ByVal divisorGiven As Long, ByVal nX As Long) As Long
nextPrimeDivisor = 0
If (divisorGiven < nX) Then
Dim i As Long
For i = (divisorGiven + 1) To nX
If (IsDivisor(i, nX) And IsPrime(i) And (i <> nX)) Then
nextPrimeDivisor = i
Exit Function
End If
Next i
End If
End Function
Public Function isPrime(ByVal nX As Long) As Boolean
If (nX = 1) Then isPrime = False
If (nX = 2) Then isPrime = True
isPrime = True
Dim i As Long
For i = 2 To nX - 1
If Not (GCD(nX, i) = 1) Then
isPrime = False
Exit For
End If
Next i
End Function
Public Function factors(ByVal nX As Long, ByVal onlyReturnPrimeFactors As Boolean) As Long()
Dim retVal() As Long
ReDim retVal(0)
If (Not IsPrime(nX)) Then
Dim i As Long
For i = 1 To nX
If (IsDivisor(i, nX)) Then
If ((onlyReturnPrimeFactors And IsPrime(i)) Or Not onlyReturnPrimeFactors) Then
retVal(UBound(retVal)) = i
ReDim Preserve retVal(UBound(retVal) + 1)
End If
End If
Next i
End If
factors = retVal
End Function
Public Function powerMod(ByVal a As Long, ByVal b As Long, ByVal n As Long) As Long
powerMod = (a ^ b) Mod n
End Function
[b]'' Miscellaneous
''
'' BinaryToDecimal, DecimalToBinary, Factorial, Binomial, ToCharacterCode
''[/b]
Public Function binaryToDecimal(ByVal binaryString As String) As Long
If (Not Len(binaryString) > 1023) Then
If (binaryString <> "") And (Replace(Replace(binaryString, "1", ""), "0", "") = "") Then
Dim i As Long
binaryString = StrReverse(binaryString)
For i = 0 To Len(binaryString)
If (Mid(binaryString, i + 1, 1) = 1) Then
binaryToDecimal = binaryToDecimal + (2 ^ (i))
End If
Next i
End If
binaryToDecimal = retVal
Else
MsgBox "Overflow would occur"
Exit Function
End If
End Function
Public Function decimalToBinary(ByVal nDecimal As Long) As String
Dim nTemp As Long
nTemp = nDecimal
Do
decimalToBinary = IIf(((nTemp / 2) = CLng(nTemp / 2)), "0", "1") & decimalToBinary
nTemp = (nTemp - 0.1) / 2
If (nTemp < 1) Then Exit Do
Loop
End Function
Public Function factorial(ByVal nX As Double) As Double
If (nX = 1) Then
factorial = 1
Else
factorial = nX * factorial(nX - 1)
End If
End Function
Public Function binomial(ByVal n As Long, ByVal m As Long) As Double
Dim tempTopLine As Long
Dim tempBottomLine As Long
tempTopLine = 1
tempBottomLine = 1
Dim i As Long
If (n > m) Then
For i = n To ((n - m) + 1) Step -1
tempTopLine = tempTopLine * i
Next i
For i = 1 To m
tempBottomLine = tempBottomLine * i
Next i
End If
Binomial = tempTopLine / tempBottomLine
End Function
Public Function toCharacterCode(ByVal strString As String, Optional ByVal strDelimeter As String) As String
Dim i As Long
Dim nStrLen As Long
nStrLen = Len(strString)
toCharacterCode = Asc(Left(strString, 1))
If (nStrLen >= 1) Then
For i = 2 To nStrLen
toCharacterCode = Asc(Mid(strString, i, 1)) & strDelimeter & toCharacterCode
Next i
End If
ToCharacterCode = retVal
End Function
Public Function linesCrossed(ByRef line1 As Line, ByRef line2 As Line) As Boolean
linesCrossed = False
Dim dx1 As Double, dy1 As Double, dx2 As Double, dy2 As Double
Dim n As Double, s As Double
dx1 = line1.X2 - line1.X1
dy1 = line1.Y2 - line1.Y1
dx2 = line2.X2 - line2.X1
dy2 = line2.Y2 - line2.Y1
n = 0#: s = 0#
If ((dx2 * dy1) - (dy2 * dx1) <> 0) Then
n = (dx1 * (line2.Y1 - line1.Y1) + dy1 * (line1.X1 - line2.X1)) / (dx2 * dy1 - dy2 * dx1)
s = (dx2 * (line1.Y1 - line2.Y1) + dy2 * (line2.X1 - line1.X1)) / (dy2 * dx1 - dx2 * dy1)
linesCrossed = ((s >= 0) And (s <= 1) And (n >= 0) And (n <= 1))
End If
End Function
[b]'' Boolean Operations
''
'' NAND, NOR, XNOR
''[/b]
Public Function NAND(ByVal bit1 As Boolean, ByVal bit2 As Boolean) As Boolean
NAND = Not (bit1 And bit2)
End Function
Public Function NOR(ByVal bit1 As Boolean, ByVal bit2 As Boolean) As Boolean
NOR = Not (bit1 Or bit2)
End Function
Public Function XNOR(ByVal bit1 As Boolean, ByVal bit2 As Boolean) As Boolean
XNOR = Not (bit1 Xor bit2)
End Function
Reply With Quote