Solving the system of linear equations???
Author Message Solving the system of linear equations???

I need a code for solving the system of linear equations - in BASIC.
If someone got it, I would apritiate to send it to my e-mail.
Thanks!

Wed, 04 Jun 2003 08:06:09 GMT  Solving the system of linear equations???

Quote:
> I need a code for solving the system of linear equations - in BASIC.
> If someone got it, I would apritiate to send it to my e-mail.
> Thanks!

I found a subroutine GEMPD on a Taiwanese site:
http://www.tacocity.com.tw/jaric/newNoScript.htm
http://www.tacocity.com.tw/jaric/vb/numerical/vbNumerical19.htm

I wrote a very quick and dirty example to call and test it. It seems to work
:-)
Be very careful though: when there is NO solution, you don't get a warning:
You can only test whether the determinant is zero (or close to zero!!!).

Good luck with it!
Dirk

Option Explicit

Dim a(3, 4) As Double       ' coefficients and constants
Dim x() As Double           ' result (will be redimmed in subroutine)
Dim d As Double             ' will receive determinant
Dim i As Integer            ' counter
Dim out As String           ' for message box with result

' fill the matrix with the coefficients, use the last column for the
constants
' In this example:
'       x + 2y +  z = 6
'            y + 6z = 6
'      2x + 7y + 9z = 2
a(1, 1) = 1:    a(1, 2) = 2:    a(1, 3) = 1:    a(1, 4) = 6
a(2, 1) = 0:    a(2, 2) = 1:    a(2, 3) = 6:    a(2, 4) = 6
a(3, 1) = 2:    a(3, 2) = 7:    a(3, 3) = 9:    a(3, 4) = 2

Call GEMPD(a(), d, x())     ' solve it

out = ""
For i = 1 To UBound(x)
out = out & "x" & i & " = " & x(i) & "    "
Next i
out = out & "    Determinant = " & d
MsgBox out

End Sub

Public Sub GEMPD(m() As Double, Determinant As Double, ReturnValue() As
Double)
Dim i As Long, j As Long, k As Long, n As Long
Dim r As Long, c() As Long, row As Long, col As Long
Dim Pivot As Double, temp() As Double, order As Long
Determinant = 1
row = UBound(m, 1): col = UBound(m, 2)
If col <> row + 1 Then MsgBox "Number of columns must be one more than
number of rows!": Exit Sub
ReDim c(1 To row), ReturnValue(1 To row), temp(1 To col)
For i = 1 To row
Pivot = 0
For j = i To row
For k = i To row
If Abs(m(k, j)) > Pivot Then
Pivot = Abs(m(k, j))
r = k: c(i) = j
End If
Next k
Next j
If Pivot = 0 Then Determinant = 0: Exit Sub
If r <> i Then
order = order + 1
For j = 1 To col
temp(j) = m(i, j)
m(i, j) = m(r, j)
m(r, j) = temp(j)
Next j
End If
If c(i) <> i Then
order = order + 1
For j = 1 To row
temp(j) = m(j, i)
m(j, i) = m(j, c(i))
m(j, c(i)) = temp(j)
Next j
End If
Pivot = m(i, i)
Determinant = Determinant * Pivot
If Pivot <> 1 Then
For k = 1 To col
m(i, k) = m(i, k) / Pivot
Next
End If
For j = i + 1 To row
Pivot = m(j, i)
If Pivot <> 0 Then
For k = 1 To col
m(j, k) = m(j, k) - m(i, k) * Pivot
Next
End If
Next
Next
For i = row To 1 Step -1
ReturnValue(i) = m(i, col)
For j = i + 1 To row
ReturnValue(i) = ReturnValue(i) - m(i, j) * ReturnValue(j)
Next
Next
For i = row To 1 Step -1
If c(i) <> i Then
temp(1) = ReturnValue(c(i))
ReturnValue(c(i)) = ReturnValue(i)
ReturnValue(i) = temp(1)
End If
Next i
Determinant = Determinant * (-1) ^ order
End Sub

Thu, 05 Jun 2003 03:15:39 GMT

 Page 1 of 1 [ 2 post ]

Relevant Pages