Gauss-Jordan (Partially Solved)

[Tec-Nico]

Hello there... Here I am posting a doubt again. I haven't checked the one of the INI file because I have been very busy working on Algorithms provided by my professor.

Anyway... Here is my question:
What am I doing wrong? I am trying to implement the Gauss-Jordan algorithm but I just can't. After the first iteration it won't work... What is wrong with my code? I also tried translating other codes I have seen into VB Code but it won't work... Here you have my code:

Public Enum MatOperator
 vbSum = 0
 vbSubstraction = 1
 vbMultiplication = 2
 vbDivision = 3
 vbPower = 4
 vbRoot = 5
End Enum
 
Public Sub MatInterchange(M As Variant, i1 As Long, j1 As Long, Optional i2 As Long = -1, Optional j2 As Long = -1)
Dim x As Double
 
If i2 = -1 Then i2 = i1
If j2 = -1 Then j2 = j1
 
x = M(i1, j1)
M(i1, j1) = M(i2, j2)
M(i2, j2) = x
End Sub
 
Public Sub MatInterChng(M As Variant, j1 As Long, j2 As Long)
Dim i As Long
 
For i = LBound(M, 1) To UBound(M, 1)
 MatInterchange M, i, j1, i, j2
Next i
End Sub
 
Public Sub MatOperateRow(M As Variant, j As Long, Operator As MatOperator, ToOperate As Long)
Dim i As Long
 
For i = LBound(M, 1) To UBound(M, 1)
 MatApOperation M, i, j, Operator, ToOperate
Next i
End Sub
 
Public Sub MatSubstitutePlusK(M As Variant, K As Long, j1 As Long, j2 As Long)
Dim i As Long
 
For i = LBound(M, 1) To UBound(M, 1)
 MatApOperation M, i, j1, vbSum, M(i, j2) * K
Next i
End Sub
 
Public Sub MatApOperation(M As Variant, i As Long, j As Long, Operator As MatOperator, ToOperate As Long)
Select Case Operator
Case 0:
 M(i, j) = M(i, j) + ToOperate
Case 1:
 M(i, j) = M(i, j) - ToOperate
Case 2:
 M(i, j) = M(i, j) * ToOperate
Case 3:
 M(i, j) = M(i, j) / ToOperate
Case 4:
 M(i, j) = M(i, j) ^ ToOperate
Case 5:
 M(i, j) = M(i, j) ^ -ToOperate
End Select
End Sub
 
Public Function GaussJordan(A As Variant, B As Variant) As Variant
Dim GJ() As Double
Dim i As Long
Dim j As Long
Dim n As Long
Dim Cons As Double
 
LnFd = ChR$(13) & ChR$(10)
DLnFd = LnFd & LnFd
 
ReDim GJ(UBound(A, 1) + 1, UBound(A, 2))
 
For i = LBound(GJ, 1) To UBound(GJ, 1)
 For j = LBound(GJ, 2) To UBound(GJ, 2)
  If i = UBound(GJ, 1) Then
   GJ(i, j) = B(LBound(B, 1), j)
  Else
   GJ(i, j) = A(i, j)
  End If
 Next j
Next i
 
For i = LBound(GJ, 2) To UBound(GJ, 2)
 For n = LBound(GJ, 2) To UBound(GJ, 2)
  If n <> i Then
   MatSubstitutePlusK GJ, -GJ(i, n), n, i
   MsgBox " i = " & i & LnFd & "GJ(" & i & ", " & n & ") = " & GJ(i, n) & " n = " & n & LnFd & "GJ(" & i & ", " & i & ") = " & GJ(i, i), vbExclamation, "Iteration " & i
  End If
 Next n
Next i
 
'Turn the main diagonal into 1
For j = LBound(GJ, 2) To UBound(GJ, 2)
 If GJ(j, j) <> 1 Then
  MatOperateRow GJ, j, vbDivision, CLng(GJ(j, j))
 End If
Next j
 
GaussJordan = GJ
End Function

[Armbruster]

I love a good math challenge, but we need more information.

