aritme_arb.pas

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

  Evalua expresiones algebraicas: primero genera el
  \'arbol binario para una expresi\'on algebraica
  ingresada por teclado y luego la calcula.
  keywords: arbol binario

  FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: aritme_arb.pas 2002/04/05 11:00 mstorti Exp jdelia$ }

program aritme_arb;

uses u_colexp, u_arbbir; {Cola de Expresiones, Arbol Binario}

const
  debug = false;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function EXPRESION (var c: colexp;
                    var a: bosque_arbbir): arbbir; forward;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function ANAL_SINT (var s: string; var C: colexp): boolean ;
var
  i, code: integer;
  s1     : string;
  r      : real;
begin
  C.ANULA;
  s1 := '';
  s  := s + ' ';
  ANAL_SINT := true;
  for i:= 1 to length (s) do begin
    case s [i] of
    '0' .. '9','.':
       s1 := s1 + s [i] ;
    '*', '-', '+', '/', '(', ')', ' ':
       begin {caso simbolos}
       if ( length (s1) > 0 ) then begin
         val (s1, r, code) ;
         if ( code <> 0 ) then
           begin
           ANAL_SINT := false;
           break;
           end
         else begin
           C.PONE (r, true);
           s1 := '' ;
         end ; {if}
       end ; {if}
       if (s [i] <> ' ') then C.PONE (ord (s [i]), false);
       end ; {caso simbolos}
    else
       begin
       ANAL_SINT := false;
       break;
       end
    end ; {case}
  end ; {i}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function OPERACION (const a: real; const b: char): boolean;
begin
  operacion := ( round (a) = ord (b) ) ;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function FACTOR (var C: colexp; var A: bosque_arbbir): arbbir;
var
  oper : real;
begin
  if ( C.FRENTE2 ) then
     begin
     FACTOR := A.CREA2 (C.FRENTE1, lambda, lambda);
     C.QUITA;
     end
  else begin
     if OPERACION (C.FRENTE1, '(') then C.QUITA;
     factor := EXPRESION (C, A);
     if OPERACION (C.FRENTE1, ')') then C.QUITA;
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function TERMINO (var C: colexp;
                  var A: bosque_arbbir): arbbir;
var
  oper   : real;
  A1, A2 : arbbir;
begin
  A1 := FACTOR (C,A);
  while not C.VACIA and not C.FRENTE2 and
    (OPERACION (C.FRENTE1,'*') or OPERACION (C.FRENTE1,'/'))
    do begin
    oper := C.FRENTE1;
    C.QUITA;
    A2 := FACTOR (C, A);
    A1 := A.CREA2 (oper, A1, A2);
  end; {while}
  TERMINO := A1;
end; { TERMINO }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function EXPRESION (var C: colexp;
                    var A: bosque_arbbir): arbbir;
var
  oper  : real;
  A1, A2: arbbir;
begin
  if not C.FRENTE2 and
    ( OPERACION (C.FRENTE1,'-') or
      OPERACION (C.FRENTE1,'+')    ) then
    A1 := A.CREA2(0., lambda, lambda)
  else begin
    A1 := TERMINO (C,A)
  end ; {if}

  while not C.VACIA and not C.FRENTE2  and
    ( OPERACION (C.FRENTE1,'+') or
      OPERACION (C.FRENTE1,'-') )
    do begin
    oper := C.FRENTE1;
    C.QUITA;
    A2 := TERMINO (C,A);
    A1 := A.CREA2 (oper,A1,A2);
  end; {while}
  EXPRESION := A1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ORD_POST (arbol: arbbir; A: bosque_arbbir);
begin
  if ( arbol <> lambda) then begin
     ORD_POST (A.HIJO_IZQ (arbol), A);
     ORD_POST (A.HIJO_DER (arbol), A);
     writeln  (A.ETIQUETA (arbol)) ;
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function EVALUA (Arbol: arbbir; A: bosque_arbbir): real;
var
  A1, A2: real;
  oper  : integer;
begin
  if A.HIJO_IZQ (Arbol) <> lambda then
    begin
    A1   := evalua (A.HIJO_IZQ (Arbol), A);
    oper := round  (A.ETIQUETA (Arbol));
    A2   := EVALUA (A.HIJO_DER (Arbol), A);
    case oper of
      Ord ('+'): evalua := A1 + A2;
      Ord ('-'): evalua := A1 - A2;
      Ord ('*'): evalua := A1 * A2;
      Ord ('/'): evalua := A1 / A2;
    end ;
    end
  else begin
    evalua := A.ETIQUETA (Arbol);
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
   C     : colexp;
   A     : bosque_arbbir;
   Arbol : arbbir;
   s     : string;
begin
   A.INICIALIZA_NODOS;
   write (' > ');
   readln (s);
   while length (s) > 0 do begin
      if ( ANAL_SINT (s,C) ) then
         begin
         if (debug) then C.IMPRIME;
         Arbol := EXPRESION (C,A);
         if (debug) then A.IMPRIME_NODOS;
         if (debug) then Ord_Post (Arbol,A);
         writeln (evalua (Arbol,A));
         A.ANULA (Arbol);
         end
      else begin
         writeln ('Error en la expresion')
      end ; {if}
      write (' > ');
      readln (s);
   end; {while}
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}