parcord.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION
  Se dice que un \'arbol binario es `parcialmente ordenado'
  (PO) si la etiqueta de cada nodo es menor o igual que las
  etiquetas de sus hijos. As\'\i\, por ejemplo, el \'arbol
  1(2,3(4,5)) es parcialmente ordenado, pero el 5(2,3(4,5))
  no lo es porque 5 es mayor que su hijo 2.
  Entonces, escribir una
  funci\'on `VERIFICA\_PO(n:nodo; A: Arbol): boolean' que
  retorna `true' si el sub\'arbol que cuelga del nodo n es
  parcialmente ordenado y `false' en caso contrario. Usar
  las primitivas del `TAD ARBOL BINARIO:', `HIJO\_IZQ(n,A)',
  `HIJO\_DER(n,A)', `ETIQUETA(n,A)'.
  [Tomado en el segundo parcial del cursado 2002, 28/5/2002]
  keywords: arbol binario
FIN DE DESCRIPCION }

{ Por simplicidad hemos usado arboles etiquetados con}
{ caracteres, tomando como relacion de orden el orden}
{ alfabetico usual. }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: parcord.pas 2002/05/22 19:59 mstorti Exp mstorti  $ }
program parcord ;
uses u_arbbii;
type
  bosque = bosque_arbbii ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function VERIF_PO (n: curs_nodo; a: bosque ): boolean ;
var
   c       : curs_nodo;
   ret_val : boolean;
begin
   if (n = lambda) then { lambda siempre verifica !! }
      ret_val := true
   else begin
      ret_val := true;
      { Verifica que el hijo izq. satisface y que todo su}
      { subarbol tambien (recursivamente) }
      c := a.HIJO_IZQ (n);
      if (c <> lambda) then
         ret_val := ret_val and VERIF_PO (c,a) and
         (a.ETIQUETA (n) <= a.ETIQUETA (c) );
      { Idem. hijo derecho }
      c := a.HIJO_DER (n);
      if (c <> lambda) then
         ret_val := ret_val and VERIF_PO (c,a) and
         (a.ETIQUETA (n) <= a.ETIQUETA (c));
   end; {if}
   VERIF_PO := ret_val;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
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 {then}
    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 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;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
   n : curs_nodo;
   B : bosque ; {El bosque donde estan los arboles }
begin
   B.INICIALIZA_NODOS ;
   n := CREA_DE_STRING ('a{b,c{d{0,f},e}}', B);
   IMPRIME_S (n, B);
   writeln('Es parcialmente ordenado? :', VERIF_PO (n,b));
   n := CREA_DE_STRING ('a{b,c{d{0,c},a}}', B);
   IMPRIME_S (n, B);
   writeln('Es parcialmente ordenado? :', VERIF_PO (n,b));
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}