arbbini.pas

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

  Representaci\'on de arboles binarios por cursores al
  padre e hijos. keywords: arbol binario

  FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: arbbini.pas v2 2002/04/05 13:20 mstorti Exp jdelia$  }

unit arbbini ;

interface

const
  nodos_max = 100;
  lambda    =   0;
type
  tipo_etiqueta = integer;
  tipo_arbol    = integer;
  tipo_nodo     = integer;

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

var
  nodos : array [1..nodos_max] of nodo;
  disp  : integer;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function PADRE    ( n: tipo_nodo) : tipo_nodo;
function HIJO_IZQ ( n: tipo_nodo) : tipo_nodo;
function HIJO_DER ( n: tipo_nodo) : tipo_nodo;
function ETIQUETA ( n: tipo_nodo) : tipo_etiqueta;
function CREA2    ( v: tipo_etiqueta;
                   a1: tipo_arbol;
                   a2: tipo_arbol) : tipo_arbol;
function  RAIZ    ( a: tipo_arbol) : tipo_nodo;
procedure ANULA   ( a: tipo_arbol);
procedure INICIALIZA_NODOS ;
procedure IMPRIME_NODOS;

implementation

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

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

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

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

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

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{devuelve 1 nvo arbol con raiz etiq v y subarboles a1 a2}
function CREA2 ( v: tipo_etiqueta;
                a1: tipo_arbol;
                a2: tipo_arbol ) : tipo_arbol;
var
  temp : tipo_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 RAIZ (a: tipo_arbol): tipo_nodo;
begin
  RAIZ := a ;
end ;

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

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

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