Kazhyal

03.06.2023 13:31 •  Информатика

нарисовать блок схему: 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;var 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.