1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Решение СЛАУ, метод Гаусса не хочет работать для матриц размерностью n>3
Ето программа которая решает СЛАУ двумя методами: с помощью обратной матрицы (матричный способ) и методом Гаусса. Матричный способ вроде как работает харашо, но Гаусса для матриц размерностью n>3 не работает.... помогите, кто может
вот исходник:
Program Lin_yravneniya; uses crt; const eps=0.00001; { all numbers less than eps are equal 0 } type matr=array [1..10,1..10] of real; mas=array [1..10] of real; var i,j: integer; b,x: mas; variant: byte; a,c: matr; dt: real; imx,np: integer; N:integer; {виведення вихідної і оберненої матриці} procedure PrintMatr2 (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); write (' '); 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 стрічці матриці а 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;
{викреслювання з матриці стрічки і стовпця} procedure GetMatr (a: matr; var b: matr; m, i,j: integer); var ki,kj,di,dj: integer; begin di:=0; for ki:=1 to m-1 do begin if (ki=i) then di:=1; dj:=0; for kj:=1 to m-1 do begin if (kj=j) then dj:=1; b [ki,kj]:=a [ki+di,kj+dj] ; end; end; end; {метод Гауса } procedure gauss (a: matr; b: mas; var x: mas; n: integer); Var k: byte; m, s: real; begin { знаходження трикутної матриці} For k:=1 to N-1 do For i:=k+1 to n do begin m:=a [i,k] /a [k,k] ; a [i,k]:=0; For j:=k+1 to N do a [i,j]:=a [i,j] -m*a [k,j] ; b [i]:=b [i] -m*b [k] ; end; {обчислення невідомих х в оберненому порядку} x [n]:=b [n] /a [n,n] ; writeln; writeln ('Resultat obchyslennja SLAR metodom Hausa'); writeln ('x [',n,'] =',x [n]: 6: 2); for i:= (n-1) downto 1 do begin s:=0; For j:=i+1 to n do s:=s-a [i,j] *x [j] ; x [i]:= (b [i] +s) /a [i, i] ; writeln ('x [', i,'] =',x [i]: 6: 2); end; end; {матричний спосіб} procedure matrica (a: matr; y: mas; n: integer); var z,a0: matr; imx,np: integer; s: mas; begin for i:=1 to n do begin for j:=1 to n do z [i,j]:=0; z [i, i]:=1; end; for i:=1 to n do for j:=1 to n do a0 [i,j]:=a [i,j] ; 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,z, 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,z, i,1/a [i, i]); for j:=i+1 to n do AddStrings (a,z,j, i,-a [j, i]); { PrintMatr (a,b,n,6,1); } end else begin writeln ('Obernenoji matryci ne isnyje!'); halt; end end; {зворотній хід: '); } if (a [n,n] >eps) then begin for i:=n downto 1 do for j:=1 to i-1 do begin AddStrings (a,z,j, i,-a [j, i]); end; { PrintMatr (a,b,n,8,4); } end else writeln ('Obernenoji matryci ne isnyje!'); MultMatr (a0,z,a); writeln ('Obernena matrycja do pochatkovoji: '); PrintMatr2 (a0,z,n,7,3); {множення оберненої матриці на стовпець вільних членів} for i:=1 to n do s [i]:=0; for i:=1 to n do for j:=1 to n do s [i]:=s [i] +z [i,j] *y [j] ; writeln ('Resultat obchyslenna SLAR matrycnym sposobom (za dopomogoju obernenoji):'); for i:=1 to n do write (' ', s [i]: 5: 2); end; begin clrscr; writeln('Vvedit porjadok matryci:'); readln(N); writeln ('Vvid matryci koeficijentiv pry nevidomyx x'); for i:=1 to N do for j:=1 to N do begin write (' Vvedit a [', i,',',j,'] => '); read (a [i,j]); end; writeln ('Vvid stovpcja vilnyx chleniv'); for i:=1 to N do begin write (' Vvedit b [', i,'] => '); read (b [i]); end; writeln ('Vyberit variant obchyslennja SLAR: '); writeln (' 1 - obchuslennja SLAR metodom Hausa'); write (' 2 - obchyslennja SLAR matrychnym metodom (za dopomogoju obernenoji matryci) => '); readln (variant); case variant of 1: gauss (a,b,x,n); 2: matrica (a,b,n); else writeln ('Vy zrobyly nevirnyj vybir. Vyberit odyn z dvox moshlyvyx variantiv!'); end; end.