(*˜1PROGRAM OpeMatrices;                            (* Victor Iniestra A. *)
                                                (* An lisis Num‚rico  *)
USES                                            (*    18 Oct. 1993    *)
    crt;

TYPE
    Matriz = Record
                   nombre:String;
                   n,m:Byte;
                   datos:Array [1..20,1..20] of Real
             END;
CONST
     Max=10;

VAR
   Matrices:Array[1..Max] OF Matriz;
   salir:Boolean;
   nul:Char;
   trash:String;
   primera,segunda:Matriz;
   i:Integer;

PROCEDURE PonMatriz(X:Matriz);

          VAR
             i,j:Byte;

          BEGIN
               IF X.nombre<>'' THEN
               BEGIN
                    WriteLn;
                    WriteLn;
                    WriteLn('La matriz ',X.nombre,' es: ');
                    WriteLn;
                    FOR i:=1 to X.n DO
                    BEGIN
                         FOR j:=1 to X.m DO
                             Write(X.datos[i,j]:10:2);
                         WriteLn
                    END;
                    WriteLn
               END
          END;

PROCEDURE LeeMatriz(VAR X:Matriz);

          VAR
             i,j:Byte;
             nul:Char;
             correcta:Boolean;(*,


          BEGIN
            correcta:=False;
            REPEAT
               REPEAT
                     REPEAT
                           ClrScr;
                           gotoxy(1,24);
                           Write('Dame el nombre de esta matriz: ');
                           ReadLn(X.nombre)
                     UNTIL X.nombre<>'';
                     Write('Dame el orden de la matriz ',X.nombre,': ');
                     Read(X.n);
                     Read(X.m)
               UNTIL (X.n>0)AND(X.m>0);
               FOR i:=1 to X.n DO
                   FOR j:=1 to X.m DO
                   BEGIN
                        clrscr;
                        gotoxy(1,24);
                        Write('El valor ',X.nombre,'[',i,',',j,']: ');
                        Read(X.datos[i,j])
                   END;
               ClrScr;
               PonMatriz(X);
               WriteLn('¨Esta correcta la matriz? (S/N) ');
               REPEAT
                     nul:=UpCase(ReadKey)
               UNTIL (nul='S')OR(nul='N');
               IF nul='S' THEN correcta:=True
            UNTIL(correcta)
          END;

PROCEDURE SumaMat(X:Matriz;Y:Matriz;VAR Z:Matriz);

         VAR
            i,j:Byte;

         BEGIN
              IF (X.n=Y.n)AND(X.m=Y.m) THEN
              BEGIN
                   FOR i:=1 to X.n DO
                       FOR j:=1 to X.m DO
                           Z.datos[i,j]:=X.datos[i,j]+Y.datos[i,j];
                   Z.n:=X.n;
                   Z.m:=X.m;
                   Z.nombre:='('+X.nombre+'+'+Y.nombre+')'
              END
              ELSE
              BEGIN
                   Z.n:=0;
                   Z.m:=0;
                   Z.nombre:=''
              END
         END;(*,

PROCEDURE ProMat(X:Matriz;Y:Matriz;VAR Z:Matriz);

         VAR
            i,j,k:Byte;
            suma:Real;

         BEGIN
              IF (X.m=Y.n) THEN
              BEGIN
                   FOR i:=1 to X.n DO
                       FOR k:=1 to Y.m DO
                       BEGIN
                            suma:=0;
                            FOR j:=1 to X.m DO
                                suma:=X.datos[i,j]*Y.datos[j,k]+suma;
                            Z.datos[i,k]:=suma
                       END;
                   Z.n:=X.n;
                   Z.m:=Y.m;
                   Z.nombre:='('+X.nombre+'*'+Y.nombre+')'
              END
              ELSE
              BEGIN
                   Z.n:=0;
                   Z.m:=0;
                   Z.nombre:=''
              END
         END;

PROCEDURE Pide1Mat(Var X:Matriz);

          VAR
             Trash:String;
             i:Integer;

          BEGIN
               X.nombre:='';
               Write('Dame el nombre de la Matriz: ');
               ReadLn(Trash);
               FOR i:=1 to Max DO
                   IF Matrices[i].nombre=trash THEN X:=Matrices[i];
          END;

PROCEDURE SisEcua(VAR X:Matriz;VAR sol:Matriz);

          VAR
             i,p,j:Integer;
             Sirve:Boolean;
             m:Real;(*,


          PROCEDURE Cambia(VAR X:Matriz;R1,R2:Integer);

                    VAR
                       i:Integer;
                       Temp:Real;

                    BEGIN
                         FOR i:=1 TO X.m DO
                         BEGIN
                              Temp:=X.datos[R1,i];
                              X.datos[R1,i]:=X.datos[R2,i];
                              X.datos[R2,i]:=Temp
                         END
                    END;

          PROCEDURE Modifica(VAR X:Matriz;R1,R2:Integer;m:Real);

                    VAR
                       i:Integer;

                    BEGIN
                         FOR i:=1 TO X.m DO
                         BEGIN
                              X.datos[R1,i]:=X.datos[R1,i]-m*X.datos[R2,i]
                         END
                    END;

          BEGIN
               sol.nombre:='';
               IF (X.n+1)=(X.m) THEN       (* X.n es el n£mero de ecuaciones *)
               BEGIN
                    Sirve:=True;
                    FOR i:=1 TO (X.n-1) DO
                        IF Sirve THEN
                        BEGIN
                             p:=i;
                             WHILE (p<=X.n)AND(X.datos[p,i]=0) DO
                                   p:=p+1;
                             IF (p>X.n) THEN
                                Sirve:=False;
                             IF Sirve THEN
                                IF (p<>i) THEN
                                   Cambia(X,p,i)
                                ELSE
                                BEGIN
                                     FOR j:=i+1 TO X.n DO
                                     BEGIN
                                         m:=X.datos[j,i]/X.datos[i,i];
                                         Modifica(X,j,i,m)
                                     END
                                END
                        END;(*,


                    IF (X.datos[X.n,X.n]=0)AND(Sirve) THEN
                       Sirve:=False;
                    IF Sirve THEN
                    BEGIN
                         FOR i:=1 TO X.n DO
                             sol.datos[i,1]:=0;
                         sol.datos[X.n,1]:=X.datos[X.n,X.n+1]/X.datos[X.n,X.n];
                         FOR i:=X.n-1 DOWNTO 1 DO
                         BEGIN
                              m:=0;
                              FOR j:=X.m-1 DOWNTO 1 DO
                                  m:=m+X.datos[i,j]*sol.datos[j,1];
                              sol.datos[i,1]:=(X.datos[i,X.n+1]-m)/X.datos[i,i]
                         END;
                         sol.n:=X.n;
                         sol.m:=1;
                         sol.nombre:='sol('+X.nombre+')';
                    END;
                    X.nombre:='esc('+X.nombre+')'
               END
               ELSE
                   X.nombre:=''
          END;

BEGIN
     FOR i:=1 TO Max DO
         Matrices[i].nombre:='';
     REPEAT
           ClrScr;
           WriteLn('Matrices con Datos:');
           WriteLn;
           FOR i:=1 TO Max DO
               IF Matrices[i].nombre<>'' THEN WriteLn(Matrices[i].nombre,' (',Matrices[i].n,',',Matrices[i].m,')');
           WriteLn;
           WriteLn('1.-Leer Matriz');
           WriteLn('2.-Borrar Matriz');
           WriteLn('3.-Sumar Matrices');
           WriteLn('4.-Multiplicar Matrices');
           WriteLn('5.-Presentar Matriz');
           WriteLn('6.-Resolver Sistema de Ecuaciones');
           WriteLn('0.-Salir');
           WriteLn;
           REPEAT
                 nul:=ReadKey;
           UNTIL (nul)IN['1','2','3','4','5','6','0'];
           CASE nul OF
                '1': BEGIN
                          salir:=False;
                          i:=0;
                          REPEAT
                                i:=i+1;
                                IF Matrices[i].nombre='' THEN(*,

                                BEGIN
                                     salir:=True;
                                     LeeMatriz(Matrices[i])
                                END
                          UNTIL (i>=Max)OR(salir)
                     END;
                '2': BEGIN
                          Write('Dame el nombre de la matriz a borrar: ');
                          ReadLn(Trash);
                          salir:=False;
                          i:=0;
                          REPEAT
                                i:=i+1;
                                IF Matrices[i].nombre=Trash THEN
                                BEGIN
                                     salir:=True;
                                     Matrices[i].nombre:=''
                                END
                          UNTIL (i>=Max)OR(salir)
                     END;
                '3': BEGIN
                          Pide1Mat(primera);
                          Pide1Mat(segunda);
                          IF (primera.nombre<>'')AND(segunda.nombre<>'') THEN
                          BEGIN
                               salir:=False;
                               i:=0;
                               REPEAT
                                     i:=i+1;
                                     IF Matrices[i].nombre='' THEN
                                     BEGIN
                                          salir:=True;
                                          SumaMat(primera,segunda,Matrices[i])
                                     END
                               UNTIL (i>=Max)OR(salir)
                          END
                     END;
                '4': BEGIN
                          Pide1Mat(primera);
                          Pide1Mat(segunda);
                          IF (primera.nombre<>'')AND(segunda.nombre<>'') THEN
                          BEGIN
                               salir:=False;
                               i:=0;
                               REPEAT
                                     i:=i+1;
                                     IF Matrices[i].nombre='' THEN
                                     BEGIN
                                          salir:=True;
                                          ProMat(primera,segunda,Matrices[i])
                                     END
                               UNTIL (i>=Max)OR(salir)
                          END
                     END;(*,

                '5': BEGIN
                          WriteLn('Desplegando');
                          WriteLn;
                          Pide1Mat(primera);
                          IF primera.nombre<>'' THEN
                             PonMatriz(primera)
                          ELSE
                              WriteLn('No tengo esa Matriz')
                     END;
                '6': BEGIN
                          Pide1Mat(primera);
                          IF primera.nombre<>'' THEN
                             SisEcua(primera,segunda)
                          ELSE
                          BEGIN
                              WriteLn('No tengo esa Matriz');
                              primera.nombre:='';
                              segunda.nombre:=''
                          END;
                          IF primera.nombre<>'' THEN
                          BEGIN
                               salir:=False;
                               i:=0;
                               REPEAT
                                     i:=i+1;
                                     IF Matrices[i].nombre='' THEN
                                     BEGIN
                                          salir:=True;
                                          Matrices[i]:=primera;
                                     END
                               UNTIL (i>=Max)OR(salir);
                          END;
                          IF segunda.nombre<>'' THEN
                          BEGIN
                               salir:=False;
                               i:=0;
                               REPEAT
                                     i:=i+1;
                                     IF Matrices[i].nombre='' THEN
                                     BEGIN
                                          salir:=True;
                                          Matrices[i]:=segunda;
                                     END
                               UNTIL (i>=Max)OR(salir)
                          END
                     END;
                '0': BEGIN
                          WriteLn;
                          WriteLn('¨Esta seguro de querer salir? (S/N) ');
                          REPEAT
                                nul:=UpCase(ReadKey)
                          UNTIL (nul='S')OR(nul='N');
                     END;
           END;(*,

           WriteLn;
           WriteLn('Oprima cualquier Tecla para Continuar.');
           REPEAT UNTIL KeyPressed
     UNTIL (nul='S')
END.(*,