Eliminacja Gaussa-Crouta

// Eliminacja Gaussa-Crouta
// Data: 3.03.2010
// (C)2012 mgr Jerzy Wałaszek
//-----------------------------

program gausscrout;

type
  NInt  = array of integer; // typ wektora kolumn
  NReal = array of double;  // typ tablic wierszy
  MReal = array of NReal;   // typ tablicy wskaźników

const
  eps = 1e-12;

// Funkcja realizuje algorytm eliminacji Gaussa-Crouta
//----------------------------------------------------
function Gauss(n : integer; AB : MReal; X : NReal; W : NInt) : boolean;
var
  i,j,k : integer;
  m,s   : double;
begin
  
  for i := 0 to n do W[i] := i;

  // eliminacja współczynników

  for i := 0 to n - 2 do
  begin
    k := i;
    for j := i + 1 to n - 1 do
      if abs(AB[i][W[k]]) < abs(AB[i][W[j]]) then k := j;
    j := W[k]; W[k] := W[i]; W[i] := j;
    for j := i + 1 to n - 1 do
    begin
      if abs(AB[i][W[i]]) < eps then exit(false);
      m := -AB[j][W[i]]/ AB[i][W[i]];
      for k := i + 1 to n do
        AB[j][W[k]] := AB[j][W[k]] + m * AB[i][W[k]];
    end;
  end;

  // wyliczanie niewiadomych

  for i := n - 1 downto 0 do
  begin
    if abs(AB[i][W[i]]) < eps then exit(false);
    s := AB[i][n];
    for j := n - 1 downto i + 1 do
      s := s - AB[i][W[j]] * X[W[j]];
    X[W[i]] := s / AB[i][W[i]];
  end;
  Gauss := true;
end;

// Program główny

var
  AB    : MReal;
  X     : NReal;
  W     : NInt;
  n,i,j : integer;

begin

  // odczytujemy liczbę niewiadomych

  read(n);

  // tworzymy macierze AB, X i W o odpowiednich rozmiarach

  SetLength(AB,n);
  SetLength(X,n);
  SetLength(W,n+1);

  for i := 0 to n - 1 do SetLength(AB[i],n + 1);

  // odczytujemy dane dla macierzy AB

  for i := 0 to n - 1 do
    for j := 0 to n  do read(AB[i][j]);

  if Gauss(n,AB,X,W) then
  begin
    for i := 0 to n - 1 do writeln('x',i+1,' = ',X[i]:9:4);
  end
  else
    writeln('DZIELNIK ZERO');

  // usuwamy macierze z pamięci

  for i := 0 to n - 1 do SetLength(AB[i],0);
  SetLength(AB,0);
  SetLength(X,0);
  SetLength(W,0);

end.

// Eliminacja Gaussa-Crouta
// Data: 3.03.2010
// (C)2012 mgr Jerzy Wałaszek
//-----------------------------

#include <iostream>
#include <iomanip>
#include <cmath>

using namespace std;

const double eps = 1e-12;

// Funkcja realizuje algorytm eliminacji Gaussa-Crouta
//----------------------------------------------------
bool gauss(int n, double ** AB, double * X, int * W)
{
  int    i,j,k;
  double m,s;

  for(i = 0; i <= n; i++) W[i] = i;
  
  // eliminacja współczynników

  for(i = 0; i < n - 1; i++)
  {
    k = i;
    for(j = i + 1; j < n; j++)
      if(fabs(AB[i][W[k]]) < fabs(AB[i][W[j]])) k = j;
    swap(W[k],W[i]);
    for(j = i + 1; j < n; j++)
    {
      if(fabs(AB[i][W[i]]) < eps) return false;
      m = -AB[j][W[i]] / AB[i][W[i]];
      for(k = i + 1; k <= n; k++)
        AB[j][W[k]] += m * AB[i][W[k]];
    }
  }

  // wyliczanie niewiadomych

  for(i = n - 1; i >= 0; i--)
  {
    if(fabs(AB[i][W[i]]) < eps) return false;
    s = AB[i][n];
    for(j = n - 1; j >= i + 1; j--)
      s -= AB[i][W[j]] * X[W[j]];
    X[W[i]] = s / AB[i][W[i]];
  }
  return true;
}

