Помощь - Поиск - Пользователи - Календарь
Полная версия: Обратная матрица
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
bembi
написала программу, которая виполняет операции над матрицами и почему то обратную матрицу находит неверно. помогите найти ошыбку. вот процедурки для вычисления:

procedure inversm(var x,obr:matrix;err:boolean);
var y:matrix; i,j:integer;
procedure swaps(i,j:integer);
var k:integer; p:TM;
procedure swap(a,b:TM);
var c:TM;
begin c:=a; a:=b; b:=c end;
begin
for k:=1 to ng do begin swap(x[i,k],x[j,k]); swap(y[i,k],y[j,k]) end;
end;
procedure adds(i,j:integer;alpha:TM);
var k:integer;
begin
for k:=1 to ng do
begin x[i,k]:=x[i,k]+x[j,k]*alpha; y[i,k]:=y[i,k]+y[j,k]*alpha
end end;
procedure divs(i:integer;alpha:TM);
var k:integer;
begin
if alpha<>0 then
for k:=1 to ng do
begin
x[i,k]:=x[i,k]/alpha; y[i,k]:=y[i,k]/alpha end
end;
begin
for i:=1 to ng do
for j:=1 to ng do y[i,j]:=0;
for i:=1 to ng do y[i,i]:=1;
{початок основного методу}
for j:=1 to ng-1 do
begin
i:=j;
while x[i,j]=0 do i:=i+1;
if i>ng then begin err:=true; end;
swaps(j,i);
for i:=j+1 to ng do begin if x[j,j]=0 then err:=true else
adds(i,j,-x[i,j]/x[j,j]); end;
end;
if x[ng,ng]=0 then begin err:=true; end;
for i:=1 to ng do divs(i,x[i,i]);
for i:=ng downto 2 do
for j:=i-1 downto 1 do adds(j,i,-x[j,i]);
{сформульована обернена}
obr:=y;
end;
procedure readm(var x:matrix);
var i,j,ti:integer;
begin repeat text1(bbb);
rx:=4; ry:=4; rz:=1;
readword2(rr,rx,ry,rz); ti:=rr; clrscr;
if (ti=1) then begin textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
for i:=1 to ng do begin
for j:=1 to ng do begin textcolor(lightgreen); write('Enter elements of matrix',i,'_',j,': ');
rx:=4; ry:=3; rz:=3;
readword2(rr,rx,ry,rz); x[i,j]:=rr; clrscr; textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
end; end; end;
if (ti=2) then begin
randomize;
for i:=1 to ng do begin
for j:=1 to ng do begin x[i,j]:=random(20); end; end; end;
until (ti>=1) and (ti<=2); clrscr; textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
textcolor(lightgreen); writeln('Start matrix:');
for i:=1 to ng do begin gotoxy(4,2+i); textcolor(white);
for j:=1 to ng do write(x[i,j]:8:2); writeln; end;
end;
procedure writem(var x:matrix);
var i,j:integer;
begin writeln; gotoxy(4,6+2*ng); textcolor(lightgreen); writeln('Inverse matrix:');
for i:=1 to ng do
begin gotoxy(4,6+2*ng+i);textcolor(lightc yan);
for j:=1 to ng do write(x[i,j]:8:2,' ');
writeln; end;
end;


Ето вывод в case:
2
: begin {Обернена матриця}
Repeat textbackground(black); clrscr; textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2); textcolor(lightgreen);
write('Enter degree of matrix: '); rx:=4; ry:=3; rz:=1; readword2(rr,rx,ry,rz); ng:=rr; gotoxy(4,5);
if (ng<=1) or (ng>5) then writeln('Error!!!') else begin
begin
readm(x); inversm(x,y,err);
end;
for ir:=1 to ng do
for jr:=1 to ng do begin
z[ir,jr] := 0;
for i:= 1 to ng do
{Підсумкова формула}
z[ir,jr] :=z[ir,jr] + x[ir,i] * x[i,jr];
end;
begin
writeln; gotoxy(4,4+ng); textcolor(yellow); writeln('Checking: it must be unitary matrix.'); textcolor(lightcyan);
for ir:=1 to ng do begin gotoxy(4,4+ng+ir);
for jr:=1 to ng do
Write(z[ir,jr]:8:2); WriteLn; end;
end;
writeln; textcolor(lightgreen);
for ir:=1 to ng do
for jr:=1 to ng do begin
if ((ir=jr) and (z[ir,jr]<>1)) or ((ir<>jr) and (z[ir,jr]<>0)) then
l1:=1; end; gotoxy(4,10+2*ng);textcolor(lightre d);
if (l1=1) then writeln('Inverse matrix not exist!')
else writem(y);
end; text(bbb);
ch:=readkey;
if ch=#0 then ch:=readkey;
until ch=#27;
end;



Если нужно, могу скинуть весь исходник.
Lapp
Цитата(bembi @ 23.03.2011 2:16) *
написала программу, которая виполняет операции над матрицами и почему то обратную матрицу находит неверно. помогите найти ошыбку.
...
Если нужно, могу скинуть весь исходник.

Даа... bembi, ты просто гигант мысли. В ТАКОМ разобраться - это надо самому быть компьютером..

Но все же потребуется все целиком. Я причесал, отформатировал, конечно, но догадываться, какие у тебя там типы - извини, большого желания нет.
TarasBer
Мне хватило этой строчки.

for j:=1 to ng do write(x[i,j]:8:2); writeln; end;

