Handy Maths Snippets

[plenderj]

Here are some maths functions/routines implemented in VB.
They may be of use to some of you.

If you have any comments or suggestions, or have any pieces of code you'd like me to add, just let me know.

Contents, in order;
00) Constant Pi
01) Constant e
02) isDivisor()
03) recursiveGCD()
04) iterativeGCD()
05) eulerPhi()
06) nextPrimeDivisor()
07) isPrime()
08) factors()
09) powerMod()
10) binaryToDecimal()
11) decimalToBinary()
12) factorial()
13) binomial()
14) toCharacterCode()
15) linesCrossed()
16) NAND
17) NOR
18) XNOR


Option Explicit

'' Mathematical Constants
''
Const Pi As Single = 3.14159265358979
Const e As Single = 2.71828182845905



'' Number Theory Related
''
'' IsDivisor, RecursiveGCD, IterativeGCD,
'' EulerPhi, NextPrimeDivisor, IsPrime
''
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



'' Miscellaneous
''
'' BinaryToDecimal, DecimalToBinary, Factorial, Binomial, ToCharacterCode
''
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



'' Boolean Operations
''
'' NAND, NOR, XNOR
''
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

[plenderj]

* 21-October-2004 - Moved to CodeBank *

[Fox]

The following functions are part of my Tile Engine Tutorial (http://fox.yhoko.com); thought they'd fit here.
Both accept 2 input points given by X and Y coordinates.

1) GetDistance
Public Function GetDistance(X1 As Long, Y1 As Long, X2 As Long, Y2 As Long) As Long

'// Returns the distance between the given points
'// by fox@yhoko.com - http://vbfx.yhoko.com/

GetDistance = Sqr(CDbl(X2 - X1) ^ 2 + CDbl(Y2 - Y1) ^ 2)
End Function

2) GetAngle
Public Function GetAngle(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As Single

'// Returns the angle between the given points
'// by fox@yhoko.com - http://vbfx.yhoko.com/

Dim TempX As Single
Dim TempY As Single
Dim Angle As Single

Const Pi As Single = 3.141593
Const Pi2 As Single = 6.283185

'Get difference
TempX = (X2 - X1)
TempY = (Y2 - Y1)

'Special case X
If TempX = 0 Then
If Y2 > Y1 Then
Angle = Pi * 0.5
ElseIf Y2 < Y1 Then
Angle = Pi * 1.5
End If

'Return angle
GetAngle = Angle
Exit Function
End If

'Special case Y
If TempY = 0 Then
If X2 > X1 Then
Angle = 0
ElseIf X2 < X1 Then
Angle = Pi
End If

'Return angle
GetAngle = Angle
Exit Function
End If

'Get angle
Angle = Atn(Abs(TempY) / Abs(TempX))

'Calculate angle
If TempX < 0 And TempY > 0 Then: Angle = Pi - Angle
If TempX < 0 And TempY < 0 Then: Angle = Pi + Angle
If TempX > 0 And TempY < 0 Then: Angle = Pi2 - Angle

'Put in range
If Angle < 0 Then: Angle = Angle + Pi2

'Return angle
GetAngle = Angle
End Function

[plenderj]

bump ;)

[Rich2189]

Private Sub Form_Load()

MsgBox getAngleBetweenLines(4, 2, 9, 1, 0, 0)

End Sub

Private Function getAngleBetweenLines(commonX As Single, commonY As Single, X1 As Single, Y1 As Single, Y2 As Single, X2 As Single) As Double

Const Pi As Single = 3.141593
Dim length As Double, differnceX1 As Double, differenceX2 As Double, differenceY1 As Double, differenceY2 As Double, other As Double

differenceX1 = commonX - X1
differenceY1 = commonY - Y1
differenceX2 = commonX - X2
differenceY2 = commonY - Y2

getAngleBetweenLines = invCos(((differenceX1 * differenceX2) + (differenceY1 * differenceY2)) / _
(Sqr(CDbl(differenceX1) ^ 2 + CDbl(differenceY1) ^ 2) * Sqr(CDbl(differenceX2) ^ 2 + CDbl(differenceY2) ^ 2)))



End Function

Private Function invCos(x As Double) As Double
If x = 1 Then
invCos = Pi
Else

invCos = (Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1))
End If

End Function

[MerrickDeWitt]

Mostly nice stuff. I haven't had time to take anything more than a very brief look. One comment:

The For loop in isPrime only needs to run from 2 to nX/2-1 and not all the way to nX-1.

[MerrickDeWitt]

Again, this is just for speed and consistency.

In the getAngleBetweenLines code:
One can save one Sqr in the denominator of the main calculation because Sqr(a)*Sqr(b) = Sqr(a*b)
Also, in the invCos function, 2*Atn(1) is a constant (pi/2). One should calculate or define that as a constant before hand (or simply use the definition of pi already provided) to save an additional Atn calcuation each time the routine is called.

[MerrickDeWitt]

I should also add: isn't it generally faster to calculate x*x than x^2?