---------------------------------------------------------------------
-- P a r s e E x p r e s s i o n T o T r e e (Spec)
--
-- Evaluates an arithmetic expression and concerts to to a binary tree.
--
-- AUTHOR: Michael Vorburger, 4.6.96
--         for Cours Progammation II, Coray, EPFL-CH
--
---------------------------------------------------------------------

with Symbols;
with Trees;

package ParseExpressionToTree is

     INTERNAL_ERROR:     exception;
     EQUAL_EXPECTED:     exception;
     FACTOR_EXPECTED:    exception;
     UNKNOWN_IDENTIFIER: exception;
     RIGHT_PAR_EXPECTED: exception;
     LEFT_PAR_EXPECTED:  exception;
     DIVISION_BY_ZERO:   exception;


     package SymbolTree is new Trees(Symbols.Symbol);
     use SymbolTree;
     subtype Tree is SymbolTree.Tree;

     function Read_Expression return Tree;

     function Eval_Expression(Expression : Tree; Value_For_X: Float) return float;

     procedure Write_Expression(Expression : Tree);

     function Derive_Expression(Expression : Tree) return Tree;

end ParseExpressionToTree;

-----------------------------------------------------------------------
-- P a r s e E x p r e s s i o n T o T r e e (Body)
--
-- Evaluates an arithmetic expression and concerts to to a binary tree.
--
-- AUTHOR: Michael Vorburger, 3.6.96
--         for Cours Progammation II, Coray, EPFL-CH
--
-- NOTE:   Line length (too long) is because of too 'clear' identifiers.
-----------------------------------------------------------------------


with Symbols;             use Symbols;
with StringSymbolFlow;    use StringSymbolFlow;

with Ada.Text_IO;         use Ada.Text_IO;
with Ada.Text_IO.Float_IO;
with Ada.Numerics;        use Ada.Numerics;
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;

