Текст программы - Разработка программы для решения систем линейных уравнений методом Гауса и Жордана-Гаусса в программном комплексе Delphi

Файл-модуль unit1.pas

Unit Unit1;

Interface

Uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, XPMan, StdCtrls, Grids, unit2;

Type

TForm1 = class(TForm)

Coef: TStringGrid;

Gauss: TStringGrid;

Jgauss: TStringGrid;

Button1: TButton;

Button2: TButton;

XPManifest1: TXPManifest;

SaveDialog1: TSaveDialog;

MainMenu1: TMainMenu;

File1: TMenuItem;

New1: TMenuItem;

Save1: TMenuItem;

Exit1: TMenuItem;

Matrix: TStringGrid;

Procedure New1Click(Sender: TObject);

Procedure Button1Click(Sender: TObject);

Procedure Button2Click(Sender: TObject);

Procedure Save1Click(Sender: TObject);

Procedure Exit1Click(Sender: TObject);

Private

{ Private declarations }

Public

{ Public declarations }

End;

Var

Form1: TForm1;

S:integer;

Implementation

{$R *.dfm}

Procedure TForm1.Exit1Click(Sender: TObject);

Begin

Close;

End;

Procedure TForm1.New1Click(Sender: TObject);

Var i, dl:integer;

Prover:string;

Begin

Form1.Enabled:=false;

Repeat

Prover:=inputbox('Введите размер системы','Значение между 2 и 20','2');

Dl:=length(prover);

If dl=0 then showmessage('Введите размер системы') else

Begin

If (dl=1) and (prover<'9') and (prover>'0') then s:=trunc(strtofloat(prover))

Else

Begin

For i:=1 to dl do

Begin

If prover[i]>'9' then

Begin

Showmessage('Введите число');

Break;

End

Else if i=dl then s:=trunc(strtofloat(inputbox('Введите размер системы','Значение между 2 и 20','2')));

End;

End;

End;

Until (s>=2) and (s<=maxr);

Form1.Enabled:=true;

Matrix. RowCount:=s+1;

Matrix. ColCount:=s+1;

Gauss. colCount:=s+1;

Coef. rowCount:=s+1;

Jgauss. colCount:=s+1;

Coef. Cells[1,0]:='B';

Gauss. Cells[0,1]:='Gauss';

Jgauss. Cells[0,1]:='J-Gauss';

For i:=1 to s do

Begin

Matrix. Cells[0,i]:=floattostr(i);

Matrix. Cells[i,0]:='A'+floattostr(i);

Coef. Cells[0,i]:=floattostr(i);

Gauss. Cells[i,0]:='X'+floattostr(i);

Jgauss. Cells[i,0]:='X'+floattostr(i);

End;

End;

Procedure TForm1.Button1Click(Sender: TObject);

Var a:ary2s;

X, y:arys;

Error:boolean;

I, j, l, K:integer;

Prover:string;

Begin

{Считывание массивов с исходными данными и проверка '.' или ','}

{***********************************************}

For i:=1 to s do

For j:=1 to s do

Begin

Prover:=matrix. Cells[j, i];

K:=length(prover);

If k=0 then

Begin

Showmessage('Вы не ввели один или несколько элементов системы.');

Exit;

End;

For l:=1 to length(prover) do

If prover[l]='.' then prover[l]:=','

Else if prover[l]>'9' then

Begin

Showmessage('В качестве одного или нескольких элементов системы введена буква. Замените их на числа!');

Exit;

End;

Matrix. Cells[j, i]:=prover;

A[i, j]:=strtofloat(matrix. cells[j, i]);

End;

For i:=1 to s do

Begin

Prover:=coef. cells[1,i];

For l:=1 to length(prover) do

If prover[l]='.' then prover[l]:=','

Else if prover[l]>'9' then

Begin

Showmessage('В качестве одного или нескольких элементов системы введена буква. Замените их на числа!');

Exit;

End;

Coef. cells[1,i]:=prover;

Y[i]:=strtofloat(coef. cells[1,i]);

End;

{***********************************************}

{Решение и вывод результатов}

{***********************************************}

Gauss1(a, y, x, s, error);

If not error then

For i:=1 to s do

