ETHZ_Logo RAMSES_Logo_Right   RAMSES   RAMSES_Logo_Left Systems Ecology  
Start    search button      Modules:   A-Z   Function   Layer        QuickRefs:   DM   AuxLib   AuxLibE   SciLib   EasyMW   MW   ISIS   RMSLib

DEFINITION MODULE FormulIntrpr;

  (*******************************************************************

    Module  FormulIntrpr     (Version 1.2)

      Copyright (c) 1988-2006 by Olivier Roth, Andreas Fischlin, Reiner
      Zah and ETH Zurich.

    Purpose   Management and computation of mathematical
              formulas/expressions given in form of strings.

    Remarks   See companion module FormulVars for the declaration
              of real variable operands to be used in formulas.
      	
              This module supports the dynamic installation or
              deinstallation of monadic, diadic, and triadic
              functions, which may be freely used during the
              interpretation of formulas.

              This module supports only a single scope, i.e. all
              intalled functions are always available for evaluations
              in all expressions.

              Reference:  Meyzis, E. (1988). "Der Formelinterpreter;
              Teil IV: Implementation in Modula-2", Toolbox,
              Dec. 1988: 49-53.


              The EBNF for expressions:
              =========================
              numDigit      "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9".
              schar         "a"|"b"|"c"|"d"|"e"|"f"|"g"|"h"|"i"|"j"|"k"|"l"|"m"|
                            "n"|"o"|"p"|"q"|"r"|"s"|"t"|"u"|"v"|"w"|"x"|"y"|"z".
              cchar         "A"|"B"|"C"|"D"|"E"|"F"|"G"|"H"|"I"|"J"|"K"|"L"|"M"|
                            "N"|"O"|"P"|"Q"|"R"|"S"|"T"|"U"|"V"|"W"|"X"|"Y"|"Z".
              character     schar|cchar.
              number        numDigit{numDigit}.
              scaleFactor   "e"["+"|"-"]number.
              realNumber    number["."number][scaleFactor].
              ident         character{character|numDigit}.
              mathFunction  "abs"|"sin"|"cos"|"tan"|"sqrt"|"exp"|"ln".
              factor        realNumber|ident|mathFunction|"("term")".
              sign          ["-"]factor.
              exponent      sign["^"sign].
              product       exponent[("*"|"/")exponent].
              term          product[("+"|"-")product].

              NOTE: In contrast to variable idents, mathFunction idents are not
              case sensitive.


              Terms:
              ======
              Expression: the definition of a mathematical construct
                          specified by a formula (string).

              Formula:    is the textual form of an expression, i.e. a string
                          containing names of variables, operators, brackets
                          and mathematical functions.

              Function:   a mathematical mapping of 1, 2 or 3
                          arguments (independent variables) to another
                          dependent variable. E.g. F "sin": y <- sin(x)
                          maps x to y according to the monadic (1 argument)
                          function sin. You may use any type of function (may
                          require installation by InstallMonadicFunc etc.
                          procedures) as long as the function requires not
                          more than 3 arguments.

              Operator:   basic algebraic operators such as + - * / and ^.

              Operand:    actual argument passed to a mathematical function


    Programming

      o Design
        Olivier Roth              27/11/1988
        Andreas Fischlin          24/04/1996 (Version 1.2)

      o Implementation
        Olivier Roth              27/11/1988
        Reiner Zah                02/09/1990
        Andreas Fischlin          24/04/1996


    ETH Zurich
    Systems Ecology
    CHN E 35.1
    Universitaetstrasse 16
    8092 Zurich
    SWITZERLAND

    URLs:
        <mailto:RAMSES@env.ethz.ch>
        <http://www.sysecol.ethz.ch>
        <http://www.sysecol.ethz.ch/SimSoftware/RAMSES>


    Last revision of definition:  24/04/1996  AF

  *******************************************************************)


  FROM SYSTEM IMPORT ADDRESS;


  TYPE
    Expression;
    Func1Arg = PROCEDURE ( REAL ): REAL;
    Func2Arg = PROCEDURE ( REAL, REAL ): REAL;
    Func3Arg = PROCEDURE ( REAL, REAL, REAL ): REAL;

    SyntaxError = ( noErr, badReal, noLParen, noRParen, tooManyRParen,
                    noComma,
                    unknownIdent, unknownFctIdent,
                    badChar, badOperator, illEnd );

    Symbol = ( null, ident, num, lParen, rParen, comma,
               plus, minus, multiply, divide, power, unknown );

    ProcPtr  = POINTER TO ADDRESS;
    FuncType = (none, monadic, diadic, triadic);

    SymbolProc = PROCEDURE ( Symbol, INTEGER, ARRAY OF CHAR );
                           (* type of found symbol, pos = index where
                           symbol starts, symStr = found symbol *)

    StringProc = PROCEDURE ( VAR ARRAY OF CHAR );

    ArithmeticError = (noAriErr,
                       invalidOperand, underFlow, overFlow,
                       divByZero, complex, undefined);

  VAR
    notInstalledExpression: Expression; (* read only *)



 (**************************************************************)

  PROCEDURE GetSymbol( VAR formulStr: ARRAY OF CHAR;
                        len          : INTEGER;
                        VAR pos      : INTEGER;
                        VAR symStr   : ARRAY OF CHAR): Symbol;
 (*			==========
  This is the basic scanner procedure also used by ScanFormula.
  From position pos of the formulStr containing len characters, procedure
  GetSymbol returns the type of the next symbol and copies the symbol
  itself to symStr.  It requires at all times
  0 <= pos < len = Length(formulStr) plus Length(symStr >= 2 );
  *)

  PROCEDURE ScanFormula( VAR formulStr: ARRAY OF CHAR;
                             doWithSymbol: SymbolProc );
 (*			==============
  This procedure scans the entire formulStr and calls the
  SymbolProc doWithSymbol consecutively for each encountered
  symbol (Uses GetSymbol). In doWithSymbol you may extract
  idents or look ahead by calling GetSymbol for particular
  parsing purposes.
  *)


  PROCEDURE WhatFunc( VAR ident: ARRAY OF CHAR;  VAR p: ProcPtr ): FuncType;
 (*			========
  This procedure returns the type of function associated with ident,
  returns none if ident is not an installed function.  The address
  pointing to the procedure with name ident is returned with p. Note
  that functions idents are not case sensitive.
  *)

 (**************************************************************)



  PROCEDURE InstallExpression( VAR      e      : Expression;
                               eName           : ARRAY OF CHAR;
                               formulaStr      : ARRAY OF CHAR;
                               VAR posBadCHinF : INTEGER       );
   PROCEDURE DeclAndParseExpr( VAR      e      : Expression;
                               fName           : ARRAY OF CHAR;
                               VAR formulaStr  : ARRAY OF CHAR;
                               VAR posBadCHinF : INTEGER       );
