algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Metoda Gaussa - Seidela - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 13 marca 2006 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

Algorytm Gaussa-Seidela - Delphi/gs.dpr:
// Metoda Gaussa-Seidela
// www.algorytm.org
// (c) 2006 Tomasz Lubinski

program gs;
{$APPTYPE CONSOLE}

uses
  SysUtils;

var
A: Array [1..100] of Array [1..100] of Double;
L: Array [1..100] of Array [1..100] of Double;
D: Array [1..100] of Array [1..100] of Double;
U: Array [1..100] of Array [1..100] of Double;
b: Array [1..100] of Double;
x: Array [1..100] of Double;

n, iter: Integer;
i, j, k : Integer;

begin
   // Get n
   Writeln('Metoda Gaussa-Seidela');
   Writeln('Rozwiazywanie ukladu n-rownan z n-niewiadomymi Ax=b');
   Writeln('Podaj n');
   Readln(n);
   if (n < 1) or (n > 100) then
      begin
         Writeln('Nieprawidlowa warosc parametru n');
         exit;
      end;

   // Get values of A
   for i:=1 to n do
      for j:=1 to n do
         begin
            writeln('A[' + IntToStr(i) + '][' + IntToStr(j) +'] = ');
            read(A[i][j]);
            if (i = j) and (A[i][j] = 0)  then
               begin
                 writeln('Wartosci na przekatnej musza byc rozne od 0');
                 exit;
               end;
         end;

   // Get values of b
   for i:=1 to n do
      begin
         writeln('b[' + IntToStr(i) + '] = ');
         read(b[i]);
      end;

   // Divide A into L + D + U
   for i:=1 to n do
      for j:=1 to n do
         begin
            if (i < j) then
               U[i][j] := A[i][j]
            else if (i > j) then
               L[i][j] := A[i][j]
            else
               D[i][j] := A[i][j];
         end;

   // Calculate D^-1
   for i:=1 to n do
      D[i][i] := 1/D[i][i];

   // Calculate D^-1 * b
   for i:=1 to n do
      b[i] := D[i][i] * b[i];

   //Calculate D^-1 * L
   for i:=1 to n do
      for j:=1 to i-1 do
         L[i][j] := D[i][i] * L[i][j];

   //Calculate D^-1 * U
   for i:=1 to n do
      for j:=i+1 to n do
         U[i][j] := D[i][i] * U[i][j];

   //Initialize x
   for i:=1 to n do
      x[i] := 0;

   writeln('Ile iteracji algorytmu wykonac? ');
   readln(iter);

   for k:=1 to iter do
      for i:=1 to n do
         begin
            x[i] := b[i];                       // x = D^-1*b -
            for j:=1 to i-1 do
               x[i] := x[i] - L[i][j]*x[j];    // D^-1*L * x -
            for j:=i+1 to n do
               x[i] := x[i] - U[i][j]*x[j];    // D^-1*U * x
         end;

   writeln('Wynik');
   for i:=1 to n do
      writeln('x[' + IntToStr(i) + '] = ' + FloatToStr(x[i]));

   readln;

end.
Dodaj komentarz