• Home
 · 
• Math/Dates
 · 
• This class shows you how to calculte (multily and summerize) with two matrices.

This class shows you how to calculte (multily and summerize) with two matrices.

This class shows you how to calculte (multily and summerize) with two matrices.

Rate This class shows you how to calculte (multily and summerize) with two matrices.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

' up and multiply two (MatrixA and MatrixB) matrices. To set the datas
' in it, call for Matrix A 'SetArrayA' with an onedimensional Array
' that will be the Rows, and the Column in wich you want to have
' this Datas. For Matrix B ist´s the same.

Option Explicit

Private MatrixA() As Double
Private MatrixB() As Double     ' Our two Matrices


Public Property Get MatrixARows() As Integer
' Gives you an Integer Value for the count of rows of Matrix A
' The first row is 0 because it´s much more easier to calculate
' 0-based.
    MatrixARows = UBound(MatrixB, 2)
End Property

Public Property Get MatrixBRows() As Integer
' Gives you an Integer value for the count of rows of Matrix B
' The first row is 0
    MatrixBRows = UBound(MatrixB, 1)
End Property

Public Property Get MatrixACols() As Integer
' Gives you an Integer Value for the count of columns of Matrix A
' The first column is 0
    MatrixACols = UBound(MatrixA, 2)
End Property

Public Property Get MatrixBCols() As Integer
' Gives you an Integer Value for the count of columns of Matrix B
' The first column is 0
    MatrixBCols = UBound(MatrixB, 2)

End Property

Public Function SetArrayA(InputArray() As Double, Col As Integer)
' Set the Array for the Matrix A. InputArray() is onedimensional
' for the rows. If you want more than one row, so call ist more than once.
' You have also to tell it, in wich column this rows should be.
    On Error Resume Next
    Dim i As Integer
    ReDim Preserve MatrixA(UBound(InputArray()), Col)
    For i = 0 To UBound(InputArray())
        MatrixA(i, Col) = InputArray(i)
    Next i
    
End Function

Public Function SetArrayB(InputArray() As Double, Col As Integer)
' Same than SetArrayA but for the Matrix B
    On Error Resume Next
    Dim i As Integer
    ReDim Preserve MatrixB(UBound(InputArray()), Col)
    For i = 0 To UBound(InputArray())
        MatrixB(i, Col) = InputArray(i)
    Next i
End Function

Public Function GetArrayA(OutputArray() As Double, Col As Integer)
' Gives you an onedimensional Array from a column.
    On Error Resume Next
    Dim i As Integer
    ReDim OutputArray(UBound(MatrixA, 1))
    For i = 0 To UBound(MatrixA, 2)
        OutputArray(i) = MatrixA(i, Col)
    Next i

End Function

Public Function GetArrayB(OutputArray() As Double, Col As Integer)
' Same
    On Error Resume Next
    Dim i As Integer
    ReDim OutputArray(UBound(MatrixB, 1))
    For i = 0 To UBound(MatrixB, 2)
        OutputArray(i) = MatrixB(i, Col)
    Next i
End Function

Function Addition(Result() As Double) As Boolean
' Sums up Matrix A and Matrix B
' Result is a twodimensional Array with the result.
' For Example:  Result(0,0) = 1         1   3
'               Result(1,0) = 2         2   4
'               Result(0,1) = 3
'               Result(1,1) = 4     will be the Result matrix
' The first index in the Result Array will be the row, and the second
' the column.

On Error GoTo Fehler

    Dim Row1() As Double, Row2() As Double, tmpRow1() As Double, tmpRow2() As Double
    Dim i As Integer ' Zeilen
    Dim j As Integer ' Spalten
    
    If (MatrixARows <> MatrixBRows) Or (MatrixACols <> MatrixBCols) Then GoTo Fehler