(*			=================
  Install an expression e defined by the formula F within an
  assignment of the form Y = F(var), e.g. "a*2/(1+Exp(b))"
  given by the string formulaStr. Additionally a name can
  be assigned by eName. If the given formula was successfully
  parsed the variable posBadCHinF returns -1, otherwise the
  position of the first erroneous symbol within formulaStr is
  returned. If the formula was not successfully compiled the
  expression Y = 0.0 is installed.  Attempts to reinstall an
  expression another time purges the former expression and
  replaces it by the new one. DeclAndParseExpr is an alternative
  with formulaStr as a var parameter for speed up reasons only.
  If the installation fails, e.g. due to a memory shortage, e
  returns notInstalledExpression.

  The following mathematical operators are available:

     +, -, *, /, ^.

  The following mathematical (non case sensitive idents, all arguments
  reals, return real) are initally preinstalled:

  Mmonadic functions:

     ABS, SIN, COS, TAN, SQRT, LN, EXP

  Diadic functions:

     MIN(x,y), MAX(x,y)

  Triadic functions:

     SWITCH(x,y1,y2)         if x < 0 returns y1 else returns y2
     LIMIT(x,min,max)        if x < min returns min
                             if x > max returns max
                             else returns x

  The computing follows the ordinary infix notation, i.e. parantheses
  "(" and ")" may be used to control priorities of evaluation. E.g.
  a * b + c  adds c to the product of a times b, but a * (b + c)
  multiplies a with the sum of b and c.
  *)

  PROCEDURE LastSyntaxErr(): SyntaxError;
 (*         =============
  Returns the last, possibly encountered syntax error during the
  parsing process initiated by InstallExpression respectively
  DeclAndParseExpr.
  *)


  PROCEDURE GetErrMsg( err: SyntaxError;  VAR errStr: ARRAY OF CHAR );
 (*			=========
  Returns the error message in "errStr" corresponding to the
  value of err.  It is suggested to use that procedure together
  with the variable formErr.
  *)


  PROCEDURE RemoveExpression( VAR  e : Expression );
 (*			================
  Frees the memory used by the expression e and marks the
  variable e as an undefined Expression.
  *)



  PROCEDURE ComputeExpression( e : Expression;
                               VAR ariErr: ArithmeticError): REAL;
 (*			=================
  Returns the computed value of expression e denoting a
  formula string. Note: arithmetic errors, i.e. over-/underflow,
  division by 0, negative arguments for LN, etc. are returned by
  arithmErr. However, computation continues as best as can, i.e.:
    invalid operand          => 0.0
    underflow     1/infinity => 0.0
    overflow      - infinity => MIN(REAL)
    overflow      + infinity => MAX(REAL)
    division by 0       +x/0 => MAX(REAL)
    division by 0       -x/0 => MIN(REAL)
    undefined            0/0 => 0.0
    complex         SQRT(-x) => 0.0
  *)

  PROCEDURE GetArithmErrMsg (ariErr: ArithmeticError; VAR errStr: ARRAY OF CHAR);
 (*         ===============
  Returns the error message associated with the arithmetic error
  ariErr. Typically you call this procedure if ComputeExpression
  returns with arithmErr <> noAriErr to learn about which arithmetic
  error was actually encountered (it is the first error condition
  encountered during formula interpretation).
  *)


  PROCEDURE ExtractFString( e: Expression;  VAR fstr: ARRAY OF CHAR );
 (*			==============
  Returns the stored formula string of expression e (is also stored
  if the installed expression was illegal).
  *)

  PROCEDURE GetFormulaName( e: Expression;  VAR fName: ARRAY OF CHAR );
 (*			==============
  Returns the stored formula name of expression e.
  *)

  PROCEDURE SetFormulaName( e: Expression;  VAR fName: ARRAY OF CHAR );
 (*			==============
  Sets the formula name of expression e.
  *)


  PROCEDURE InstallMonadicFunc( f1 : Func1Arg; funcName: ARRAY OF CHAR;
                                VAR done: BOOLEAN );
 (*			==================
  Allows the installation of a ONE argument math function f1,
  e.g. Sin( arg1 ). The function's name is passed via funcName
  ! Note that function names are not case sensitive, (but
  variables are).
  *)

  PROCEDURE InstallDiadicFunc( f2 : Func2Arg; funcName: ARRAY OF CHAR;
                                VAR done: BOOLEAN );
 (*			=================
  Allows the installation of a TWO argument math function f2,
  e.g. RMax( arg1, arg2 ). The function's name is passed via
  funcName
  ! Note that function names are not case sensitive, (but
  variables are).
  *)

  PROCEDURE InstallTriadicFunc( f3 : Func3Arg; funcName: ARRAY OF CHAR;
                                VAR done: BOOLEAN );
 (*			==================
  Allows the installation of a THREE argument math function f3,
  e.g. RLimit( x, xlow, xhigh ). The function's name is passed
  via funcName
  ! Note that function names are not case sensitive, (but
  variables are).
  *)

  PROCEDURE RemoveFunc( funcName: ARRAY OF CHAR );
 (*			==========
  Allows to remove a previously installed function via its name.
  ! Note that function names are not case sensitive.
  *)

  PROCEDURE PresentFuncNames( funcType: FuncType;  strProc: StringProc );
 (*			================
  This procedure calls the StrProc for each installed function of the
  specified funcType in ascending alphabetic order.
  *)


END FormulIntrpr.

  Contact RAMSES@env.ethz.ch Last updated: 25-Jul-2011 [Top of page]