| ← Июнь 2019 → | ||||||
|
3
|
4
|
5
|
8
|
9
|
||
|---|---|---|---|---|---|---|
|
10
|
11
|
12
|
13
|
14
|
16
|
|
|
17
|
18
|
19
|
20
|
21
|
22
|
23
|
|
24
|
25
|
26
|
27
|
28
|
29
|
30
|
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://rusfaq.ru/
Открыта:
14-03-2002
Статистика
0 за неделю
RFpro.ru: Программирование на Delphi и Lazarus
| РАССЫЛКИ ПОРТАЛА RFPRO.RU
Лучшие эксперты в разделе
∙ Pascal / Delphi / Lazarus
Консультация # 195739: Здравствуйте! У меня возникли сложности с таким вопросом: Решение системы линейных алгебраических уравнений методом Гаусса Матрица А коэффициентов системы- 1,53 1,61 1,43 2,35 2,31 2,07 3,83 3,73 3,45 Столбец свободных членов b- -5,13 -3,69 -5,98 в Delphi ... Здравствуйте! У меня возникли сложности с таким вопросом:
Дата отправки: 27.05.2019, 23:50 Консультирует Зенченко Константин Николаевич (Старший модератор): Здравствуйте, mustang289! Код (Pascal) :: выделить код const
sizemat = 10;
type
mattype = array[1..sizemat, 1..sizemat] of real;
mattype1 = array[1..sizemat] of real;
procedure writemat(var a: mattype; n, m: byte);
var
i, j: byte;
begin
writeln;
for i := 1 to n do
begin
for j := 1 to m do
write(a[i, j]:7:3, ' ');
writeln
end;
end;
procedure inputmat(var a: mattype; var d: mattype1; var n: byte);
var
i, j: byte;
begin
writeln;
write('size = ');
readln(n);
writeln;
writeln;
for i := 1 to n do
for j := 1 to n do
begin
write('a[',i,',',j,']:=');
read(a[i, j]);
end;
writeln;
for i := 1 to n do
begin
write('b[',i,']=');
readln(d[i]);
end;
writeln;
end;
procedure getBnC(var a, b, c: mattype; n: byte);
var
k, i, a1, j: byte;
begin
for k := 1 to n do
for i := 1 to n do
begin
if k = i then c[k, i] := 1
else c[k, i] := 0;
b[k, i] := 0;
end;
for a1 := 1 to n do
begin
if a1 = 1 then
begin
for i := 1 to n do
b[i, 1] := a[i, 1];
for i := 2 to n do
c[1, i] := a[1, i] / b[1, 1];
end
else
begin
k := a1;
for i := a1 to n do
begin
b[i, k] := a[i, k];
for j := 1 to k - 1 do
b[i, k] := b[i, k] - b[i, j] * c[j, k];
end;
i := a1;
for k := i + 1 to n do
begin
c[i, k] := a[i, k];
for j := 1 to i - 1 do
c[i, k] := c[i, k] - b[i, j] * c[j, k];
c[i, k] := c[i, k] / b[i, i];
end;
end;
end;
end;
procedure otvet(var b, c: mattype; d: mattype1; n: byte);
var
x, y, s: mattype1;
i, j, k: byte;
w, q: real;
y1, x1: mattype;
begin
for i := 1 to n do
if i = 1 then y[i] := d[i] / b[i, i]
else
begin
w := 0;
for k := 1 to i - 1 do
begin
y1[i, k] := w + b[i, k] * y[k];
w := y1[i, k];
end;
y[i] := (d[i] - w) / b[i, i];
end;
for i := n downto 1 do
if i = n then x[i] := y[i]
else
begin
q := 0;
for k := i + 1 to n do
begin
x1[i, k] := q + c[i, k] * x[k];
q := x1[i, k];
end;
x[i] := y[i] - q;
end;
writeln;
writeln('roots X:');
writeln;
for i := 1 to n do
writeln('x[', i, ']= ', x[i]:1:4);
writeln;
end;
var
a, a1, c, b: mattype;
d: mattype1;
n: byte;
begin
InputMat(a, d, n);
getBnC(a, b, c, n);
Writeln('matrix B: ');
writemat(b, n, n);
Writeln('matrix C: ');
writemat(c, n, n);
otvet(b, c, d, n);
readln;
end.Код брался тут. Удачи!
Здравствуйте! У меня возникли сложности с таким вопросом:
Дата отправки: 27.05.2019, 23:51 Консультирует Зенченко Константин Николаевич (Старший модератор): Здравствуйте, mustang289! Код (Pascal) :: выделить код const
n=3;
type
tMas=array[1..n,1..n+1]of real;
var
a:array[1..n,1..n]of real;
b:array[1..n]of real;
t:tMas;
i,j:integer;
procedure Gaus(var a:tMas;b,c:integer);
var
d,e:integer;
begin
if b<=c then
begin
e:=b;
while e<=c do
begin
d:=c+1;
while b<=d do
begin
a[e,d]:=a[e,d]/a[e,b];
dec(d);
end;
inc(e);
end;
e:=b+1;
while e<=c do
begin
for d:=b to c+1 do
a[e,d]:=a[e,d]-a[b,d];
inc(e);
end;
Gaus(a,b+1,c);
a[b,b]:=a[b,4];
e:=c;
while b<e do
begin
a[b,b]:=a[b,b]-a[e,e]*a[b,e];
dec(e);
end;
end;
end;
begin
for i:=1 to n do
begin
for j:=1 to n do
begin
write('a[',i,',',j,']:=');
readln(a[i,j]);
end;
write('b[',i,']:=');
readln(b[i]);
end;
{ a[1,1]:=1.53;a[1,2]:=1.61;a[1,3]:=1.43;b[1]:=-5.13;
a[2,1]:=2.35;a[2,2]:=2.31;a[2,3]:=2.07;b[2]:=-3.69;
a[3,1]:=3.83;a[3,2]:=3.73;a[3,3]:=3.45;b[3]:=-5.98;}
for i:=1 to n do
begin
for j:=1 to n do
t[i,j]:=a[i,j];
t[i,4]:=b[i];
end;
writeln('extenge matrix:');
for i:=1 to n do
begin
for j:=1 to n+1 do
write(t[i,j]:10:5);
writeln;
end;
Gaus(t,1,n);
writeln('roots:');
for i:=1 to n do
write(t[i,i]:10:5);
writeln;
writeln('check:');
for i:=1 to n do
begin
t[i,4]:=0;
for j:=1 to n do
begin
t[i,4]:=t[i,4]+a[i,j]*t[j,j];
write(a[i,j]*t[j,j]:10:5);
end;
writeln(t[i,4]:10:5,' = ',b[i]:10:5);
end;
readln;
end.Удачи!
Оценить выпуск | Задать вопрос экспертам
главная страница
|
стать участником
|
получить консультацию
|
| В избранное | ||
