sexta-feira, 8 de abril de 2011

Eliminação de Gauss com Pivoteamento Parcial - Resolução de Sistemas Lineares

O programa abaixo foi desenvolvido no compilador Dev-Pascal, e utiliza a Eliminação de Gauss para o Escalonamento (Triangularização Superior da Matriz Ampliada) e Pivoteamento Parcial, para evitar pivôs nulos, resolvendo o sistema equivalente por retrossubstituição.


Download do Código em Pascal e Executável do Programa:   

http://www.4shared.com/file/Fyh79JY1/Eliminacao_Gauss_Pivot_Parcial.html

Download do Compilador Dev-Pascal: http://www.bloodshed.net/devpascal.html


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.


Se desejarem fazer qualquer melhoria, correção de algum eventual erro, fiquem a vontade! ; )

7 comentários:

  1. Como criar o mesmo programa em C++?
    Nesse programa, cada matriz tem 100 linhas e 100 colunas?

    ResponderExcluir
    Respostas
    1. Bem, para criar o programa em C++ não é complicado, a lógica é a mesma, basta ir trocando a linguagem pascal por pela linguagem C, a sintaxe. Esse programa pode ler uma matriz n x n, n linhas e n colunas, sendo que n é escolhido durante a execução do programa, pode ser uma matriz 2 x 2 ate uma matriz 100 x 100. Na verdade eu coloquei 100 como o máximo por convenção, se quiser uma matriz maior basta aumentar o tamanho das variáveis a, b, x.

      Excluir
  2. Poderiamos difundir esse algoritmo, eu poderia fornece-lo em python

    ResponderExcluir
  3. Seria bem legal! Fique a vontade para difundi-lo e reescreve-lo em outras linguagens. O link abaixo é do código escrito em linguagem C: http://pascalmath.blogspot.com.br/2014/04/cc-programas-para-resolucao-de-sistemas.html

    ResponderExcluir
  4. Luiz,

    Muito bacana ela em C, estava precisando. Me ajudou muito!
    Depois me mande seu email, tenho algumas resoluções bacanas de calculo de autovalores, multiplicação de matrizes.

    Grande Abraço

    Parabens!

    ResponderExcluir
    Respostas
    1. Olá Michelle! Seria interessante compartilhar seus trabalhos! Me interessa bastante procedimentos com matrizes. Meu email é: lvmsoglia@hotmail.com

      Abraço!

      Excluir
  5. Bom dia,

    vi que seu site oferece arquivos para baixar. O http://Minhateca.com.br é um site de armazenamento e compartilhamento de arquivos com espaço ILIMITADO e totalmente gratuito! Sem tempo de espera ou qualquer restrição, download ilimitado e super rápido - 100% GRATIS! Porque não usa nosso site para hospedar os arquivos do seu site?

    ResponderExcluir