Схемы алгоритмов
Ниже на рисунке 1 представлена схема выбора ведущего элемента в методе Гаусса.
Рисунок 1 – Схема алгоритма выбора ведущего элемента в методе Гаусса
Далее на рисунке 2 представлена схема алгоритма приведения матрицы к треугольному виду (прямой ход метода Гаусса)
Рисунок 2 – Схема алгоритма приведения матрицы к треугольному виду
(прямой ход метода Гаусса)
Далее на рисунке 3 представлена схема алгоритма обратного хода метода Гаусса.
Рисунок 3 – Схема алгоритма обратного хода метода Гаусса
Далее на рисунке 4 представлена схема алгоритма метода Крамера.
Рисунок 4 – Схема алгоритма метода Крамера
Ниже на рисунке 5 представлена схема алгоритма метода прогонки для трехдиагональной матрицы.
Рисунок 5 – Схема алгоритма метода прогонки для трехдиагональной матрицы
Текст программы
Далее представлен текст основного модуля программы, решающего СЛАУ методами Крамера или Гаусса.
unit SLAY;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids, ComCtrls, SolveSLAY, Menus;
type
TGausseKramer = class(TForm)
LbInfo: TLabel;
EdAmountEq: TEdit;
LbAmountEq: TLabel;
UDAmountEq: TUpDown;
SGMatrA: TStringGrid;
SGMatrB: TStringGrid;
SGAccuracy: TStringGrid;
MemInfo: TMemo;
ButKramer: TBitBtn;
ButGausse: TBitBtn;
ButClean: TBitBtn;
ButMatr: TBitBtn;
ButClose: TBitBtn;
LbAccuracy: TLabel;
MainMenu1: TMainMenu;
nAction: TMenuItem;
nMatr: TMenuItem;
nGausse: TMenuItem;
nKramer: TMenuItem;
nClear: TMenuItem;
N6: TMenuItem;
nClose: TMenuItem;
nHelp: TMenuItem;
nAboutProgram: TMenuItem;
ButClear: TBitBtn;
nClean: TMenuItem;
procedure ButMatrClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButGausseClick(Sender: TObject);
procedure ButCleanClick(Sender: TObject);
procedure nAboutProgramClick(Sender: TObject);
procedure ButCloseClick(Sender: TObject);
procedure ButKramerClick(Sender: TObject);
procedure ButClearClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
GausseKramer: TGausseKramer;
implementation
{$R *.dfm}
procedure TGausseKramer.ButMatrClick(Sender: TObject);
var i,j,n:integer;
begin
try
n:=StrToInt(EdAmountEq.Text);
if n<2
then raise EConvertError.Create('');
ButKramer.Enabled:=True;
ButGausse.Enabled:=True;
ButClean.Enabled:=True;
SGMatrA.ColCount:=n+1;
SGMatrA.RowCount:=n+1;
SGmatrB.RowCount:=n+1;
SGMatrA.Cells[0,0]:='A';
SGMatrB.Cells[0,0]:='B';
SGMatrB.Cells[1,0]:='1';
for i:=1 to n do
begin
SGMatrA.Cells[0,i]:=IntToStr(i);
SGMatrA.Cells[i,0]:=IntToStr(i);
SGMatrB.Cells[0,i]:=IntToStr(i);
end;
for i:=1 to n do
begin
for j:=1 to n do
SGMatrA.Cells[i,j]:='0';
SGMatrB.Cells[1,i]:='0';
end;
except on EConvertError do MessageDlg('Данные введены некорректно!',mtError,[mbOK],0);
end;
end;
procedure TGausseKramer.FormCreate(Sender: TObject);
begin
MemInfo.Clear;
end;
procedure TGausseKramer.ButGausseClick(Sender: TObject);
var n,i,j:integer;
finder:extended;
d:boolean;
A:masA;
B,X,E:masB;
begin
try
n:=SGMatrA.RowCount-1;
SetLength(A,n);
for i:=Low(A) to High(A) do
SetLength(A[i],n);
SetLength(B,n);
SetLength(X,n);
for i:=0 to n-1 do
begin
for j:=0 to n-1 do
A[i,j]:=StrToFloat(SGMatrA.Cells[j+1,i+1]);
B[i]:=StrToFloat(SGMatrB.Cells[1,i+1]);
end;
DirectMoveGausse(n,A,B,finder,d);
if ((finder<>0) and d)
then
begin
FlybackGausse(n,A,B,X);
SetLength(E,n);
VectorAccuracy (n,A,B,X,E);
SGAccuracy.ColCount:=n+1;
SGAccuracy.Cells[0,0]:='E';
SGAccuracy.Cells[0,1]:='1';
MemInfo.Lines.Add('Решение системы уравнений методом Гаусса:');
for i:=0 to n-1 do
begin
MemInfo.Lines.Add('x['+IntToStr(i+1)+']='+FloatToStr(X[i]));
SGAccuracy.Cells[i+1,0]:=IntToStr(i+1);
SGAccuracy.Cells[i+1,1]:=FloatToStr(E[i]);
end;
E:=nil;
end
else
begin
MessageDlg('Система не имеет решения!',mtError,[mbOK],0);
MemInfo.Lines.Add('Система не имеет решения.')
end;
A:=nil;
B:=nil;
X:=nil;
except on EConvertError do MessageDlg('Данные введены некорректно!',mtError,[mbOK],0)
else MessageDlg ('Ошибка!',mtError,[mbOK],0);
end;
end;
procedure TGausseKramer.ButCleanClick(Sender: TObject);
var i,j,n:integer;
begin
n:=SGMatrA.RowCount-1;
for i:=1 to n do
begin
for j:=1 to n do
SGMatrA.Cells[i,j]:='0';
SGMatrB.Cells[1,i]:='0';
end;
end;
procedure TGausseKramer.nAboutProgramClick(Sender: TObject);
begin
MessageDlg('Выполнили студенты группы 220691',mtInformation,[mbOK],0);
end;
procedure TGausseKramer.ButCloseClick(Sender: TObject);
begin
Close;
end;
procedure TGausseKramer.ButKramerClick(Sender: TObject);
var n,i,j:integer;
A:masA;
B,X,E:masB;
d:boolean;
begin
try
n:=SGMatrA.RowCount-1;
SetLength(A,n);
for i:=Low(A) to High(A) do
SetLength(A[i],n);
SetLength(B,n);
SetLength(X,n);
for i:=0 to n-1 do
begin
for j:=0 to n-1 do
A[i,j]:=StrToFloat(SGMatrA.Cells[j+1,i+1]);
B[i]:=StrToFloat(SGMatrB.Cells[1,i+1]);
end;
MethodKramer (n,A,B,X,d);
if d
then
begin
SetLength(E,n);
VectorAccuracy (n,A,B,X,E);
SGAccuracy.ColCount:=n+1;
SGAccuracy.Cells[0,0]:='E';
SGAccuracy.Cells[0,1]:='1';
MemInfo.Lines.Add('Решение системы уравнений методом Крамера:');
for i:=0 to n-1 do
begin
MemInfo.Lines.Add('x['+IntToStr(i+1)+']='+FloatToStr(X[i]));
SGAccuracy.Cells[i+1,0]:=IntToStr(i+1);
SGAccuracy.Cells[i+1,1]:=FloatToStr(E[i]);
end;
E:=nil;
end
else
begin
MessageDlg('Система не имеет решения!',mtError,[mbOK],0);
MemInfo.Lines.Add('Система не имеет решения.')
end;
A:=nil;
B:=nil;
X:=nil;
except on EConvertError do MessageDlg('Данные введены некорректно!',mtError,[mbOK],0)
else MessageDlg ('Ошибка!',mtError,[mbOK],0);
end;
end;
procedure TGausseKramer.ButClearClick(Sender: TObject);
begin
MemInfo.Clear;
end;
end.
Далее представлен текст модуля SolveSLAY, содержащий методы Гаусса и Крамера для решения СЛАУ.
unit SolveSLAY;
interface
type
masA=array of array of extended;
masB=array of extended;
procedure DirectMoveGausse(n:integer; var A:masA; var B:masB; var finder:extended; var d:boolean);
procedure FlybackGausse (n:integer; A:masA; B:masB; var X:masB);
procedure VectorAccuracy (n:integer; A:masA; B,X:masB; var E:masB) ;
procedure MethodKramer (n:integer; A:masA; B:masB; var X:masB; var d:boolean);
implementation
procedure LeadElement (k,n:integer; var A:masA; var B:masB; var d:boolean);
var z:extended;
t,p:integer;
begin
d:=false;
t:=k+1;
repeat
if A[t,k]<>0 then
begin
for p:=0 to n-1 do
begin
z:=a[t,p];
A[t,p]:=A[k,p];
A[k,p]:=z;
end;
z:=B[t];
B[t]:=B[k];
B[k]:=z;
d:=true;
end;
t:=t+1;
until (d or (t=n));
end;
procedure DirectMoveGausse(n:integer; var A:masA; var B:masB; var finder:extended; var d:boolean);
var i,j,k:integer;
f:extended;
begin {приведение матрицы к треугольному виду}
for k:=0 to n-2 do
begin
for i:=k+1 to n-1 do
begin
d:=true;
if A[k,k]=0
then LeadElement(k,n,A,B,d);
if d then
begin
f:=A[i,k]/A[k,k];
for j:=k to n-1 do
A[i,j]:=A[i,j]-f*A[k,j];
B[i]:=B[i]-f*B[k];
end;
end;
end;
finder:=1; {вычисление определителя матрицы}
if d then
for i:=0 to n-1 do
finder:=finder*a[i,i];
end;
procedure FlybackGausse (n:integer; A:masA; B:masB; var X:masB);
var k,j:integer;
f:extended;
begin
for k:=n-1 downto 0 do
begin
f:=0;
for j:=k+1 to n-1 do
f:=f+A[k,j]*X[j];
X[k]:=((B[k]-f)/(A[k,k]));
end;
end;
procedure MethodKramer (n:integer; A:masA; B:masB; var X:masB; var d:boolean);
var NewA:masA;
NewB:masB;
detA,finder:extended;
k,i,j:integer;
begin
SetLength(NewA,n);
for i:=Low(NewA) to High(NewA) do
SetLength(NewA[i],n);
SetLength(NewB,n);
for i:=0 to n-1 do
begin
for j:=0 to n-1 do
NewA[i,j]:=A[i,j];
NewB[i]:=B[i];
end;
DirectMoveGausse(n,NewA,NewB,finder,d);
if ((finder<>0) and d)
then
begin
detA:=finder;
for k:=0 to n-1 do
begin
for i:=0 to n-1 do
begin
for j:=0 to n-1 do
if j=k
then NewA[i,j]:=B[i]
else NewA[i,j]:=A[i,j];
NewB[i]:=B[i];
end;
DirectMoveGausse(n,NewA,NewB,finder,d);
X[k]:=finder/detA;
end;
end
else d:=false;
NewA:=nil;
NewB:=nil;
end;
procedure VectorAccuracy (n:integer; A:masA; B,X:masB; var E:masB) ;
var i,j:integer;
begin
for i:=0 to n-1 do
begin
E[i]:=0;
for j:=0 to n-1 do
E[i]:=E[i]+A[i,j]*x[j];
E[i]:=E[i]-B[i];
end;
end;
end.
Далее представлен текст основного модуля программы, решающего СЛАУ методом прогонки.
unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, uSweepMethod, XPMan, Menus;
const
StartSize=3;
type
TfLR1SweepMethod = class(TForm)
strgrMatrixA: TStringGrid;
strgrMatrixX: TStringGrid;
strgrMatrixB: TStringGrid;
bFindAnswer: TButton;
eSizeOfSLAU: TEdit;
bVerifyAnswer: TButton;
bClearMatrixes: TButton;
lSizeOfSLAU: TLabel;
lMultiply: TLabel;
lEquel: TLabel;
bSetMatrixes: TButton;
strgrError: TStringGrid;
XPManifest1: TXPManifest;
MainMenu1: TMainMenu;
nFile: TMenuItem;
nHelp: TMenuItem;
nExit: TMenuItem;
nAbout: TMenuItem;
procedure bFindAnswerClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure bSetMatrixesClick(Sender: TObject);
procedure bClearMatrixesClick(Sender: TObject);
procedure bVerifyAnswerClick(Sender: TObject);
procedure strgrMatrixASetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure nExitClick(Sender: TObject);
procedure nAboutClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fLR1SweepMethod: TfLR1SweepMethod;
implementation
{$R *.dfm}
procedure TfLR1SweepMethod.bFindAnswerClick(Sender: TObject);
var
a,b,c,d,x:TLine;
i,j,n:integer;
begin
try
n:=strtoint(eSizeOfSLAU.Text);
setlength(a,n);
setlength(b,n);
setlength(c,n);
setlength(d,n);
for i:=1 to n do
begin
b[i-1]:=-strtofloat(strgrMatrixA.Cells[i,i]);
d[i-1]:=strtofloat(strgrMatrixB.Cells[1,i]);
end;
for i:=1 to n-1 do
begin
a[i]:=strtofloat(strgrMatrixA.Cells[i,i+1]);
c[i-1]:=strtofloat(strgrMatrixA.Cells[i+1,i]);
end;
x:=SweepMethod(a,b,c,d);
for i:=1 to n do
strgrMatrixX.Cells[1,i]:=floattostr(x[i-1]);
a:=nil; b:=nil; c:=nil; d:=nil; x:=nil;
except
on EMathError do showmessage('Невозможно решить СЛАУ.');
esle showmessage('Возникла непредвиденная ошибка.');
end;
end;
procedure ClearMatrixes();
var
i,j,n:integer;
begin
n:=strtoint(fLR1SweepMethod.eSizeOfSLAU.Text);
for i:=1 to n do
begin
fLR1SweepMethod.strgrMatrixA.Cells[i,0]:=inttostr(i);
fLR1SweepMethod.strgrMatrixA.Cells[0,i]:=inttostr(i);
fLR1SweepMethod.strgrMatrixB.Cells[0,i]:=inttostr(i);
fLR1SweepMethod.strgrMatrixX.Cells[0,i]:=inttostr(i);
fLR1SweepMethod.strgrError.Cells[i,0]:=inttostr(i)+' уравнение';
fLR1SweepMethod.strgrError.Cells[i,1]:='0';
fLR1SweepMethod.strgrMatrixB.Cells[1,i]:='0';
fLR1SweepMethod.strgrMatrixX.Cells[1,i]:='0';
for j:=1 to n do
fLR1SweepMethod.strgrMatrixA.Cells[i,j]:='0';
end;
end;
procedure TfLR1SweepMethod.FormCreate(Sender: TObject);
begin
strgrMatrixA.Cells[0,0]:='Матрица A';
strgrMatrixB.Cells[0,0]:='Матрица B';
strgrMatrixX.Cells[0,0]:='Матрица X';
strgrError.Cells[0,0]:='Погрешность';
eSizeOfSLAU.Text:=inttostr(StartSize);
end;
procedure TfLR1SweepMethod.bSetMatrixesClick(Sender: TObject);
var
n:integer;
begin
try
n:=strtoint(fLR1SweepMethod.eSizeOfSLAU.Text);
strgrMatrixA.ColCount:=n+1;
strgrMatrixA.RowCount:=n+1;
strgrMatrixB.RowCount:=n+1;
strgrMatrixX.RowCount:=n+1;
strgrError.ColCount:=n+1;
strgrMatrixA.Enabled:=true;
strgrMatrixB.Enabled:=true;
strgrMatrixX.Enabled:=true;
bFindAnswer.Enabled:=true;
bVerifyAnswer.Enabled:=true;
ClearMatrixes();
except
on EConvertError do showmessage('Неверно задано количество уравнений СЛАУ.');
else showmessage('Возникла непредвиденная ошибка.');
end;
end;
procedure TfLR1SweepMethod.bClearMatrixesClick(Sender: TObject);
begin
ClearMatrixes();
end;
procedure TfLR1SweepMethod.bVerifyAnswerClick(Sender: TObject);
var
i,j,n:integer;
b,buf: extended;
a,x: TLine;
begin
n:=strtoint(eSizeOfSLAU.Text);
setlength(a,n);
setlength(x,n);
for i:=1 to n do
x[i-1]:=strtofloat(strgrMatrixX.Cells[1,i]);
for i:=1 to n do
begin
buf:=0; b:=strtofloat(strgrMatrixB.Cells[1,i]);
for j:=1 to n do
begin
a[j-1]:=strtofloat(strgrMatrixA.Cells[j,i]);
buf:=buf+a[j-1]*x[j-1];
end;
strgrError.Cells[i,1]:=floattostr(abs(b-buf));
end;
end;
procedure TfLR1SweepMethod.strgrMatrixASetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
if (ACol<>ARow) and (ACol+1<>ARow) and (ACol-1<>ARow)
and (strgrMatrixA.Cells[ACol,ARow]<>'0')
then strgrMatrixA.Cells[ACol,ARow]:='0';
end;
procedure TfLR1SweepMethod.nExitClick(Sender: TObject);
begin
close;
end;
procedure TfLR1SweepMethod.nAboutClick(Sender: TObject);
begin
showmessage('Выполнили ст. гр. 220691 Губарева А.А. и Карпов Р.О.')
end;
end.
Далее представлен текст модуля uSweepMethod , содержащий метод прогонки для решения СЛАУ.
unit uSweepMethod;
interface
uses
math;
type
TLine=array of extended;
TMatrix=array of TLine;
function SweepMethod(a,b,c,d:TLine):TLine;
implementation
function SweepMethod(a,b,c,d:TLine):TLine;
var
i,n:integer;
p,q:TLine;
begin
n:=length(a);
setlength(p,n+1);
setlength(q,n+1);
setlength(Result,n);
p[1]:=c[0]/b[0];
q[1]:=-d[0]/b[0];
for i:=1 to n-1 do
begin
p[i+1]:=c[i]/(b[i]-a[i]*p[i]);
q[i+1]:=(a[i]*q[i]-d[i])/(b[i]-a[i]*p[i]);
end;
Result[n-1]:=q[n];
for i:=n-2 downto 0 do Result[i]:=p[i+1]*Result[i+1]+q[i+1];
end;
end.