[webmenn]

Привет! Если есть у кого готовая прога выложите пожалуйста оч надо! с исходниками)

[ART]

Если я не ошибаюсь в методе решения, то там самый гемор написать функцию нахождения определителя (это можно найти в инете), а остальное дело техники

[webmenn]

Если б это было дело техники я б наверно не просил! Если есть выложи плс!

[ART]

Ммм... сейчас скинуть не могу. Возможно, если получится, то скину на выходных

[webmenn]

Спасибо! Буду ждать)

[ART]

Короче, я оказывается перепутал методы Но я всё таки попробовал решить это. На половину получислось на половину нет.
Решать вам:

привожу полный код для обсуждения, т.к. самому интересно:

Код:

unit Unit1;

interface

uses
  Windows,  Messages,  SysUtils,  Variants,  Classes,  Graphics,  Controls,  Forms, 
  Dialogs,  StdCtrls,  Grids,  XPMan;

{Суть метода:
На каждом шаге решения выбирается разрешающий элемент Ars  <>  0
(любой элем. не равный нулю); r  -  я строка называется разрешающей
строкой,  Xs  -  разрешающей переменной. Для перехода к следующему шагу
разрешающая переменная Xs исключается из всех остальных уравнений
; элементы разрешающей строки делятся на разр.элемент,  а элементы
других строк заменяются на новые по следующему правилу
Aij  =  (Aij  *  Ars  -  Ais  *  Arj) / Ars.
После получения новой матрицы выбирается новый,  отличный от нуля, 
разр. элемент в другой строке,  вычисляется новая матрица и т.д.,  пока
матрица A не будет приведена к диагональному виду}

// *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 
{В примере,  ответы должны быть 1,  2,  3  -  'решает'
(в решение получается только диагональная матрица,  а
не чистый ответ  -  не знаю как это сделать) ,  но как
я думаю,  возможно,  неправильное решение в случае когда
одна ли несколько строк равны нулю}
// *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 


type

  TRow  =  array of extended; //ряд

  TMatrix  =  array of TRow; //Mass[номер строки][номер столбца]


type
  TForm1  =  class(TForm)
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    XPManifest1: TXPManifest;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R  * .dfm}

{проверка строки на нулевые элементы}
function AllZero(R: TRow): boolean;
var
 i: integer;
begin
 for i  :=  0 to High(R) do
  if R[i]  <>  0 then begin
   Result  :=  false;
   exit;
  end;
 Result  :=  true;
end;

{Для удобства ищем в строке единицу, 
если не найдена и выбираем случайное
число  <>  0}
function GetX(R: TRow): integer;
var
 i,  c: integer;
begin
 for i  :=  0 to High(R) do
  if Abs(R[i])  =  1 then begin
   Result  :=  i;
   exit;
  end;
 randomize;
 repeat
  c  :=  random(Length(R))
 until R[c]  <>  0;
 Result  :=  c;
end;

{Разрешающая переменная (X) исключается из всех
остальных уравнений; r,  c  -  координаты разр. переменной}
procedure XtoZero(var M: TMatrix; r,  c: integer);
var
 i: integer;
begin
 for i  :=  0 to High(M) do
  if r  <>  i then M[i][c]  :=  0;
end;

{Делим элементы (разрешающей) строки на разрешающий элемент}
function RowDivX(R: TRow; X: extended): TRow;
var
 i: integer;
begin
 for i  :=  0 to High(R) do R[i]  :=  R[i] / X;
 Result  :=  R;
end;

{получение нового значение элемента по правилу прямоугольника}
{i,  j  -  координаты (стр,  стлб) элемента; r,  c  -  координаты}
function GetNewElem(M:TMatrix; i,  j,  r,  c: integer): extended;
begin
 Result  :=  (m[i][j]  *  m[r][c]  -  m[i][c]  *  m[r][j]) / m[r][c];
end;

{преобразование матрицы к диагональному виду}
function GetDiagonalMatrix(M: TMatrix): TMatrix;
var
 r,  c,  i,  j: integer;
begin
 randomize;
 for r  :=  0 to High(M) do begin
  if AllZero(M[r])  =  true then continue; //проверка строки на нули
  c  :=  GetX(M[r]);                       //выбираем разрешающее число
  M[r]  :=  RowDivX(M[r],  M[r][c]);        //делим текущую строку на этот элемент
  for i  :=  0 to High(M) do
   for j  :=  0 to High(M[i]) do           //получаем 'новые' элементы из 'старых' по правилу прямоугольника
     if (i  <>  r) and (c  <>  j) then M[i][j]  :=  GetNewElem(M,  i,  j,  r,  c);
   XtoZero(M,  r,  c);                     //удаляем эту переменную из других уравнений
 end;
Result  :=  M;
end;

function GridToMatrix(Grid: TStringGrid; W,  H: integer): TMatrix;
var
 x,  y: integer;
 M: TMatrix;
 R: TRow;
begin
 SetLength(M,  H);
 for y  :=  0 to H  -  1 do begin
  SetLength(M[y],  W);
  for x  :=  0 to W  -  1 do begin
   M[y][x]  :=  StrToFloat(Grid.Cells[x,  y]);
  end;
 end;
 Result  :=  M;
end;

procedure MatrixToGrid(Grid: TStringGrid; M: TMatrix);
var
 x,  y: integer;
begin
 for y  :=  0 to High(M) do begin
  for x  :=  0 to High(M[y]) do begin
   Grid.Cells[x,  y]  :=  FloatToStr(M[y][x]);
  end;
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 M : TMatrix;
begin
 M  :=  GridToMatrix(StringGrid1,  StrToInt(Edit2.Text),  StrToInt(Edit1.Text));;
 MatrixToGrid(StringGrid2,  GetDiagonalMatrix(M));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
with StringGrid1 do begin
 Cells[0,  0]  :=  '1';
 Cells[1,  0]  :=  '1';
 Cells[2,  0]  :=  '1';
 Cells[3,  0]  :=  '6';

 Cells[0,  1]  :=  '2';
 Cells[1,  1]  :=  ' - 1';
 Cells[2,  1]  :=  '1';
 Cells[3,  1]  :=  '3';

 Cells[0,  2]  :=  '1';
 Cells[1,  2]  :=  ' - 1';
 Cells[2,  2]  :=  '2';
 Cells[3,  2]  :=  '5';

 Cells[0,  3]  :=  '3';
 Cells[1,  3]  :=  ' - 6';
 Cells[2,  3]  :=  '5';
 Cells[3,  3]  :=  '6';

end;
end;

end.

[webmenn]

Спасибо большое Вы мне спасли жизнь!)