Библиотека Gauss

unit UGauss;
//Реализация метода Гаусса с выбором строк
interface

  type
    TArrSingle = array of single;

  TGauss = class
    private
      Erange: integer;  //Размер матрицы
      Eresultat: TArrSingle;  //Решение
      procedure SetRange(const Value: integer);
    public
      matrix: array of TArrSingle;  //Матрица
      right: TArrSingle;  //Правые части
      property range: integer read Erange write SetRange;  //Установка ранга
      property resultat: TArrSingle read Eresultat; //Получение результата
      function Calc: boolean;  //Вычисление. true если резултата получен
    end;

implementation

{ TGauss }

function TGauss.Calc: boolean;
var i, j, k: integer;
  koef: extended;
  procedure Exchange(x, y: integer);
  var tmp: single;
    i: integer;
  begin
    for i := 0 to range-1 do begin
      tmp:=matrix[x, i];
      matrix[x,i]:=matrix[y,i];
      matrix[y,i]:=tmp;
    end;
  end;


  function triangle(x: integer): boolean;
  var j: integer;
    max: integer;
  begin
    max:=x;
    for j := x+1 to range-1 do
      if abs(matrix[j, x]) > abs(matrix[max, x]) then
        max:=j;
    if max <> x then
      Exchange(x,max);
    result:=matrix[x,x] <> 0;
//    if matrix[x,x] = 0 then
//      for j := x+1 to range - 1 do
//        if matrix[j, x] <> 0 then begin
//          Exchange(x,j);
//          result:=true;
//          break;
//        end;

  end;

begin
  result:=true;
  for i := 0 to range-1 do begin //базовая строка
    result:= triangle(i);
    if not result then
      exit;
    for k := i+1 to range-1 do begin//строка, которю обрабатываем
      koef:=matrix[k, i]/matrix[i,i];
      for j := i to range - 1 do //эл-т обрабатываемой строки
        matrix[k,j]:=matrix[k,j]-koef*matrix[i,j];
      right[k]:=right[k]-koef*right[i];
    end;
  end;
  for i := range-1 downto 0 do begin //базовая строка
    for k := 0 to i-1 do begin
      right[k]:=right[k] - right[i]/matrix[i,i]*matrix[k,i];
      matrix[k,i]:=0;
    end;
  end;
  setlength(Eresultat, range);
  try
    for i := 0 to range - 1 do
      Eresultat[i]:=right[i]/matrix[i,i];
  except
     result:=false;
  end;
end;

procedure TGauss.SetRange(const Value: integer);
begin
  Erange:=Value;
  SetLength(matrix, Erange, Erange);
  SetLength(right, Erange);
end;

end.