tpu/u_arborr.pas

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

  Arbol ordenado y orientado de reales por cursores.
  keywords: arbol orientado, cursores

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

interface

const
  nodos_max = 100;
  lambda    = 0;

type

  tipo_etiqueta = reales ;
  curs_nodo     = integer;

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

  bosque_arborr = object
  private
    nodos : array [1..nodos_max] of nodo;
    disp  : curs_nodo;
    procedure ERROR (s : string);
    function  DISPONIBLE : curs_nodo;
  public
    procedure INICIALIZA_NODOS ;
    procedure IMPRIME_NODOS;
    function CREA0  ( v: tipo_etiqueta) : curs_nodo;
    function CREA1  ( v: tipo_etiqueta;
                     a1: curs_nodo ) : curs_nodo;
    function CREA2  ( v: tipo_etiqueta;
                     a1: curs_nodo;
                     a2: curs_nodo ) : curs_nodo;
    function CREA3  ( v: tipo_etiqueta;
                     a1: curs_nodo;
                     a2: curs_nodo;
                     a3: curs_nodo ) : curs_nodo;
    function CREA4  ( v: tipo_etiqueta;
                     a1: curs_nodo;
                     a2: curs_nodo;
                     a3: curs_nodo;
                     a4: curs_nodo ) : curs_nodo;
    function  RAIZ  (a: curs_nodo) : curs_nodo;
    procedure ANULA (a: curs_nodo) ;
    function  PADRE        (n: curs_nodo) : curs_nodo;
    function  HIJO_MAS_IZQ (n: curs_nodo) : curs_nodo;
    function  HERMANO_DER  (n: curs_nodo) : curs_nodo;
    function  ETIQUETA     (n: curs_nodo) : tipo_etiqueta;
    procedure IMPRIME      (n: curs_nodo);
    function  AGREGA_HIJO_MAS_IZQ
                           (a: curs_nodo;
                            x: tipo_etiqueta): curs_nodo;
    function  AGREGA_HERM_DER
                           (a: curs_nodo;
                            x: tipo_etiqueta): curs_nodo;
    end;

  implementation

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

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

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

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.HERMANO_DER (n: curs_nodo): curs_nodo;
begin
  HERMANO_DER := nodos [n].herm_der;
end;

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.CREA0 (v: tipo_etiqueta): curs_nodo;
var
  temp : curs_nodo;
begin
  temp := DISPONIBLE;
  nodos [temp].etiqueta := v;
  nodos [temp].herm_der := lambda;
  nodos [temp].hijo_izq := lambda;
  CREA0 := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.CREA1 ( v: tipo_etiqueta;
                              a1: curs_nodo): curs_nodo;
var
  temp : curs_nodo;
begin
  temp := DISPONIBLE;
  nodos [temp].etiqueta := v;
  nodos [temp].herm_der := lambda;
  nodos [temp].hijo_izq := a1;
  nodos [a1].padre      := temp;
  nodos [a1].herm_der   := lambda;
  CREA1 := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.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].herm_der := lambda;
  nodos [temp].hijo_izq := a1;
  nodos [a1].padre      := temp;
  nodos [a1].herm_der   := a2;
  nodos [a2].padre      := temp;
  nodos [a2].herm_der   := lambda;
  CREA2 := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.CREA3 ( v: tipo_etiqueta;
                              a1: curs_nodo;
                              a2: curs_nodo;
                              a3: curs_nodo) : curs_nodo;
var
  temp : curs_nodo;
begin
  temp := DISPONIBLE;
  nodos [temp].etiqueta := v;
  nodos [temp].herm_der := lambda;
  nodos [temp].hijo_izq := a1;
  nodos [a1].padre      := temp;
  nodos [a1].herm_der   := a2;
  nodos [a2].padre      := temp;
  nodos [a2].herm_der   := a3;
  nodos [a3].padre      := temp;
  nodos [a3].herm_der   := lambda;
  CREA3 := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.CREA4 ( v: tipo_etiqueta;
                              a1: curs_nodo;
                              a2: curs_nodo;
                              a3: curs_nodo;
                              a4: curs_nodo ): curs_nodo;
var
  temp : curs_nodo;
begin
  temp := DISPONIBLE;
  nodos [temp].etiqueta := v;
  nodos [temp].herm_der := lambda;
  nodos [temp].hijo_izq := a1;
  nodos [a1].padre      := temp;
  nodos [a1].herm_der   := a2;
  nodos [a2].padre      := temp;
  nodos [a2].herm_der   := a3;
  nodos [a3].padre      := temp;
  nodos [a3].herm_der   := a4;
  nodos [a4].padre      := temp;
  nodos [a4].herm_der   := lambda;
  CREA4 := temp;
end;

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure bosque_arborr.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].herm_der <> lambda) then
    ANULA ( nodos [a].herm_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
      curs_n := nodos [curs_n].hijo_izq;
      while (nodos [curs_n].herm_der <> a) do begin
        curs_n := nodos [curs_n].herm_der
      end ; {while}
      nodos [curs_n].herm_der := lambda;
    end ; {if}
  end ; {if}
  nodos [a].hijo_izq := lambda;
  nodos [a].herm_der := disp;
  nodos [a].padre    := lambda;
  nodos [a].etiqueta := lambda;
  disp := a;
end;

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

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.AGREGA_HIJO_MAS_IZQ
                      (a: curs_nodo;
                       x: tipo_etiqueta): curs_nodo;
var
  temp: curs_nodo;
begin
  temp := DISPONIBLE;
  nodos [temp].etiqueta := x;
  nodos [temp].hijo_izq := lambda;
  nodos [temp].herm_der := nodos [a].hijo_izq;
  nodos [temp].padre := a;
  nodos [a].hijo_izq := temp;
  AGREGA_HIJO_MAS_IZQ := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function bosque_arborr.AGREGA_HERM_DER
                      (a: curs_nodo;
                       x: tipo_etiqueta): curs_nodo;
var
  temp:  curs_nodo;
begin
  temp := DISPONIBLE;
  nodos [temp].etiqueta := x;
  nodos [temp].hijo_izq := lambda;
  nodos [temp].padre := nodos [a].padre;
  nodos [temp].herm_der := nodos [a].herm_der;
  nodos [a].herm_der :=temp;
  AGREGA_HERM_DER := temp;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure bosque_arborr.IMPRIME (n: curs_nodo);
var
   c: curs_nodo;
begin
   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;

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