- Код: Выделить всё
Program Reshenie_Sistem_Ypavhehi;
Uses CRT;
Const
MaxN = 10;
MaxK = 10;
T=0.00001; {Ограничиваем числа бликие к нулю}
Type
TVector = array[1..MaxN] of Real;
TMatrix = array[1..MaxN, 1..MaxN] of Real;
Procedure ReadSystem(N: Integer; var A: TMatrix; var B: TVector);
{Процедура ввода расширенной матрицы}
Var
r, i, j: Integer;
Begin
r := WhereY;
GotoXY(2, r);
TextColor(12);
Write('A');
for i := 1 to n do
Begin
GotoXY(i*6+2, r);
TextColor(11);
Write(i);
GotoXY(1, r+i+1);
TextColor(11);
Write(i:2);
End;
GotoXY((n+1)*6+2, r);
TextColor(12);
Write('B');
TextColor(7);
for i := 1 to n do
Begin
For j := 1 to n do
Begin
GotoXY(j*6+2, r+i+1);
Readln(A[i,j]);
End;
GotoXY((n+1)*6+2, r+i+1);
Readln(B[i]);
End;
End;
Procedure Vyvod (var a: TMatrix; n:integer);
{Процедура вывода матрицы на экран}
Var
i,j: integer;
Begin
for i:= 1 to n do
Begin
for j:= 1 to n do
Write ('|',A[i,j]:8:2,'|'); {Вывод матрицы с отступами}
Writeln;
End;
End;
Procedure Per(k,n:integer; var a:TMatrix; var p:integer);
{Процедура переустановки строк, чтобы главный элемент не оказался 0 или близким к 0 значением}
Var
i,j: integer;
z: real;
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;
{Изменение знака при переустановке строк при нахождении дополнений}
Function Znak1(i,m:integer):integer;
Begin
if (i+m) mod 2=0 then
znak1:=1 else znak1:=-1;
End;
{Процедура вычисления определителя матрицы}
Procedure opr(n, p:integer; var a:TMatrix; var det:real; var f:byte);
Var k, i, j:integer;
delenie:real;
Begin
det:=1;
f:=0;
For k:=1 to n do
Begin
if a[k,k]=0 then {Если главный элемент = 0,}
Per(k,n,a,p); {делаем переустановку}
det:=Znak(p) * det * a[k,k]; {Меняем знак определителя}
if abs(det)<t then {Если модуль определителя меньше константы...}
Begin
f:=1;
writeln ('Обратной матрицы нет!'); {выводим, что обр матрицы нет}
readln;
exit;
End;
For j:=k+1 to n do {Ниже делаем преобразования}
Begin
delenie:=a[j,k]/a[k,k];
For i:=k to n do
Begin
a[j,i]:=a[j,i] - delenie * a[k,i];
End;
End;
End;
End;
{Процедура вычисления определений для дополнений}
procedure opr1(n, p:integer; d:Tmatrix; var det1:real);
var k, i, j:integer;
delenie:real;
begin
det1:=1.0;
for k:=2 to n do
begin
if d[k,k]=0 then {Если главный элемент = 0,}
Per(k,n,d,p); {делаем переустановку}
for j:=k+1 to n do {Ниже делаем преобразования}
begin
delenie:=d[j,k]/d[k,k];
for i:=k to n do
begin
d[j,i]:=d[j,i] - delenie * d[k,i];
end;
end;
end;
end;
{Процедура вычисления дополнений}
procedure Peresch(n,p:integer; var U:Tmatrix; det1:real; var a:Tmatrix);
var i,m,k,j:integer;
z:real;
d,c:Tmatrix;
begin
for i:=1 to n do
for m:=1 to n do
begin
for j:= 1 to n do {Переустановка строк}
begin
z:=U[i,j];
for k:=i downto 2 do
d[k,j]:=U[k-1,j];
for k:=i+1 to n do
d[k,j]:=U[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;
Opr1(n,p,c,det1);{Вычисление определителей}
a[i,m]:=det1*znak1(i,m);{Вычисление дополнений}
end;
end;
{Процедура траспонирования матрицы}
Procedure Transp(a:Tmatrix; n:integer; var at:Tmatrix);
var k,j:integer;
begin
for k:=1 to n do
for j:=1 to n do
at[k,j]:=a[j,k];
end;
Procedure Transp1(var a: TMatrix; n:integer);
{Процедура вывода транспонированной матрицы на экран}
Var
k,j: integer;
Begin
for k:= 1 to n do
Begin
for j:= 1 to n do
Write ('|',A[j,k]:8:2,'|'); {Вывод транспонированной матрицы}
Writeln;
End;
End;
Procedure Dop(var a: TMatrix; n:integer);
{Процедура вывода дополнений на экран}
Var
i,m: integer;
Begin
for i:= 1 to n do
Begin
for m:= 1 to n do
Write ('|',a[i,m]:8:2,'|'); {Вывод дополнений матрицы}
Writeln;
End;
End;
Var
n,k,j,p: Integer;
f:Byte;
det,det1:Real;
at,U:Tmatrix;
a: TMatrix ;
b: TVector;
Begin
ClrScr;
Write('Введите порядок матрицы системы (макс. 10): ');
repeat
Readln(n);
until (n > 0) and (n <= maxn);
Writeln;
Writeln('Введите расширенную матрицу системы');
ReadSystem(n, a, b);
Writeln;
Writeln('Исходная матрица, без коэффициентов:');
Vyvod(a,n);
Writeln;
Readln;
Writeln('Транспонированная матрица');
Transp1(a,n);
Writeln;
Opr(n,p,a,det,f); {Вычисление определителя}
write('Определитель = ',det:2:0, '.');
Writeln;
Writeln('Матрица дополнений');
Dop(a,n);
Writeln;
Writeln('Обратная матрица:');
for k:=1 to n do
for j:=1 to n do
a[k,j]:=a[k,j]/det; {Создаем обратную матрицу}
Vyvod (a,n);
Writeln;
End.
Не подскажите, в чём может быть ошибка, полагаю, что программа не дописана?, но процедуры вроде правильные(. . .
