tpu/u_setlis.pas

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

  Conjuntos como listas. keywords: lista, conjunto

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_setlis.pas,v 1.1 2002/04/25 15:57:09 mstorti Exp mstorti $}
 
unit u_setlis;

interface

uses u_listpi ;

type

setlis = object
  private
    LL : listpi;
  public
    procedure INSERTA (c: tipo_elemento);
    procedure SUPRIME (c: tipo_elemento);
    procedure ANULA;
    procedure IMPRIME (s: string);
    function  MIEMBRO (c: tipo_elemento) : boolean;
    procedure UNION        (A, B: setlis);
    procedure INTERSECCION (A, B: setlis);
    procedure DIFERENCIA   (A, B: setlis);
end;

implementation

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure setlis.INSERTA (c: tipo_elemento);
var
  x : tipo_elemento;
  p : posicion;
label
  999;
begin
  p  := LL.PRIMERO;
  while (p <> LL.FIN) do begin
    x := LL.RECUPERA (p);
    if (x >  c) then LL.INSERTA (c,p);
    if (x >= c) then goto 999 ;
    p := LL.SIGUIENTE (p);
  end; {while}
  LL.INSERTA (c,p);
  999:
end; { setlis.INSERTA }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure setlis.SUPRIME (c: tipo_elemento);
var
  p: posicion;
begin
  p := LL.LOCALIZA (c);
  if ( p <> LL.FIN ) then LL.SUPRIME (p);
end; { setlis.SUPRIME }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure setlis.ANULA;
begin
  LL.ANULA;
end; { setlis.ANULA }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function setlis.MIEMBRO (c: tipo_elemento) : boolean;
var
  p: posicion;
begin
  p       := LL.LOCALIZA (c);
  MIEMBRO := (p <> LL.FIN);
end; { setlis.SUPRIME }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure setlis.IMPRIME (s: string);
begin
  LL.IMPRIME (s);
  writeln;
end; { setlis.IMPRIME }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure setlis.UNION (A, B: setlis);
var
  pa, pb : posicion;
  xa, xb : tipo_elemento;
begin
  ANULA;
  pa := A.LL.PRIMERO;
  pb := B.LL.PRIMERO;
  while (pa <> A.LL.FIN) and (pb <> B.LL.FIN) do begin
    xa := A.LL.RECUPERA (pa);
    xb := B.LL.RECUPERA (pb);
    if (xa < xb ) then
      LL.INSERTA (xa, LL.FIN)
    else begin
      LL.INSERTA (xb, LL.FIN)
    end ; {if}
    if (xa <= xb) then pa := A.LL.SIGUIENTE (pa);
    if (xa >= xb) then pb := B.LL.SIGUIENTE (pb);
  end ; {while}

  while (pb <> B.LL.FIN) do begin
    LL.INSERTA (B.LL.RECUPERA (pb), LL.FIN);
    pb := B.LL.SIGUIENTE (pb);
  end; {while}

  while (pa <> A.LL.FIN) do begin
    LL.INSERTA (A.LL.RECUPERA (pa), LL.FIN);
    pa := A.LL.SIGUIENTE (pa);
  end; {while}
end; { setlis.UNION }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure setlis.INTERSECCION (A, B: setlis);
var
  pa, pb : posicion;
  xa, xb : tipo_elemento;
begin
  ANULA;
  pa := A.LL.PRIMERO;
  pb := B.LL.PRIMERO;
  while (pa <> A.LL.FIN) and (pb <> B.LL.FIN) do begin
    xa := A.LL.RECUPERA (pa);
    xb := B.LL.RECUPERA (pb);
    if (xa =  xb) then LL.INSERTA (xa, LL.FIN);
    if (xa <= xb) then pa := A.LL.SIGUIENTE (pa);
    if (xa >= xb) then pb := B.LL.SIGUIENTE (pb);
  end; {while}
end; { setlis.INTERSECCION }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure setlis.DIFERENCIA (A, B: setlis);
var
  pa, pb : posicion;
  xa, xb : tipo_elemento;
begin
  ANULA;
  pa := A.LL.PRIMERO;
  pb := B.LL.PRIMERO;
  while (pa <> A.LL.FIN) and (pb <> B.LL.FIN) do begin
    xa := A.LL.RECUPERA (pa);
    xb := B.LL.RECUPERA (pb);
    if (xa <  xb ) then LL.INSERTA (xa, LL.FIN);
    if (xa <= xb ) then pa := A.LL.SIGUIENTE (pa);
    if (xa >= xb ) then pb := B.LL.SIGUIENTE (pb);
  end; {while}

  while (pa <> A.LL.FIN) do begin
    LL.INSERTA (A.LL.RECUPERA (pa), LL.FIN);
    pa := A.LL.SIGUIENTE (pa);
  end ; {while}
end; { setlis.DIFERENCIA }

end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}