Anónimo
Necesito ayuda con las Listas en pascal
Ya casi lo termino pero el punto c del enunciado no hace lo que tiene que hacer o lo hace pero el programa nunca termina(bucle infinito). Este es el enunciado:"Un coro municipal tiene que realizar una serie de presentaciones en distintos lugares del pais. Los datos conocidos son: provincia, localidad, nombre, nombre del lugar donde se llevara a cabo el evento, direccion, telefono y fecha. Se desea obtener un menú que permita realizar lo siguiente:
a) Cargar datos en el archivo
b)Agregar datos a los ya existentes
C)Generar una lista ordenada por nombre de las localidades en las que se llevara a cabo el evento, también deben figurar la provincia y la fecha de la presentacion
d)modificar la fecha de alguna presentación en el archivo
e)Imprimir el archivo y la lista "
Mi codigo hasta ahora es´:
program coro;
uses crt,dos;
type
lista=^reg;
reg=record
prov,loc,noml,dir:string;
tel:string[7];
fech:string[8];
ps:lista;
end;
var
regis:reg;
arc,auxarc:file of reg;
a,op,op5:integer;
sn,s1:string[1];
l:lista;
ar:string;
procedure menu;{Muestra el Menu en pantalla}
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('PROGRAMA CORO MUNICIPAL');end;
end;
writeln('');writeln('');
writeln(' MENU');
writeln('1) Cargar Datos en el Archivo');
writeln('2) Agregar Datos a los ya Existentes');
writeln('3) Generar una lista');
writeln('4) Modificar la fecha de presentaci¢n');
writeln('5) Imprimir archivo y lista');
writeln('6) Salir');
end;
procedure opc1;{Carga el archivo}
var
f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 1'); end;
end;
writeln;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('El archivo fue creado correctamente');writeln;
rewrite(arc);end
else begin
a:=filesize(arc);
writeln('El archivo fue abierto posee ',a,' Registros');
writeln('Si no desea sobreescribirlos ingrese 0');writeln;
end;
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
writeln;writeln;
close(arc);
end;
procedure opc2; {A¤ade otro registro en el archivo}
var
b,f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 2: Agregando Datos'); end;
end;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
rewrite(arc);
end;
b:=filesize(arc);
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
seek(arc,b);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
close(arc);
writeln;
end;
procedure opc3;{Crea una lista ordenada por localidad}
var
nue,act,ant:lista;
fx,f:integer;
m:string;
begin
clrscr;
if op5<>1 then begin
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 3'); end;
end;
end;
writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
fx:=filesize(arc);
l:=nil;
for f:=0 to fx do begin
if f<fx then begin
seek(arc,f);
read(arc,regis);
new(nue);writeln;
nue^.prov:=regis.prov;writeln('Provincia: ',nue^.prov);
nue^.loc:=regis.loc;writeln('Localidad: ',nue^.loc);
nue^.noml:=regis.noml;writeln('Nombre del lugar: ',nue^.noml);
nue^.fech:=regis.fech;writeln('Fecha del Evento: ',nue^.fech);
nue^.ps:=l;
l:=nue;
end else begin nue^.ps:=nil end;
end;writeln;
writeln(' La lista se creo correctamente');readln(m);
if op5<>1 then begin
for a:=1 to 40 do begin write('*');
if a=20 then begin write('OPCION 3: Ordenando por localidad'); end;
end;writeln;
end;
ant:=nil;
act:=l;
seek(arc,0);read(arc,regis);
m:=regis.loc;
for f:=0 to fx-1 do begin
while (act<>nil) and (m=act^.loc) do begin
ant:=act;
act:=act^.ps;
end;
end;
seek(arc,0);read(arc,regis);
while (l<>nil) do begin
writeln(l^.loc);
writeln(l^.prov);
writeln(l^.noml);
writeln(l^.fech);
end;
close(arc);
end;
end;
procedure opc4;{Modifica la fecha de alguna presentaci¢n}
var ax:reg;
fx,f,cod,m:integer;
begin
if op5<>1 then begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4'); end;
end;
writeln;
end;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
seek(arc,0);
fx:=filesize(arc);
writeln('Presentaciones guardadas:');
for f:=1 to fx do begin
read(arc,regis);
writeln;
writeln(' Presentacion: ',f);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Direcci¢n:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
end;
writeln;write(' ');
writeln('Cantidad de presentaciones: ',fx);writeln;
if op5<>1 then begin
write('¨Que presentaci¢n desea modificar? ');
{$I-}
readln(m);
{$I+}
if (m>fx) or (IOResult<>0) then begin
writeln('Introdujo un numero mayor al registro o un caracter invalido');
end else begin
assign(auxarc,'C:\proyec.txt');
rewrite(auxarc);
seek(arc,m-1);
read(arc,regis);
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4: Modificando Fecha'); end;
end;writeln;
writeln('Registro Actual:');
writeln(' Presentacion: ',m);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Dirección:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
ax:=regis;
write('Ingrese nueva fecha: ');readln(ax.fech);
val(ax.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(ax.fech);
end;
for f:=0 to filesize(arc)-1 do...
a) Cargar datos en el archivo
b)Agregar datos a los ya existentes
C)Generar una lista ordenada por nombre de las localidades en las que se llevara a cabo el evento, también deben figurar la provincia y la fecha de la presentacion
d)modificar la fecha de alguna presentación en el archivo
e)Imprimir el archivo y la lista "
Mi codigo hasta ahora es´:
program coro;
uses crt,dos;
type
lista=^reg;
reg=record
prov,loc,noml,dir:string;
tel:string[7];
fech:string[8];
ps:lista;
end;
var
regis:reg;
arc,auxarc:file of reg;
a,op,op5:integer;
sn,s1:string[1];
l:lista;
ar:string;
procedure menu;{Muestra el Menu en pantalla}
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('PROGRAMA CORO MUNICIPAL');end;
end;
writeln('');writeln('');
writeln(' MENU');
writeln('1) Cargar Datos en el Archivo');
writeln('2) Agregar Datos a los ya Existentes');
writeln('3) Generar una lista');
writeln('4) Modificar la fecha de presentaci¢n');
writeln('5) Imprimir archivo y lista');
writeln('6) Salir');
end;
procedure opc1;{Carga el archivo}
var
f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 1'); end;
end;
writeln;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('El archivo fue creado correctamente');writeln;
rewrite(arc);end
else begin
a:=filesize(arc);
writeln('El archivo fue abierto posee ',a,' Registros');
writeln('Si no desea sobreescribirlos ingrese 0');writeln;
end;
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
writeln;writeln;
close(arc);
end;
procedure opc2; {A¤ade otro registro en el archivo}
var
b,f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 2: Agregando Datos'); end;
end;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
rewrite(arc);
end;
b:=filesize(arc);
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
seek(arc,b);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
close(arc);
writeln;
end;
procedure opc3;{Crea una lista ordenada por localidad}
var
nue,act,ant:lista;
fx,f:integer;
m:string;
begin
clrscr;
if op5<>1 then begin
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 3'); end;
end;
end;
writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
fx:=filesize(arc);
l:=nil;
for f:=0 to fx do begin
if f<fx then begin
seek(arc,f);
read(arc,regis);
new(nue);writeln;
nue^.prov:=regis.prov;writeln('Provincia: ',nue^.prov);
nue^.loc:=regis.loc;writeln('Localidad: ',nue^.loc);
nue^.noml:=regis.noml;writeln('Nombre del lugar: ',nue^.noml);
nue^.fech:=regis.fech;writeln('Fecha del Evento: ',nue^.fech);
nue^.ps:=l;
l:=nue;
end else begin nue^.ps:=nil end;
end;writeln;
writeln(' La lista se creo correctamente');readln(m);
if op5<>1 then begin
for a:=1 to 40 do begin write('*');
if a=20 then begin write('OPCION 3: Ordenando por localidad'); end;
end;writeln;
end;
ant:=nil;
act:=l;
seek(arc,0);read(arc,regis);
m:=regis.loc;
for f:=0 to fx-1 do begin
while (act<>nil) and (m=act^.loc) do begin
ant:=act;
act:=act^.ps;
end;
end;
seek(arc,0);read(arc,regis);
while (l<>nil) do begin
writeln(l^.loc);
writeln(l^.prov);
writeln(l^.noml);
writeln(l^.fech);
end;
close(arc);
end;
end;
procedure opc4;{Modifica la fecha de alguna presentaci¢n}
var ax:reg;
fx,f,cod,m:integer;
begin
if op5<>1 then begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4'); end;
end;
writeln;
end;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
seek(arc,0);
fx:=filesize(arc);
writeln('Presentaciones guardadas:');
for f:=1 to fx do begin
read(arc,regis);
writeln;
writeln(' Presentacion: ',f);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Direcci¢n:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
end;
writeln;write(' ');
writeln('Cantidad de presentaciones: ',fx);writeln;
if op5<>1 then begin
write('¨Que presentaci¢n desea modificar? ');
{$I-}
readln(m);
{$I+}
if (m>fx) or (IOResult<>0) then begin
writeln('Introdujo un numero mayor al registro o un caracter invalido');
end else begin
assign(auxarc,'C:\proyec.txt');
rewrite(auxarc);
seek(arc,m-1);
read(arc,regis);
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4: Modificando Fecha'); end;
end;writeln;
writeln('Registro Actual:');
writeln(' Presentacion: ',m);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Dirección:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
ax:=regis;
write('Ingrese nueva fecha: ');readln(ax.fech);
val(ax.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(ax.fech);
end;
for f:=0 to filesize(arc)-1 do...
1 Respuesta
Respuesta
1
Para serte sincera no he trabajado nunca con listas en pascal, sino en lenguaje C, pero tratare de ayudarte lo más que pueda.
Primero, se te está quedando en un bucle infinito, ya que al momento de imprimir la lista nunca estas moviendo el puntero de la lista que pretendes recorrer, por lo tanto, siempre imprimirás el primer elemento y la lista nunca va a ser nula, por lo tanto nunca se cumple la condición de parada.
Asegurate de colocar luego de la impresion la linea l:=l^. Ps.
while (l<>nil) do
begin
writeln(l^.loc);
writeln(l^.prov);
writeln(l^.noml);
writeln(l^.fech);
l:=l^.ps;
end;
Lo segundo que note es que no estas creando la lista de la manera adecuada. Te esta quedando una lista con solo un elemento. El ultimo que insertas. Aqui te envio la corrección:
for f:=0 to fx do
begin
if f
begin
seek(arc,f);
read(arc,regis);
new(nue);
writeln;
nue^.prov:=regis.prov;
writeln('Provincia: ',nue^.prov);
nue^.loc:=regis.loc;
writeln('Localidad: ',nue^.loc);
nue^.noml:=regis.noml;
writeln('Nombre del lugar: ',nue^.noml);
nue^.fech:=regis.fech;
writeln('Fecha del Evento: ',nue^.fech);
nue^.ps:=nil;
if(l=nil) then
l:=nue
else
begin
ult:=l;
while(ult^.ps<>nil) do
ult:=ult^.ps;
ult^.ps:=nue;
end;
end;
end;
Por ultimo tienes que ordenar la lista por localidad. Puedes usar algo como el algoritmo de la burbuja pero aplicado a las listas y a tu caso en especifico.
Aqui esta como ordenar vectores:
http://www.dma.eui.upm.es/historia_informatica/Doc/Lenguajes/PASCAL.htm
Cualquier duda o aclaración no dudes en escribirme. Yo tratare de ayudarte en lo más que pueda. :-D
Nota: Por favor valora mi esfuerzo, dando puntuación a mi respuesta.
Primero, se te está quedando en un bucle infinito, ya que al momento de imprimir la lista nunca estas moviendo el puntero de la lista que pretendes recorrer, por lo tanto, siempre imprimirás el primer elemento y la lista nunca va a ser nula, por lo tanto nunca se cumple la condición de parada.
Asegurate de colocar luego de la impresion la linea l:=l^. Ps.
while (l<>nil) do
begin
writeln(l^.loc);
writeln(l^.prov);
writeln(l^.noml);
writeln(l^.fech);
l:=l^.ps;
end;
Lo segundo que note es que no estas creando la lista de la manera adecuada. Te esta quedando una lista con solo un elemento. El ultimo que insertas. Aqui te envio la corrección:
for f:=0 to fx do
begin
if f
begin
seek(arc,f);
read(arc,regis);
new(nue);
writeln;
nue^.prov:=regis.prov;
writeln('Provincia: ',nue^.prov);
nue^.loc:=regis.loc;
writeln('Localidad: ',nue^.loc);
nue^.noml:=regis.noml;
writeln('Nombre del lugar: ',nue^.noml);
nue^.fech:=regis.fech;
writeln('Fecha del Evento: ',nue^.fech);
nue^.ps:=nil;
if(l=nil) then
l:=nue
else
begin
ult:=l;
while(ult^.ps<>nil) do
ult:=ult^.ps;
ult^.ps:=nue;
end;
end;
end;
Por ultimo tienes que ordenar la lista por localidad. Puedes usar algo como el algoritmo de la burbuja pero aplicado a las listas y a tu caso en especifico.
Aqui esta como ordenar vectores:
http://www.dma.eui.upm.es/historia_informatica/Doc/Lenguajes/PASCAL.htm
Cualquier duda o aclaración no dudes en escribirme. Yo tratare de ayudarte en lo más que pueda. :-D
Nota: Por favor valora mi esfuerzo, dando puntuación a mi respuesta.