oparboles.pas

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

Diversas operaciones con \'arboles binarios:
CREA_DE_STRING: permite ingresar \'arboles con
                ``a(b,c(d,r))'';
IMPRIME_S:      imprime en el mismo formato;
SEMEJANTE:      determina si la estructura de dos \'arboles
                es la misma;
ES_ESPEJO:      determina si la estructura de un \'arbol es
                la espejada de otro;
IGUALES:        determina si dos \'arboles son iguales,
                en estructura y contenido;
INCLUIDO:       determina si la estructura de un \'arbol
                est\'a contenido en la de otro;
COPIA:          copia un \'arbol en otro;
COPIA_ESPEJO:   copia un \'arbol en otro en forma espejada;
INTERSECCION:   determina aquella parte de la estructura
                que es com\'un a dos \'arboles.
keywords: arbol binario

  FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: oparboles.pas 2002/04/30 11:00 mstorti Exp jdelia $ }
program oparboles ;
uses u_arbbii;
type
  bosque = bosque_arbbii ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function SIGUIENTE_FICHA (var pos: integer; s: string): char;
begin
   SIGUIENTE_FICHA := s [pos];
   pos := pos + 1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure DEVUELVE_FICHA (var pos: integer; s: string);
begin
   pos := pos - 1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function CREA_DE_STRING_REC (s : string;
                             var bos: bosque;
                             var pos: integer): curs_nodo ;
var
  eti    : integer;
  f, aux : char;
  n1, n2 : curs_nodo;
begin
  f := SIGUIENTE_FICHA (pos,s);
  if (f = '0') then
    CREA_DE_STRING_REC := Lambda
  else if (f in ['a'..'z']) then
    begin
    eti := ord (f);
    aux := SIGUIENTE_FICHA (pos,s);
    if (aux ='{') then
      begin
      n1 := CREA_DE_STRING_REC (s, bos, pos);
      aux:= SIGUIENTE_FICHA (pos,s);
      if (aux <> ',') then begin
        writeln('No puede encontrar ","');
        exit;
      end; {if}
      n2 := CREA_DE_STRING_REC (s, bos, pos);
      aux:= SIGUIENTE_FICHA (pos,s);
      if (aux <>'}') then begin
         writeln ('No puede encontrar ","');
         exit;
      end; {if}
      CREA_DE_STRING_REC := bos.CREA2 (eti,n1,n2);
      end
    else begin
      DEVUELVE_FICHA (pos,s);
      CREA_DE_STRING_REC := bos.CREA2 (eti, Lambda, Lambda);
    end ; {if}
  end ; {if}
end; { CREA_DE_STRING_REC }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function CREA_DE_STRING (s: string;
                         var bos: bosque): curs_nodo ;
var
  pos : integer;
begin
  pos := 1;
  CREA_DE_STRING := CREA_DE_STRING_REC (s,bos,pos);
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ORD_PREV (n: curs_nodo; b: bosque);
begin
  if (n = Lambda) then exit;
  writeln ( chr (b.ETIQUETA (n)),' ');
  ORD_PREV (b.HIJO_IZQ (n),b);
  ORD_PREV (b.HIJO_DER (n),b);
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure IMPRIME_S (n: curs_nodo; b: bosque);
var
  mi, md: curs_nodo;
begin
  if (n = Lambda) then begin
    write('0');
    exit;
  end; {if}
  write ( chr ( b.ETIQUETA (n) ));
  mi := b.HIJO_IZQ (n);
  md := b.HIJO_DER (n);
  if ( mi <> Lambda ) or ( md <> Lambda ) then begin
    write('{');
    IMPRIME_S (mi,b);
    write (',');
    IMPRIME_S (md,b);
    write ('}');
  end; {if}
  if ( b.PADRE (n) = Lambda) then writeln ('');
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function SEMEJANTE (n1, n2: curs_nodo; b: bosque): boolean;
begin
  if      (n1 <> Lambda) xor (n2 <> Lambda) then
     SEMEJANTE := false
  else if (n1 = Lambda) then
     SEMEJANTE := true
  else begin
     SEMEJANTE :=
     SEMEJANTE ( b.HIJO_IZQ (n1), b.HIJO_IZQ (n2), b) and
     SEMEJANTE ( b.HIJO_DER (n1), b.HIJO_DER (n2), b)
  end ; {if}