' NOTE: You can only summerize matrices when they are from the same
' dimension: A(2,3)+B(2,3) will work fine but
' A(4,5)+B(1,2) ist not possible.
    
    ReDim Row1(MatrixARows, MatrixACols)
    ReDim Row2(MatrixBRows, MatrixBCols)
    For i = 0 To MatrixARows
        GetArrayA tmpRow1(), i
        For j = 0 To UBound(tmpRow1())
            Row1(i, j) = tmpRow1(j)
        Next j
    Next i
    For i = 0 To MatrixBRows
        GetArrayB tmpRow2(), i
        For j = 0 To UBound(tmpRow2())
            Row2(i, j) = tmpRow2(j)
        Next j
    Next i
    
    ReDim Result(MatrixARows, MatrixACols)
    For i = 0 To UBound(tmpRow1())
        For j = 0 To MatrixARows
            Result(i, j) = Row1(i, j) + Row2(i, j)
        Next j
    Next i
    Addition = True
    Exit Function
Fehler:
    Addition = False

End Function

Function Subtraktion(Result() As Double) As Boolean
' I don´t know if it´s legal to subtract two matrices.
'
On Error GoTo Fehler

    Dim Row1() As Double, Row2() As Double, tmpRow1() As Double, tmpRow2() As Double
    Dim i As Integer ' Zeilen
    Dim j As Integer ' Spalten
    
    If (MatrixARows <> MatrixBRows) Or (MatrixACols <> MatrixBCols) Then GoTo Fehler
    
    ReDim Row1(MatrixARows, MatrixACols)
    ReDim Row2(MatrixBRows, MatrixBCols)
    For i = 0 To MatrixARows
        GetArrayA tmpRow1(), i
        For j = 0 To UBound(tmpRow1())
            Row1(i, j) = tmpRow1(j)
        Next j
    Next i
    For i = 0 To MatrixBRows
        GetArrayB tmpRow2(), i
        For j = 0 To UBound(tmpRow2())
            Row2(i, j) = tmpRow2(j)
        Next j
    Next i
    
    ReDim Result(MatrixARows, MatrixACols)
    For i = 0 To UBound(tmpRow1())
        For j = 0 To MatrixARows
            Result(i, j) = Row1(i, j) - Row2(i, j)
        Next j
    Next i
    Subtraktion = True
    Exit Function
Fehler:
    Subtraktion = False

End Function

Function Multiplikation(Result() As Double) As Boolean
' This ist the function wich multiply two matrices.
' The Result Array looks like the Result Array from the Addition.

On Error GoTo Fehler

    Dim Row1() As Double, Row2() As Double, tmpRow1() As Double, tmpRow2() As Double
    Dim x As Integer ' Zeilen
    Dim y As Integer ' Spalten
    Dim z As Integer
    Dim i As Integer, j As Integer, k As Integer
    If (MatrixACols <> MatrixBRows) Then GoTo Fehler

' NOTE: You can only multiple Matrices if there are as many columns in
' the first Matrix than rows in the second.

    i = MatrixARows: j = MatrixBCols: k = MatrixACols
    
    ReDim Row1(i, k) ' first Matrix, bad name but first I made it different
    ReDim Row2(k, j) ' second Matrix
    For x = 0 To i
        GetArrayA tmpRow1(), x
        For y = 0 To UBound(tmpRow1())
            Row1(y, x) = tmpRow1(y)
        Next y
    Next x
    For x = 0 To k
        GetArrayB tmpRow2(), x
        For y = 0 To UBound(tmpRow2())
            Row2(y, x) = tmpRow2(y)
        Next y
    Next x
    
    ReDim Result(i, j)
    Dim Sum As Double
    Sum = 0
    For x = 0 To i
        For y = 0 To j
            For z = 0 To k
                Sum = Sum + (Row1(x, z) * Row2(z, y))
            Next z
            Result(x, y) = Sum
            Sum = 0
        Next y
    Next x
        
    ' Everything fine
    Multiplikation = True
    Exit Function
    
Fehler:
    ' Error
    Multiplikation = False
End Function

Public Function DeterminanteA(ResArray() As Double) As Boolean
' coming soon
End Function
Public Function DeterminanteB(ResArray() As Double) As Boolean
' coming soon
End Function

Private Sub ClearUp()
    ReDim MatrixA(1, 1)
    ReDim MatrixB(1, 1)
End Sub

Private Sub Class_Initialize()
    ClearUp
End Sub