purgaord.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION

  Escribir un programa que elimina los elementos repetidos de
  una lista ordenada. 
  keywords: lista
  FIN DE DESCRIPCION }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: purgaord.pas 2002/04/05 16:35 jdelia  Exp jdelia   $}

program prupurga;

uses u_listpi;

type
  lista = listpi ;

procedure ERROR (s: string);
begin
    writeln (s);
    halt;
end; {error}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function PURGA_ORD (var L: lista) : boolean;
var
  p, q   : posicion;
  xp, xq : tipo_elemento;
begin
  PURGA_ORD := true ;
  p  := L.PRIMERO ;
  xp := L.RECUPERA (p);
  while (p <> L.FIN) and (PURGA_ORD) do begin
    q  := L.SIGUIENTE (p);
    if ( q = L.FIN ) then  exit ;
    xq := L.RECUPERA (q) ;
    if  (xq < xp) then
      PURGA_ORD := false
    else if (xq = xp) then
      L.SUPRIME (p)
    else begin
      p  := q;
      xp := xq;
    end; {if}
  end; {while}
  PURGA_ORD := true;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
  L : lista;
  p : posicion;
begin
  L.ANULA;
  L.IMPRIME ('lista inicial');
  p := L.PRIMERO;
  L.INSERTA (17,p);
  L.INSERTA (8,p);
  L.INSERTA (4,p);
  L.INSERTA (3,p);
  L.INSERTA (3,p);
  L.INSERTA (3,p);
  L.INSERTA (2,p);
  L.INSERTA (2,p);
  L.INSERTA (2,p);
  L.INSERTA (1,p);
  L.IMPRIME ('Lista inicial ordenada');

  if not PURGA_ORD (L) then begin
     ERROR ('La lista no esta en orden!');
  end ; {if}
  L.IMPRIME ('Lista ordenada y purgada');
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}