tpu/u_arborip.pas

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

  Arbol ordenado y orientado de enteros por punteros. Esta
  implementaci\'on introduce primitivas adicionales para
  crear y modificar \'arboles. Las rutinas CREAi son muy
  ``rigidas'' para crear arboles entonces se proponen las
  funciones AGREGA_HIJO_MAS_IZQ, AGREGA_HERM_DER,
  CORTA_PEGA_HIJO_MAS_IZQ y CORTA_PEGA_HERM_DER que
  permiten crear y modificar el \'arbol en una forma
  mucho mas \'agil.
  keywords: arbol orientado, punteros

  FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_arborip.pas 2002/04/26 12:25 mstorti Exp mstorti $ }
 
unit u_arborip;

interface

const
  lambda = nil;
	     
type 
  tipo_etiqueta = integer;
  pcelda        = ^celda;
  nodo          = pcelda;
   
  celda = record
    hj_mas_izq, herm_der, padre : nodo;
    etiqueta		        : tipo_etiqueta
  end;			       

  procedure ERROR (s : string);

type
  arborip = object
  private
    cab : nodo;
    procedure CORTA (n : nodo);
  public
    procedure INICIALIZA;
    function  RAIZ: nodo;
    procedure ANULA (n: nodo) ;
    function  PADRE (n: nodo) : nodo;
    function  HIJO_MAS_IZQ (n: nodo): nodo;
    function  HERMANO_DER  (n: nodo): nodo;
    function  ETIQUETA     (n: nodo): tipo_etiqueta;
    procedure IMPRIME      (n: nodo; s: string);
    procedure IMPRIME_ARB  (s: string);
    procedure CREA0 (v: tipo_etiqueta) ;
    procedure CREA1 (v: tipo_etiqueta; a1: nodo ) ;
    procedure CREA2 (v: tipo_etiqueta; a1,a2: nodo ) ;
{   procedure CREA3 (v: tipo_etiqueta; a1,a2,a3) ;}
{   procedure CREA4 (v: tipo_etiqueta; a1,a2,a3,a4 : nodo) ;}
    function  AGREGA_HIJO_MAS_IZQ (x: tipo_etiqueta;
                                   n: nodo): nodo;
    function  AGREGA_HERM_DER     (x: tipo_etiqueta;
                                   n: nodo): nodo;
    procedure CORTA_PEGA_HIJO_MAS_IZQ (A: arborip;
         			       m, n: nodo);
    procedure CORTA_PEGA_HERM_DER     (A: arborip;
          			       m, n: nodo);
  end ;
  
implementation

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ERROR (s: string);
begin
  write ('error: ');
  writeln (s);
  halt;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function arborip.PADRE (n: nodo): nodo;
begin
   PADRE := n^.padre ;
   if (PADRE = cab) then PADRE := lambda;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function arborip.HIJO_MAS_IZQ (n :nodo): nodo;
begin
  HIJO_MAS_IZQ := n^.hj_mas_izq;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function arborip.HERMANO_DER (n: nodo): nodo;
begin
  HERMANO_DER := n^.herm_der;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function arborip.ETIQUETA (n: nodo): tipo_etiqueta;
begin
  ETIQUETA := n^.etiqueta;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function arborip.RAIZ : nodo;
begin
   RAIZ := cab^.hj_mas_izq;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.INICIALIZA;
begin
   if (cab = nil)  then new (cab);
   cab^.padre := lambda;
   cab^.hj_mas_izq := lambda;
   cab^.herm_der   := lambda;
   cab^.etiqueta   := 0;
end; { arborip }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.CORTA (n: nodo);
var
   p, c: nodo;
