

Title  Solve a system of equations with Gaussian elimination 
Description  This example shows how to solve a system of equations with Gaussian elimination in Visual Basic 6. 
Keywords  solve, equations, system of equations, Gaussian elimination 
Categories  Algorithms 


The system of equations is of the form:
A1*x1 + B1*x2 + ... + N1*xn = c1
A2*x1 + B2*x2 + ... + N2*xn = c2
...
Am*x1 + Bm*x2 + ... + Nm*xn = cm
For example:
9 * x1 + 4 * x2 = 7
4 * x1 + 3 * x2 = 8
You can write these equations as a matrix multiplied by a vector of variables x1, x2, ..., xn, equals a vector of constants c1, c2, ..., cn.
 A1 B1 ... N1   x1   c1 
 A2 B2 ... N2   x2   c2 
 ...  * ...  = ... 
 Am Bm ... Nm   xm   cm 
Subroutine LoadArray loads data from text boxes into an augmented matrix that includes the constants:
 A1 B1 ... N1 c1 
 A2 B2 ... N2 c2 
 ... 
 Am Bm ... Nm cm 


' Load the augmented array.
' Column num_cols + 1 holds the result values.
' Column num_cols + 2 will hold the variables' final values.
Private Function LoadArray(ByRef num_rows As Integer, ByRef _
num_cols As Integer) As Double()
Dim value_rows() As String
Dim coef_rows() As String
Dim one_row() As String
Dim r As Integer
Dim c As Integer
Dim arr() As Double
' Build the augmented matrix.
value_rows = Split(txtValues.Text, vbCrLf)
coef_rows = Split(txtCoefficients.Text, vbCrLf)
one_row = Split(coef_rows(0), " ")
num_rows = UBound(coef_rows) + 1
num_cols = UBound(one_row) + 1
ReDim arr(1 To num_rows, 1 To num_cols + 2)
For r = 1 To num_rows
one_row = Split(coef_rows(r  1), " ")
For c = 1 To num_cols
arr(r, c) = CDbl(one_row(c  1))
Next c
arr(r, num_cols + 1) = CDbl(value_rows(r  1))
Next r
LoadArray = arr
End Function


When you click the Solve button, the program uses row operations to zero out leading terms in each row. For example, to zero out the leading term in the second row, the program multiplies each entry in the first row by A2/A1 and adds the result to the second row. Multiplying A1 by A2/A1 gives A2, which cancels out the value in the first column of row 2. The program makes similar substitutions to zero out the first element in the other rows.
Next the program uses row 2 to zero out the second column in rows 3 and later. It continues in this way until it can no longer zero out rows. Ideally at that point, the final row has the form  0 0 ... Km Lm . This represents the equation 0*x1 + 0*x2 + ... + Km*xm = Lm so it is easy to solve for xm. The program plugs that value into the secondtolast row to calculate x(m1) and continues "backsolving" up the list until it has a value for every variable.


Private Sub cmdSolve_Click()
Const TINY As Double = 0.00001
Dim num_rows As Integer
Dim num_cols As Integer
Dim r As Integer
Dim c As Integer
Dim r2 As Integer
Dim tmp As Double
Dim factor As Double
Dim arr() As Double
Dim orig_arr() As Double
Dim txt As String
' Build the augmented matrix.
arr = LoadArray(num_rows, num_cols)
orig_arr = arr
' Display the initial array.
'PrintArray arr
' Start solving.
For r = 1 To num_rows  1
' Zero out all entries in column r after this row.
' See if this row has a nonzero entry in column r.
If Abs(arr(r, r)) < TINY Then
' Not a nonzero value. Try to swap with a
' later row.
For r2 = r + 1 To num_rows
If Abs(arr(r2, r)) > TINY Then
' This row will work. Swap them.
For c = 1 To num_cols + 1
tmp = arr(r, c)
arr(r, c) = arr(r2, c)
arr(r2, c) = tmp
Next c
Exit For
End If
Next r2
End If
' If this row has a nonzero entry in column r,
' skip this column.
If Abs(arr(r, r)) > TINY Then
' Zero out this column in later rows.
For r2 = r + 1 To num_rows
factor = arr(r2, r) / arr(r, r)
For c = r To num_cols + 1
arr(r2, c) = arr(r2, c) + factor * _
arr(r, c)
Next c
Next r2
End If
Next r
' Display the uppertriangular array.
'PrintArray arr
' See if we have a solution.
If arr(num_rows, num_cols) = 0 Then
' We have no solution.
txt = "No solution"
Else
' Back solve.
For r = num_rows To 1 Step 1
tmp = arr(r, num_cols + 1)
For r2 = r + 1 To num_rows
tmp = tmp  arr(r, r2) * arr(r2, num_cols + _
2)
Next r2
arr(r, num_cols + 2) = tmp / arr(r, r)
Next r
' Display the results.
txt = " Values"
For r = 1 To num_rows
txt = txt & vbCrLf & "x" & Format$(r) & " = " & _
Format$(arr(r, num_cols + 2))
Next r
' Verify.
txt = txt & vbCrLf & " Check:"
For r = 1 To num_rows
tmp = 0
For c = 1 To num_cols
tmp = tmp + orig_arr(r, c) * arr(c, _
num_cols + 2)
Next c
txt = txt & vbCrLf & Format$(tmp)
Next r
txt = Mid$(txt, Len(vbCrLf) + 1)
End If
txtResults.Text = txt
End Sub


For more information on Gaussian Elimination, see the article Gaussian Elimination by Eric W. Weisstein at MathWorldA Wolfram Web Resource.





