Einzelnen Beitrag anzeigen

Fiete45

Registriert seit: 3. Jun 2019
Ort: Timmendorfer Strand
6 Beiträge
 
Delphi 6 Professional
 
#44

AW: Lineares Gleichungssystem lösen

  Alt 9. Nov 2020, 14:33
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
Wolfgang
use your brain (THINK)
  Mit Zitat antworten Zitat