где тот бегин, к которому относится этот енд? Я когда так пишу в 1 строчку, то бегин и енд на одной строке.
volvo
Цитата
почему то обратную матрицу находит неверно
Неправда. Все верно находит. Проверил на матрице

const
x : matrix = (
(1, 2, 3, 0, 0),
(3, 4, 2, 0, 0),
(9, 8, 2, 0, 0),
(0, 0, 0, 0, 0),
(0, 0, 0, 0, 0)
);
при ng = 3, в результате после вызова inversm матрица Y приняла вид:
   0.40  -1.00   0.40
-0.60 1.25 -0.35
0.60 -0.50 0.10

, что полностью соответствует истине. А уж что ты потом делаешь с матрицей, что ты там вычисляешь в Z - это к делу не относится. Как я уже сказал, сама процедура инвертирования работает правильно.

P.S. Все-таки, третий параметр inversm неплохо было бы описать как Var, чтоб в случае ошибки это можно было определить снаружи, в основной программе.
bembi
тогда значит у меня в програм какая то другая ошыбка, потому что какую би я матрицу не ввела, всегда вывдится сообщение, что нету обратной матрицы
вот исходник, посмотрите пожалуйста что там не так... (Показать/Скрыть)


Убрал исходник под спойлер, там все-таки 750 строк...
volvo
Ты не хочешь меня слушать? Я ж говорю: матрица вычисляется правильно. То есть, (см. на строки 365-370)

Цитата
 if (ng<=1) or (ng>5) then writeln('Error!!!')  { Это строка 365 }
else begin
begin
readm(x);
inversm(x,y,err); { <--- Всё, обратная матрица УЖЕ НАЙДЕНА }
end;
Все, что ты делаешь дальше - это не нужно. Обратная матрица УЖЕ находится в переменной Y. Просто сразу печатай ее. Сразу после Inversm добавь вызов процедуры Writem(Y), а строки с 371 до 404 можешь вообще закомментировать или убрать, они не нужны. Там ты производишь никому не нужную и к тому же неправильную последовательность действий. Зачем делать второй раз то, что уже сделано?
вова
так чо програмка працює?????
Shmanich
Очень необходима помощь! Помогите найти ошибку в этой программе, второй день найти не могу:


program OBRMAT;
uses crt;
const c=4;
t=0.00001; {Ограничиваем числа бликие к нулю}
type Tmatr=array [1..c, 1..c] of real;

{Процедура переустановки строк, чтобы главный элемент не оказался 0 или
близким к 0 значением}
procedure Per(k,n:integer; var a:Tmatr; var p:integer);
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:Tmatr; var det:real; var f:byte);
var k, i, j:integer;
delenie:real;
begin
det:=1.0;
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:Tmatr; 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
d[j,i]:=d[j,i] - delenie * d[k,i];
end;
end;
end;

{Процедура вычисления дополнений}
procedure Peresch(n,p:integer; var b:Tmatr; det1:real; var e:Tmatr);
var i,m,k,j:integer;
z:real;
d,c:Tmatr;
begin
for i:=1 to n do
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;
Opr1(n,p,c,det1);{Вычисление определителей}
e[i,m]:=det1 * znak1(i,m);{Вычисление дополнений}
end;
end;

{Процедура траспонирования матрицы}
procedure Transp(a:Tmatr; n:integer; var at:Tmatr);
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 Vyvod (var a: Tmatr; n:integer);
var k,j:integer;
begin
for k:=1 to n do
begin
for j:=1 to n do
write (a[k,j]:5:3,' ':2); {Вывод матрицы с отступами}
writeln;
end;
end;

{Основная программа}
var n,k,j,i,p:integer; {n - размер матрицы, k - счетчик по строкам,}
{j - счетчик по столбцам, p - счетчик переустановок}
a,at,b,e:Tmatr; {a - исходная матрица, at - транспонированная,}
{b - матрица дополнений, e - обратная матрица}
det,det1:real; {det - определитель исх. матрицы, det1 - определители-дополнения}
f:byte; {признак несуществования обратной матрицы}

begin
clrscr;
writeln('Вычислить определитель матрицы (Только для квадратной матрицы) и обратную матрицу.');
writeln;

writeln('Введите кол-во элементов в строке матрицы и нажмите ENTER');
writeln('(Число элементов в строке будет равно числу элементов в столбце!):');
readln(n);

writeln;
writeln('Вводите коэфф-ты матpицы A по стpокам нажимая ENTER:');
for k:=1 to n do
for j:=1 to n do
begin
write ('a[',k,',',j,']=');
read(a[k,j]);
end;
writeln;

writeln('Исходная матрица:');
Vyvod (a,n);
writeln;

Opr(n,p,a,det,f); {Вычисление определителя}
if f=1 then exit; {Если обратной матрицы не существует,}
{то завершить программу}
write('Определитель = ',det:2:0, '.');
writeln;

if f=1 then exit;
Transp (a,n,b);
Peresch(n,p,b,det1,e);
writeln;

writeln('Обратная матрица:');
for k:=1 to n do
for j:=1 to n do
e[k,j]:=e[k,j]/det; {Создаем обратную матрицу}
Vyvod (e,n);
writeln;

readkey;

end.




Определитель вычисляет правильно, а вот обратную матрицу нет sad.gif.
Когда вводишь матрицу:
1 2
3 4

Выводится:
-0,5 0,5
0,5 -0,5

А должно быть:
-2 1
1.5 -0.5
Что и где пропущено?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.