by BasuDip (5 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 2nd October 2007
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Perform Gaussian Elimination to solve a system of linear equations on n-variables, having n-number of equations, with partial pivoting.
API Declarations
' Solve a system of linear equations by GaussElimination with PartialPivoting
' Accuracy upto five-decimal dizits of N linear equations on N variables
' Programmed by Dipankar Bose on November 30, 2006. Updated : February 2007.
VBcoders
Private mat() As Single
Private NoOfVariableEquations As Integer
Private Sub BkSubst() ' BackSubstitution
Dim i As Integer
Dim j As Integer
Dim mBound As Integer
Dim sSum As Single
Dim msgStr As String
mBound = NoOfVariableEquations - 1
ReDim reslt(mBound) As Single
reslt(mBound) = FormatNumber(mat(mBound, mBound + 1) / mat(mBound, mBound), 5)
For i = mBound - 1 To 0 Step -1
sSum = 0
For j = i + 1 To mBound
sSum = sSum + mat(i, j) * reslt(j)
Next j
reslt(i) = FormatNumber((mat(i, mBound + 1) - sSum) / mat(i, i), 5)
Next i
For i = 0 To mBound
msgStr = msgStr + vbNewLine & "X" & i + 1 & vbTab & reslt(i)
Next i
MsgBox msgStr, , "Result"
Print "Solution of Equations" & msgStr
End Sub
Private Sub Command1_Click() ' Input Matrix data
Dim mBound As Integer
Dim i As Integer
Dim j As Integer
NoOfVariableEquations = Val(InputBox("Number of variables", "Equations", 3))
If Not NoOfVariableEquations <= 0 Then
mBound = NoOfVariableEquations - 1
If mBound > 1 Then
ReDim mat(mBound, mBound + 1)
End If
For i = 0 To mBound
For j = 0 To mBound
mat(i, j) = InputBox("Enter Element co-eff value" & vbNewLine & "Element [" & i & "," & j & "]", "Input Data Element")
Next j
mat(i, mBound + 1) = InputBox("Enter Element Value" & vbNewLine & "Value [" & i & "," & mBound + 1 & "]", "Input Equation Value")
Next i
Print "Matrix representation of the linear Equations"
DisplayMatrixData
UpperTriangular
Print "converted to Upper Triangular form"
DisplayMatrixData
BkSubst
End If
End Sub
Private Sub DisplayMatrixData()
Dim i As Integer
Dim j As Integer
Dim res As String
For i = 0 To NoOfVariableEquations - 1
For j = 0 To NoOfVariableEquations
res = res & vbTab & mat(i, j)
Next j
res = res & vbNewLine
Next i
MsgBox res
Print res & vbNewLine
End Sub
Private Sub swapRowMat(ByVal r1 As Integer, _
ByVal r2 As Integer)
Dim i As Integer
Dim mB As Integer
Dim dVal As Single
mB = NoOfVariableEquations
For i = 0 To mB
dVal = mat(r1, i)
mat(r1, i) = mat(r2, i)
mat(r2, i) = dVal
Next i
End Sub
Private Sub UpperTriangular() ' Matrix to Echelon form
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim mBound As Integer
Dim df As Single
Dim pTerms As Integer
mBound = NoOfVariableEquations - 1
For k = 0 To mBound - 1
For i = k + 1 To mBound
For pTerms = i To mBound
If Abs(mat(k, k)) < Abs(mat(pTerms, k)) Then
swapRowMat pTerms, k
End If
Next pTerms
df = mat(i, k) / mat(k, k)
For j = k To 3
mat(i, j) = FormatNumber(mat(i, j) - mat(k, j) * df, 6)
Next j
Next i
Next k
End Sub
No comments have been posted about Perform Gaussian Elimination to solve a system of linear equations on n-variables, having n-number . Why not be the first to post a comment about Perform Gaussian Elimination to solve a system of linear equations on n-variables, having n-number .
