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.