practica 11 ejercicio 2
program HelloWorld;
const
categorias = 4;
caracteres = 70;
FIN = 'fin';
type
conj = set of char;
rangoCategorias = 1 .. categorias;
rangoCaracteres = 1 .. caracteres;
Tnombre = string[15];
Tvector = record
vector : array [rangoCaracteres] of char;
DimL : rangoCaracteres;
end;
Tcliente = record
nombre : Tnombre;
apellido : Tnombre;
categoria : rangoCategorias;
montoBasico : real;
direccion : Tvector;
end;
Tlista = ^nodo;
nodo = record
datos : Tcliente;
sig : Tlista;
end;
montoExtra = array [rangoCategorias] of real;
procedure imprimirElemento(e : Tcliente);
var i : rangoCaracteres;
begin
writeln('nombre : ',e.nombre);
writeln('apellido : ',e.apellido);
writeln('categoria : ',e.categoria);
writeln('monto basico : ',e.montoBasico:10:2);
write('direccion : ');
for i := 1 to e.direccion.DimL do write(e.direccion.vector[i]);
writeln;
writeln('-----------------------------------------------------------------');
end;
procedure imprimirLista( l: Tlista);
begin
writeln('imprimimos lista -----------------------------------------------------------------');
while l <> nil do begin
imprimirElemento(l^.datos);
l:= l^.sig;
end;
writeln('---------------------------------------------------------------------------------------------------------------');
end;
procedure leerDireccion (var v : Tvector);
var car : char;
begin
v.DimL := 1;
read(car);
while (car <> '.') and (v.DimL < caracteres) do begin
v.vector[v.DimL] := car;
v.DimL := v.DimL + 1;
read(car);
end;
readln;
if v.DimL > 1 then
v.DimL := v.DimL - 1;
end;
procedure leerElemento(var e : Tcliente);
begin
readln(e.nombre);
if e.nombre <> FIN then begin
readln(e.apellido);
e.montoBasico :=random(10000);
e.categoria:=random(categorias)+1;
leerDireccion(e.direccion);
end;
end;
procedure agregarElemento(var l : Tlista; e : Tcliente);
var nue : Tlista;
begin
new(nue);
nue^.datos:= e;
nue^.sig := l;
l:= nue;
end;
procedure cargarLista(var l: Tlista);
var e : Tcliente;
begin
l := nil;
leerElemento(e);
while e.nombre <> FIN do begin
agregarElemento(l,e);
leerElemento(e);
end;
end;
procedure cargarVector(var v : montoExtra);
var
i : rangoCategorias;
begin
for i := 1 to categorias do v[i] := random(2600);
end;
procedure imprimirVector(v: montoExtra);
var i : rangoCategorias;
begin
for i := 1 to categorias do
write('-------');
for i := 1 to categorias do
write(' | ',v[i]:4:2);
writeln(' | ',v[i]:4:2,' | ');
for i := 1 to categorias do
write('-------');
end;
procedure espacio;
begin
writeln;writeln;writeln;writeln;
writeln('-----------------------------------------------------------------------------------------------------------------------');
writeln;writeln;writeln;writeln;
end;
function pasarMinus (car : char): char;
begin
case car of
'A': pasarMinus:= 'a';
'B': pasarMinus:= 'b';
'C': pasarMinus:= 'c';
'D': pasarMinus:= 'd';
'E': pasarMinus:= 'e';
'F': pasarMinus:= 'f';
'G': pasarMinus:= 'g';
end;
end;
procedure inicializarConjunto(var c1 : conj; var digitoPar : conj; var A : Tvector; var exito : boolean; var j : rangoCaracteres; var A2 : conj; var i : rangoCaracteres);
begin
c1 := ['A','B','C','D','E','F','G'];
digitoPar := ['2','4','6','8'];
exito := true;
A.DimL := 1;
j := 1; i := 1;
A2:= [];
end;
procedure parteA(var v : Tvector; var i : rangoCaracteres; var exito : boolean; var A : Tvector;c1,digitoPar:conj ;var A2 : conj );
begin
while(v.vector[i] <> '%') and (exito) do begin
if not (v.vector[i] in c1)or not(v.vector[i] in digitoPar) then begin exito := false;
end else begin
if v.vector[i] in c1 then begin
A.vector[A.DimL] := pasarMinus(v.vector[i]);
A.DimL := A.DimL + 1;
end;
A2 := A2 + [v.vector[i]];
i := i+1;
end;
end;
A.DimL := A.DimL - 1;
end;
procedure parteB(var v : Tvector; var i : rangoCaracteres; var exito : boolean; var j : rangoCaracteres;A : Tvector);
begin
while(v.vector[i] <> '%') and (exito) do begin
if not (v.vector[i] <> A.vector[j]) then begin exito := false;
end else begin
i := i+1;
j := j+1;
end;
end;
end;
procedure parteC(var v : Tvector; var i : rangoCaracteres; var exito : boolean; A2 : conj);
begin
while (v.vector[i] <> '%') and (exito)and (i < v.DimL)do begin
if (v.vector[i] in A2) then begin exito := false;
end else i := i+1;
end;
end;
function cumple(v : Tvector):boolean;
var
i : rangoCaracteres;
c1,digitoPar : conj;
exito : boolean;
A : Tvector;A2 : conj;
j : rangoCaracteres;
begin
inicializarConjunto(c1,digitoPar,A,exito,j,A2,i);
while (exito) and (i <= v.DimL)do begin
parteA(v ,i ,exito,A,c1,digitoPar,A2);
i := i+1;
parteB(v,i,exito,j,A);
i := i+1;
parteC(v,i,exito,A2);
end;
cumple := exito;
end;
procedure informar(r : montoExtra;nmax : Tnombre);
var i : rangoCategorias;
begin
for i := 1 to categorias do
writeln('para la categoria ',i, ' se recaudó ',r[i]:10:2);
if r[2] = 0 then begin writeln(' no se recaudo en la categoria 2');
end else writeln(' el nombre de la persona que mas pago en la categoria 2 fue ',nmax);
end;
procedure masPago(l : Tlista;var max : real; var nmax : Tnombre);
begin
if l^.datos.categoria = 2 then begin
if l^.datos.montoBasico > max then begin
max := l^.datos.montoBasico;
nmax := l^.datos.nombre;
end;
end;
end;
procedure inicializacion(var r : montoExtra; var max : real);
var i : rangoCategorias;
begin
for i := 1 to categorias do
r[i] := 0;
max := 0;
end;
procedure recorrerLista(l : Tlista; v : montoExtra);
var
r : montoExtra;
max : real;
nmax : Tnombre;
begin
inicializacion(r,max);
while l <> nil do begin
r[l^.datos.categoria] := r[l^.datos.categoria] + l^.datos.montoBasico + v[l^.datos.categoria];
masPago(l,max,nmax);
writeln('la secuencia cumple : ',cumple(l^.datos.direccion));
l := l^.sig;
end;
informar(r,nmax);
end;
var
l : Tlista;
v : montoExtra;
begin
cargarLista(l);
imprimirLista(l);espacio;
cargarVector(v);
imprimirVector(v);espacio;
recorrerLista(l,v);
end.
|
run
| edit
| history
| help
|
0
|
|
|