Abt. Lineare Gleichungssysteme mit Gauss-Seidel-Iterationsalgorithmus lösen
================================================
Code
WindowTitle "LGS-Lösung mittels Gauß-Seidel-Iteration"
' Quelle: http://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!
'
' Sinngemäß abgewandeltes Zitat aus dem Originaltext von Prof. Hirte:
' 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 für 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.
' 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
Alles anzeigen
Gruß
P.S.: Testmatrix und Fehlermeldung stammen vom Übersetzer. Allerdings sollten Fehlermeldungen überhaupt noch verbessert werden, denn der Fall "Singuleäre Matrix" liegt bei Division durch Null nämlich nicht immer vor. Es war jedoch sinnvoll, zumindest diesen Fehler einmal abzufangen.