end;

   {-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure SEMEJANTE_W (n1, n2: curs_nodo; B: bosque);
begin
  if SEMEJANTE (n1, n2, B) then
    writeln ('Son semejantes!! :-) ')
  else begin
    writeln ('No son semejantes!! :-((')
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function ES_ESPEJO (n1, n2: curs_nodo; B: bosque): boolean;
begin
  if       (n1 <> Lambda) xor (n2 <> Lambda) then
    ES_ESPEJO := false
  else if (n1 = Lambda) then
    ES_ESPEJO := true
  else begin
    ES_ESPEJO :=
    ES_ESPEJO (B.HIJO_IZQ (n1), B.HIJO_DER (n2), B) and
    ES_ESPEJO (B.HIJO_DER (n1), B.HIJO_IZQ (n2), B)
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ES_ESPEJO_W (n1, n2: curs_nodo; B: bosque);
begin
  if ES_ESPEJO (n1, n2, B) then
    writeln ('Es el espejo!! :-)')
  else begin
    writeln('No es el espejo!! :-((')
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function IGUALES (n1, n2: curs_nodo; B: bosque): boolean;
begin
  if      (n1 <> Lambda) xor (n2<>Lambda) then
    IGUALES := false
  else if (n1 = Lambda) then
    IGUALES := true
  else if B.ETIQUETA (n1) <> B.ETIQUETA (n2) then
    IGUALES := false
  else begin
    IGUALES :=
    IGUALES (B.HIJO_IZQ (n1), B.HIJO_IZQ (n2), B) and
    IGUALES (B.HIJO_DER (n1), B.HIJO_DER (n2), B)
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure IGUALES_W (n1, n2: curs_nodo; B: bosque);
begin
 if IGUALES (n1, n2, B) then
   writeln ('Son iguales!! :-)')
 else begin
   writeln ('No son iguales!! :-((');
 end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function INCLUIDO (n1, n2: curs_nodo; B: bosque) : boolean;
begin
  if      (n1 = Lambda) then
    INCLUIDO := true
  else if (n2 = Lambda) then
    INCLUIDO := false
  else begin
    INCLUIDO :=
    INCLUIDO (B.HIJO_IZQ (n1), B.HIJO_IZQ (n2), B) and
    INCLUIDO (B.HIJO_DER (n1), B.HIJO_DER (n2), B)
  end ;{if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure INCLUIDO_W (n1, n2 : curs_nodo; B: bosque);
begin
  if INCLUIDO (n1,n2,B) then
    writeln ('Esta incluido!! :-)')
  else begin
    writeln ('NO esta incluido!! :-((')
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function COPIA (n: curs_nodo; var B: bosque): curs_nodo;
var
  nuevo_hi, nuevo_hd : curs_nodo;
begin
  if (n = Lambda) then
    COPIA := Lambda
  else begin
    nuevo_hi := COPIA (B.HIJO_IZQ (n), B);
    nuevo_hd := COPIA (B.HIJO_DER (n), B);
    COPIA := B.CREA2 (B.ETIQUETA (n), nuevo_hi, nuevo_hd)
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function COPIA_ESPEJO (    n: curs_nodo;
                       var B: bosque): curs_nodo;
var
  nuevo_hi, nuevo_hd : curs_nodo;
begin
  if (n = Lambda) then
    COPIA_ESPEJO := Lambda
  else begin
    nuevo_hi := COPIA_ESPEJO (B.HIJO_DER (n), B);
    nuevo_hd := COPIA_ESPEJO (B.HIJO_IZQ (n), B);
    COPIA_ESPEJO := B.CREA2 (B.ETIQUETA(n),nuevo_hi,nuevo_hd)
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function INTERSECCION (n1, n2: curs_nodo;
                        var B: bosque): curs_nodo;
var
  nuevo_hi, nuevo_hd : curs_nodo;
begin
  if (n1 = Lambda) or (n2 = Lambda) then
    INTERSECCION := Lambda
  else begin
    nuevo_hi := INTERSECCION (B.HIJO_IZQ (n1),
                              B.HIJO_IZQ (n2), B);
    nuevo_hd := INTERSECCION (B.HIJO_DER (n1),
                              B.HIJO_DER (n2), B);
    INTERSECCION := B.CREA2  (B.ETIQUETA (n1),
                             nuevo_hi, nuevo_hd)
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
  n1, n2 : curs_nodo;
  n3, n4 : curs_nodo;
  B      : bosque ; {El bosque donde estan los arboles }
begin
   B.INICIALIZA_NODOS ;
   n1 := CREA_DE_STRING ('a{b,c{d{0,f},e}}', B);
   IMPRIME_S (n1, B);

   n2 := CREA_DE_STRING ('q{k,l{d{0,m},p}}', B);
   SEMEJANTE_W (n1, n2, B); { SI son semejantes ...  }

   IGUALES_W   (n1, n2, B); { NO son iguales ...  }

   B.ANULA (n2);
   n2 := CREA_DE_STRING ('q{k,l{d{r,m},p}}', B);
   SEMEJANTE_W (n1, n2, B); { NO son semejantes }
   INCLUIDO_W  (n1, n2, B); { Esta incluido!! :-) }

   B.ANULA (n2);
   n2 := CREA_DE_STRING ('q{k,l{0,p{q,r}}}', B);
   INCLUIDO_W (n1, n2, B); { NO esta incluido!! :-(( }

   n3 := COPIA (n2, B);
   B.ANULA (n2);
   IMPRIME_S (n3, B); { La copia sigue existiendo en n3 }

   B.ANULA (n3);
   n2 := CREA_DE_STRING ('q{k,l{0,p{q,r}}}', B);
   n3 := COPIA_ESPEJO (n2, B);
   IMPRIME_S (n3, B); { Copia espejada }

   ES_ESPEJO_W (n2, n3, B); {Es el espejo ... }
   ES_ESPEJO_W (n2, n2, B); {Falso porque no es simetrico}

   n4 := INTERSECCION (n2, n3, B);
   IMPRIME_S   (n4, B);
   ES_ESPEJO_W (n4, n4, B);
   { Verdadero: porque n4 es la interseccion de n2 con su
     espejo y por lo tanto es simetrico }
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}