нарисовать блок схему: uses crt;
const nmax=10;
var n:integer;
type
Tmass=array[1..nmax] of real;
Tmatrix=array[1..nmax,1..nmax] of real;
{перестановка строк при главном элементе=0}
procedure Per(k:integer;var a:Tmatrix;var p:integer);
var z:Real;
j, i:integer;
begin
z:=abs(a[k, k]);{модуль главного элемента}
i:=k;{номер строки}
p:=0;{количество перестановок}
for j:=k+1 to n do {ищем в столбце ниже}
begin
if abs(a[j, k])>z then {элемент по модулю больше}
begin
z:=abs(a[j, k]);
i:=j;
p:=p+1;//счетчик перестановок
end;
end;
if i>k then{если нашли}
for j:=k to n do
begin
z:=a[i, j];
a[i, j]:=a[k, j];{обмениваем строки}
a[k, j]:=z;
end;
end;
{определение знака определителя}
function Znak(p:integer):integer;
begin
if p mod 2=0 then
Znak:=1 else Znak:=-1;
end;
{вычисление определителя матрицы коэффициентов по Гауссу}
procedure Opr(var det:real;var a:tmatrix);
var k, i,j, p:integer;r:real;
begin
det:=1.0;
for k:=1 to n do
begin
if a[k, k]=0 then Per(k, a,p);//перестановка строк
det:=znak(p)*det*a[k, k];//вычисление определителя
for j:=k+1 to n do //пересчет коэффициентов
begin
r:=a[j, k]/a[k, k];
for i:=k to n do
a[j, i]:=a[j, i]-r*a[k, i];
end;
end;
end;
{вычисление алгебраических дополнений}
procedure Dop(d:tmatrix;var det1:real);
var k, i,j, p:integer;r:real;
begin
det1:=1.0;
for k:=2 to n do
begin
Per(k, d,p);
det1:=znak(p)*det1*d[k, k];
for j:=k+1 to n do
begin
r:=d[j, k]/d[k, k];
for i:=k to n do
d[j, i]:=(d[j, i]-r*d[k, i]);
end;
end;
end;
{установление знака алгебраических дополнений}
function Znak1(i, m:integer):integer;
begin
if (i+m) mod 2=0 then
Znak1:=1 else Znak1:=-1;
end;
{формирование присоединенной матрицы}
Procedure Peresch(b:Tmatrix;var e:Tmatrix );
var i, m,k, j:integer;z, det1:real;d, c:Tmatrix;
begin
for i:=1 to n do
begin
for m:=1 to n do
begin
for j:=1 to n do {перестановка строки}
begin
z:=b[i, j];
for k:=i downto 2 do
d[k, j]:=b[k-1,j];
for k:=i+1 to n do
d[k, j]:=b[k, j];
d[1,j]:=z;
end;
for k:=1 to n do {перестановка столбца}
begin
z:=d[k, m];
for j:=m downto 2 do
c[k, j]:=d[k, j-1];
for j:=m+1 to n do
c[k, j]:=d[k, j];
c[k,1]:=z;
end;
Dop(c, det1); {вычисление дополнений}
e[i, m]:=(det1)*znak1(i, m); {установление знака дополнений и }
end; {формирование присоединенной матрицы }
end;
end;
{транспонирование матрицы}
Procedure Trans(b:Tmatrix;var e:Tmatrix);
var i, j:integer;
begin
for i:=1 to n do
for j:=1 to n do
e[i, j]:=b[j, i];
end;
{нахождение корней умножением обратной матрицы на столбец свободных членов}
Procedure Resh(n:integer;a:Tmatrix;b:Tmass;va r x:Tmass);
var k, j:integer;z:real;
begin
for k:=1 to n do
begin
x[k]:=0;
for j:=1 to n do
begin
z:=a[k, j]*b[j];
x[k]:=x[k]+z;
end;
end;
end;
var a, a1,at, b,c:Tmatrix;
f, x:Tmass;
det:Real;
i, j,d, v:integer;
begin
textbackground(black);
clrscr;
for d := 10 to 110 do
for v:= 1 to 1 do
begin
GotoXY(d, v);
Write('-');
end;
for d := 110 to 110 do
for v := 2 to 15 do
begin
GotoXY(d, v);
textcolor(white);
Write('|');
end;
for d := 10 to 10 do
for v := 2 to 15 do
begin
GotoXY(d, v);
textcolor(white);
Write('|');
end;
for d := 10 to 110 do
for v := 15 to 15 do
begin
GotoXY(d, v);
textcolor(white);
Write('-');
end;
textcolor(red);
gotoxy(55,2);
writeln('Курсовая работа');
//textcolor(lightblue);
gotoxy(56,3);
writeln('по дисциплине');
textcolor(red);
gotoxy(42,4);
write('"Алгоритмические языки программирования"');
textcolor(red);
gotoxy(57,5);
writeln('на тему');
textcolor(red);
gotoxy(52,6);
writeln('"работа с матрицами"');
textcolor(red);
gotoxy(56,7);
writeln('Задание 5.4');
textcolor(red);
gotoxy(90,8);
writeln('Выполнил:');
textcolor(red);
gotoxy(90,9);
writeln('Студент гр. 9044');
textcolor(red);
gotoxy(90,10);
writeln('Демянчук Д. В.');
textcolor(red);
gotoxy(90,11);
writeln('Проверила');
textcolor(red);
gotoxy(90,12);
writeln('Доцент кафедры ВПМ');
textcolor(red);
gotoxy(90,13);
writeln('Москвитина О. А.');
textcolor(red);
gotoxy(55,14);
writeln('Рязань 2020');
textcolor(red);
gotoxy(55,15);
writeln(' ');
textcolor(white);
{решение системы}
repeat
write('Порядок системы до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Введите коэффициенты системы:');
for i:=1 to n do
for j:=1 to n do
begin
write('a[',i,',',j,']=');
readln(a[i, j]);
end;
clrscr;
writeln('Введите свободные члены:');
for i:=1 to n do
begin
write('f[',i,']=');
readln(f[i]);
end;
clrscr;
writeln('Исходная система:');
for i:=1 to n do
begin
for j:=1 to n do
write(a[i, j]:5:1);
writeln(f[i]:7:1);
end;
writeln;
a1:=a;{сделаем копию матрицы для нахождения определителя, она изменится}
Opr(det, a1);{вычисление определителя матрицы}
writeln('Определитель=',det:0:0); if det=0 then
begin
write('Решений не существует');
readln;
exit;
end;
Peresch(a, b); { вычисление присоединенной матрицы}
Trans(b, c);{транспонирование присоединенной матрицы}
for i:=1 to n do
for j:=1 to n do
c[i, j]:=c[i, j]/det;{деление на определитель=обратная матрица}
{нахождение корней}
Resh(n, c,f, x);
for i:=1 to n do
writeln('x[',i,']=',x[i]:0:1);
readln;
end.
Другие вопросы по: Информатика
Знаешь правильный ответ?
нарисовать блок схему: uses crt; const nmax=10; var n:integer; type Tmass=array[1..nmax] of real; Tm...
Популярные вопросы