PROGRAM OpeMatrices; (* Victor Iniestra A. *)
(* An lisis Num‚rico *)
USES (* 22 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;
m:Real;
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 ProMatEsc(X:Matriz;y:Real;VAR Z:Matriz);
VAR
i,j:Byte;
trash:String;
BEGIN
FOR i:=1 to X.n DO
FOR j:=1 to X.m DO
Z.datos[i,j]:=X.datos[i,j]*m;
Z.n:=X.n;
Z.m:=X.m;
Str(m:1:2,trash);
Z.nombre:='('+trash+' '+X.nombre+')'
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 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
X.datos[R1,i]:=X.datos[R1,i]-m*X.datos[R2,i]
END;
PROCEDURE SisEcuaEliGauss(VAR X:Matriz;VAR sol:Matriz);
VAR
i,p,j:Integer;
Sirve:Boolean;
m:Real;
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+')';
X.nombre:='esc('+X.nombre+')'
END
ELSE
X.nombre:='equ('+X.nombre+')'
END
ELSE
X.nombre:=''
END;
PROCEDURE SisEcuaGaussJordan(VAR X:Matriz);
VAR
i,p,j:Integer;
Sirve:Boolean;
m:Real;
BEGIN
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
BEGIN
m:=X.datos[i,i];
FOR j:=1 TO X.m DO
X.datos[i,j]:=X.datos[i,j]/m
END;
FOR i:=X.n DOWNTO 2 DO
FOR j:=i-1 DOWNTO 1 DO
BEGIN
m:=X.datos[j,i];
Modifica(X,j,i,m)
END;
X.nombre:='uni('+X.nombre+')'
END
ELSE
X.nombre:='equ('+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 Matriz por escalar');
WriteLn('5.-Multiplicar Matrices');
WriteLn('6.-Presentar Matriz');
WriteLn('7.-Resolver Sistema de Ecuaciones (Eliminaci¢n Gaussiana)');
WriteLn('8.-Resolver Sistema de Ecuaciones (Gauss-Jordan)');
WriteLn('0.-Salir');
WriteLn;
REPEAT
nul:=ReadKey
UNTIL (nul)IN['1','2','3','4','5','6','7','8','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);
IF (primera.nombre<>'') THEN
BEGIN
salir:=False;
i:=0;
REPEAT
i:=i+1;
IF Matrices[i].nombre='' THEN
BEGIN
Write('Dame el n£mero a multiplicar: ');
ReadLn(m);
salir:=True;
ProMatEsc(primera,m,Matrices[i])
END
UNTIL (i>=Max)OR(salir)
END
END;
'5': 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;
'6': BEGIN
WriteLn('Desplegando');
WriteLn;
Pide1Mat(primera);
IF primera.nombre<>'' THEN
PonMatriz(primera)
ELSE
WriteLn('No tengo esa Matriz')
END;
'7': BEGIN
Pide1Mat(primera);
IF primera.nombre<>'' THEN
SisEcuaEliGauss(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;
'8': BEGIN
Pide1Mat(primera);
IF primera.nombre<>'' THEN
SisEcuaGaussJordan(primera)
ELSE
BEGIN
WriteLn('No tengo esa Matriz');
primera.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
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.