getpair.pro

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

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

		Copyright (c) My Company

 Project:  TRY
 FileName: GETPAIR.PRO
 Purpose: No description
 Written by: Visual Prolog
 Comments:
******************************************************************************/
include "formula.inc"
include "formula.con"
include "hlptopic.con"
/*DOMAINS
rlist=real*
*/
PREDICATES
%get_Pair_Elem(string ExprIn,string IniB, string PairElem,string EndB,string ExprOut)
elem_foundN(string Str, string E, integer N,rlist PList)
        %count how many times an elem occurs in a str
nThElem_sum(real C,real N,rlist ValList,real Sum)
verify_pairElem(string ExprIn,string PairElem0,string PairElem,string EndB,string IniB, string ExprOut)
check_expr_syntax(string Str,string IniB,string EndB, real N1,real N2,boolean YN)
compare_rlists(rlist List1,rlist RList2,string Spec,boolean BigYN) %Spec="all_bigger" or "all_smaller"
compare_rlists_sums(rlist PL1,rlist PL2,real NN,rlist RList1,rlist RList2,string Spec,boolean SmYN)
verify_RestExpr(string RestStr0,string RestStr, string PElemT0,string PElemT,string EndB, real D,boolean SynYN)

CLAUSES
%%%how many times an elem occurs in a str
elem_foundN(Str, E, N, PList):-
	searchstring(Str, E, Pos1),
	frontstr(Pos1,Str,_E1,RestStr),
	elem_foundN(RestStr, E, N0,PList0),
	PList=[Pos1|PList0],
	N=N0+1,!.
elem_foundN(_Str, _E, 0,[]):-!.	

%%%get nth sum from a list
nThElem_sum(C,C,[Val|_RList],Val):-!.
nThElem_sum(C,N,[Val|RList],Sum):-
	NC=C+1,
	nThElem_sum(NC,N,RList,TSum),
	Sum=TSum+Val,
	!.