How are you declaring all of the variables you use?
How are you calling these functions?
Where are you recieving errors or what function is returning incorrect results.

"It doesn't work" isn't enough detail.

[Tec-Nico]

First... Thanks for replying!
Second, you are right. I am not providing a lot of information.

It is I had comments but most of them where in spanish. It took me a while to translate some of the functions and I forgot to add what I was trying to do. Alright, let me explain myself.

As you know, I am trying to use Gauss-Jordan to solve a Matrix Problem. I have already programmed Crammer's rule in a Module called "MatrixEs" which is the module where I am working now. Basicly you give a square matrix to the program, the results matrix and you fuse them to create the Gauss-Jordan matrix.

Lets say we are calling the following Matrix using the Command6:

x1 + 4x2 + 3x3= 2600 (1) 1 4 3 2600
2x1 + 5x2 + 4x3= 3500 (2) 2 5 4 3500
x1 + 3x2 + 2x3= 2000 (3) 1 3 2 2000

Private Sub Command6_Click()
Dim A() As Long
Dim B() As Long
Dim X As Variant
Dim i As Long
Dim j As Long
 
ReDim A(2, 2)
ReDim B(0, 2)
 
A(0, 0) = 1
A(1, 0) = 4
A(2, 0) = 3
A(0, 1) = 2
A(1, 1) = 5
A(2, 1) = 4
A(0, 2) = 1
A(1, 2) = 3
A(2, 2) = 2
 
B(0, 0) = 2600
B(0, 1) = 3500
B(0, 2) = 2000
 
X = MatResolve(A, B, vbGauss)
 
For i = LBound(X, 1) To UBound(X, 1)
 For j = LBound(X, 2) To UBound(X, 2)
  MsgBox "X(" & i & ", " & j & ") = " & X(i, j)
 Next j
Next i
End Sub

I will keep adding info, but this is it for this first reply.

[Tec-Nico]

Alright, as you could see I called a function "MatResolve" which will receive the data of the Matrices and will select the method to use to solve them. In this case VBGauss is for Gauss-Jordan.

Let me include here that procedure and the proper enumeration:

Public Enum MatMethods
 vbCramer = 0
 vbGauss = 1
 vbMontante = 2
End Enum
 
 
Public Function MatResolve(A As Variant, B As Variant, Optional ByVal Method As MatMethods = vbCramer) As Variant
Select Case Method
Case vbCramer:
 MatResolve = Cramer(A, B)
Case vbGauss:
 MatResolve = GaussJordan(A, B)
Case vbMontante:
 MatResolve = Montante(A, B)
Case Else
 MatResolve = Cramer(A, B)
End Select
End Function

I also read in most of the pages I have reviewed that I would need to add basic operations, and that is what I did. Some of the functions above are the basic operations. I will add more info in next reply.

[Armbruster]

Are you getting errors or unexpected result?

(Man, mathmatical matrixes was years ago, I hope I can restart that section of my brain!)

[Tec-Nico]

As you know... Gauss Jordan will get the following Matrix:

1 0 0 300
0 1 0 500
0 0 1 100

Which means that the answer to the first equation is 300, the answer to the second one is 500 and the answer to the third one is 100. So you can see the last thing I added to the function of Gauss-Jordan was to divide each row over the number that is left in the main diagonal, if it is different from 1.

Now, after the first I get the following:

1 4 3 2600
0 -3 -2 -1700
0 -1 -1 -600

And so far is doing fine... In the next iteration it should be:

1 0 -1 2600
0 -3 -2 -1700
0 0 1 100

But my code gives different values to this... So I don't know what is wrong, this is the 15th time I redo it and I am tired of trying to solve it.

I have to also explain that it shows the matrix from up to down... So in the first iteration you will get as messages this:

message 1: 1
message 2: 0
message 3: 0

Instead of:

message 1: 1
message 2: 4
message 3: 3
message 4: 2600

I am sure the functions above work properly but I don't know how I should use them to make the algorithm work properly!

[Tec-Nico]

I know, I know... But I am an University student. Do you want me to tell my professor "Man, this was years ago, please get updated!"?

