RosettaCodeData/Task/LU-decomposition/FreeBASIC/lu-decomposition.basic

101 lines
2.2 KiB
Plaintext

Sub pivotize(m() As Double, im() As Double)
Dim As Integer n, i, j
n = Ubound(m)
Redim im(n, n)
For i = 0 To n
For j = 0 To n
im(i, j) = 0
Next j
im(i, i) = 1
Next i
For i = 0 To n
Dim As Double mx
Dim As Integer fila
mx = Abs(m(i, i))
fila = i
For j = i To n
If Abs(m(j, i)) > mx Then
mx = Abs(m(j, i))
fila = j
End If
Next j
If i <> fila Then
For j = 0 To n
Swap im(i, j), im(fila, j)
Next j
End If
Next i
End Sub
Sub LUdecomposition(a() As Double,l() As Double, u() As Double, p() As Double)
Dim As Integer i, j, k, n
Dim As Double s
n = Ubound(a)
Redim l(n, n), u(n, n), p(n, n)
Dim As Double b(n, n)
pivotize(a(), p())
For i = 0 To n
For j = 0 To n
b(i, j) = 0
For k = 0 To n
b(i, j) += p(i, k) * a(k, j)
Next k
Next j
Next i
For j = 0 To n
l(j, j) = 1
For i = 0 To j
s = 0
For k = 0 To i - 1
s += u(k, j) * l(i, k)
Next k
u(i, j) = b(i, j) - s
Next i
For i = j + 1 To n
s = 0
For k = 0 To j - 1
s += u(k, j) * l(i, k)
Next k
l(i, j) = (b(i, j) - s) / u(j, j)
Next i
Next j
End Sub
Sub showMatrix(a() As Double)
Dim As Integer i, j
Dim As String As1
For i = 0 To Ubound(a, 1)
For j = 0 To Ubound(a, 2)
Print Using "###.##### "; a(i, j);
Next j
Print
Next i
Print
End Sub
Dim As Double A1(2, 2) => {{1, 3, 5}, {2, 4, 7}, {1, 1, 0}}
Dim As Double L1(), U1(), P1()
LUdecomposition(A1(), L1(), U1(), P1())
Print "L1:"
showMatrix(L1())
Print "U1:"
showMatrix(U1())
Print "P1:"
showMatrix(P1())
Dim As Double A2(3, 3) => {{11, 9, 24, 2}, {1, 5, 2, 6}, {3, 17, 18, 1}, {2, 5, 7, 1}}
Dim As Double L2(), U2(), P2()
LUdecomposition(A2(), L2(), U2(), P2())
Print "L2:"
showMatrix(L2())
Print "U2:"
showMatrix(U2())
Print "P2:"
showMatrix(P2())
Sleep