calc.pro

利用人工智能程序设计语言prolog编程实现的公式计算软件源代码。

/*****************************************************************************

		Copyright (c) My Company

 Project:  TRY
 FileName: CALC.PRO
 Purpose: No description
 Written by: Visual Prolog
 Comments:
******************************************************************************/
include "formula.inc"
include "formula.con"
include "hlptopic.con"

%%%%%%%%%%%%%%%%%%%%%%test section %%%%%%%%%%%%%%%%
/*
 this module serves to commodate test pres.  
*/
   
domains
   expr = number(integer); x; log(expr);
          plus(expr, expr); mult(expr, expr)

predicates
%writeExp(expr)
%expr_val_loop(string OriginalExpr1,string RestExpr,real Tout,real Out,string EndCond)
calc(real Elem1,string Elem2,real Elem3,real Out)



clauses
/*   writeExp(x) :- write('x').
   writeExp(number(No)) :- write(No).
   writeExp(log(Expr)) :- write("log("), writeExp(Expr), write(')').
   writeExp(plus(U1, U2)) :- writeExp(U1), write('+'), writeExp(U2).
   writeExp(mult(U1, U2)) :- writeExp(U1), write('*'), writeExp(U2).*/
PREDICATES
get_elem(STRING Elem1, string RestExpr1, string RestExpr2,real Tout, real NTout)
check_calc(real Tout,string Elem1,real NextElem,real NTOut,string RestExpr20,string RestExpr2)
func_compare(string Func2, string Func1,string SmorBig)
CLAUSES
expr_val_loop("",Out,Out):-
%	write("end of expr_val_loop(emptystr,", Out,",", Out,")"),nl,
	!.
expr_val_loop(Expr,Out,Out):-
	not(fronttoken(Expr,_,_)),
	!.
