Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Solve a set of LinearEquations by GaussElimination
Author:
Dipankar Basu
Website:
http://www.geocities.com/basudip_in/vb6code/
Submitted:
2/10/2007
Version:
VB6
Compatibility:
VB6
Category:
Mathematics
Views:
11632
Perform Gaussian Elimination to solve a system of linear equations on n-variables, having n-number of equations, with partial pivoting. This is the final update to my program. Subject : Methods of Numerical Analysis
Declarations:
REM PLACE A COMMAND_BUTTON ON THE FORM ' 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.
Code:
Option Explicit 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
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement