Task: Gaussian elimination






PHP: function swap_rows(&$a, &$b, $r1, $r2)
{
    if ($r1 == $r2) return;

    $tmp = $a[$r1];
    $a[$r1] = $a[$r2];
    $a[$r2] = $tmp;

    $tmp = $b[$r1];
    $b[$r1] = $b[$r2];
    $b[$r2] = $tmp;
}

function gauss_eliminate($A, $b, $N)
{
    for ($col = 0; $col < $N; $col++)
    {
        $j = $col;
        $max = $A[$j][$j];

        for ($i = $col + 1; $i < $N; $i++)
        {
            $tmp = abs($A[$i][$col]);
            if ($tmp > $max)
            {
                $j = $i;
                $max = $tmp;
            }
        }

        swap_rows($A, $b, $col, $j);

        for ($i = $col + 1; $i < $N; $i++)
        {
            $tmp = $A[$i][$col] / $A[$col][$col];
            for ($j = $col + 1; $j < $N; $j++)
            {
                $A[$i][$j] -= $tmp * $A[$col][$j];
            }
            $A[$i][$col] = 0;
            $b[$i] -= $tmp * $b[$col];
        }
    }
    $x = array();
    for ($col = $N - 1; $col >= 0; $col--)
    {
        $tmp = $b[$col];
        for ($j = $N - 1; $j > $col; $j--)
        {
            $tmp -= $x[$j] * $A[$col][$j];
        }
        $x[$col] = $tmp / $A[$col][$col];
    }
    return $x;
}

function test_gauss()
{
    $a = array(
        array(1.00, 0.00, 0.00,  0.00,  0.00, 0.00),
        array(1.00, 0.63, 0.39,  0.25,  0.16, 0.10),
        array(1.00, 1.26, 1.58,  1.98,  2.49, 3.13),
        array(1.00, 1.88, 3.55,  6.70, 12.62, 23.80),
        array(1.00, 2.51, 6.32, 15.88, 39.90, 100.28),
        array(1.00, 3.14, 9.87, 31.01, 97.41, 306.02)
    );
    $b = array( -0.01, 0.61, 0.91, 0.99, 0.60, 0.02 );

    $x = gauss_eliminate($a, $b, 6);

    ksort($x);
    print_r($x);
}

test_gauss();






Ada: with Ada.Text_IO;
with Ada.Numerics.Generic_Real_Arrays;

procedure Gaussian_Eliminations is

   type Real is new Float;

   package Real_Arrays is
      new Ada.Numerics.Generic_Real_Arrays (Real);
   use Real_Arrays;

   function Gaussian_Elimination (A : in Real_Matrix;
                                  B : in Real_Vector) return Real_Vector
   is

      procedure Swap_Row (A        : in out Real_Matrix;
                          B        : in out Real_Vector;
                          R_1, R_2 : in     Integer)
      is
         Temp : Real;
      begin
         if R_1 = R_2 then return; end if;

         
         for Col in A'Range (1) loop
            Temp := A (R_1, Col);
            A (R_1, Col) := A (R_2, Col);
            A (R_2, Col) := Temp;
         end loop;

         
         Temp    := B (R_1);
         B (R_1) := B (R_2);
         B (R_2) := Temp;
      end Swap_Row;

      AC : Real_Matrix := A;
      BC : Real_Vector := B;
      X  : Real_Vector (A'Range (1)) := BC;
      Max, Tmp : Real;
      Max_Row  : Integer;
   begin
      if
        A'Length (1) /= A'Length (2) or
        A'Length (1) /= B'Length
      then
         raise Constraint_Error with "Dimensions do not match";
      end if;

      if
        A'First (1) /= A'First (2) or
        A'First (1) /= B'First
      then
         raise Constraint_Error with "First index must be same";
      end if;

      for Dia in Ac'Range (1) loop
         Max_Row := Dia;
         Max     := Ac (Dia, Dia);

         for Row in Dia + 1 .. Ac'Last (1) loop
            Tmp := abs (Ac (Row, Dia));
            if Tmp > Max then
               Max_Row := Row;
               Max     := Tmp;
            end if;
         end loop;
         Swap_Row (Ac, Bc, Dia, Max_Row);

         for Row in Dia + 1 .. Ac'Last (1) loop
            Tmp := Ac (Row, Dia) / Ac (Dia, Dia);
            for Col in Dia + 1 .. Ac'Last (1) loop
               Ac (Row, Col) := Ac (Row, Col) - Tmp * Ac (Dia, Col);
            end loop;
            Ac (Row, Dia) := 0.0;
            Bc (Row) := Bc (Row) - Tmp * Bc (Dia);
         end loop;
      end loop;

      for Row in reverse Ac'Range (1) loop
         Tmp := Bc (Row);
         for J in reverse Row + 1 .. Ac'Last (1) loop
            Tmp := Tmp - X (J) * Ac (Row, J);
         end loop;
         X (Row) := Tmp / Ac (Row, Row);
      end loop;

      return X;
   end Gaussian_Elimination;

   procedure Put (V : in Real_Vector) is
      use Ada.Text_IO;
      package Real_IO is
         new Ada.Text_IO.Float_IO (Real);
   begin
      Put ("[ ");
      for E of V loop
         Real_IO.Put (E, Exp => 0, Aft => 6);
         Put (" ");
      end loop;
      Put (" ]");
      New_Line;
   end Put;

   A : constant Real_Matrix :=
     ((1.00, 0.00, 0.00,  0.00,  0.00, 0.00),
      (1.00, 0.63, 0.39,  0.25,  0.16, 0.10),
      (1.00, 1.26, 1.58,  1.98,  2.49, 3.13),
      (1.00, 1.88, 3.55,  6.70, 12.62, 23.80),
      (1.00, 2.51, 6.32, 15.88, 39.90, 100.28),
      (1.00, 3.14, 9.87, 31.01, 97.41, 306.02));

   B : constant Real_Vector :=
     ( -0.01, 0.61, 0.91, 0.99, 0.60, 0.02 );

   X : constant Real_Vector := Gaussian_Elimination (A, B);
begin
   Put (X);
end Gaussian_Eliminations;