expr_val_loop(Expr,TOut,Out):- %TExpr may be plus(number(0,Expr), 
	fronttoken(Expr, Elem1, RestExpr1),
%	write("elem1=",Elem1, " , RestExpr1=",RestExpr1,", going to get_elem(Tout=", Tout),nl,
	get_elem(Elem1, RestExpr1, RestExpr2,Tout, NTout),
%	write("get elem back,  Restexpr2=", RestExpr2, ", NTOut=", NTOut),nl,
	expr_val_loop(RestExpr2,NTOut,Out).

%%
get_elem(Elem1, RestExpr1, RestExpr2,Tout, NTout):-%if elem is num followed by (, eg: 8(9+2) should be 8*(9+2)
	str_real(Elem1,N),
	NTout=Tout+N,
	fronttoken(RestExpr1,"(", _),
	concat("*",RestExpr1,RestExpr2),
%	write("in get_elem, elem1 is a num, NTout=", Tout, "+", N,"=", NTout, ",  RestExpr=", RestExpr2),nl,
	!.

get_elem(Elem1, RestExpr1, RestExpr2,Tout, NTout):-%if elem is num, just remain
	str_real(Elem1,N),
	NTout=Tout+N,
	RestExpr2=RestExpr1,
%	write("in get_elem, elem1 is a num, NTout=", Tout, "+", N,"=", NTout, ",  RestExpr=", RestExpr2),nl,
	!.

get_elem(Elem1, RestExpr1, RestExpr4,Tout, NTout):-%if elem is functor, see if next elem is a negative
	FuncList1=["*","+","-","/"],
	slist_member(Elem1,FuncList1,YN),
	YN=b_true, 
	%if next elem is "-", must be a negative
	fronttoken(RestExpr1, "-", RestExpr2),	!,
	fronttoken(RestExpr2, Elem3, RestExpr3),
	concat("-",Elem3,Elem4),
	str_real(Elem4,NextElem),
%	write("elem is a neg:", NextElem),nl,
	check_calc(Tout,Elem1,NextElem,NTOut,RestExpr3,RestExpr4),
%	write("check calc=",Tout, Elem1,NextElem,"=",NTout),nl,
	!.
get_elem(Elem1, RestExpr1, RestExpr2,Tout, NTout):-%if elem is functor, see if can calc out
	FuncList1=["*","+","-","/"],
	slist_member(Elem1,FuncList1,YN),
	YN=b_true, !,
	%the elem next Elem1 must be one of  num, "(","sqr",or "sq", should not be  "-" 
	fronttoken(RestExpr1,Elem2,RestExpr10),
	Elem2<>"-",
	HereTOut=0,
%	write("in get_elem, elem1 is one of functors1, get elem2=", Elem2, ",  going to get_elem(Tout=0)"),nl,
	get_elem(Elem2,RestExpr10,RestExpr20,HereTout,NextElem),
%	write("get_elem   back, NextElem=",NextElem),nl,
%	write("goint to check calc, ", Tout, Elem1, NextElem, "=?"),nl,
	check_calc(Tout,Elem1,NextElem,NTOut,RestExpr20,RestExpr2),
	!.

get_elem(Elem1, RestExpr1, RestExprOut,_Tout, FinalOut):-%if elem is "sqr", "sq", just cacl it out
	FuncList2=["sqr", "sq"],
	slist_member(Elem1,FuncList2,YN),
	YN=b_true, 
%	write(" elem1=", Elem1, ",RestExpr1=", RestExpr1," It must be followed by ("),nl,
	fronttoken(RestExpr1,"(", RestExpr2), !, %must be "("
	HereTOut=0,
%	write("go get sqr elem.from:", RestExpr1),nl,
	get_elem("(", RestExpr2, RestExprOut,HereTOut, HereOut),
	calc(1,Elem1,HereOut,FinalOut),
	%calc sqr etc.
	!.
get_elem(Elem1, _RestExpr1, _RestExprOut,_Tout, _FinalOut):-%if elem is "sqr", "sq", but not followed by "("
	FuncList2=["sqr", "sq"],
	slist_member(Elem1,FuncList2,YN),
	YN=b_true, 
	dlg_note("sqr must be followed by \"(\""),
	fail.
	
get_elem(Elem1, RestExpr1, RestExprOut,_Tout, NTout):-%if elem is "(", get val within "(" and ")"
	Elem1="(", !,
	concat(Elem1,RestExpr1,RestExpr10),
	get_Pair_Elem(RestExpr10,"(", PairElem,")",RestExpr2),
%	EndCond=")", %end loop condition is ")" encountered
	HereTout=0,
%	expr_val_loop(PairElem,RestExprOut0,HereTout,HereNTOut,EndCond),
%	write("expr begins with (, get PairElem=", PairElem, ", * going to expr_val_loop"),nl,
	expr_val_loop(PairElem,HereTout,HereNTOut),
%	write("  *  expr_val_loop back, res=", HereNTOut),nl,
	RestExprOut=RestExpr2,
	NTout=HereNTout,
	!.
	
%%check calc able
check_calc(N1,Func1,N2,NTOut,RestExpr20,RestExprOut):-%if next elem of N2 is a bigger functor, deal with behind
	fronttoken(RestExpr20,Func2,RestExpr3),
	func_compare(Func2, Func1, SmorBig), %"+" is smaller than "*"
	SmorBig= "bigger", !,
%	write(" next functor not_smaller than first functor, so get calc using next functor first"),nl,
	HereTOut=0,
	fronttoken(RestExpr3, NextElem,RestExpr4),
%	write("in check_calc ,  goint to get_elem(", NextElem,", N3=?"),nl,
	get_elem(NextElem,RestExpr4,RestExpr5,HereTout,N3),
%	write("back, N3=", N3, ",  so going to calc(", N2,Func2,N3,", Res=?"),
	calc(N2,Func2,N3, Res),
%	write("Res=", Res, ",  and then going to calc(", N1,Func1,Res,", NTout=?"),nl,
	/* 3+4*5/9+2*2=6.55555 , when 4*5=20 back, need check_calc again 
	need a loop here maybe
	*/
	%rewrite the expression to = "3+20/9+2",NTout=0, do the new expression from beginning
	str_real(ResStr,Res),str_real(N1Str,N1),
	format(RestExprOut,"%-%-%-%-", N1Str,Func1,ResStr,RestExpr5),
%	write(" at this time, rewrite expression=", N1Str,Func1,ResStr,RestExpr5),
%	calc(N1,Func1,Res,NTOut),
	NTout=0, 
%	write(" NTout= ", NTout, ", go back."),nl,
	!.	
	
	
check_calc(N1,Func1,N2,NTOut,RestExpr20,RestExpr2):-%if next  is a maller functor or other , just calc
	fronttoken(RestExpr20,Func2,_RestExprTemp),
	func_compare(Func2, Func1, SmorBig), %"+" is smaller than "*"
	SmorBig<>"not_bigger", !,
	RestExpr2=RestExpr20,
	calc(N1,Func1,N2,NTOut),
%	write("calc(", N1, Func1,N2,"=", NTOut),nl,
	!.
check_calc(N1,Func1,N2,NTOut,RestExpr20,RestExprOut):-% above failed, may be RestEXpr20 already empty
	RestExprOut=RestExpr20,
	calc(N1,Func1,N2,NTOut),
	!.

	
	
%calc(N1,F,N2,Out):-
calc(N1,"*",N2,Out):-
%	get_val(N2,N2r),
	Out=N1*N2,
%	write(N1,"*",N2,"=",Out),nl,
	!.
calc(N1,"+",N2,Out):-
	Out=N1+N2,
%	write(N1,"+",N2,"=",Out),nl,
	!.
calc(N1,"-",N2,Out):-
	Out=N1-N2,
	!.
calc(N1,"/",N2,Out):-
	N2<>0,
	Out=N1/N2,
	!.
calc(_N1,"sqr",N2,Out):-	
	Out = sqrt(N2),
	!.
calc(_N1,"sq",N2,Out):-
	Out=N2*N2,
	!.
	
%%functor compare
func_compare(Func2, Func1, "bigger"):- %eg: "+" is smaller than "*"
	slist_member(Func2,["*","/"],YN),
	YN=b_true,
	slist_member(Func1,["+","-"],YN),
	!.
func_compare(_Func2, _Func1, "not_bigger"):-
	!.