Alguém tem algum código de Eliminação de Gauss com Pivoteamento Parcial?
Trabalho de Cálculo Numérico.
Cálculo Numérico•USP-SP
5 resposta(s) - Contém resposta de Especialista
RD Resoluções 
Há mais de um mês
Para responder essa pergunta devemos colocar em prática nosso conhecimento sobre Cálculo Numérico
Abaixo está programa desenvolvido no compilador Dev-Pascal.
Program Gauss_pivoteamento_parcial; Uses crt;
Var
a : Array[1..100,1..100] Of Real; //se desejar uma matriz maior, basta criar arrays maiores//
x, b : Array[1..100] Of Real;
i, j, n, ji, ii, ipivo, k : Integer; // i's sao variaveis auxiliares//
m, soma, pivo, baux, aux : Real;
resposta : char;
nome : String;
erro : Boolean;
resultado : Text;
Begin
Repeat
repeat
Clrscr;
Textcolor (White);
Writeln ('Resolucao de sistemas de equacoes lineares utilizando o metodo da eliminacao');
Writeln ('de Gauss (triangularizacao) com pivoteamento parcial.');
Writeln;
Write ('Digite a ordem do sistema (n), no maximo n=100: ');
Readln (n);
until n >= 2;
//le os coeficientes da matriz A//
for j:=1 to n do
begin
Repeat
clrscr;
Writeln ('AX = B');
Writeln;
Writeln ('Matriz ampliada do sistema');
Writeln;
Writeln ('Digite os elementos da coluna ',j,' da matriz A (coeficientes de x',j,'):');
Writeln;
for i:=1 to n do
begin
Write('a[',i,'x',j,']= ');
readln(a[i,j]);
end;
writeln;
writeln;
Textcolor (White);
Write ('Confira os valores digitados, estao corretos? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta = 'S') Or (resposta = 's');
end;
//le os coeficientes da matriz B//
repeat
clrscr;
Writeln ('AX = B');
Writeln;
Writeln ('Matriz ampliada do sistema');
Writeln;
Writeln ('Digite os elementos da matriz B (termos independentes)');
Writeln;
for i:=1 to n do
begin
Write('b[',i,']= ');
readln(b[i]);
end;
writeln;
writeln;
Write ('Confira os valores digitados, estao corretos? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta = 'S') Or (resposta = 's');
//Metodo da eliminacao de Gauss (Triangularizacao)//
k := 1; //Passo//
erro := False; //A variavel erro se tornara True caso haja erros de divisao por zero//
For j:=1 To n Do
Begin
For i:=k+1 To n Do
Begin
pivo := Abs(a[j,k]); //Pivoteamento Parcial//
ipivo := j; //Encontra em qual linha da coluna k esta o maior elemento//
For ii:=j to n Do
Begin
If Abs(a[ii,k]) > pivo Then
Begin
pivo := a[ii,k];
ipivo := ii;
End;
End;
If ipivo <> j Then //Se ipivo = j e porque o maior elemento ja esta na linha do pivo, e a permutacao nao e necessaria//
Begin
For ji:=1 to n Do //Permuta as linhas necessarias para o pivoteamento parcial//
Begin
aux := a[j,ji];
a[j,ji] := a[ipivo,ji];
a[ipivo,ji] := aux;
End;
baux := b[j];
b[j] := b[ipivo];
b[ipivo] := baux;
End;
If a[j,j] <> 0 Then //Evita erros de divisao por zero//
Begin
m := -1*(a[i,j]/a[j,j]);
For ji:=1 To n Do
a[i,ji] := a[i,ji] + (m*(a[j,ji]));
b[i] := b[i] + m*b[j];
End
Else
erro := True;
End;
k := k + 1;
End;
If erro = True Then
Begin
Clrscr;
Writeln ('Erro! Talvez este sistema linear nao tenha solucao (sistema impossivel)');
End
Else
Begin
//Metodo de resolucao de sistemas triangulares (Retrossubstituicao)//
If a[n,n] <> 0 Then
x[n] := b[n] / a[n,n]
Else
x[n] := 0;
For i := n-1 Downto 1 Do
Begin
soma := 0;
For j := i+1 To n Do
soma := soma + a[i,j]*x[j];
If a[i,i] <> 0 Then
x[i] := (1/a[i,i]) * (b[i] - soma)
Else
x[i] := (b[i] - soma);
End;
//Imprime na tela o resultado//
clrscr;
Writeln ('AX = B');
Writeln;
Textcolor (Lightcyan);
For i := 1 To n Do
Writeln ('x', i, ' = ', x[i]);
writeln;
//Grava o resultado em um arquivo de texto .txt//
Writeln;
Textcolor (White);
Write ('Deseja salvar os resultados em um arquivo de texto? (digite s=sim, n=nao): ');
Readln (resposta);
If (resposta = 's') Or (resposta = 'S') Then
Begin
Writeln;
Write ('Digite o nome do arquivo a ser salvo: ');
Readln (nome);
nome := (nome + '.txt');
Assign(resultado, nome);
Rewrite (resultado);
Writeln (resultado, 'valores de x (incognitas):');
Writeln (resultado);
For i:=1 To n Do //Escreve X//
Writeln (resultado,'X',i, ' = ',x[i]);
Close (resultado);
Writeln;
Writeln ('O arquivo foi salvo no mesmo diretorio do arquivo executavel!');
End;
End;
Writeln;
Textcolor (White);
Write ('Deseja reiniciar o programa? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta <> 'S') And (resposta <> 's');
End
RD Resoluções
Há mais de um mês
Para responder essa pergunta devemos colocar em prática nosso conhecimento sobre Cálculo Numérico
Abaixo está programa desenvolvido no compilador Dev-Pascal.
Código:
Program Gauss_pivoteamento_parcial; Uses crt;
Var
a : Array[1..100,1..100] Of Real; //se desejar uma matriz maior, basta criar arrays maiores//
x, b : Array[1..100] Of Real;
i, j, n, ji, ii, ipivo, k : Integer; // i's sao variaveis auxiliares//
m, soma, pivo, baux, aux : Real;
resposta : char;
nome : String;
erro : Boolean;
resultado : Text;
Begin
Repeat
repeat
Clrscr;
Textcolor (White);
Writeln ('Resolucao de sistemas de equacoes lineares utilizando o metodo da eliminacao');
Writeln ('de Gauss (triangularizacao) com pivoteamento parcial.');
Writeln;
Write ('Digite a ordem do sistema (n), no maximo n=100: ');
Readln (n);
until n >= 2;
//le os coeficientes da matriz A//
for j:=1 to n do
begin
Repeat
clrscr;
Writeln ('AX = B');
Writeln;
Writeln ('Matriz ampliada do sistema');
Writeln;
Writeln ('Digite os elementos da coluna ',j,' da matriz A (coeficientes de x',j,'):');
Writeln;
for i:=1 to n do
begin
Write('a[',i,'x',j,']= ');
readln(a[i,j]);
end;
writeln;
writeln;
Textcolor (White);
Write ('Confira os valores digitados, estao corretos? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta = 'S') Or (resposta = 's');
end;
//le os coeficientes da matriz B//
repeat
clrscr;
Writeln ('AX = B');
Writeln;
Writeln ('Matriz ampliada do sistema');
Writeln;
Writeln ('Digite os elementos da matriz B (termos independentes)');
Writeln;
for i:=1 to n do
begin
Write('b[',i,']= ');
readln(b[i]);
end;
writeln;
writeln;
Write ('Confira os valores digitados, estao corretos? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta = 'S') Or (resposta = 's');
//Metodo da eliminacao de Gauss (Triangularizacao)//
k := 1; //Passo//
erro := False; //A variavel erro se tornara True caso haja erros de divisao por zero//
For j:=1 To n Do
Begin
For i:=k+1 To n Do
Begin
pivo := Abs(a[j,k]); //Pivoteamento Parcial//
ipivo := j; //Encontra em qual linha da coluna k esta o maior elemento//
For ii:=j to n Do
Begin
If Abs(a[ii,k]) > pivo Then
Begin
pivo := a[ii,k];
ipivo := ii;
End;
End;
If ipivo <> j Then //Se ipivo = j e porque o maior elemento ja esta na linha do pivo, e a permutacao nao e necessaria//
Begin
For ji:=1 to n Do //Permuta as linhas necessarias para o pivoteamento parcial//
Begin
aux := a[j,ji];
a[j,ji] := a[ipivo,ji];
a[ipivo,ji] := aux;
End;
baux := b[j];
b[j] := b[ipivo];
b[ipivo] := baux;
End;
If a[j,j] <> 0 Then //Evita erros de divisao por zero//
Begin
m := -1*(a[i,j]/a[j,j]);
For ji:=1 To n Do
a[i,ji] := a[i,ji] + (m*(a[j,ji]));
b[i] := b[i] + m*b[j];
End
Else
erro := True;
End;
k := k + 1;
End;
If erro = True Then
Begin
Clrscr;
Writeln ('Erro! Talvez este sistema linear nao tenha solucao (sistema impossivel)');
End
Else
Begin
//Metodo de resolucao de sistemas triangulares (Retrossubstituicao)//
If a[n,n] <> 0 Then
x[n] := b[n] / a[n,n]
Else
x[n] := 0;
For i := n-1 Downto 1 Do
Begin
soma := 0;
For j := i+1 To n Do
soma := soma + a[i,j]*x[j];
If a[i,i] <> 0 Then
x[i] := (1/a[i,i]) * (b[i] - soma)
Else
x[i] := (b[i] - soma);
End;
//Imprime na tela o resultado//
clrscr;
Writeln ('AX = B');
Writeln;
Textcolor (Lightcyan);
For i := 1 To n Do
Writeln ('x', i, ' = ', x[i]);
writeln;
//Grava o resultado em um arquivo de texto .txt//
Writeln;
Textcolor (White);
Write ('Deseja salvar os resultados em um arquivo de texto? (digite s=sim, n=nao): ');
Readln (resposta);
If (resposta = 's') Or (resposta = 'S') Then
Begin
Writeln;
Write ('Digite o nome do arquivo a ser salvo: ');
Readln (nome);
nome := (nome + '.txt');
Assign(resultado, nome);
Rewrite (resultado);
Writeln (resultado, 'valores de x (incognitas):');
Writeln (resultado);
For i:=1 To n Do //Escreve X//
Writeln (resultado,'X',i, ' = ',x[i]);
Close (resultado);
Writeln;
Writeln ('O arquivo foi salvo no mesmo diretorio do arquivo executavel!');
End;
End;
Writeln;
Textcolor (White);
Write ('Deseja reiniciar o programa? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta <> 'S') And (resposta <> 's');
End
Portanto, a baixo está o código em Pascal.
Código:
Program Gauss_pivoteamento_parcial; Uses crt;
Var
a : Array[1..100,1..100] Of Real; //se desejar uma matriz maior, basta criar arrays maiores//
x, b : Array[1..100] Of Real;
i, j, n, ji, ii, ipivo, k : Integer; // i's sao variaveis auxiliares//
m, soma, pivo, baux, aux : Real;
resposta : char;
nome : String;
erro : Boolean;
resultado : Text;
Begin
Repeat
repeat
Clrscr;
Textcolor (White);
Writeln ('Resolucao de sistemas de equacoes lineares utilizando o metodo da eliminacao');
Writeln ('de Gauss (triangularizacao) com pivoteamento parcial.');
Writeln;
Write ('Digite a ordem do sistema (n), no maximo n=100: ');
Readln (n);
until n >= 2;
//le os coeficientes da matriz A//
for j:=1 to n do
begin
Repeat
clrscr;
Writeln ('AX = B');
Writeln;
Writeln ('Matriz ampliada do sistema');
Writeln;
Writeln ('Digite os elementos da coluna ',j,' da matriz A (coeficientes de x',j,'):');
Writeln;
for i:=1 to n do
begin
Write('a[',i,'x',j,']= ');
readln(a[i,j]);
end;
writeln;
writeln;
Textcolor (White);
Write ('Confira os valores digitados, estao corretos? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta = 'S') Or (resposta = 's');
end;
//le os coeficientes da matriz B//
repeat
clrscr;
Writeln ('AX = B');
Writeln;
Writeln ('Matriz ampliada do sistema');
Writeln;
Writeln ('Digite os elementos da matriz B (termos independentes)');
Writeln;
for i:=1 to n do
begin
Write('b[',i,']= ');
readln(b[i]);
end;
writeln;
writeln;
Write ('Confira os valores digitados, estao corretos? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta = 'S') Or (resposta = 's');
//Metodo da eliminacao de Gauss (Triangularizacao)//
k := 1; //Passo//
erro := False; //A variavel erro se tornara True caso haja erros de divisao por zero//
For j:=1 To n Do
Begin
For i:=k+1 To n Do
Begin
pivo := Abs(a[j,k]); //Pivoteamento Parcial//
ipivo := j; //Encontra em qual linha da coluna k esta o maior elemento//
For ii:=j to n Do
Begin
If Abs(a[ii,k]) > pivo Then
Begin
pivo := a[ii,k];
ipivo := ii;
End;
End;
If ipivo <> j Then //Se ipivo = j e porque o maior elemento ja esta na linha do pivo, e a permutacao nao e necessaria//
Begin
For ji:=1 to n Do //Permuta as linhas necessarias para o pivoteamento parcial//
Begin
aux := a[j,ji];
a[j,ji] := a[ipivo,ji];
a[ipivo,ji] := aux;
End;
baux := b[j];
b[j] := b[ipivo];
b[ipivo] := baux;
End;
If a[j,j] <> 0 Then //Evita erros de divisao por zero//
Begin
m := -1*(a[i,j]/a[j,j]);
For ji:=1 To n Do
a[i,ji] := a[i,ji] + (m*(a[j,ji]));
b[i] := b[i] + m*b[j];
End
Else
erro := True;
End;
k := k + 1;
End;
If erro = True Then
Begin
Clrscr;
Writeln ('Erro! Talvez este sistema linear nao tenha solucao (sistema impossivel)');
End
Else
Begin
//Metodo de resolucao de sistemas triangulares (Retrossubstituicao)//
If a[n,n] <> 0 Then
x[n] := b[n] / a[n,n]
Else
x[n] := 0;
For i := n-1 Downto 1 Do
Begin
soma := 0;
For j := i+1 To n Do
soma := soma + a[i,j]*x[j];
If a[i,i] <> 0 Then
x[i] := (1/a[i,i]) * (b[i] - soma)
Else
x[i] := (b[i] - soma);
End;
//Imprime na tela o resultado//
clrscr;
Writeln ('AX = B');
Writeln;
Textcolor (Lightcyan);
For i := 1 To n Do
Writeln ('x', i, ' = ', x[i]);
writeln;
//Grava o resultado em um arquivo de texto .txt//
Writeln;
Textcolor (White);
Write ('Deseja salvar os resultados em um arquivo de texto? (digite s=sim, n=nao): ');
Readln (resposta);
If (resposta = 's') Or (resposta = 'S') Then
Begin
Writeln;
Write ('Digite o nome do arquivo a ser salvo: ');
Readln (nome);
nome := (nome + '.txt');
Assign(resultado, nome);
Rewrite (resultado);
Writeln (resultado, 'valores de x (incognitas):');
Writeln (resultado);
For i:=1 To n Do //Escreve X//
Writeln (resultado,'X',i, ' = ',x[i]);
Close (resultado);
Writeln;
Writeln ('O arquivo foi salvo no mesmo diretorio do arquivo executavel!');
End;
End;
Writeln;
Textcolor (White);
Write ('Deseja reiniciar o programa? (digite s=sim, n=nao): ');
Readln (resposta);
Until (resposta <> 'S') And (resposta <> 's');
End
Amanda
Há mais de um mês
Voce conseguiu o codigo? pode me passar? amandasantoro@poli.ufrj.br
Jonath
Há mais de um mês
http://pascalmath.blogspot.com.br/2011/04/algoritmo-pascal-calculo-do.html tenta fazer o download do Código em Pascal e Executável do Programa.
nesse link segue um PDF:
http://wwwp.fc.unesp.br/~arbalbo/Iniciacao_Cientifica/sistemaslineares/teoria/1_Gauss_com_Pivoteamento_Parcial.pdf
