Matrix Calculation ; Gauss-Jordan Method

When I try running your macro, it bombs on line 28 because a(j, j) = 0, and thus you have a division by
zero situation, which of course is arithmetically impossible.

I will not pretend to understand your method, but you need to either prevent the divisor from ever being
zero, or test for the possibility of the quotient being zero and then bypassing the division if needed.

For example, a simple rule like "if a(j, j) = 0 then make the result 0" can be implemented by replacing

            If j <> i Then a(j, i) = a(j, i) / a(j, j)

with

            If a(j, j) <> 0 Then
                If j <> i Then a(j, i) = a(j, i) / a(j, j)
            Else
                a(j, i) = 0
            End If

Heers the technical bit...

The Gauss Jordan method is used to reduce a matrix into reduced row-echelon form, not all matricies have can be solved this way without some row manipulation first, and in those cases the Gauss Jordan method will not work (you see it as a division by zero)

You can change your matrix to fit by changing the order of the rows to ensure that you have a non zero value at all points on the leading diagonal as these become divisors in the calculation. Your algorithm should be doing that itself when searching for the next pivot point.

By changing your matrix to

-1      0      0      0.7071      0      0      0
0      0.7071      1      0      0      0      0
0      0      -1      -0.7071      0      0      0
0      0      0      0.7071      0      0      -10
0      -0.7071      0      0      -1      1      0
0      0      0      -0.7071      0      -1      0


you get the resultant matrix

1      0      0      0      0      0      -10
0      1      0      0      0      0      -14.14227125
0      0      1      0      0      0      10
0      0      0      1      0      0      -14.14227125
0      0      0      0      1      0      20
0      0      0      0      0      1      10
 when running the macro

• Here are the functions ;

         -a  +   0.7071*d  = 0
          -c   -   0.7071*d  = 0
          -0.7071*b   -e  +  f  = 0
           0.7071*b  +  c  = 0
          -0.7071*d  -  f  = 0
           0.7071*d  =10

• So by converting the functions into matrix it will be like this ;

       (  A * x = b  )
          -1          0               0          0.7071        0       0         a            0
   0          0               -1         -0.7071         0        0          b            0
   0          -0.7071    0          0                -1         1   *     c    =      0
   0         0.7071      1          0                   0       0         d            0
   0           0                 0        -0.7071        0     - 1         e            0
   0           0                 0          0.7071         0       0          f             10

• On paper from my calculation, the answers are ;
  

           a = 10 , b = -14.14 , c = 10 , d = 14.14 , e = 0 , f = -10

Instead of changing the rows is there any other solution?

For example input the numbers in the cells and when run the program it will automatically calculate the outputwhich are from a-f.

Hi,

I have made the changes to your macro to include the pivot search

The code also updates the values in the secondary grid at each stage to help you follow what is going on.

It gives slightly different numbers to your paper ones,

a = -10
b = -14.14227125
c = 10
d = -14.14227125
e = 20
f = 10

although I think that you have entered the last equation wrong in either the spreadsheet or on paper. The spreadsheet indicates 0.7071d = -10, and from above 0.7071*d  =10

Changing it to +10 gives the following results

10
14.14227125
-10
14.14227125
-20
-10

Option Explicit
 
    Private MatrixElements() As Double
    Private NumberofRows As Integer
 
 