package body ParseExpressionToTree is

  package Float_IO is new Ada.Text_IO.Float_IO(Float); use Float_IO;

  type Access_Function is access function(X:Float) return Float;

  Empty : constant Tree := SymbolTree.Empty; -- "renaming" for visibility control


     function Expression return Tree is
        Return_Value : Tree;
        Temporary    : Tree;
        Operator     : Symbol;


        function Term return Tree is
           Return_Value: Tree;
           Temporary   : Tree;
           Operator    : Symbol;


           function Factor return Tree is
              Return_Value: Tree;
              
              function Parse_Function(Function_Name: Symbol) return Tree is
                 Local_Variable_To_Store_Function_Parameter_Value: Tree;
              begin -- Parse_Function
                 GetSymbolInFlow;
                 if KindOfSymbol(SymbolInFlow) /= LeftPar then
								raise LEFT_PAR_EXPECTED;
              end if;
                 GetSymbolInFlow; -- skip '('
                 Local_Variable_To_Store_Function_Parameter_Value := Expression;
                 if KindOfSymbol(SymbolInFlow) /= RightPar then	
								raise RIGHT_PAR_EXPECTED;
						 end if;
                 return Cons(Function_Name,
                             Local_Variable_To_Store_Function_Parameter_Value,
                             Empty);
              end Parse_Function;


           begin -- Factor
              if KindOfSymbol(SymbolInFlow) = Number then
                 Return_Value := Cons(SymbolInFlow, Empty, Empty);
              elsif KindOfSymbol(SymbolInFlow) = LeftPar then
                 GetSymbolInFlow;
                 Return_Value := Expression;
                 if KindOfSymbol(SymbolInFlow) /= RightPar then
                     raise RIGHT_PAR_EXPECTED;
                 end if;
              elsif KindOfSymbol(SymbolInFlow) = Minus then   -- NEW: Unary Minus
                 GetSymbolInFlow;
                 -- NOT: Return_Value := Cons(To_Symbol("*"),
                                              Cons(RealToSymbol(-1.0),
                                                Empty, Empty), Factor);
                 Return_Value := Cons(To_Symbol("-"),
                                      Cons(RealToSymbol(0.0), Empty, Empty),  
                                      Factor);
             elsif KindOfSymbol(SymbolInFlow) = Plus then    -- NEW: Unary Plus
                 GetSymbolInFlow;
                 Return_Value := Factor;
              elsif KindOfSymbol(SymbolInFlow) = Identifier then 
                 if SymbolInFlow = To_Symbol("x") or
                    SymbolInFlow = To_Symbol("X") then
                      Return_Value := Cons(To_Symbol("x"), Empty, Empty);
                 elsif SymbolInFlow = To_Symbol("Pi") or
                       SymbolInFlow = To_Symbol("PI") or
                       SymbolInFlow = To_Symbol("pi") then
                       Return_Value := Cons(RealToSymbol(Pi), Empty, Empty);
                 elsif SymbolInFlow = To_Symbol("sin") or
                       SymbolInFlow = To_Symbol("Sin") then
                          Return_Value := Parse_Function(To_Symbol("sin"));
                 elsif SymbolInFlow = To_Symbol("cos") or 
                       SymbolInFlow = To_Symbol("Cos") then
                          Return_Value := Parse_Function(To_Symbol("cos"));
                 else
                    raise UNKNOWN_IDENTIFIER;
                 end if;
              else
                 raise FACTOR_EXPECTED;
              end if;
              GetSymbolInFlow;
              return Return_Value;
           end Factor;


        begin -- Term
           Return_Value:=Factor;
           while KindOfSymbol(SymbolInFlow) = Times or
                 KindOfSymbol(SymbolInFlow) = Division loop
              Operator:= SymbolInFlow;
              GetSymbolInFlow;
              Temporary:=Factor;
              if KindOfSymbol(Operator) = Times or
                 KindOfSymbol(Operator) = Division then
                   Return_Value := Cons(Operator, Return_Value, Temporary);
              else
                 raise INTERNAL_ERROR;
              end if;
           end loop;
           return Return_Value;
        end Term;


     begin -- Expression
        if not (KindOfSymbol(SymbolInFlow) = Plus or
                KindOfSymbol(SymbolInFlow) = Minus) then
           Return_Value := Term;
        else
           Return_Value := Cons(RealToSymbol(0.0), Empty, Empty);
        end if;

        while (KindOfSymbol(SymbolInFlow) = Plus or
               KindOfSymbol(SymbolInFlow) = Minus) loop
           Operator := SymbolInFlow;
           GetSymbolInFlow;
           Temporary := Term;
           if KindOfSymbol(Operator) = Plus or KindOfSymbol(Operator) = Minus then
             Return_Value := Cons(Operator, Return_Value, Temporary);
           else
             raise INTERNAL_ERROR;
           end if;
        end loop;
        return Return_Value;
     end Expression;


     function Read_Expression return Tree is
        Input_Buffer: String(1..80);
        Input_Buffer_Length: Natural := 0;
        Return_Value : Tree;
     begin
        Put_Line("Type the expression to be evaluated: (Pi is allowed)");
        Get_Line(Input_Buffer, Input_Buffer_Length);
        OpenStringSymbolFlow(Input_Buffer,Input_Buffer_Length);

        Return_Value := Expression;

        if KindOfSymbol(SymbolInFlow) /= Symbols.Empty then
           Put_Line("The expression was probably only partially evaluated!");
           Put_Line("(Some symbols at the end could not be parsed.)");
        end if;

        return Return_Value;
     end Read_Expression;


     function Eval_Expression(Expression : Tree;
                              Value_For_X: Float) return Float is
       
         -- This is just so that we don't have to pass Value_For_X 
         -- on each recursive call, ok?
         function Internal_Evaluate_Expression(Expression : Tree) return float is
            
            function CheckForNullity(Expression: Float) return Float is
            begin
               if Expression = 0.0 then
                   raise DIVISION_BY_ZERO;
                else
                   return Expression;
                end if;
             end CheckForNullity;

             function Evaluate_Identifier(Identifier_Expression: Tree)
                return float is
             begin
               if Value(Identifier_Expression) = To_Symbol("x") then
                    return Value_For_X;
               elsif Value(Identifier_Expression) = To_Symbol("sin") then
                       return Sin( Internal_Evaluate_Expression
                                    ( Left(Identifier_Expression) ) );
               elsif Value(Identifier_Expression) = To_Symbol("cos") then
                       return Cos( Internal_Evaluate_Expression
                                    ( Left(Identifier_Expression) ) );
               else
                       raise INTERNAL_ERROR;
               end if;
             end Evaluate_Identifier;


         begin -- Internal_Evaluate_Expression
            case KindOfSymbol( Value(Expression) ) is
               when Number     => return SymbolToReal( Value(Expression) );
               when Plus       => return Internal_Evaluate_Expression(Left(Expression))
 					+ Internal_Evaluate_Expression(Right(Expression));
               when Minus      => return Internal_Evaluate_Expression(Left(Expression))
					- Internal_Evaluate_Expression(Right(Expression));
               when Times=> return Internal_Evaluate_Expression(Left(Expression))
     				* Internal_Evaluate_Expression(Right(Expression));
               when Division   => return Internal_Evaluate_Expression(Left(Expression))
					/ CheckForNullity(Internal_Evaluate_Expression(Right(Expression)) );
               when Identifier => return Evaluate_Identifier(Expression);
               when others     => raise INTERNAL_ERROR; 
            end case;
         end Internal_Evaluate_Expression;

     begin -- Evaluate_Expression
        return Internal_Evaluate_Expression(Expression);
     end Eval_Expression;


     
     procedure Write_Expression_In_Standard_Form(Expression : Tree) is
     begin
        case KindOfSymbol( Value(Expression) ) is
           when Number   => Put( SymbolToReal( Value(Expression) ), Exp => 0);
           when Plus     => Put("(");
                            Write_Expression_In_Standard_Form(Left(Expression)); 
                            Put("+");
                            Write_Expression_In_Standard_Form(Right(Expression));
                            Put(")");
           when Minus    => Put("(");
                            Write_Expression_In_Standard_Form(Left(Expression)); 
                            Put("-");
                            Write_Expression_In_Standard_Form(Right(Expression));
                             Put(")");
           when Times    => Write_Expression_In_Standard_Form(Left(Expression)); 
                            Put("*");
                            Write_Expression_In_Standard_Form(Right(Expression));
           when Division => Write_Expression_In_Standard_Form(Left(Expression)); 
                            Put("/");
                            Write_Expression_In_Standard_Form(Right(Expression));
                            Write_Expression_In_Standard_Form(Right(Expression));
           when Identifier => Put (To_String( Value(Expression) ) );
                              if Left(Expression) /= Empty then
                                  Put("(");
                            Write_Expression_In_Standard_Form(Left(Expression)); 
                                  Put(")");
                              end if;
           when others     => raise INTERNAL_ERROR; 
        end case;
     end Write_Expression_In_Standard_Form;


     procedure Write_Expression_In_UPN_Form(Expression : Tree) is
     begin
        case KindOfSymbol( Value(Expression) ) is
           when Number     => Put( SymbolToReal( Value(Expression) ), Exp => 0);
           when Plus       => Write_Expression_In_UPN_Form(Left(Expression)); 
                              Write_Expression_In_UPN_Form(Right(Expression));
                              Put("+");
           when Minus      => Write_Expression_In_UPN_Form(Left(Expression)); 
                              Write_Expression_In_UPN_Form(Right(Expression));
                              Put("-");
           when Times      => Write_Expression_In_UPN_Form(Left(Expression)); 
                              Write_Expression_In_UPN_Form(Right(Expression));
                              Put("*");
           when Division   => Write_Expression_In_UPN_Form(Left(Expression)); 
                              Write_Expression_In_UPN_Form(Right(Expression));
                              Put("/");
           when Identifier => Put (To_String( Value(Expression) ) );
                              if Left(Expression) /= Empty then
                                  Put("(");
                                  Write_Expression_In_UPN_Form(Left(Expression)); 
                                  Put(")");
                              end if;
           when others     => raise INTERNAL_ERROR; 
        end case;
        Put(" ");
     end Write_Expression_In_UPN_Form;


     procedure Write_Expression(Expression : Tree) is
     begin
        Put("Expression in UPN: ");
        Write_Expression_In_UPN_Form(Expression);
        New_Line;
        Put("Expression in Standard Form: ");
        Write_Expression_In_Standard_Form(Expression);
        New_Line;
     end Write_Expression;



     function Derive_Expression(Expression : Tree) return Tree is
                  
         function Derive_Product(Expression: Tree) return Tree is
         begin
             return Cons(To_Symbol("+"),            -- (fg)' = f'g + fg'
                         Cons(To_Symbol("*"),
                              Derive_Expression(Left(Expression)),
                              Right(Expression)),
                         Cons(To_Symbol("*"),
                              Left(Expression),
                              Derive_Expression(Right(Expression)) ) );
         end Derive_Product;

         function Derive_Quotient(Expression: Tree) return Tree is
         begin
             return Cons(To_Symbol("/"),       -- (f/g)' = ( f'g - fg' ) / (g*g)
                         Cons(To_Symbol("-"),
                              Cons(To_Symbol("*"),
                                   Derive_Expression(Left(Expression)),
                                   Right(Expression)),
                              Cons(To_Symbol("*"),
                                   Left(Expression),
                                   Derive_Expression(Right(Expression)) ) ),
                         Cons(To_Symbol("*"),
                              Right(Expression), Right(Expression) ) );
         end Derive_Quotient;

         function Derive_Functions(Expression: Tree) return Tree is
         begin
            if Value(Expression) = To_Symbol("sin") then -- sin'(f) = f' * cos(f)
                return Cons(To_Symbol("*"),
                            Derive_Expression(Left(Expression)),
                            Cons(To_Symbol("cos"), Left(Expression), Empty) );
            elsif Value(Expression) = To_Symbol("cos") then 
                return Cons(To_Symbol("*"),        -- cos'(f) = f' * ( -sin(f) )
                            Derive_Expression(Left(Expression)),
                            Cons(To_Symbol("-"),
                               Cons(RealToSymbol(0.0), Empty, Empty),
                               Cons(To_Symbol("cos"), Left(Expression), Empty)));
            elsif Value(Expression) = To_Symbol("x") then
                 return Cons(RealToSymbol(1.0), Empty, Empty);
            else
                 raise INTERNAL_ERROR;
            end if;
         end Derive_Functions;

     begin
         case KindOfSymbol( Value(Expression) ) is
             when Number              => return Cons(RealToSymbol(0.0),
                                           Empty,
                                           Empty);
             when Plus | Minus        => return Cons(Value(Expression),
                                           Derive_Expression(Left(Expression)),
                                           Derive_Expression(Right(Expression)));
             when Times               => return Derive_Product(Expression);
             when Division            => return Derive_Quotient(Expression);
             when Identifier          => return Derive_Functions(Expression);
             when others              => raise INTERNAL_ERROR;
         end case; 
     end Derive_Expression;

end ParseExpressionToTree;

more ADA: [ Plot ] [ Sorting ] [ OOP-Matrices ] [ Symbol Table ] [ Sym. Derivation ]