%%%get elem within boundaries: IniB and EndB: eg.ExprIn=(9*((14-9)/3)), PairElem should be 9*((14-9)/3)
%%ExprIn should always begin with a (
get_Pair_Elem(ExprIn,IniB, PairElem,EndB,ExprOut):-
	%check syntax: 
	check_expr_syntax(ExprIn,IniB,EndB, _IniBN,_EndBN,SynYN),
	SynYN=b_true,!,
%	write(ExprIn, "'s syntax ok"),nl,
	%going to get and verify pairelem
	searchstring(ExprIn, EndB,Pos1),
	frontstr(Pos1,ExprIn,PairElem0,RestExprIn),%EG: PairElem0=(9*((4-9)
%	write("ExprIn=", ExprIn,", pairElem0=", PairElem0, ", RestExprIn=", RestExprIn),nl,
	verify_pairElem(RestExprIn,PairElem0,PairElem,EndB,IniB, ExprOut),
	!.
get_Pair_Elem(ExprIn,IniB, _PairElem,EndB,_ExprOut):-
%	elem_foundN(ExprIn, IniB, _N1,_PList),
%	elem_foundN(ExprIn, EndB, _N2,_EndBPList),%must have the same number as IniB
%	write(ExprIn,"  has ", N1,  IniB, ", and has ", N2, EndB),nl,
%	N2<>N1, !,
	check_expr_syntax(ExprIn,IniB,EndB, _IniBN,_EndBN,SynYN),
	SynYN=b_false,
	beep,
	format(Msg," wrong syntax in expression. A \")\" or \"(\" may be missing. Check this: \"%-\"",  ExprIn),
	dlg_note(Msg),
	fail.
	
%%%
verify_pairElem(RestExprIn,PairElem0,PairElem,EndB,IniB, ExprOut):- %more than one IniB
	/*pairElem0 has more than one IniB, eg: OrigStr=9*((14-9)/3)), PairElem0=9*((4-9), 
	then need get the Nth EndB, i.e. get 2nd ")" at  9*((14-9)/3))	
	Pay attention to : "(9*(3+2)+*14/(8-3))"
	*/
	elem_foundN(PairElem0, IniB, N,_PList),
%	write(PairElem0,"  has ", N,  IniB),nl,
	N>=2, 
	concat(PairElem0, RestExprIn,OrigStr),
%	write("PairElem0=", PairElem0),nl,
	elem_foundN(OrigStr, EndB, EndN1,EndBPList),%must have the same number as or more than IniB
	EndN1>=N,
%	write("Origstr has N1=",EndN1, " \"",EndB,"\""),nl,
	nThElem_sum(1,N,EndBPlist,EPos),
%	write(" OrigStr= ", OrigStr, " has ", N,"  ", EndB," , Nth pos=", EPos),nl,
	L=EPos,%-1,
	frontstr(L,OrigStr,PairElemT0,RestString0),
	check_expr_syntax(RestString0,IniB,EndB, IniBN,EndBN,SynYN),
	D=EndBN-IniBN,
%	write("SynYN=",SynYN, ", D=",D),nl,
	verify_RestExpr(RestSTring0,RestString, PairElemT0,PairElemT1,EndB, D,SynYN), 
	            %Origstr=(5-2*60+(9-6*60)*(5/7))*(7+9), if RestString=)*(7+9), 
	            % and PairElemT1=(5-2*60+(9-6*60)*(5/7), should adjust to PairElem= (5-2*60+(9-6*60)*(5/7))
	            %and RestString=*(7+9)
	%del IniB and EndB
%	write("concat(\"",IniB,"\",PairElemT2 ?,", PairElemT1,"  ) "),nl, 
	concat(IniB,PairElemT2, PairElemT1), %del IniB and EndB
%	write(" PairElemT2=",PairElemT2),nl,
%	write("concat(",",PairElem?,\"",EndB,"\",", PairElemT2,"  ) "),nl, 
	concat(PairElem, EndB,PairElemT2),
%	concat(EndB,ExprOut, RestString),
	ExprOut=RestString,
%	write("more than 2 IniB, pairElem=", PairElem, ", Reststring=", RestString, ", Final left expr=", ExprOut),nl,
	!.
	
verify_pairElem(RestExprIn,PairElem0,PairElem,EndB,IniB, ExprOut):- %only one (at least has one)
	/* eg: PairElem0= "(2+3)/4" has 1 or no IniB, then PairElem should be PairElem0, ie: (2+3)/4 */
	elem_foundN(PairElem0, IniB, N,_PList),
	N=1,
%	write("concat(",IniB,",PairElemT1 ?,", PairElem0,") "),nl, 
	concat(IniB,PairElemT1, PairElem0), %del IniB and EndB
%	write("concat(",",PairElem?,",EndB, PairElemT1,") "),nl, 
	concat(PairElem, EndB,PairElemT1),
	ExprOut=RestExprIn,
%	write("del ",EndB, " from ", PairElem0, ", PairElem=", PairElem, ", ExprOut=", ExprOut),nl,
%	write(PairElem0, " has  ", N," ", IniB, ", PairElem=",PairElem, ", ExprOut=",RestExprIn),nl,
	!.
verify_pairElem(RestExprIn,PairElem0,_PairElem,EndB,IniB, _ExprOut):- %more than one IniB
	elem_foundN(PairElem0, IniB, N1,_PList),
	concat(PairElem0, RestExprIn,OrigStr),
	elem_foundN(OrigStr, EndB, N2,_EndBPList),%must have the same number as IniB
%	write(PairElem0,"  has ", N1,  IniB, ", and has ", N2, EndB),nl,
	N2<>N1, !,
	beep,
%	write(" wrong syntax in expression. A \")\" may be missing. Check this: \"", OrigStr,"\""),nl,
	fail.

%%%check whether an expression has right syntax

%check_expr_syntax(Str,IniB,EndB, N1,N2,b_true):- %need more elaboration 97.8.8
check_expr_syntax(Str,IniB,EndB, N1,N2,b_true):-
	elem_foundN(Str, IniB, N1,PList1),
	elem_foundN(Str, EndB, N2,PList2),
	N1=N2,
	compare_rlists_sums(PList1,PList2,1,PList1,PList2,"all_smaller",SmYN),
	SmYN=b_true,
	!.
check_expr_syntax(Str,IniB,EndB, N1,N2,b_false):-
	elem_foundN(Str, IniB, N1,_PList1),
	elem_foundN(Str, EndB, N2,_PList2),
	!.
%%%
verify_RestExpr(RestSTring,RestString, PairElemT,PairElemT,_EndB, _D,b_true):-%reststring's syntax is ok
	!.
verify_RestExpr(RestSTring0,RestString, PairElemT0,PairElemT1,EndB, D,b_false):-%reststring's syntax is not ok
%	write(" verify restExpr, not syntactic, D=",D),nl,
	D>0, !,
	elem_foundN(RestSTring0, EndB, EndN,EndBPList),%must have the same number as or more than IniB
	EndN>=D, %may not be necessary
	nThElem_sum(1,D,EndBPlist,EPos),
%	write(" RestSTring0= ", RestSTring0, " has ", EndN, "  ", EndB," ,", D," 's pos=", EPos),nl,
	L=EPos,%-1,
	frontstr(L,RestSTring0,AddStr,RestString),
%	searchstring(RestSTring0,EndB,Pos),
%	frontstr(Pos,RestSTring0,AddStr,RestString),
	concat(PairElemT0,AddStr, PairElemT1),
	!.
	
%%% elem is smaller than same position's in anther list: eg: [1,2,3], [4,5,6], SmYN will be "b_true"
compare_rlists([],[],_,b_true):-!.
compare_rlists([P1|RList1],[P2|RList2],"all_smaller",SmYN):-
	P1<P2, !,
	compare_rlists(RList1,RList2,"all_smaller",SmYN).
compare_rlists([P1|RList1],[P2|RList2],"all_bigger",BigYN):-
	P1<P2, !,
	compare_rlists(RList1,RList2,"all_bigger",BigYN).
compare_rlists([_P1|_RList1],[_P2|_RList2],_,b_false):-!.

%%% acumulative sum of list members. eg: [1,8,9,7], [16,6,1,6], SmyN will be all_smaller, will be true
compare_rlists_sums(_,_,_TN,[],[],_,b_true):-!.
compare_rlists_sums(PL1,PL2,N,[_P1|RList1],[_P2|RList2],"all_smaller",SmYN):-
	nThElem_sum(1,N,PL1,PSum1),
	nThElem_sum(1,N,PL2,PSum2),
	PSum1<PSum2, !,
	NN=N+1,
	compare_rlists_sums(PL1,PL2,NN,RList1,RList2,"all_smaller",SmYN).
compare_rlists_sums(PL1,PL2,N,[_P1|RList1],[_P2|RList2],"all_bigger",SmYN):-
	nThElem_sum(1,N,Pl1,PSum1),
	nThElem_sum(1,N,PL2,PSum2),
	PSum1>PSum2, !,
	NN=N+1,
	compare_rlists_sums(PL1,PL2,NN,RList1,RList2,"all_bigger",SmYN).
compare_rlists_sums(_,_,_,[_P1|_RList1],[_P2|_RList2],_,b_false):-!.