begin
   { Corta `m' del arbol `A' }
   p := n^.padre;
   if ( p^.hj_mas_izq = n ) then
      p^.hj_mas_izq := n^.herm_der
   else begin
      { Busca el hermano izquierdo } 
      c := p^.hj_mas_izq;
      while ( c^.herm_der <> n) do begin
	c := c^.herm_der;
      end ; {while}
      c^.herm_der := n^.herm_der;
   end; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.ANULA (n : nodo) ;
var
   c, q :  nodo;
begin
   INICIALIZA ;
   if (n = lambda) then exit;
   c := hijo_mas_izq (n);
   while c <> lambda do begin
      q := hermano_der (c);
      ANULA (c);
      c := q;
   end; {while}
   CORTA (n);
   dispose (n);
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function arborip.AGREGA_HIJO_MAS_IZQ (x: tipo_etiqueta;
                                      n: nodo): nodo;
var
   temp	: nodo;
begin
   if (n = lambda) then n := cab;
   new (temp);
   temp^.etiqueta   := x;
   temp^.hj_mas_izq := lambda;
   temp^.herm_der   := n^.hj_mas_izq;
   temp^.padre      := n;
   n^.hj_mas_izq    := temp;
   AGREGA_HIJO_MAS_IZQ := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function arborip.AGREGA_HERM_DER (x: tipo_etiqueta;
                                  n: nodo): nodo;
var
  temp : nodo;
begin
   new (temp);
   temp^.etiqueta   := x;
   temp^.hj_mas_izq := lambda;
   temp^.padre      := n^.padre;
   temp^.herm_der   := n^.herm_der;
   n^.herm_der      := temp;
   AGREGA_HERM_DER  := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.IMPRIME_ARB (s: string) ;
begin
   IMPRIME (cab^.hj_mas_izq, s);
   writeln;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.IMPRIME (n: nodo; s: string);
var
   c : nodo;
begin
   if length (s) > 0 then write (s);
   if (n = lambda) then exit;
   write ( ETIQUETA (n),' ');
   c := HIJO_MAS_IZQ (n);
   if ( c = lambda) then exit;
   write ('{ ');
   while (c <> lambda) do begin
     IMPRIME (c,'');
     c := HERMANO_DER (c);
   end; {while}
   write ('} ');
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ Corta el subarbol que cuelga del nodo `m' en              }
{ el arbol `A' y lo pega como hijo mas izquierdo de `n'     }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure  arborip.CORTA_PEGA_HIJO_MAS_IZQ (A   : arborip;
				            m, n: nodo);
begin
   CORTA (m);
   if (n = lambda) then n := cab;
   m^.herm_der := n^.hj_mas_izq;
   m^.padre := n;
   n^.hj_mas_izq := m;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ Corta el subarbol que cuelga del nodo `m' en
el arbol `A' y lo pega como hermano derecho de `n' }
procedure  arborip.CORTA_PEGA_HERM_DER (A: arborip;
					m, n: nodo);
begin
   CORTA (m);
   if (n = lambda) then n := cab;
   m^.herm_der := n^.herm_der;
   n^.herm_der := m;
   m^.padre := n^.padre;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.CREA0 (v : tipo_etiqueta);
var
   temp	: pcelda;
begin
   inicializa;
   new(temp);
   cab^.hj_mas_izq := temp;

   temp^.padre := cab;
   temp^.hj_mas_izq := lambda;
   temp^.herm_der := lambda;
   temp^.etiqueta := v;
   
end; { arborip }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.CREA1 (v: tipo_etiqueta; a1 : nodo );
var
   temp	: pcelda;
begin
   INICIALIZA;
   new (temp);
   cab^.hj_mas_izq := temp;

   CORTA (a1);
   temp^.padre := cab;
   temp^.hj_mas_izq := a1;
   temp^.herm_der := lambda;
   temp^.etiqueta := v;
   
   a1^.padre := temp;
   a1^.herm_der := lambda;
end; { arborip }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure arborip.CREA2 (v: tipo_etiqueta; a1, a2 : nodo);
var
   temp	: pcelda;
begin
   inicializa;
   new (temp);
   cab^.hj_mas_izq := temp;

   corta (a1);
   corta (a2);
   temp^.padre := cab;
   temp^.hj_mas_izq := a1;
   temp^.herm_der := lambda;
   temp^.etiqueta := v;

   a1^.padre := temp;
   a1^.herm_der := a2;
   
   a2^.padre := temp;
   a2^.herm_der := lambda;
end; { arborip }

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