Registriert seit: 26. Sep 2013
85 Beiträge
|
AW: Lineares Gleichungssystem lösen
10. Nov 2020, 09:50
Moin,
habe das Gaußverfahren als Prozedur geschrieben:
Delphi-Quellcode:
type
TVektor=Array of Extended;
TMatrix=Array of TVektor;
procedure TGauss.GaussLGS(A:TMatrix;B:TVektor;var X:TVektor;var Anzahl:Integer);
var N,K,I,L:Integer;
T,Summe:Extended;
begin
N:=Length(B);
for K:=0 to N-1 do
begin
// Pivotsuche
I:=K;
for L:=K+1 to N-1 do
if abs(A[L,K])>abs(A[I,K]) then I:=L;
if I>K then // tauschen der Zeilen i und k
begin
for L:=K to N-1 do
begin T:=A[I,L];A[I,L]:=A[K,L];A[K,L]:=T end;
T:=B[I];B[I]:=B[K];B[K]:=T;
end;
if A[K,K]=0.0 then begin Anzahl:=0;break end // K - Schleife verlassen, da keine Lösung
else
// Elimination
begin
for I:=K+1 to N-1 do
begin
T:=A[I,K]/A[K,K];
for L:=K to N-1 do A[I,L]:=A[I,L]-A[K,L]*T;
B[I]:=B[I]-B[K]*T;
end;
end
end;
if (A[N-1,N-1]=0.0) and (B[N-1]=0.0) then
begin
Anzahl:=1000000; // unendlich viele Lösungen
exit;
end;
// Rücksubstitution
Anzahl:=1; // genau eine Lösung
X[N-1]:=B[N-1]/A[N-1,N-1];
for I:=N-2 downto 0 do
begin
Summe:=0.0;
for K:=I+1 to N-1 do Summe:=Summe+A[I,K]*X[K];
X[I]:=(B[I]-Summe)/A[I,I];
end;
end;
Aufruf der Prozedur, wobei A und B mit Werten gefüllt sein müssen: GaussLGS(A,B,X,Anzahl);
X ist der Lösungsvektor, Anzahl enthält die Lösungsanzahl.
0 - keine Lösung
1 - genau eine Lösung
1000000 - viele Lösungen
Gruß Fiete
Ich bin jetzt die Strategie gefahren alles, was ich brauche (und noch mehr...) aus dem Gauss Programm zu übernehmen und so die Gleichung zu lösen. Es funktioniert so weit, aber ich habe noch tiefgreifende Probleme an ganz anderen Stellen.
|
|
Zitat
|