Gauss. cells[i,1]:=floattostr(x[i])

Else

Begin

Showmessage('Система решения не имеет');

New1.Click;

End;

{***********************************************}

End;

Procedure TForm1.Button2Click(Sender: TObject);

Var a:ary2s;

X, y:arys;

Error:boolean;

I, j, l, k:integer;

Prover:string;

Begin

{Считывание массивов с исходными данными}

{***********************************************}

{Считывание массивов с исходными данными и проверка '.' или ','}

{***********************************************}

For i:=1 to s do

For j:=1 to s do

Begin

Prover:=matrix. Cells[j, i];

K:=length(prover);

If k=0 then

Begin

Showmessage('Вы не ввели один или несколько элементов системы.');

Exit;

End;

For l:=1 to length(prover) do

If prover[l]='.' then prover[l]:=','

Else if prover[l]>'9' then

Begin

Showmessage('В качестве одного или нескольких элементов системы введена буква. Замените их на числа!');

Exit;

End;

Matrix. Cells[j, i]:=prover;

A[i, j]:=strtofloat(matrix. cells[j, i]);

End;

For i:=1 to s do

Begin

Prover:=coef. cells[1,i];

For l:=1 to length(prover) do

If prover[l]='.' then prover[l]:=','

Else if prover[l]>'9' then

Begin

Showmessage('В качестве одного или нескольких элементов системы введена буква. Замените их на числа!');

Exit;

End;

Coef. cells[1,i]:=prover;

Y[i]:=strtofloat(coef. cells[1,i]);

End;

{***********************************************}

{***********************************************}

{Решение и вывод результатов}

{***********************************************}

Gaussj(a, y, x, s, error);

If not error then

For i:=1 to s do

Jgauss. cells[i,1]:=floattostr(x[i])

Else

Begin

Showmessage('Система решения не имеет');

New1.Click;

End;

{***********************************************}

End;

Procedure TForm1.Save1Click(Sender: TObject);

Var f:textfile;

I, j:integer;

Begin

Savedialog1.Filter:='Text files (*.txt)|*.txt|';

If savedialog1.Execute then

Begin

Assignfile(f, savedialog1.filename+'.txt');

Rewrite(f);

For i:=1 to s do

Begin

Writeln(f);

For j:=1 to s do

Write(f, matrix. cells[i, j]:4,' ');

Write(f,'|',coef. cells[1,i]);

End;

Writeln(f);

Writeln(f);

Writeln(f,'Gauss');

For i:=1 to s do

Writeln(f,'X'+floattostr(i)+'='+gauss. cells[i,1],' ');

Writeln(f);

Writeln(f,'J-Gauss');

For i:=1 to s do

Writeln(f,'X'+floattostr(i)+'='+jgauss. cells[i,1],' ');

Closefile(f);

End;

End;

End.

Unit unit2;

Interface

Constmaxr=20;

Type arys=array[1..maxr] of real;

Ary2s=array[1..maxr,1..maxr] of real;

Procedure gauss1(a:ary2s; y:arys; var coef:arys; ncol:integer; var error:boolean);

Procedure gaussj(var b:ary2s; y: arys; var coef:arys; ncol:integer; var error: boolean);

Implementation

{Решение системы линейных уравнений методом Гаусса}

{**********************************************************}

Procedure gauss1(a:ary2s; y:arys; var coef:arys; ncol:integer; var error:boolean);

Var b:ary2s;

W:arys;

I, j, i1,k, l, n:integer;

Hold, sum, t, ab, big: real;

Begin

Error:=false;

N:=ncol;

For i:=1 to n do

Begin

For j:=1 to n do

B[i, j]:=a[i, j];

W[i]:=y[i]

End;

For i:=1 to n-1 do

Begin

Big:=abs(b[i, i]);

L:=i;

I1:=i+1;

For j:=i1 to n do

Begin

Ab:=abs(b[j, i]);

If ab>big then

Begin

Big:=ab;

L:=j

End

End;

If big=0.0 then error:= true

Else

Begin

If l<>i then

Begin

For j:=1 to n do

Begin

Hold:=b[l, j];

B[l, j]:=b[i, j];

B[i, j]:=hold

End;

Hold:=w[l];

W[l]:=w[i];

