Determinante em Pascal

Gj6925 · 10 de agosto de 2013

Olá pessoal, tudo bem?

Estou fazendo um trabalho sobre resolução de sistemas lineares e um dos métodos é decomposição LU, enfim... Nessa parte eu preciso resolver um determinante da matriz A dada pelo usuário. Fiz esse que está aí embaixo. Compilou e funciona com algumas matrizes, mas em alguns casos, por exemplo, como a matriz 2x2 com a primeira linha de zeros e a segunda de 1, não dá certo. Se alguém puder me ajudar, eu agradeço bastante.

Código:

var i,j,modmax,v1,k,n:integer;
A:array[1..150,1..150] of real;
tlzeros:boolean;
DetA,v2,m: real;
begin
(*Leitura da matriz A*)
Write('Sua matriz sera NxN onde N=');
readln(n);
for i:= 1 to n do
begin
for j:= 1 to n do
begin
write('A(',i,',',j,'):');
readln(A[i,j]);
end;
end;
(*Se uma linha (ou coluna) de A for composta de zeros, det(A)=0*)
tlzeros:=false;
i:=1;
(*teste para linhas*)
while (tlzeros=false) or (i<>(n+1)) do
begin
j:=1;
While (tlzeros=false) or (j<>n+1) do
begin
If A[i,j]=0 then
begin
tlzeros:=true;
end
else
begin
tlzeros:=false;
end;
j:=j+1;
end;
i:=i+1;
end;
If (tlzeros=true) then
begin
DetA:=0;
end
Else
Begin
(*Teste para colunas*)
tlzeros:=false;
j:=1;
i:=1;
while (tlzeros=false) or (j<>(n+1)) do
begin
i:=1;
while (tlzeros=true) or (i<>n+1) do
begin
If A[i,j]=0 then
begin
tlzeros:=true;
end
else
begin
tlzeros:=false;
end;
i:=i+1;
end;
j:=j+1;
end;
If (tlzeros=true) then
begin
DetA:=0;
end
Else (*Se uma matriz é triangular (superior ou inferior) o seu
determinante é o produto dos
elementos da diagonal principal*)
(*Se somarmos a uma linha (ou coluna) de A um mutiplo de outra linha
(ou coluna), o determinante
da nova matriz e igual ao de A;
Se permutarmos duas linhas ou colunas de A então o determinante da
nova matriz é -det(A)*)
Begin
(*pivotacao parcial*)
Modmax:=0;
v1:=0;
v2:=1;
DetA:=1;
For j:=1 to n do
begin
For i:=1 to n do
begin
If (A[i,j]<0) and ((A[i,j]*(-1))>modmax) then
begin
modmax:=i;
end;
If (A[i,j]>0) and (A[i,j]>modmax) then
begin
modmax:=i;
end;(*Cada vez que uma linha precisar se permutada,
multiplicaremos o determinante por
-1. Seja v1 o numero de vezes que a permutacao
ocorreu,multiplicaremos o determinante por (-1)^v1*)
end;
(*permutacao*)
If (modmax<>j) and (modmax<>0) then
begin
v1:=v1+1;
For k:=1 to n do
begin
A[j,k]:=A[modmax,k];
end;
(*zerar elementos abaixo do pivo*)
For i:=(j+1) to n do
begin
m:=-1*(A[i,j]/A[j,j]);
For k:=1 to n do
begin
A[i,k]:=m*A[i,k];
end;
v2:=v2*m;(*Multiplicando uma fila (linha ou coluna) de
uma matriz A por um escalar
v2, então o determinante da nova matriz é
igual ao determinante
de A multiplicado por v2*)
end;
end;
end;
For j:=1 to n do
begin
DetA:=DetA*A[j,j];
end;
If (v1 mod 2)=0 then
begin
DetA:=DetA;
end
else
begin
DetA:=-DetA;
end;
DetA:=v2*DetA;
End;
End;
writeln(DetA);
readln;
End.
program Determinante;

Simon Viegas · 12 de agosto de 2013

Olá pessoal, tudo bem?

Estou fazendo um trabalho sobre resolução de sistemas lineares e um dos métodos é decomposição LU, enfim... Nessa parte eu preciso resolver um determinante da matriz A dada pelo usuário. Fiz esse que está aí embaixo. Compilou e funciona com algumas matrizes, mas em alguns casos, por exemplo, como a matriz 2x2 com a primeira linha de zeros e a segunda de 1, não dá certo. Se alguém puder me ajudar, eu agradeço bastante.

