|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
22.03.2011, 01:27 | #1 |
Пользователь
Регистрация: 15.01.2011
Сообщений: 15
|
Обратная матрица
написала программу, которая виполняет операции над матрицами и почему то обратную матрицу находит неверно. помогите найти ошыбку. вот процедурки для вычисления:
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; Если нужно, могу скинуть весь исходник. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Обратная матрица на VB | Vitek.i | Помощь студентам | 1 | 21.01.2011 19:34 |
обратная матрица | LastBreath | Помощь студентам | 1 | 04.06.2010 20:30 |
Обратная матрица | Шахрия | Помощь студентам | 1 | 26.10.2009 17:28 |
Обратная матрица | Artemm | Общие вопросы C/C++ | 6 | 26.05.2009 17:55 |
обратная матрица=) | PrincEssa91 | Паскаль, Turbo Pascal, PascalABC.NET | 0 | 23.05.2009 15:59 |