Другие языки программирования и технологии

Скиньте пожалуйста рабочий код для поиска обратной матрицы методом гаусса, в Pascal ABC?

ссылку послал по почте )
там приведен код на дельфи, сами допилите подpascal abc :)

Пример десятый. Нахождение обратной матрицы.

const n=5;
eps=0.00001; { all numbers less than eps are equal 0 }
type matr=array[1..n,1..n] of real;
var a,b,a0:matr;
i,j,imx,np:integer;
s0,s1:real;
procedure PrintMatr(m,m1:matr;n,nz,nd:integer);
var i,j:integer;
begin
for i:=1 to n do
begin
if (i=1) then write(np:2,':')
else write(' ');
for j:=1 to n do
write(m[i,j]:nz:nd);
for j:=1 to n do
write(m1[i,j]:nz:nd);
writeln;
end;
inc(np);
end;
procedure MultString(var a,b:matr;i1:integer;r:real);
var j:integer;
begin
for j:=1 to n do
begin
a[i1,j]:=a[i1,j]*r;
b[i1,j]:=b[i1,j]*r;
end;
end;
procedure AddStrings(var a,b:matr;i1,i2:integer;r:real);
{ Процедура прибавляет к i1 строке матрицы a i2-ю умноженную на r}
var j:integer;
begin
for j:=1 to n do
begin
a[i1,j]:=a[i1,j]+r*a[i2,j];
b[i1,j]:=b[i1,j]+r*b[i2,j];
end;
end;
procedure MultMatr(a,b:matr;var c:matr);
var i,j,k:byte;
s:real;
begin
for i:=1 to n do
for j:=1 to n do
begin
s:=0;
for k:=1 to n do
s:=s+a[i,k]*b[k,j];
c[i,j]:=s;
end;
end;
function sign(r:real):shortint;
begin
if (r>=0) then sign:=1 else sign:=-1;
end;
begin { начало основной программы }
randomize; { используем автозаполнение матрицы случайными числами }
for i:=1 to n do
begin
for j:=1 to n do
begin
b[i,j]:=0;
a[i,j]:=1.0*random(8)-4;
end;
b[i,i]:=1;
end;
{ отладочные присвоения
a[1,1]:= 3; a[1,2]:=-1; a[1,3]:= 2; a[1,4]:= 0;
a[2,1]:=-2; a[2,2]:= 1; a[2,3]:= 0; a[2,4]:= 5;
a[3,1]:= 1; a[3,2]:= 4; a[3,3]:=-2; a[3,4]:= 2;
a[4,1]:= 0; a[4,2]:=-2; a[4,3]:= 3; a[4,4]:=-4;

a[1,1]:= 5; a[1,2]:= 7; a[1,3]:= 7; a[1,4]:= 1;
a[2,1]:= 6; a[2,2]:= 6; a[2,3]:= 3; a[2,4]:= 4;
a[3,1]:= 5; a[3,2]:= 1; a[3,3]:= 1; a[3,4]:= 1;
a[4,1]:= 3; a[4,2]:= 3; a[4,3]:= 3; a[4,4]:= 3;
}
for i:=1 to n do
for j:=1 to n do
a0[i,j]:=a[i,j];
writeln('Starting matrix:'); np:=0;
PrintMatr(a,b,n,6,1);
for i:=1 to n do
begin
{ К i-той строке прибавляем (или вычитаем) j-тую строку
взятую со знаком i-того элемента j-той строки. Таким образом,
на месте элемента a[i,i] возникает сумма модулей элементов i-того
столбца (ниже i-той строки) взятая со знаком бывшего элемента a[i,i],
равенство нулю которой говорит о несуществовании обратной матрицы }
for j:=i+1 to n do
AddStrings(a,b,i,j,sign(a[i,i])*sign(a[j,i]));
{ PrintMatr(a,b,n,6,1);}
{ Прямой ход }
if (abs(a[i,i])>eps) then
begin
MultString(a,b,i,1/a[i,i]);
for j:=i+1 to n do
AddStrings(a,b,j,i,-a[j,i]);
{ PrintMatr(a,b,n,6,1);}
end
else
begin
writeln('Обратной матрицы не существует. ');
halt;
end
end;
{writeln('Обратный ход: ');}
if (a[n,n]>eps) then
begin
for i:=n downto 1 do
for j:=1 to i-1 do
begin
AddStrings(a,b,j,i,-a[j,i]);
end;
{ PrintMatr(a,b,n,8,4);}
end
else writeln('Обратной матрицы не существует. ');
MultMatr(a0,b,a);
writeln('Начальная матрица, обратная к ней матрица: ');
PrintMatr(a0,b,n,7,3);
writeln('Проверка: должна быть единичная матрица. ');
PrintMatr(a,a,n,7,3);
{ Выполним еще проверку насколько полученная проверочная матрица
близка к единичной. Сложим отдельно суммы модулей диагональных
и недиагональных элементов. По диагонали должно быть n, а не по
диагонали 0 }
s0:=0; s1:=0;
for i:=1 to n do
for j:=1 to n do
if (i=j) then s1:=s1+abs(a[i,j])
else s0:=s0+abs(a[i,j]);
writeln('Сумма модулей диагональных элементов: ',s1);
writeln('Сумма модулей недиагональных эл-тов : ',s0);
end.
АТ
Алексей Тарасов
53 286
Лучший ответ