Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 2)

// Процедура "перестановки" матрицы, возвращает true если все хорошо

function Remove(Var rez: Matrix; i: integer): boolean;

// Умножение 2-х матриц

procedure Multiple(a,b:Matrix; Var rez: Matrix);

// Возвращение решений

function FindDet(Var a:Matrix):string;

// Обнуление матриц

procedure Zero(Var a:Matrix);

public

{ Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.FindDet(Var a: Matrix):string;

Var i,j : integer;

M,Mob,bac : Matrix;

flag : boolean;

begin

SetLength(M,Length(a[1]),Length(a[1]));

SetLength(Mob,Length(a[1]),Length(a[1]));

SetLength(bac,Length(a[1]),Length(a[1]));

flag:=true;

for i:=Length(a[1])-2 downto 0 do

// Построение матриц

BEGIN

// Обработка случая 2.1

if (a[i+1,i]=0) and (not Remove(a,i)) then

begin

// Если ничего не помогло

flag:=false;

Break;

end;

// Обнуление всех матриц

Zero(M); Zero(Mob); Zero(bac);

// Построение матриц М

for j:=0 to Length(a[i])-1 do

begin

Mob[j,j]:=1;

Mob[i,j]:=a[i+1,j];

M[j,j]:=1;

M[i,j]:=-Mob[i,j]/a[i+1,i];

if i=j then M[i,j]:=1/a[i+1,i];

end;

// Умножение матрицы А на М

Multiple(a,M,bac); // A*M

Multiple(Mob,bac,a); // M^(-1)*(A*M)

END;

// Обработка случая 2.2, если надо

if not flag then

begin

M:=nil;

Mob:=nil;

// Находим матрицу С и выводим ее коэффициенты

SetLength(bac,1,length(a)-i-1);

for j:=i+1 to length(a)-1 do bac[0,j-i-1]:=a[i,j]; // Матрица C

Result:='('+FloatToStrF(bac[0,0],ffFixed,10,3);

for i:=1 to Length(bac)-1 do

Result:=Result+','+FloatToStrF(bac[0,i],ffFixed,10,3);

Result:=Result+'),';

// "Урезаем" матрицу А до состояния B, см. 2.2 пункт алгоритма

SetLength(a,i+1,i+1);

// Вызываем рекурсивно процедуру

Result:=Result+FindDet(a);

end

else begin

Result:='('+FloatToStrF(a[0,0],ffFixed,10,3);

for i:=1 to Length(a)-1 do

Result:=Result+','+FloatToStrF(a[0,i],ffFixed,10,3);

Result:=Result+')';

end;

bac:=nil;

end;

procedure TForm1.bbPlusClick(Sender: TObject);

begin

sgInData.ColCount:=sgInData.ColCount+1;

sgInData.RowCount:=sgInData.RowCount+1;

if sgInData.ColCount=11 then ShowMessage('Attention!!! Полученные результаты имеют малую точность');

end;

procedure TForm1.bbMinusClick(Sender: TObject);

begin

if sgInData.ColCount<3 then Exit;

sgInData.ColCount:=sgInData.ColCount-1;

sgInData.RowCount:=sgInData.RowCount-1;

end;

procedure TForm1.bbOpenClick(Sender: TObject);

Var k : real;

f : textfile;

a,i,j : integer;

begin

OpenDialog1.Filter:='Все файлы (*.*)|*.*| Файлы .txt (*.txt)|*.TXT';

OpenDialog1.Title:='Выбор файла для этой проги';

OpenDialog1.FilterIndex:=2;

if OpenDialog1.Execute then

begin

AssignFile(f,OpenDialog1.FileName);

Reset(f);

end

else Exit;

ReadLn(f,a);

sgInData.ColCount:=a;

sgIndata.RowCount:=a;

for i:=0 to a-1 do

begin

for j:=0 to a-1 do

begin

Read(f,k);

sgIndata.Cells[j,i]:=FloattoStr(k);

end;

ReadLn(f);

end;

CloseFile(f);

end;

procedure TForm1.bbFindClick(Sender: TObject);

Var a :matrix;

i,j :integer;

begin

try

SetLength(a,sgInData.ColCount,sgInData.RowCount);

for i:=0 to sgInData.RowCount-1 do

for j:=0 to sgInData.RowCount-1 do a[i,j]:=StrToFloat(sgInData.Cells[j,i]);

except

begin

a:=nil;

ShowMessage('STOP! Неправильный ввод, проверьте входные данные');

Exit;

end;

end;

OutData.Clear;

OutData.Lines.Add('Коэффициенты характеристического уравнения');

OutData.Lines.Add(FindDet(a));

a:=nil;

end;

procedure TForm1.Multiple(a, b: Matrix; var rez: Matrix);

var i,k,j : word;

Begin

for i:=0 to Length(a[1])-1 do

for k:=0 to Length(a[1])-1 do

begin

// Обновление занятых матриц

rez[i,k]:=0;

for j:=0 to Length(a[1])-1 do rez[i,k]:=rez[i,k]+a[i,j]*b[j,k];

end;

end;

function TForm1.Remove(var rez: Matrix; i: integer): boolean;

Var j,k : integer;

E,bac : Matrix;

begin

Result:=false;

for k:=0 to i-1 do // Ищем ненулевой элемент слева

if rez[i+1,k]<>0 then

begin

Result:=true;

Break;

end;

if not Result then Exit;

SetLength(E,Length(rez[1]),Length(rez[1]));

SetLength(bac,Length(rez[1]),Length(rez[1]));

for j:=0 to Length(rez[1])-1 do E[j,j]:=1;

for j:=0 to Length(rez[1])-1 do

begin

// Меняем две строки местами в матрице E

E[i,j]:=-E[i,j]-E[k,j];

E[k,j]:=-E[i,j]-E[k,j];

E[i,j]:=-E[i,j]-E[k,j];

end;

Multiple(rez,E,bac); // A*M

Multiple(E,bac,rez); // M^(-1)*(A*M)

E:=nil;

bac:=nil;

end;

procedure TForm1.Zero(var a: Matrix);

Var i,j: integer;

begin

for i:=0 to Length(a)-1 do

for j:=0 to Length(a[0])-1 do a[i,j]:=0;

end;

end.

Приложение Б

Результаты работы программы с теми же входными данными:

Рис 1.

Приложение Б

(продолжение)

Результаты работы программы с теми же входными данными:

Рис 2.

Характеристики

Список файлов курсовой работы