// Program główny

int main()
{
  double **AB, *X;
  int n,i,j,*W;

  cout << setprecision(4) << fixed;
  
  // odczytujemy liczbę niewiadomych

  cin >> n;

  // tworzymy macierze AB, X i W

  AB = new double * [n];
  X  = new double [n];
  W  = new int [n + 1];

  for(i = 0; i < n; i++) AB[i] = new double[n + 1];

  // odczytujemy dane dla macierzy AB

  for(i = 0; i < n; i++)
    for(j = 0; j <= n; j++) cin >> AB[i][j];

  if(gauss(n,AB,X,W))
  {
    for(i = 0; i < n; i++)
      cout << "x" << i + 1 << " = " << setw(9) << X[i]
           << endl;
  }
  else
    cout << "DZIELNIK ZERO\n";

  // usuwamy macierze z pamięci

  for(i = 0; i < n; i++) delete [] AB[i];
  delete [] AB;
  delete [] X;
  delete [] W;

  return 0;
}

' Eliminacja Gaussa-Crouta
' Data: 3.03.2010
' (C)2012 mgr Jerzy Wałaszek
'-----------------------------

Const eps As Double = 1e-12

' Funkcja realizuje algorytm eliminacji Gaussa-Crouta
'----------------------------------------------------
Function Gauss(n As Integer, AB As Double Ptr Ptr, X As Double Ptr, W As Integer Ptr) As Integer

  Dim As Integer i,j,k
  Dim As Double m,s
  
  For i = 0 To n
    W[i] = i
  Next

  ' eliminacja współczynników

  For i = 0 To n - 2
    k = i
    For j = i + 1 To n - 1
      If Abs(AB[i][W[k]]) < Abs(AB[i][W[j]]) Then k = j
    Next
    Swap W[k], W[i] 
    For j = i + 1 To n - 1
      If Abs(AB[i][W[i]]) < eps Then Return 0
      m = -AB[j][W[i]]/ AB[i][W[i]]
      For k = i + 1 To n
        AB[j][W[k]] += m * AB[i][W[k]]
      Next
    Next
  Next
  
  ' wyliczanie niewiadomych

  For i = n - 1 To 0 Step -1
    If Abs(AB[i][W[i]]) < eps Then Return 0
    s = AB[i][n]
    For j = n - 1 To i + 1 Step -1
      s -= AB[i][W[j]] * X[W[j]]
    Next
    X[W[i]] = s / AB[i][W[i]]
  Next
  Gauss = 1
End Function

' Program główny
'---------------

Dim AB As Double Ptr Ptr
Dim X As Double Ptr
Dim W As Integer Ptr
Dim As Integer n,i,j

Open Cons For Input As #1

' odczytujemy liczbę niewiadomych

Input #1,n

' tworzymy macierze AB, X i W o odpowiednich rozmiarach

AB = New Double Ptr [n]
X  = New Double [n]
W  = New Integer [n + 1]

For i = 0 To n - 1
  AB[i] = New Double [n + 1]
Next

' odczytujemy dane dla macierzy AB

For i = 0 To n - 1
  For j = 0 To n
    Input #1,AB[i][j]
  Next
Next

Close #1

If Gauss(n,AB,X,W) = 1 Then
  For i = 0 To n - 1
    Print Using "x# = ####.####"; i + 1; X[i]
  Next
Else
  Print "DZIELNIK ZERO"
End If

' usuwamy macierze z pamięci

For i = 0 To n - 1
  Delete [] AB[i]
Next
Delete [] AB
Delete [] X
Delete [] W

End