METODO DE GAUSS

El siguiente programa nos ayuda a resolver sistemas de ecuaciones en Pascal, compatibles determinados, y en el caso de que no fuese compatible determinado, el programa nos lo indicará. El método utilizado es el de Gauss, Método poco recomendado para matrices muy grandes pero que para trabajos del día a día puede ser útil. No me voy a parar a explicar el método de Gauss (es de entender que los que estéis viendo esto lo sabréis mas que de sobras). Es un programa que tal vez no sea muy correcto en el sentido de los nombres de las variables, o los tipos de variables, por ejemplo tpMatriz sería mejor un record con un campo que fuera el tpMatriz y otro la dim, y otras pequeñas cosas que tal vez hagan complicado el entendimiento del programa, de todas formas espero que os resulte útil.

(Hay que añadir que los resultados se pueden guardar en un fichero)

Espero que os resulte útil si alguna vez tenéis que resolver un sistema de ecuaciones con un programa en pascal.


program MetodoGauss (input,output);
uses crt;

const
  MaxDim=1000;
  error=0.00000001;{Valor por debajo del cual el programa considerara 0}
type
  tpMatriz=array[1..MaxDim,1..MaxDim] of real;
  tpContador=1..Maxint;
  tpNom=string[50];
var
  matriz:tpMatriz;
  opcion,Dim:tpContador;
  determinado:boolean;

procedure EscribirMatriz(matriz:tpMatriz);
  var
    c1,c2:tpContador;
  begin
    for c1:=1 to dim do begin
        for c2:=1 to (dim+1) do
          write(matriz[c1,c2]:10:2);
        writeln
    end;
    writeln
  end;

procedure PideDatos(VAR matriz:tpMatriz; VAR Dim:tpContador);
  var
    c1,c2:tpContador;
  begin
    write('Introduzca la dimension de la matriz: ');readln(Dim);clrscr;
      for c1:=1 to dim do
        for c2:=1 to dim do begin
          write('Introduzca el termino (',c1,',',c2,'): ');readln(matriz[c1,c2]);clrscr
        end;
      for c1:=1 to dim do begin
        write('Introduzca el termino independiente b(',c1,'): ');readln(matriz[c1,dim+1]);clrscr
      end;
    writeln;writeln('El sistema introducido es el siguiente:');
    EscribirMatriz(matriz);
  end;

procedure Diagonaliza(VAR matriz:tpMatriz; dim:integer; VAR determinado:boolean);
  var
    paso,c1,c2:tpContador;
    PivCorrect:boolean;
    pivote,aux:real;
  begin{0}
    for paso:=1 to dim do begin{1}
      PivCorrect:=false;
      c1:=paso;
      while (not PivCorrect) and (c1<=dim) do begin{2}
        If abs(matriz[c1,paso])>error then PivCorrect:=true;
        c1:=c1+1
      end;{2}
      c1:=c1-1;
      If PivCorrect then begin{3}
        pivote:=matriz[c1,paso];
        for c2:=paso to (dim+1) do begin{4}
          if c1<>paso then begin
            aux:=matriz[paso,c2];
            matriz[paso,c2]:=matriz[paso,c2]/pivote;
            matriz[c1,c2]:=aux
          end else
            matriz[paso,c2]:=matriz[paso,c2]/pivote
        end;{4}
        {Hasta aquí ha sido solo preparar el pivote para hacer ceros por debajo
        el pivote en estos momentos es 1}
      end;{3}
     for c1:=(paso+1) to dim do begin
       aux:=matriz[c1,paso];
       for c2:=paso to (dim+1) do
         matriz[c1,c2]:=matriz[c1,c2]-aux*matriz[paso,c2]
     end;
    end;{1}
    {Aqui la matriz ya esta escalonada (se imprime en pantalla). Se comprueba que el sistema sea determinado}
    determinado:=true;
    for c1:=1 to dim do                   
      if abs(matriz[c1,c1])<error then
        determinado:=false;

    if determinado then begin
      writeln('La matriz escalonada es: ');EscribirMatriz(matriz);writeln;
      for paso:=dim downto 1 do begin
        pivote:=matriz[paso,paso];
        matriz[paso,paso]:=1;
        matriz[paso,dim+1]:=matriz[paso,dim+1]/pivote;
        for c1:=(paso-1) downto 1 do begin
          aux:=matriz[c1,paso];
          matriz[c1,paso]:=0;
          matriz[c1,dim+1]:=matriz[c1,dim+1]-matriz[paso,dim+1]*aux
        end
      end;
      writeln('La matriz diagonalizada es: ');EscribirMatriz(matriz); writeln {Aqui la matriz ya esta diagonalizada}
    end
    else
      writeln('El sistema no es compatible determinado')
  end;{0}

procedure MuestraResultados(matriz:tpMatriz);
  var
    c1:tpContador;
  begin
    writeln('Las soluciones del sistema son:');
    for c1:=1 to dim do
      writeln('  *)  X',c1,'= ',matriz[c1,dim+1])
  end;

procedure GuardaFich(matriz:tpMatriz);
  var
    c1:tpContador;
    fichero:text;
    nomfich:tpNom;
  begin
    write('Introduzca el nombre del fichero (sin la extension): ');readln(nomfich);
    nomfich:=nomfich+'.txt';
    assign(fichero,nomfich);
    rewrite(fichero);
    writeln(fichero,'Las soluciones del sistema son:');
    for c1:=1 to dim do
      writeln(fichero,'  -X',c1,'= ',matriz[c1,dim+1]);
    close(fichero)
  end;

begin
  writeln('--METODO DE GAUSS--':40);
  writeln('Resuleve mediante el metodo de Gauss sistemas Determinados de Ecuaciones.');
  writeln('Si el sistema no es Comp. Determinado el programa se lo indicara.');
  writeln('De ahora en adelante, a la hora de seleccionar una opcion: 0=SI   y   Cualquier otra tecla=NO');
  opcion:=1; writeln;writeln;
  while (opcion=1) do begin
    PideDatos(matriz,Dim);writeln;
    Diagonaliza(matriz,dim,determinado); writeln;
    If determinado then begin
      MuestraResultados(matriz);
      write('Quiere guardar los resultados en un fichero? ');readln(opcion);
      If opcion=1 then
        GuardaFich(matriz)
    end;
    write('Quiere volver a trabajar con el programa? ');readln(opcion);
    clrscr
  end
end.