Obtener intervalo de una lista de enteros desordenados

Cuestiones y dudas acerca de lenguajes de programación diversos.

Moderador: Moderadores

Mathias
Junior
Mensajes: 9
Registrado: Lun Nov 08, 2010 2:06 am

Obtener intervalo de una lista de enteros desordenados

Mensaje por Mathias » Dom Feb 05, 2012 5:57 pm

Buenas!
Estoy tratando de hacer una función a la cual se le dan 2 valores enteros y en una lista simple con números (dados por random) me indique los números que hay entre los que doy, no importa si hay números repetidos en la lista, hagamos como que no (aunque creo que cualquier código funcional serviría igual)
Esto es lo que voy haciendo:

Código: Seleccionar todo

function encontrarIntervalo(lista:TipoLista;i,j:integer):TipoLista;
VAR p,s:TipoLista;
BEGIN
	
	WHILE (lista <> nil) AND (lista^.info <> i) DO lista := lista^.sig;

	IF lista <> nil
	THEN BEGIN
		new(s);
		p := s^.sig;
		lista := lista^.sig;
		WHILE (lista <> nil) AND (lista^.info <> j) DO
		BEGIN
			s^.info := lista^.info;
			new(s^.sig);
			s := s^.sig;
			lista := lista^.sig
		END;

	END;
	encontrarIntervalo := s