Código:
var i,j,modmax,v1,k,n:integer;
A:array[1..150,1..150] of real;
tlzeros:boolean;
DetA,v2,m: real;
begin
(*Leitura da matriz A*)
Write('Sua matriz sera NxN onde N=');
readln(n);
for i:= 1 to n do
begin
for j:= 1 to n do
begin
write('A(',i,',',j,'):');
readln(A[i,j]);
end;
end;
(*Se uma linha (ou coluna) de A for composta de zeros, det(A)=0*)
tlzeros:=false;
i:=1;
(*teste para linhas*)
while (tlzeros=false) or (i<>(n+1)) do
begin
j:=1;
While (tlzeros=false) or (j<>n+1) do
begin
If A[i,j]=0 then
begin
tlzeros:=true;
end
else
begin
tlzeros:=false;
end;
j:=j+1;
end;
i:=i+1;
end;
If (tlzeros=true) then
begin
DetA:=0;
end
Else
Begin
(*Teste para colunas*)
tlzeros:=false;
j:=1;
i:=1;
while (tlzeros=false) or (j<>(n+1)) do
begin
i:=1;
while (tlzeros=true) or (i<>n+1) do
begin
If A[i,j]=0 then
begin
tlzeros:=true;
end
else
begin
tlzeros:=false;
end;
i:=i+1;
end;
j:=j+1;
end;
If (tlzeros=true) then
begin
DetA:=0;
end
Else (*Se uma matriz é triangular (superior ou inferior) o seu
determinante é o produto dos
elementos da diagonal principal*)
(*Se somarmos a uma linha (ou coluna) de A um mutiplo de outra linha
(ou coluna), o determinante
da nova matriz e igual ao de A;
Se permutarmos duas linhas ou colunas de A então o determinante da
nova matriz é -det(A)*)
Begin
(*pivotacao parcial*)
Modmax:=0;
v1:=0;
v2:=1;
DetA:=1;
For j:=1 to n do
begin
For i:=1 to n do
begin
If (A[i,j]<0) and ((A[i,j]*(-1))>modmax) then
begin
modmax:=i;
end;
If (A[i,j]>0) and (A[i,j]>modmax) then
begin
modmax:=i;
end;(*Cada vez que uma linha precisar se permutada,
multiplicaremos o determinante por
-1. Seja v1 o numero de vezes que a permutacao
ocorreu,multiplicaremos o determinante por (-1)^v1*)
end;
(*permutacao*)
If (modmax<>j) and (modmax<>0) then
begin
v1:=v1+1;
For k:=1 to n do
begin
A[j,k]:=A[modmax,k];
end;
(*zerar elementos abaixo do pivo*)
For i:=(j+1) to n do
begin
m:=-1*(A[i,j]/A[j,j]);
For k:=1 to n do
begin
A[i,k]:=m*A[i,k];
end;
v2:=v2*m;(*Multiplicando uma fila (linha ou coluna) de
uma matriz A por um escalar
v2, então o determinante da nova matriz é
igual ao determinante
de A multiplicado por v2*)
end;
end;
end;
For j:=1 to n do
begin
DetA:=DetA*A[j,j];
end;
If (v1 mod 2)=0 then
begin
DetA:=DetA;
end
else
begin
DetA:=-DetA;
end;
DetA:=v2*DetA;
End;
End;
writeln(DetA);
readln;
End.
program Determinante;

Olá, Gj6925. Seja bem vindo ao Fórum do Clube do Hardware.

Então, creio que um problema inicial esteja nas condições do while.

while (tlzeros=false) or (j<>(n+1)) do

while (tlzeros=true) or (i<>n+1) do

Nos meus testes, o programa está caindo em "loops infinitos"...

Sugiro que revise as sentenças... se possível faça um "teste de mesa".

No aguardo.

Gj6925 · 13 de agosto de 2013

Olá, Gj6925. Seja bem vindo ao Fórum do Clube do Hardware.
Então, creio que um problema inicial esteja nas condições do while.
while (tlzeros=false) or (j<>(n+1)) do
while (tlzeros=true) or (i<>n+1) do
Nos meus testes, o programa está caindo em "loops infinitos"...

Sugiro que revise as sentenças... se possível faça um "teste de mesa".

No aguardo.

Uma hora j e i vão ser diferentes de n+1 já q eles vão sendo adicionados de 1 a cada loop. Acho que nao é aí o erro. Já fiz o teste de mesa e também nao encontrei o erro :/

Gj6925 · 13 de agosto de 2013

Fiz algumas mudanças, tirei alguns excessos, inclusive a parte q poderia dar loop infinito e ainda nao deu certo. ficou assim:

program Determinante;
var i,j,itroca,v1,k,n:integer;
    A,B:array[1..150,1..150] of real;
    DetA,m,troca: real;
begin
     (*Leitura da matriz A*)
     Write('Sua matriz sera NxN onde N=');
     readln(n);
     for i:= 1 to n do
     begin
         for j:= 1 to n do
         begin
              write('A(',i,',',j,'):');
              readln(A[i,j]);
         end;
     end;
     For i:=1 to n do
         For j:=1 to n do
         B[i,j]:=A[i,j];
     (*Se uma matriz é triangular (superior ou inferior) o seu
     determinante é o produto dos
     elementos da diagonal principal*)
     (*Se somarmos a uma linha (ou coluna) de A um multiplo de outra linha
     (ou coluna), o determinante
     da nova matriz é igual ao de A;
     Se permutarmos duas linhas ou colunas de A então o determinante da
     nova matriz é -det(A)*)
     (*pivotacao parcial*)
     v1:=0;
     DetA:=1;
     For j:=1 to n do
     begin
          If A[j,j]=0 then (*permutacao*)
          begin
               itroca:=j+1;
               troca:=0;
               while (troca=0) and (itroca<n) do
               begin
                    If A[itroca,j]<>0 then
                    begin
                         troca:=A[itroca,j];
                    end;
                    itroca:=itroca+1;
               end;
               If troca<>0 then
               begin
                    v1:=v1+1;
                    For k:=1 to n do
                    begin
                         A[j,k]:=A[itroca,k];
                    end;
               end
               Else
               begin
                    DetA:=0;
               end;
          end;
          If A[j,j]<>0 then (*zerar elementos abaixo do pivo*)
          begin
               If j <> n then
               begin
                    For i:=(j+1) to n do
                    begin
                         m:=-1*(A[i,j]/A[j,j]);
                         For k:=1 to n do
                         begin
                              A[i,k]:=A[i,k]-m*A[j,k];
                         end;
                    end;
               end;
          end;
     end;
     For j:=1 to n do
     begin
          DetA:=DetA*A[j,j];
     end;
     If (v1 mod 2)=0 then
     begin
          DetA:=DetA;
     end
     else
     begin
          DetA:=-DetA;
     end;
     writeln(DetA);
     For i:=1 to n do
         For j:=1 to n do
         A[i,j]:=B[i,j];
     readln;
End.