tpu/u_arbbii.pas

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

  Arboles binarios de enteros por cursores.
  keywords: arbol binario, cursores

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

unit u_arbbii;

interface

const
  nodos_max = 100;
  lambda    =   0;

type
  tipo_etiqueta = integer;
  tipo_arbol    = integer;
  curs_nodo     = integer;

  nodo = record
    hijo_izq, hijo_der, padre : curs_nodo;
    etiqueta                  : tipo_etiqueta
  end;

  bosque_arbbii = object
  private
    nodos : array [1..nodos_max] of nodo;
    disp  : integer ;
    procedure ERROR (s: string);
    function  DISPONIBLE : integer;
  public
    function PADRE    ( n: curs_nodo) : curs_nodo;
    function HIJO_IZQ ( n: curs_nodo) : curs_nodo;
    function HIJO_DER ( n: curs_nodo) : curs_nodo;
    function ETIQUETA ( n: curs_nodo) : tipo_etiqueta;
    function CREA2    ( v: tipo_etiqueta;
                       a1: curs_nodo;
                       a2: curs_nodo) : curs_nodo;
    function  RAIZ    ( a: curs_nodo) : curs_nodo;
    procedure ANULA   ( a: curs_nodo);
    procedure INICIALIZA_NODOS;
    procedure IMPRIME_NODOS;
    function LIBRE : integer;
  end;

implementation

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.DISPONIBLE : integer;
begin
   DISPONIBLE := disp;
   disp       := nodos[disp].hijo_der;
   if (disp = lambda) then begin
     ERROR ('no hay mas celdas disponibles')
   end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.libre : integer;
var
  aux : integer;
begin
  libre := 0;
  aux := disp;
  while (aux <> 0) do begin
    libre := libre + 1;
    aux := nodos [aux].hijo_der;
  end; {while}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.PADRE (n: curs_nodo): curs_nodo;
begin
  PADRE := nodos [n].padre;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.HIJO_IZQ (n: curs_nodo): curs_nodo;
begin
  HIJO_IZQ := nodos [n].hijo_izq;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.HIJO_DER (n: curs_nodo): curs_nodo;
begin
  HIJO_DER := nodos [n].hijo_der;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.ETIQUETA (n: curs_nodo):tipo_etiqueta;
begin
  ETIQUETA := nodos [n].etiqueta;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.CREA2 (v	 : tipo_etiqueta;
			      a1 : curs_nodo;
			      a2 : curs_nodo ): curs_nodo;
{devuelve un nuevo arbol con raiz etiqueta v,
 y subarboles a1, a2}
var
  temp	: curs_nodo;
begin	
  temp := DISPONIBLE;
  nodos [temp].etiqueta := v;
  nodos [temp].hijo_izq := a1;
  nodos [temp].hijo_der := a2;
  if (a1 <> lambda) then nodos [a1].padre := temp;
  if (a2 <> lambda) then nodos [a2].padre := temp;
  CREA2 := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbii.RAIZ (a: curs_nodo): curs_nodo;
begin
  RAIZ := a;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure bosque_arbbii.ANULA (a: curs_nodo);
var
  curs_n : curs_nodo;
begin	   
  if (nodos [a].hijo_izq <> lambda) then
    ANULA (nodos [A].hijo_izq);
  if (nodos [a].hijo_der <> lambda) then
    ANULA (nodos [A].hijo_der);
  if (nodos [a].padre <> lambda) then begin
    curs_n := nodos [a].padre;
    if (nodos [curs_n].hijo_izq = a) then
      nodos [curs_n].hijo_izq := lambda
    else begin
      nodos [curs_n].hijo_der := lambda
    end ; {if}
  end ; {if}
  nodos [a].hijo_izq := lambda;
  nodos [a].hijo_der := disp;
  nodos [a].padre    := lambda;
  nodos [a].etiqueta := lambda;
  disp := a;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure bosque_arbbii.INICIALIZA_NODOS;
var
  i : integer;
begin
  for i := 1 to nodos_max do begin
    nodos [i].hijo_der := i+1;
    nodos [i].hijo_izq := lambda;
    nodos [i].padre    := lambda;
    nodos [i].etiqueta := lambda;
  end;
  nodos [nodos_max].hijo_der := lambda;
  disp := 1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure bosque_arbbii.IMPRIME_NODOS;
var
  i : integer;
begin
   for i:=1 to nodos_max do
    writeln (' celda, hi, hd, p, etiq ', i,
	     nodos [i].hijo_izq, nodos [i].hijo_der,
	     nodos [i].padre,    nodos [i].etiqueta);
end;

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