XProfan

Italia

p.specht

Die Gauss-Seidel-Iteration ist ein zyklisches Verfahren zur Lösung linearer Gleichungssysteme (LGS) der allgemeinen Form A*x = b.
Diese kann man schrittweise lösen, indem man mehrfach rechnet:
x(neu) = x(alt) - Korr, mit Korrekturvektor Korr = A*x(alt) - b

Es handelt sich also um eine Fehlerrückkopplung. Jeder Durchgang verbessert das Ergebnis ein wenig. Man beginnt dabei mit geratenen Werten, und mit etwas Glück kommt ein Fehler sehr nahe Null heraus.

Die Gauß-Seidel-Iteration ist speziell geeignet per schlecht konditionierte Gleichungsysteme (das sind solche, bei denen sich Rundungs- und Binärübersetzungsfehler gegenseitig verstärken würden). Sie reagiert auch weniger empfindlich auf fehlerbehaftete Koeffizienten als das Gauß-Verfahren. Natürlicher Nachteil von Iterationsverfahren ist, daß die Rechenzeit erheblich größer ist als bei direkten Algorithmen.

Fehlermeldungen sollten noch verbessert werden, denn der Fall "Singuläre Matrix" liegt bei Division durch Null nämlich nicht immer vor. Es war jedoch sinnvoll, zumindest diesen Fehler einmal abzufangen.

Kompilieren Markieren Separieren

WindowTitle "LGS-Lösung mittels Gauß-Seidel-Iteration"
' Quelle: https://www.rhirte.de/vb/gleichsys.htm#seidel
' Aus Visual Basic in XProfan 11.2a übersetzt von
' P. Specht 2012-04. Demoware! Keine wie immer geartete Haftung,
' Verwendung ausschließlich auf eigenes Risiko des Anwenders!
'
' TESTMATRIX DEFINIEREN:
Var n&=4
Var e!=val("1e-9")
Declare A![n&,n&+1],x![n&],Er$
'            Koeffizienten                 +  Rechte Seite:
A![1,1]=1 :A![1,2]=0 :A![1,3]=0 :A![1,4]=0 :  A![1,5]=10' = b1
A![2,1]=0 :A![2,2]=1 :A![2,3]=0 :A![2,4]=0 :  A![2,5]=20' = b2
A![3,1]=0 :A![3,2]=0 :A![3,3]=1 :A![3,4]=0 :  A![3,5]=30' = b3
A![4,1]=0 :A![4,2]=0 :A![4,3]=0 :A![4,4]=1 :  A![4,5]=40' = b4
Start:
Declare xp![n&],R!,S!,T!,i&,j&,num&

WhileLoop n&:i&=&Loop

    x![i&] = 5' Startvektor mit einer ersten Ausgangslösung

EndWhile

Repeat

    WhileLoop n&

        i&=&Loop
        S!=0

        WhileLoop i&-1

            j&=&Loop
            S!=S!+A![i&,j&]*xp![j&]

        EndWhile

        T!=0

        WhileLoop i&+1,n&

            j&=&Loop
            T!=T!+A![i&,j&]*X![j&]

        EndWhile

        if A![i&,i&]=0

            print " Singuläre Matrix!"
            Er$="sing"
            BREAK

        Endif

        xp![i&]=(A![i&,n&+1]-S!-T!) / A![i&,i&]

    EndWhile

    case Er$="sing":break
    S!=0

    WhileLoop n&:i&=&Loop

        R!=X![i&]-xp![i&]
        S!=S!+ R!*R!
        X![i&]=xp![i&]

    EndWhile

    num& = num& + 1

Until Sqr(S!/(n&-1)) < e!

Case Er$<>"":Goto "Stop"
' Ausgabe:
print "\n Ergebnis gefunden in ";num&;" Durchläufen:"

WhileLoop n&

    i&=&Loop
    print " x"+str$(i&)+" = ";x![i&]

EndWhile

Stop:
print
WaitInput
End