tpu/u_arbbir.pas

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

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

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

interface

const
  nodos_max = 20;
  lambda    = 0;

type
  tipo_etiqueta = real;
  tipo_arbol    = integer;
  curs_nodo     = integer;
  arbbir        = curs_nodo;

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

  bosque_arbbir = 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;
  end;

  implementation

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbir.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_arbbir.PADRE (n: curs_nodo): curs_nodo;
begin
  PADRE := nodos [n].padre;
end;

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

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

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arbbir.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_arbbir.RAIZ (a: curs_nodo): curs_nodo;
begin
  RAIZ := a;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure bosque_arbbir.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_arbbir.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 ; {for}
  nodos [nodos_max].hijo_der := lambda;
  disp := 1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure bosque_arbbir.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 ; {for}
end;

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