Sub matrix2()
 
    Dim MatrixColumn As Integer
    Dim MatrixRow As Integer
    Dim l As Integer
    Dim w As Double
    Dim PivotRow As Integer
    Dim SearchRow As Integer
    Dim PivotValue As Double
    
    
    
    NumberofRows = Sheet1.Cells(20, 3)
       
    ReDim MatrixElements(NumberofRows, NumberofRows + 1)
    
    ' load an array with Cell values
    
    For MatrixRow = 1 To NumberofRows
        For MatrixColumn = 1 To NumberofRows + 1
            MatrixElements(MatrixRow, MatrixColumn) = Sheet1.Cells(MatrixRow, MatrixColumn)
        Next MatrixColumn
    Next MatrixRow
 
    ' for each row of the matrix
 
    For MatrixRow = 1 To NumberofRows
    
    ' Find the first nonzero element in the  equivalent column
    
        PivotRow = 0
    
        For SearchRow = MatrixRow To NumberofRows
          If MatrixElements(SearchRow, MatrixRow) <> 0 And PivotRow = 0 Then
            PivotRow = SearchRow
          End If
        Next SearchRow
        
        ' If pivotrow <> matrixRow then swap the rows
        
        If PivotRow <> MatrixRow Then
           
           Call SwapRows(PivotRow, MatrixRow)
           
        End If
 
        Call Update
 
        PivotValue = MatrixElements(MatrixRow, MatrixRow)
 
        For MatrixColumn = 1 To NumberofRows + 1
                   
            MatrixElements(MatrixRow, MatrixColumn) = MatrixElements(MatrixRow, MatrixColumn) / PivotValue
        
        Next MatrixColumn
        
        Call Update
        
        For l = 1 To NumberofRows
            If l <> MatrixRow Then
                w = MatrixElements(l, MatrixRow)
        
                For MatrixColumn = 1 To NumberofRows + 1
                    MatrixElements(l, MatrixColumn) = MatrixElements(l, MatrixColumn) - MatrixElements(MatrixRow, MatrixColumn) * w
                Next MatrixColumn
            End If
        Next l
        
        Call Update
        
    Next MatrixRow
    
 
End Sub
 
Sub SwapRows(Row1 As Integer, Row2 As Integer)
 
Dim Column As Integer
Dim tempvalue As Double
 
    For Column = 1 To NumberofRows + 1
      tempvalue = MatrixElements(Row1, Column)
      MatrixElements(Row1, Column) = MatrixElements(Row2, Column)
      MatrixElements(Row2, Column) = tempvalue
    Next Column
 
End Sub
 
Sub Update()
 
Dim MatrixColumn As Integer
Dim MatrixRow As Integer
 
 
    For MatrixRow = 1 To NumberofRows
        For MatrixColumn = 1 To NumberofRows + 1
            Sheet1.Cells(MatrixRow + 8, MatrixColumn) = MatrixElements(MatrixRow, MatrixColumn)
        Next MatrixColumn
    Next MatrixRow
    
End Sub

Select allOpen in new window

ChloesDad ;
        Thanks man for  helping me.


matthewspatrick:
       I'd put another sets of matrix and ran the program that I'd made  
       before.Fortunately  it works.

                3     -5      4     2      8      9      10                                      1   0   0   0   0   0    7
        2       7     -7      1      5      8      - 4                                     0   1   0   0   0   0    2
        5       9     -12    4      6      9        4       ------>                     0   0   1   0   0   0    4
        8       1     -5     11     9    - 5     - 9                                       0   0   0   1   0   0  2
        1      3       2      -9     2       5       6                                      0   0   0   0   1   0   -6
        4     -7      8        2    11     3     -7                                       0   0   0   0   0   1    3

       But when I used the input before,the output only
       showed  Identity Matrix  and beside it the answers were all '0'.

             1   0   0   0   0   0 0      
      0   1   0   0   0   0   0
      0   0   1   0   0   0   0
      0   0   0   1   0   0   0
      0   0   0   0   1   0   0
      0   0   0   0   0   1   0  

The second matrix already has non zeroes in the leading diagonal so the find pivot part of my code will just use the same row, and your code will work fine, replacing the division by zero with a 0 will just stop the code from erroring, but won't solve the matrix, as you have shown, all you get is zeroes.

Glad to help

Hi;
Yes there were miscalculation on paper .The answers should be
a = 10
b = 14.14227125
c = -10
d = 14.14227125
e = -20
f = -10

But why did I can't the answers as same as on paper?
The output became all '0'.

Really need your help guys

ChloesDad
     Thanks a lot man!!!