W[i]:=hold

End;

For j:=i1 to n do

Begin

T:=b[j, i]/b[i, i];

For k:=i1 to n do

B[j, k]:=b[j, k]-t*b[i, k];

W[j]:=w[j]-t*w[i]

End

End

End;

If b[n, n]=0.0 then error:=true

Else

Begin

Coef[n]:=w[n]/b[n, n];

I:=n-1;

Repeat

Sum:=0.0;

For j:=i+1 to n do

Sum:=sum+b[i, j]*coef[j];

Coef[i]:=(w[i]-sum)/b[i, i];

I:=i-1

Until i=0

End

End;

{**********************************************************}

{Решение системы линейных уравнений методом Жордана-Гаусса}

{**********************************************************}

Procedure gaussj(var b:ary2s; y: arys; var coef:arys; ncol:integer; var error: boolean);

Var w:array[1..maxr,1..maxr] of real;

Index:array[1..maxr,1..3] of integer;

I, j, k, l, nv, irow, icol, n, l1:integer;

Determ, pivot, hold, sum, t, ab, big:real;

{++++++++++++++++++++++++++++++++++++++++++++}

Procedure swap(var a, b: real);

Var hold:real;

Begin

Hold:=a;

A:=b;

B:=hold

End;

{++++++++++++++++++++++++++++++++++++++++++++}

{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}

Procedure gausj2;

Var i, j, k, l, l1:integer;

{===============================================}

Procedure gausj3;

Var l:integer;

Begin

If irow<>icol then

Begin

Determ:=-determ;

For l:=1 to n do

Swap(b[irow, l],b[icol, l]);

If nv>0 then

For l:=1 to nv do

Swap(w[irow, l],w[icol, l])

End

End;

{===============================================}

Begin

Error:=false;

Nv:=1;

N:=ncol;

For i:=1 to n do

Begin

W[i,1]:=y[i];

Index[i,3]:=0

End;

Determ:=1.0;

For i:=1 to n do

Begin

Big:=0.0;

For j:=1 to n do

Begin

If index[j,3]<>1 then

Begin

For k:=1 to n do

Begin

If index[k,3]>1 then

Begin

Error:=true;

Exit;

End;

If index[k,3]<1 then

If abs(b[j, k])>big then

Begin

Irow:=j;

Icol:=k;

Big:=abs(b[j, k])

End

End

End

End;

Index[icol,3]:=index[icol,3]+1;

Index[i,1]:=irow;

Index[i,2]:=icol;

Gausj3;

Pivot:=b[icol, icol];

Determ:=determ*pivot;

B[icol, icol]:=1.0;

For l:=1 to n do

B[icol, l]:=b[icol, l]/pivot;

If nv>0 then

For l:=1 to nv do

W[icol, l]:=w[icol, l]/pivot;

For l1:=1 to n do

Begin

If l1<>icol then

Begin

T:=b[l1,icol];

B[l1,icol]:=0.0;

For l:=1 to n do

B[l1,l]:=b[l1,l]-b[icol, l]*t;

If nv>0 then

For l:=1 to nv do

W[l1,l]:=w[l1,l]-w[icol, l]*t;

End

End

End;

End;

{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}

Begin

Gausj2;

If error then exit;

For i:=1 to n do

Begin

L:=n-i+1;

If index[l,1]<>index[l,2] then

Begin

Irow:=index[l,1];

Icol:=index[l,2];

For k:=1 to n do

Swap(b[k, irow],b[k, icol])

End

End;

For k:=1 to n do

If index[k,3]<>1 then

Begin

Error:=true;

Exit;

End;

For i:=1 to n do

Coef[i]:=w[i,1];

End;

{**********************************************************}

End.

Program Project1;

Uses

Forms,

Unit1 in 'Unit1.pas' {Form1},

Unit2 in 'Unit2.pas';

{$R *.res}

Begin

Application. Initialize;

Application. Title := 'Gauss&;J-Gauss';

Application. CreateForm(TForm1, Form1);

Application. Run;

End.

Похожие статьи




Текст программы - Разработка программы для решения систем линейных уравнений методом Гауса и Жордана-Гаусса в программном комплексе Delphi

Предыдущая | Следующая