Lineares Gleichungssystem mit dem Gaußverfahren lösen

Tinas Oma ist zehnmal so alt wie Tina. In zehn Jahren ist Oma nur noch viermal so alt wie Tina. Wie alt sind Oma und Tina jetzt?

Alles klar? Solche und ähnliche Probleme (z.Bsp. Interpolationen mit Splines) lassen sich sehr einfach als ein System linearer Gleichungen formulieren und mit einem Verfahren wie dem Gaußschen Eliminationsverfahren (auch bekannt als Gauß-Verfahren) lösen.

In der Beispiel-Datei im Anhang ist die Lösung einer einfachen diagonalen Matrix und das Beispiel mit Tinas Oma ausgeführt.

Hier ist der Quellcode für das Gaußsche Eliminationsverfahren:

Public Function GaussElimination(Matrix() As Double, Vektor() As DoubleAs Double()
    Dim L() As Double    'lower diagonal
    Dim U() As Double    'upper diagonal
    Dim y() As Double
    Dim x() As Double
    Dim k As Long, i As Long, j As Long
    Dim Lij As Double
    Dim temp As Double

    'only valid for symmetric matrix
    If UBound(Matrix, 1) <> UBound(Matrix, 2) Then Exit Function

    'initialize
    ReDim L(UBound(Matrix, 1), UBound(Matrix, 1))
    ReDim U(UBound(Matrix, 1), UBound(Matrix, 1))

    'GaussElimination method:
    'A  x  = b
    'L U x = b
    'L  y  = b   (Lij = aij/ajj, current Matrix)
    'U  x  = y

    'initialize upper- & lower-diagonal matrix
    For i = 1 To UBound(Matrix, 1)
        For j = 1 To UBound(Matrix, 2)
            U(i, j) = Matrix(i, j)    'initialize matrix U
            If i = j Then
                L(i, j) = 1    'initialize matrix L
            Else
                L(i, j) = 0    'initialize matrix L
            End If
        Next
    Next

    'get upper- & lower-diagonal matrix
    For k = 1 To UBound(Matrix, 1) - 1    'k: loop over all rows
        For i = k + 1 To UBound(Matrix, 1)   'i: row index
            Lij = U(i, k) / U(k, k)    'U(i,k) = most left non zero entry in line i
            For j = 1 To UBound(Matrix, 2)   '
                U(i, j) = U(i, j) - Lij * U(k, j)
            Next
            L(i, k) = Lij
        Next
    Next
    'Gauss-Elimination finished

    'get y
    'L  y  = b
    '1 0 0       y   b
    'L 1 0 times y = b
    'L L 1       y   b
    ReDim y(UBound(Vektor, 1), 1)
    For i = 1 To UBound(y, 1)
        temp = 0
        'y(i, 1) = (Vektor(i, 1)
        For j = 1 To i - 1
            temp = temp + y(j, 1) * L(i, j)
        Next
        y(i, 1) = (Vektor(i, 1) - temp)
    Next

    'get x
    'U  x  = y
    'u u u       x   y
    '0 u u times x = y
    '0 0 u       x   y
    ReDim x(UBound(Vektor, 1), 1)
    For i = UBound(x, 1) To 1 Step -1
        temp = 0
        For j = UBound(Vektor, 1) To i + 1 Step -1
            temp = temp + x(j, 1) * U(i, j)
        Next
        x(i, 1) = (y(i, 1) - temp) / U(i, i)
    Next

    'return Result
    GaussElimination = x
End Function

Code eingefügt mit Syntaxhighlighter 4.15
AnhangGröße
Gaußsches Eliminationsverfahren.xls42.5 KB
GaußschesEliminationsverfahren.bas2.59 KB
Your rating: Keine Average: 4 (3 votes)