Консультация № 195738
27.05.2019, 23:50
0.00 руб.
0 1 1
Здравствуйте! У меня возникли сложности с таким вопросом:
Решение системы линейных алгебраических уравнений метод
квадратных корней (Холецкого)
Матрица А коэффициентов системы-
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

Обсуждение

давно
Старший Модератор
31795
6196
06.06.2019, 18:56
общий
это ответ
Здравствуйте, mustang289!

[code lang=pascal h=300]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.[/code]
Код брался тут.

Удачи!
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

Форма ответа