home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / turbopas / spoc88.arc / DCG.ARC / MATHEXP.PRO < prev    next >
Text File  |  1988-06-17  |  6KB  |  200 lines
  1. /* Mathematical Expression parser
  2.  
  3.   Barbara Clinger, 1988
  4.  
  5.   This program parses a mathematical expression and returns the
  6.   value of the expression. It allows the use of ^ for exponation,
  7.   grouping using parentheses, evaluation of functions (sine,
  8.   cosine, ...). Decimals in the range from -1 to +1 must be entered
  9.   with a leading zero (i.e., 0.25). A warning is issued if negative
  10.   numbers are raised to fractional powers;  the indeterminant zero
  11.   raised to the zero power stops execution of the program.
  12.   
  13.   sample input: 2^3 + ( sin(2*pi/3) + 1 )^2 - ln(0.123)
  14.  
  15. */
  16.   
  17. domains
  18.     toklist = string*
  19. predicates
  20.     reader(string,toklist)
  21.     give_result(real,toklist,toklist)
  22.     append(toklist,toklist,toklist)
  23.     do
  24.     if_can_do(real,real,real)
  25.     is_odd_int(real)
  26.     is_even_int(real)
  27. /* the grammar */
  28.     expr(real,toklist,toklist)
  29.     term(real,toklist,toklist)
  30.     power(real,toklist,toklist)
  31.     group(real,toklist,toklist)
  32.     number(real,toklist,toklist)
  33. /* goal
  34.     do. */
  35. clauses
  36. do :-
  37.     write("When entering numbers between -1 and +1 enter"),nl,
  38.     write("a leading zero.  For example  0.15"),nl,nl,
  39.     nl,write("Enter an expression: "),nl, write(">"),
  40.     readln(S),nl,nl,        /* get the expression */
  41.     reader(S,List_in),        /* process for expr */
  42.     expr(Info_out,List_in,Rest),!,    /* parse expression */
  43.     give_result(Info_out,List_in,Rest).    /* print results */
  44.  
  45. give_result(N,_,T) :-
  46.     T = [],
  47.     write("The value of the expression is ", N),nl.
  48. give_result(_,_,T) :-
  49.     write("Cannot evaluate the expression."),nl,
  50.     write("Unevaluated remainder list is:"),nl,nl,
  51.     write(T),nl,nl.
  52.  
  53. /* THE GRAMMAR */
  54. /* An expression takes the form of
  55.        an expression plus a term,
  56.     or an express minus a term,
  57.     or a term
  58. */
  59.  
  60. expr(X,L1,L2) :-
  61.     append(Left,["+"|Right],L1),
  62.     expr(V1,Left,L2),
  63.     term(V2,Right,L2),
  64.     X = V1 + V2.        /* returns left value plus right value */
  65. expr(X,L1,L2) :-
  66.     append(Left,["-"|Right],L1),
  67.     expr(V1,Left,L2),
  68.     term(V2,Right,L2),
  69.     X = V1 - V2.       /* returns left value minus right value */
  70. expr(X,L1,L2) :- term(X,L1,L2).
  71.   
  72. /* A term takes the form of
  73.     a term times a power
  74.      or a term divided by a power
  75.      or a power
  76. */
  77.  
  78. term(X,L1,L2) :- 
  79.     append(Left,["*"|Right],L1),
  80.     term(V1,Left,L2),
  81.     power(V2,Right,L2),
  82.     X = V1 * V2.    /* returns left value times right value */
  83. term(X,L1,L2) :-
  84.     append(Left,["/"|Right],L1),    
  85.     term(V1,Left,L2),
  86.     power(V2,Right,L2), 
  87.     X = V1 / V2.    /* returns left value divided by right */
  88. term(X,L1,L2) :- power(X,L1,L2).
  89.         
  90. /* A power takes the form of
  91.     a group raised to a power
  92.     or  a group
  93.  
  94.    Not all expressions of the form X ^ Y are possible.  The clause
  95.    if_can_do allows the obvious cases to be evaluated.
  96. */
  97.  
  98. power(X,L1,L2) :-
  99.     append(Left,["^"|Right],L1),
  100.     group(V1,Left,L2),
  101.     power(V2,Right,L2),
  102.     if_can_do(X,V1,V2).  /* check for acceptable cases */
  103. power(X,L1,L2) :- group(X,L1,L2).
  104.     
  105. /* a group takes the form of
  106.     an expression enclosed in parentheses
  107.     or  a number
  108. */
  109.  
  110. group(X,["("|L1],L2) :-
  111.     append(Sub_expr,[")"],L1),
  112.     expr(V,Sub_expr,L2),!,
  113.     X = V.     /* return the value inside the parentheses */
  114. group(X,L1,L2) :- number(X,L1,L2).
  115.     
  116. /* a number takes the form of
  117.     a plus sign followed by a an unsigned number N
  118.     or  a minus sign followed by a an unsigned number N
  119.     or  sin(x), cos(x), ... , ln(x), or the number pi
  120.     or an unsigned number N
  121. */
  122.     
  123. number(X,["+"|T],L2) :-     /*  + N is the same as N */
  124.     number(X,T,L2).
  125. number(X,["-"|T],L2) :-        /* return negative of unsigned N */
  126.     number(X1,T,L2),
  127.     X = -X1.
  128. number(X,["sin"|L1],L2) :-      /* use of the sine function, must */
  129.     group(V,L1,L2),        /* be of the form sin(arg) */
  130.     X = sin(V),!.
  131. number(X,["cos"|L1],L2) :-
  132.     group(V,L1,L2),X = cos(V),!.
  133. number(X,["tan"|L1],L2) :-
  134.     group(V,L1,L2), X = tan(V),!.
  135. /* secant definition */
  136. number(X,["sec"|L1],L2) :-
  137.     group(V,L1,L2),
  138.     cos(V) <> 0,
  139.     X = 1/cos(V),!.
  140. number(_,["sec"|L1],L2) :-
  141.     group(V,L1,L2),
  142.     cos(V) = 0,
  143.     write("error in secant argument"),nl,nl,!,fail.
  144. number(X,["arctan"|L1],L2) :-
  145.     group(V,L1,L2),X = arctan(V),!.
  146. number(X,["exp"|L1],L2) :-
  147.     group(V,L1,L2), X = exp(V),!.
  148. number(X,["ln"|L1],L2) :-
  149.     group(V,L1,L2), X = ln(V),!.
  150. number(X,["pi"|T],T) :-
  151.     X = 4 * arctan(1),!.
  152.                /* the angle whose tangent is 1 is pi/4 */
  153. Number(Num,[H|T],T) :-
  154.     str_real(H,Num),!.  /* convert string to unsigned number */
  155.     
  156. reader("",[]) :- !.
  157. reader(Str,[Tok|Rest]) :-
  158.     fronttoken(Str,Tok,Str1),
  159.     reader(Str1,Rest),!.
  160.  
  161. append([],List,List).
  162. append([H|T],L,[H|T2]) :-
  163.     append(T,L,T2).
  164.  
  165. /* The clause if_can_do tests some cases for the evaluation of 
  166.    expressions of the form V1 ^ V2
  167. */
  168. if_can_do(X,V1,V2) :-
  169.     V1 > 0,!,        /* positive base, all ok */
  170.     X = exp(V2 * ln(V1)).
  171. if_can_do(X,V1,V2) :-        /* 0 raised to 0 is indeterminant */
  172.     V1 = 0,V2 = 0,!,
  173.     write("*************** ERROR **************"),nl,
  174.     write("expression contains indeterminant form 0 ^ 0"),nl,
  175.     write("*************************************"),nl,nl,
  176.     X = ln(V1).        /* automatic stop of program */
  177. if_can_do(X,V1,_) :-
  178.     V1 = 0,           /* 0 raised to nonzero power is 0 */
  179.     X = 0.
  180. if_can_do(X,_,V2) :-
  181.     V2 = 0,             /* any number except 0 raised to */
  182.     X = 1.            /* the 0 power is 1 */
  183. if_can_do(X,V1,V2) :-        /* negative number to an odd */
  184.     is_odd_int(V2),     /* integer is ok */
  185.     X = -exp(V2 * ln(abs(V1))).
  186. if_can_do(X,V1,V2) :-        /* negative number to an even */
  187.     is_even_int(V2),    /* integer is ok */
  188.     X = exp(V2 * ln(abs(V1))).
  189. /* negative number to a fractional power can swing right or wrong.
  190.    For example:
  191.         (-32)^ 0.2 (the fifth root of -32) is -2
  192.     (-1024)^0.1 (the 10th root of -1024) does not exist.*/   
  193. if_can_do(X,V1,V2) :- 
  194.     X = exp(V2 * ln(abs(V1))),
  195.     write("*************** WARNING **************"),nl,
  196.     write("expression contains (",V1,") ^ ",V2),nl,
  197.     write("had to use (abs(",V1,")) ^ ",V2),nl,nl.
  198.     
  199. is_odd_int(X) :- X = round(X), (round(X) mod 2) = 1.
  200. is_even_int(X) :- X = round(X).