| перформенс | Дата: Четверг, 29.12.2011, 21:57 | Сообщение # 1 |
|
Рядовой
Группа: Пользователи
Сообщений: 1
Статус: Offline
| {Решение СЛАУ методом Зейделя
Идея: задана основная матрица A и вектор B
Сначала нормализуем матрицу и вектор.
Вычисляется транспонированная матрица A ,т.е A^t;
Выполняются действия: A'=(A^t)*A; B'=(A^t)*b
Далее операции выполняются над этими матрицами
Случайным образом задается вектор X(x1,x2,..,xn);
Далее вычисляется вектор Xk через Xk-1.
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids,MAth;
type
Matrix=array [1..10,1..10] of Real;
Vector=array [1..10] of Real;
TForm1 = class(TForm)
Ad: TStringGrid;
Calculate: TButton;
edEpsilon: TEdit;
Bd: TStringGrid;
edN: TEdit;
Label1: TLabel;
Label2: TLabel;
Cd: TStringGrid;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Exit: TButton;
procedure CalculateClick(Sender: TObject);
procedure edNChange(Sender: TObject);
procedure edNKeyPress(Sender: TObject; var Key: Char);
procedure ExitClick(Sender: TObject);
procedure AdKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
eps : Real;
n : Byte;
A : Matrix;
B : Vector;
implementation
{$R *.dfm}
procedure TForm1.CalculateClick(Sender: TObject);
var
i,j,k : Byte;
tt : Real;
A1 : Matrix;
A2 : Matrix;
B1 : Vector;
X : vector;
X1 : vector;
function CheckConds:Boolean;
{Условие прекращения вычислений}
var
l : Byte;
mm : Real;
begin
mm:=abs(X1[1]-X[1]);
for l:=2 to n do
if mm<abs(X1[l]-X[l]) then mm:=abs(X1[l]-X[l]);
if mm<eps then result:=true else result:=false;
end;
procedure CalculateNextX;
var
l,m : Byte;
zz : real;
begin
for l:=1 to n do
begin
zz:=(B[l]/A[l,l]);
for m:=1 to n do
begin
if m=l then continue;
zz:=zz-(A[l,m]*X[m]/A[l,l])
end;
X[l]:=zz;
end;
end;
begin
n:=StrToInt(edN.Text);
eps:=StrToFloat(edEpsilon.Text);
for i:=0 to n-1 do begin
for j:=0 to n-1 do begin
A[i+1,j+1]:=StrToFloat(Ad.Cells[j,i]);
end;
B[i+1]:=StrToFloat(Bd.Cells[0,i]);
end;
A1:=A;
for i:=1 to n do
begin
for j:=i to n do
begin
tt:=A1[i,j];
A1[i,j]:=A1[j,i];
A1[j,i]:=tt;
end;
end;
for i:=1 to n do
begin
for j:=1 to n do
begin
tt:=0;
for k:=1 to n do
tt:=tt+A1[i,k]*A[k,j];
A2[i,j]:=tt;
end;
end;
for i:=1 to n do
begin
tt:=0;
for k:=1 to n do
tt:=tt+A1[i,k]*B[k];
B1[i]:=tt;
end;
A:=A2;
B:=B1;
for i:=1 to n do
X[i]:=0;
repeat
X1:=X;
CalculateNextX;
until CheckConds;
for i:=0 to n-1 do
Cd.Cells[0,i]:=FloatToStr(RoundTo(X[i+1],-10));
end;
procedure TForm1.edNChange(Sender: TObject);
var
z : Byte;
begin
z:=StrToInt(edN.Text);
AD.RowCount:=z;
AD.ColCount:=z;
Cd.RowCount:=z;
Bd.RowCount:=z;
end;
procedure TForm1.edNKeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#8,'0'..'9',',','-']) then
ShowMessage('Неправилный ввод. Используйте только цифры');
//Key:=#0;
end;
procedure TForm1.ExitClick(Sender: TObject);
begin
close;
end;
procedure TForm1.AdKeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#8,'0'..'9',',','-']) then
//Key:=#0;
ShowMessage('Неправилный ввод. Используйте только цифры');
end;
end.
|
| |
| |
| diamFC | Дата: Четверг, 29.12.2011, 22:24 | Сообщение # 2 |
|
Полковник
Группа: Администраторы
Сообщений: 207
Статус: Offline
| блок-схема сделана за одну минуту с помощью программы построения блок-схем diamFC
все блок-схемы в архиве
|
| |
| |
Программа для построения БЛОК-СХЕМ!!!