END;
Parece funcionar, pero siempre me devuelve un valor más que es menor a -500 (lo que supongo que me leerá alguna celda vacía, no sé..
ustedes que piensan?

el código completo del programa es este:

Código: Seleccionar todo

Uses Crt;
TYPE
	TipoLista = ^nodo;
	nodo = record
				info:integer;
				sig:TipoLista
			end;

	
procedure insertar(var lista : TipoLista; x: integer);
var  p	: TipoLista;
begin
   new(p);
   p^.info:= x;

   p^.sig:= lista;
   lista:= p
end;

procedure insertarf(var lista: TipoLista; x: integer);
VAR nuevo,p,anterior :TipoLista;
begin
	new(nuevo);
	nuevo^.info := x;
	nuevo^.sig := nil;
	anterior := nil;
	
	IF lista = NIL
	THEN lista := nuevo
	ELSE BEGIN
		p := lista;
		while (p^.sig <> nil) do p := p^.sig;
		p^.sig := nuevo;
	END;

end;


procedure imprimir(lista:TipoLista);
Begin
     If lista <> Nil Then
      Begin
		  Write(' (',lista^.Info,') ');
		  lista := lista^.sig;
		  Imprimir(lista);
      End;

End;

procedure imprimir2(lista:TipoLista);
Begin
		WHILE  lista <> NIL DO
		BEGIN
			writeln(lista^.info);
			lista := lista^.sig;
		END;
END;


procedure borrarHasta(var lista:TipoLista;n:integer);
VAR q,aux:TipoLista; s,t:integer;
begin
IF lista <> nil THEN
	IF (n = lista^.info )
	THEN BEGIN
			q := lista;
			lista := q^.sig;
			dispose(q)
	END
	ELSE BEGIN
		aux := lista;	s := 1; {el contador y la lista auxiliar para el WHILE}
		WHILE  (aux <> nil) and (n <> aux^.info) DO  {busca el número en la lista}
			BEGIN aux := aux^.sig; s := s + 1 END; {su posición será "s"}
			
				IF aux <> NIL
				THEN FOR t:= 1 to s DO
					 BEGIN
						q := lista;
						lista := lista^.sig;
						dispose(q);
					 END
				ELSE BEGIN
					writeln('');
					writeln('El ',n,', no se encuentra en la lista');
					readkey
				END
	END
END;

procedure borrar(var lista:TipoLista;n:integer);
VAR p,s: TipoLista;
Begin
IF lista <> nil THEN
	IF lista^.info = n
	THEN BEGIN  p := lista;
				lista := lista^.sig;
				dispose(p)
	END
	ELSE BEGIN
		p := lista;
		s := p^.sig;
		WHILE s <> NIL DO
		BEGIN
			IF s^.info = n	
			THEN p^.sig := s^.sig;
			p := p^.sig;
			s := s^.sig
		END;
		dispose(s);
		dispose(p)
	END
END;			

function menor(lista:TipoLista):integer;
VAR n,p:integer;
BEGIN
	IF lista <> nil
	THEN begin
		 n := lista^.info;
		WHILE lista <> nil DO BEGIN
				 IF n > lista^.info
				 THEN n := lista^.info;
				lista := lista^.sig;
		END;
		menor := n
	end;
end;

function mayor(lista:TipoLista):integer;
VAR n,p:integer;
BEGIN
	IF lista <> nil
	THEN begin
		 n := lista^.info;
		WHILE lista <> nil DO BEGIN
				 IF n < lista^.info
				 THEN n := lista^.info;
				lista := lista^.sig;
		END;
		mayor := n
	end;
end;

procedure ordenar(var lista:TipoLista);
VAR listar,q:TipoLista; n:integer;
begin
	listar := lista; {para no modificar el apuntador de lista}
	WHILE listar <> nil DO BEGIN
		q := listar^.sig;
		WHILE q <> nil DO BEGIN
			IF listar^.info > q^.info
			THEN BEGIN
				n:= listar^.info;
				listar^.info := q^.info;
				q^.info := n
			END;
			q := q^.sig
		END;
		listar := listar^.sig
	END
END;

function encontrar(lista:TipoLista;n:integer):boolean;
begin
	WHILE (lista <> nil) AND (lista^.info <> n) DO lista := lista^.sig;
	IF lista = nil
	THEN encontrar := false
	ELSE encontrar := true
end;

procedure crearcadena(var lista:TipoLista);
VAR l:integer;
begin
	randomize;
	FOR l := 0 to 2 DO
	insertarf(lista,random(100))
end;

function encontrarIntervalo(lista:TipoLista;i,j:integer):TipoLista;
VAR p,s:TipoLista;
BEGIN
	
	WHILE (lista <> nil) AND (lista^.info <> i) DO lista := lista^.sig;

	IF lista <> nil
	THEN BEGIN
		new(s);
		p := s^.sig;
		lista := lista^.sig;
		WHILE (lista <> nil) AND (lista^.info <> j) DO
		BEGIN
			s^.info := lista^.info;
			new(s^.sig);
			s := s^.sig;
			lista := lista^.sig
		END;

	END;
	encontrarIntervalo := s
END;

VAR
	lista:TipoLista;
	i,j,m,n:integer;
	k:char;

BEGIN
	lista := NIL;
	k := 'z';
REPEAT
    ClrScr;
	write('* '); IF lista = NIL THEN write('   ¡No hay numeros!   ') ELSE imprimir(lista); writeln(' *');
	writeln('                     ');
	writeln('Seleccione opcion...');
	writeln('-----------------------------------');
	writeln('0) Crear cadena      ');	
	writeln('1) Insertar al inicio');
	writeln('2) Insertar al final ');
	IF lista = NIL THEN BEGIN
	writeln('3) eliminar numero  (No disponible)');  END ELSE writeln('3) eliminar numero    ');
	writeln('4) eliminar hasta... ');	
	writeln('5) Menor             ');
	writeln('6) Mayor             ');
	writeln('7) Ordenar           ');
	writeln('8) Encontrar         ');
	writeln('9) Intervalo         ');
	writeln('.                    ');
	writeln('.                    ');
	writeln('.                    ');
	writeln('                     ');
	writeln('S) Salir             ');
	writeln('-----------------------------------');

	CASE k of
		'z'	  	:	writeln(' ');
		
		'*'		:	writeln('Saliendo...');
		
			'8' :   BEGIN IF encontrar(lista,i)
					THEN writeln('El numero ',i,' esta en la lista.')
					ELSE  writeln('El numero ',i,' NO esta en la lista.'); readkey END;
		
	'3','4'   	:	IF lista <> nil
					THEN writeln('Eliminando, actualizando lista...');
				
		'5'	 	 :	writeln('El menor de la lista es: ',n);
		
		'6'	 	 :	writeln('El mayor de la lista es: ',n);
		
'1','2','7','0'	 :	writeln('Actualizando lista..');
				
		'9'	  	:	IF encontrarIntervalo(lista,i,j) <> nil
					THEN BEGIN writeln('En el intervalo [',i,',',j,'] se encontraron los siguientes numeros:'); imprimir(encontrarIntervalo(lista,i,j)); readkey END
					ELSE BEGIN writeln('En el intervalo [',i,',',j,'] NO encontraron numeros.'); imprimir(encontrarIntervalo(lista,i,j)); readkey END 
					

	END;

	writeln('                     ');
	  write('Opcion: '             );
	Readln(k);
	writeln('                     ');

CASE k of
	'0' : crearcadena(lista);

	'1' :	BEGIN
				write('1) Cantidad de celdas a agregar: ');
				j := 1;
				readln(i);
				writeln('-----------------------------------');
				WHILE i >= j DO
				BEGIN
					writeln('Inserte un numero: ');
					readln(m);
					insertar(lista,m);
					j := j + 1;
				END
			END;
	'2' :	BEGIN
				write('1) Cantidad de celdas a agregar: ');
				j := 1;
				readln(i);
				writeln('-----------------------------------');
				WHILE i >= j DO
				BEGIN
					writeln('Inserte un numero: ');
					readln(m);
					insertarf(lista,m);
					j := j + 1;
				END;
			END;
	'3' :	BEGIN write('Numero a eliminar: ');
					read(i);
					borrar(lista,i);
					writeln('Actualizando lista...');
					imprimir(lista)
			END;
	'4' : BEGIN 	write('¿Hasta donde borrar? -> ');
					read(i);
	              	borrarHasta(lista,i)
					END;
	'5' :		n := menor(lista);
	'6' :		n := mayor(lista);
	'7' : 	ordenar(lista);
	'8' : BEGIN write('Numero a encontrar: '); read(i) END;
	'9' : BEGIN write('Ingrese el intervalo [i,j]: ['); read(i); write('],['); read(j); write(']') END;
	
END;
		writeln;
	
UNTIL (k = '*')
END.

que por otro lado, lo había posteado viewtopic.php?f=9&t=20503 y ahora lo modifiqué y me dá un error raro, en el case k de lo que sale en pantalla, hay una opción para '8', sin embargo se va enseguida, es como que vuelve a tomar la k y le cambia el valor enseguida.

Estoy practicando para un examen, por eso hago este programa tan poco funcional. Saludos