перформенс | Дата: Четверг, 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 все блок-схемы в архиве
|
|
| |