I just can't... Besides I like the challenge programming these algorithms make me feel. The problem is that I cannot find a proper algorithm anywhere to check how this should be applied.

In pages I have gone to they say that there are 3 elemental operations... Which are:

1.- Switching Rows
2.- Multiply a Row times a Number (Not a Matrix)
3.- Fj = Fj + n*Fi

These basic operations have been defined by me in these procedures:

''-- Basic Operations --''
'1.- MatInterChng GJ, 0, 1
'2.- MatOperarateRow GJ, 1, vbMultiplication, 2
'3.- MatSubstitutePlusK GJ, 2, 2, 0

[Tec-Nico]

Here, you go... This is the partial solution to the Gauss-Jordan Method. I have not added the code to switch rows in case you find a zero in the main diagonal, but otherwise it works perfectly.

So if you can help me getting the switching row code, then this post will be completely solved. Here you have the code if you ever need it:

Public Function GaussJordan(A As Variant, B As Variant) As Variant
Dim GJ() As Double
Dim i As Long
Dim j As Long
Dim n As Long
Dim Cons As Double
 
ReDim GJ(UBound(A, 1) + 1, UBound(A, 2))
 
For i = LBound(GJ, 1) To UBound(GJ, 1)
 For j = LBound(GJ, 2) To UBound(GJ, 2)
  If i = UBound(GJ, 1) Then
   GJ(i, j) = B(LBound(B, 1), j)
  Else
   GJ(i, j) = A(i, j)
  End If
 Next j
Next i
 
For i = LBound(GJ, 2) To UBound(GJ, 2)
 Cons = GJ(i, i)
 
 For n = LBound(GJ, 1) To UBound(GJ, 1)
  GJ(n, i) = GJ(n, i) / Cons
 Next n
 
 For j = LBound(GJ, 2) To UBound(GJ, 2)
  If j <> i Then
   Cons = (-GJ(i, j))
   For n = LBound(GJ, 1) To UBound(GJ, 1)
    GJ(n, j) = GJ(n, j) + GJ(n, i) * Cons
   Next n
  End If
 Next j
 
Next i
 
GaussJordan = GJ
End Function

[yrwyddfa]

Private Sub GaussianElimination(oMatrix As CMatrix)
 
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim Max As Single
    Dim Pos As Long
    Dim Temp As Single
    Dim Val As Single
    
    With oMatrix
    
        For i = 1 To .Rows
        
            Max = 0
            Pos = 1
            
            For j = i To .Rows
                If Abs(.Element(j, i) > Max) Then
                    Max = Abs(.Element(j, i))
                    Pos = j
                End If
            Next
            
            Max = .Element(Pos, i)
            
            For j = 1 To .Cols
                Temp = .Element(Pos, j)
                .Element(Pos, j) = .Element(i, j)
                .Element(i, j) = Temp / Max
            Next
            
            For k = 1 To .Rows
                If Not (k = i) Then
                    Val = .Element(k, i)
                    For j = i To .Cols
                        .Element(k, j) = .Element(k, j) - Val * (.Element(i, j))
                    Next
                End If
            Next
            
        Next
        
    End With
    
End Sub

I do not know who the original author is - but it's not me: I converted it from C++

You'll also need this:

Option Explicit
 
Private mArr() As Single
 
Private Sub Class_Initialize()
'
End Sub
 
Private Sub Class_Terminate()
'
End Sub
 
Public Sub Create(i As Long, j As Long)
    ReDim mArr(i - 1, j - 1)
End Sub
 
Public Sub Destroy()
    Erase mArr
End Sub
 
Public Property Get Rows() As Long
    Rows = UBound(mArr, 1) + 1
End Property
 
Public Property Get Cols() As Long
    Cols = UBound(mArr, 2) + 1
End Property
 
Public Property Get Element(i As Long, j As Long) As Single
    Element = mArr(i - 1, j - 1)
End Property
 
Public Property Let Element(i As Long, j As Long, RHS As Single)
    mArr(i - 1, j - 1) = RHS
End Property

Hope this helps.