by Adam Ilan (1 Submission)
Category: Math/Dates
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Thu 11th March 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Calculates Square Matrice Determinant
VBcoders
'
'Matrice Determinant Calculation Code By Adam Ilan 2/11/1999
' [email protected]
'Test subroutine for the functions
Private Sub Test()
Dim B(1 To 3, 1 To 3) As Double
Dim mB() As Double
Dim m(1 To 1, 1 To 1) As Double
m(1, 1) = 45
Debug.Print GetDeterminant(m)
B(1, 1) = 1.2
B(1, 2) = 2.3
B(1, 3) = 3.2
B(2, 1) = 4.8
B(2, 2) = 5.2
B(2, 3) = 6
B(3, 1) = 7
B(3, 2) = 6
PrintMatrix B
Debug.Print
mB = GetMinorM(B, 2, 2)
PrintMatrix mB
Debug.Print "Determinant of B:" & GetDeterminant(B)
Debug.Print "Determinant of mB:" & GetDeterminant(mB)
End Sub
' Purpose: This Function gets a Square matrice of any size, and returns its Determinant
' How: The function is a recursive function, it uses GetMinorM to get the Minor
' Matrice of the first row's limbs and then calls itself to calculate
' the Minor's Determinant
Public Function GetDeterminant(Matrix() As Double) As Double
Dim SizeX As Integer, SizeY As Integer
Dim LboundX As Integer, LboundY As Integer
Dim x As Integer, Det As Double
Dim MinorM() As Double
LboundX = LBound(Matrix, 1)
LboundY = LBound(Matrix, 2)
SizeX = UBound(Matrix, 1) - LboundX + 1
SizeY = UBound(Matrix, 2) - LboundY + 1
If SizeX <> SizeY Then
GetDeterminant = 0
Exit Function
End If
If SizeX = 1 Then
GetDeterminant = Matrix(LboundX, LboundY)
Exit Function
End If
For x = LboundX To LboundX + SizeX - 1
MinorM = GetMinorM(Matrix, x, LboundY)
Det = Det + ((-1) ^ (x - LBound(Matrix, LboundY))) * Matrix(x, LboundY) * GetDeterminant(MinorM)
Next x
GetDeterminant = Det
End Function
'Purpose: Extracts The (MinorX,MinorY) minor matrice of Matrix()
Public Function GetMinorM(Matrix() As Double, MinorX As Integer, MinorY As Integer) As Double()
Dim SizeX As Integer, SizeY As Integer
Dim x As Integer, y As Integer
Dim i As Integer, j As Integer
Dim MinorM() As Double
SizeX = UBound(Matrix, 1) - LBound(Matrix, 1) + 1
SizeY = UBound(Matrix, 2) - LBound(Matrix, 2) + 1
If SizeX <> SizeY Then
Exit Function
End If
ReDim MinorM(LBound(Matrix, 1) To UBound(Matrix, 1) - 1, LBound(Matrix, 2) To UBound(Matrix, 2) - 1)
i = LBound(Matrix, 1)
For x = LBound(Matrix, 1) To UBound(Matrix, 1)
If x <> MinorX Then
j = LBound(Matrix, 2)
For y = LBound(Matrix, 2) To UBound(Matrix, 2)
If y <> MinorY Then
MinorM(i, j) = Matrix(x, y)
j = j + 1
End If
Next y
i = i + 1
End If
Next x
GetMinorM = MinorM
End Function
'Prints a matrice to the debug window
Public Sub PrintMatrix(Matrix() As Double)
Dim x As Integer, y As Integer
For x = LBound(Matrix, 1) To UBound(Matrix, 1)
For y = LBound(Matrix, 2) To UBound(Matrix, 2)
Debug.Print Format(Matrix(x, y), "00.0") & " , ";
Next y
Debug.Print
Next x
End Sub
