Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/11: Рейтинг темы: голосов - 11, средняя оценка - 5.00
0 / 0 / 0
Регистрация: 14.11.2014
Сообщений: 7
1

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

14.11.2014, 23:41. Просмотров 2055. Ответов 3
Метки нет (Все метки)

Помогите пожалуйста начала работать сначала работать с методом Гаусса, но в Unit2 Delphi ругается на type arys=array[1..maxr] of real;
не могу понять что не так...
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, XPMan, StdCtrls, Grids;
 
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    New1: TMenuItem;
    Save1: TMenuItem;
    Exit1: TMenuItem;
    XPManifest1: TXPManifest;
    SaveDialog1: TSaveDialog;
    Matrix: TStringGrid;
    Coef: TStringGrid;
    Gaus: TStringGrid;
    JGaus: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    procedure Exit1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  s:integer;
 
implementation
 
uses Unit2;
 
 
 
{$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.Save1Click(Sender: TObject);
begin
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;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
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;
 
 
end.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
unit Unit2;
 
interface
const maxr=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.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
14.11.2014, 23:41
Ответы с готовыми решениями:

Решение линейных уравнений методом Жордана-Гаусса
я хочу что бы программа обходила двумерный масив jeka и в результате вычислений получить матрицу...

Расчёт системы линейных уравнений методом Гаусса
Здравствуйте, умные ребята) Помогите, пожалуйста, разобраться с тем, почему на меня ругается это...

Решение системы уравнений методом Гаусса
Здравствуйте! Помогите исправить ошибку в системе гаусса с графиком))) unit Unit1; interface ...

Решение СЛАУ методом Гаусса-Жордана
Прошу вас помочь мне с портированием программы решения СЛАУ методом исключений Гаусса-Жордана с С++...

3
Модератор
Эксперт Pascal/Delphi
6169 / 4161 / 4569
Регистрация: 05.06.2014
Сообщений: 20,468
14.11.2014, 23:46 2
Delphi
1
2
const maxr=20
type arys=array[1..maxr] of real;- проблемы начались здесь
Нет, ошибка в строке выше.
1
0 / 0 / 0
Регистрация: 14.11.2014
Сообщений: 7
14.11.2014, 23:50  [ТС] 3
подскажите пожалуйста как исправить
0
Модератор
Эксперт Pascal/Delphi
6169 / 4161 / 4569
Регистрация: 05.06.2014
Сообщений: 20,468
14.11.2014, 23:57 4
Delphi
1
const maxr=20;
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
14.11.2014, 23:57

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Delphi Решение СЛУ Методом Жордана-Гаусса
Привет, форум. Нуждаюсь в вашей помощи. Т.к. я - новичок до мозга костей в delphi, одному...

Решение систем линейных уравнений методами Крамера и Гаусса
помогите разработать проект, который вычисляет решение систем линейных уравнений методами Крамера и...

Написать программу решения по методу Гаусса системы линейных уравнений
задания: 1.Написать программу решения по методу Гаусса системы линейных уравнений 4х1 + 0,24х2 -...

Написать программу решения по методу Гаусса системы линейных уравнений
Написать программу решения по методу Гаусса системы линейных уравнений a11x1.......a1nxn=b1...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.