expnstr.pro

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

%This module expands string : "A1*B1+...An*Bn" to "A1*B1+A2*B2+A3*B3",
%if specify n=3

/*
include "tools.pro"
DOMAINS
%slist=string*
file=temp
*/
include "formula.inc"
include "formula.con"
include "hlptopic.con"

PREDICATES
%expand_str_loop(string Instr, integer N,string Outstr)-(i,i,o) %Instr must be "A1*B1+...An*Bn"
expand_str(string InfStrUnit,integer N,slist ToBeList,slist WithList, string NewInfStrUnit) %Instr ="A1*B1+"
            %N=5, OutStr should be "A1*B1+A2*B2+A3*B3+A4*B4+A5*B5"
%ToBeList=["A1","B1"], Withlist will be [A1,A2,A3,A4,A5,B1,B2,B3,B4,B5]
find_infinite(STRING InStr,string InfStrUnit,slist InfUnitList,string BFUnitSTr,string RInStr)%Instr is an infinite string , found unit

CLAUSES
/*
expand_str_loop(Instr,_N,Toutstr, Outstr,VarList,VarList):-
	concat(Toutstr,Instr,OutStr),
	not(searchstring(Instr, "...", _)),
	!.
expand_str_loop(Instr,N, TOutStr, Outstr,TVarList,VarList):-
	find_infinite(InStr,InfStrUnit,InfUnitList,BFUnitSTr,RInStr),%InfStrUnit="A1*B1+"
	            %RInStr=str cut from "Bn", like: "-8*C1-...Cn+3"
%	write("InfStrUnit=", InfStrUnit, ", InfUnitList=",InfUnitList,",RInStr=",RinStr),nl,
%	expand_str_loop(RInstr,N, TOutstr),
%	repl_slist_lastChar(InfUnitList,3, WithList),
	%process the cut unit:
	expand_str(InfStrUnit,N,InfUnitList,WithList, UnExpandedStr0),
%	write("InfStrUnit ",InfStrUnit, " was expanded to ", UnExpandedStr0, " ,\n replaced list =", WithList),nl,
	%if UnExpandedStr0="A1*B1+A2*B2+A3*B3+", a "+" should be deleted:
	str_len(UnExpandedStr0,L0),
	L=L0-1,
	frontstr(L,UnExpandedStr0,UnExpandedStr,NewInfLast),
	slist_member(NewInfLast,["+","-","*","/"],YN),
	YN=b_true, !,
	concat(TOutStr, BFUnitSTr,TOutStr1),
	concat(TOutStr1,UnExpandedStr,NTOutstr),
	concat_slists(TVarList,WithList,NTVarList),
	expand_str_loop(RInstr,N, NTOutstr,OutStr,NTVarList,VarList).
	
expand_str_loop(Instr,_N,_TOutStr, INstr,_TVarList,_VarList):-
	beep,
	format(Msg, "公式\"%-\"有语法错误。",Instr),
	dlg_note(Msg),
	fail.
	concat(Toutstr,Instr,OutStr),
	not(searchstring(Instr, "...", _)),
	!.
*/

expand_str_loop(Outstr,VarList):-
	retract(expand_rec(InStr, TOutstr,TVarList, N)),
	find_infinite(InStr,InfStrUnit,InfUnitList,BFUnitSTr,RInStr),%InfStrUnit="A1*B1+"
	            %RInStr=str cut from "Bn", like: "-8*C1-...Cn+3"
%	write("InfStrUnit=", InfStrUnit, ", InfUnitList=",InfUnitList,",RInStr=",RinStr),nl,
%	expand_str_loop(RInstr,N, TOutstr),
%	repl_slist_lastChar(InfUnitList,3, WithList),
	%process the cut unit:
	retractall(do_expand_rec(_,_,_)),
	assert(do_expand_rec(1,TVarList,"")),
%	write("rec TVArlist=",TVArList),nl,
	expand_str(InfStrUnit,N,InfUnitList,WithList, UnExpandedStr0),
%	write("InfStrUnit ",InfStrUnit, " was expanded to ", UnExpandedStr0, " ,\n replaced list =", WithList),nl,
	%if UnExpandedStr0="A1*B1+A2*B2+A3*B3+", a "+" should be deleted:
	str_len(UnExpandedStr0,L0),
	L=L0-1,
	frontstr(L,UnExpandedStr0,UnExpandedStr,NewInfLast),
	slist_member(NewInfLast,["+","-","*","/"],YN),
	YN=b_true,
	concat(TOutStr, BFUnitSTr,TOutStr1),
	concat(TOutStr1,UnExpandedStr,NTOutstr),	
	check_concat_slists(TVarList,WithList,NTVarList),
	assert(expand_rec(RInStr,  NTOutStr, NTVarList,N)),
	not(searchstring(RInStr, "...",_)),!,
	concat(NToutstr,RInstr,OutStr),
	VarList=NTVarList,
%	write("after expand, outstr=", OutStr, ", VarList=",VarList),nl,
	!.
		
expand_str_loop(_Instr,_VarList):-
	beep,
%	format(Msg, "公式\"%-\"有语法错误。",Instr),
	Msg= "公式有语法错误。",
	dlg_note(Msg),
	fail.


%%%
/*	
expand_str(_Instr,0,_ToBeList,[], ""):- !.
expand_str(Instr,N,ToBeList,WithList, OutStr):- 
	NN=N-1,
	expand_str(Instr,NN,ToBeList,TWithList, TOutStr),
	%replace 1 in A1 and B1 with N, so to get A2, B2: 
	str_real(Nstr,N),
	repl_slist_lastChar(ToBeList,Nstr, ToBeListAdded),
%	write("replace ", ToBeList, " with ", N, ", out is ",ToBeListAdded),nl,
	%replace A1 and B1 in Instr with A2 and B2
	replace_str(Instr, ToBeList,ToBeListAdded,"",NTOutStr), 
%	write("replace instr \"", Instr,"\" with ", ToBeListAdded, ", out is ", NTOutStr),nl,
	concat_slists(TWithList,ToBeListAdded, WithList),
%	write("combine ", TWithList, " with ", ToBeListAdded, " Out is ", WithList),nl,
	concat(TOutStr, NToutStr, Outstr).
%	write(" combine ",TOutStr , " with ", NTOutStr, ", Out is ", Outstr),nl.
*/
expand_str(_Instr,0,_ToBeList,[], ""):- !.
expand_str(Instr,N,ToBeList,WithList, OutStr):- 
	retract(do_expand_rec(C,TWithList,TOutStr)),
%	write("C=",C),nl,
%	NN=N-1,
%	expand_str(Instr,NN,ToBeList,TWithList, TOutStr),
	%replace 1 in A1 and B1 with N, so to get A2, B2: 
	str_real(Cstr,C),
	repl_slist_lastChar(ToBeList,Cstr, ToBeListAdded),
%	write("replace ", ToBeList, " with ", N, ", out is ",ToBeListAdded),nl,
	%replace A1 and B1 in Instr with A2 and B2
	replace_str(Instr, ToBeList,ToBeListAdded,"",NTOutStr), 
%	write("replace instr \"", Instr,"\" with ", ToBeListAdded, ",  out= ", NTOutStr),nl,
	check_concat_slists(TWithList, ToBeListAdded,NTWithList),
%	write("combine ", TWithList, " with ", ToBeListAdded, " Out is ", NTWithList),nl,
	concat(TOutStr, NToutStr, NNTOutstr),
%	write("concat combine ",TOutStr , " with ", NTOutStr, ", Out is ", NNTOutstr),nl,
	NC=C+1,
	assert(do_expand_rec(NC,NTWithList,NNTOutStr)),
%	write("Nc=",C, "+ 1=", NC, ", N=",N),nl,
	NC>N,
	OutStr=NNTOutstr,
	WithList=NTWithList,
	retractall(do_expand_rec(_,_,_)),
%	write("final outstr =", Outstr),nl,
	!.	
	
%%%begin: find and segment infinite str

PREDICATES
seg_infElem(STRING InfStrUnit, slist InfUnitList) %InfstrUnit = "A1*B1+", InfUnitList=["A1","B1"], 
seg_InfUnit(string InfStrUnit0,string TNotstr ,string BFStr, string InfStrUnit)%bf marker is letter+"1"

CLAUSES
find_infinite(InStr,InfStrUnit,InfUnitList,BFStr,RInStr):-%Instr is an infinite string , found unit
	searchstring(Instr, "...", P),!,
	L=P-1, 
	frontstr(L,Instr,InfStrUnit0,RestInStr1),%InfStrUnit0="1+A1*B1+"
%	write("InfStrUnit0=",InfStrUnit0,",RestInStr1=",RestInStr1), nl,
	seg_InfUnit(InfStrUnit0, "",BFStr, InfStrUnit),%BFStr="1+", 
	fronttoken(InfstrUnit,_,_),
%	write("found unit=", InfStrUnit),nl,
	seg_infElem(InfStrUnit, InfUnitList), %InfUnitList=["A1","B1"], 
%	write("got InfUnitList=",InfUnitList),nl,
	%get the last elem of unitlist:
	slist_length(InfUnitList, ListNo), 
%	write("InfUnitList 's number is ", ListNo),nl,
	ListNo<>0,
	nth_Slist_member(LastMem,InfUnitList, ListNo,1),
	fronttoken(LastMem,_,_),
%	write(ListNo, "'s mem is ", LastMem),nl,
	%find the last unit elem: "Bn",
	concat(LastUnitElem,"1",LastMem),
%	replace_str(LastMem,["1"],["n"], "",LastUnitElem),
%	write("replace 1 with n, in ", LastMem, "),nl,
%	write(" last UnitElem is ", LastUnitElem),nl,
	concat(LastUnitElem, "n", LastUnitElem_n),
	searchstring(RestInStr1, LastUnitElem_n,P2),
	str_len(LastUnitElem_n, L2),
	L3=P2+L2-1,
	frontstr(L3,RestInStr1,_deletedStr, RInStr),
	!.	
find_infinite(InStr,"",[],"",InStr):-%Instr is not an infinite string , found unit
 	!.
 %%%end: find and segment infinite str

PREDICATES
check_got(string T, slist TInfUnitList, slist InfUnitList)
CLAUSES
%%%begin: segment the InfStrUnit into a list
seg_infElem(InfStrUnit, []):-
	not(fronttoken(InfStrUnit,_,_)),
	!.
seg_infElem(InfStrUnit, InfUnitList):- %InfstrUnit = "A1*B1", InfUnitList=["A1","B1"], 
	fronttoken(InfStrUnit, T,RestInStr),
	seg_infElem(RestInstr, TInfUnitList),
	check_got(T, TInfUnitList, InfUnitList).
%%
check_got(T, TInfUnitList, InfUnitList):-%infinite var is marked as Letter(s) +1
	searchstring(T,"1", _),
	upper_lower(T1,T), 
	frontchar(T1,FrontChar,_RestString), %is a letter?
	FrontChar>=65, %'A'
	FrontChar<=90, %'Z'
	InfUnitList=[T|TInfUnitList],
	!.
check_got(_T, InfUnitList, InfUnitList):-% not a inf unit
	!.
	
%%%end: segment the InfStrUnit into a list
%%%begin: segment other str from infinite unit eg: "2+A1*B1+" : "2+", and "A1*B1+"
seg_InfUnit(InfStrUnit,  _TnotStr,InfStrUnit,""):-%no inf
	not(searchstring(InfStrUnit, "1", _)),!,
	beep,	
	format(Msg,"\"%-\"没有合法的变量名。不定变量名应由一个字母+\"1\"组成。",InfStrUnit),
	dlg_note(Msg),
%	write(Msg),nl,
	fail.
seg_InfUnit(InfStrUnit0,TNotStr, BFStr, InfStrUnit):-%bf marker is letter+"1"
	searchstring(InfStrUnit0, "1", P),
	First=P-1,
	First>0,
	substring(InfStrUnit0,First,1,Letterstr),
	is_letter(Letterstr, StrYN),
	StrYN=yes,
	Length=First-1,
	frontstr(Length,InfStrUnit0,HereTNotStr,InfStrUnit),
	concat(TNotStr, HereTNotStr, BFStr),
	!.
seg_InfUnit(InfStrUnit0, TNotStr, BFStr, InfStrUnit):-%bf marker is not a letter, go on to find
	searchstring(InfStrUnit0, "1", P),
/*	First=P-1,
	substring(InfStrUnit0,First,1,Letterstr),
	is_letter(Letterstr, StrYN),
	StrYN=no,
	*/
	frontstr(P,InfStrUnit0,HereNotstr,RInfStrUnit0),%eg: "1+A1*B1+", not="1", RIn="+A1*B1+"
	concat(TNotStr,HereNotstr, NTNotStr), 
	seg_InfUnit(RInfStrUnit0, NTNotStr, BFStr,InfStrUnit).
%%%end: segment other str from infinite unit eg: "2+A1*B1+" : "2+", and "A1*B1+"


/*
GOAL
%
%fronttoken("A1*B1",T,_).
%concat_slists(["1","2"],["3","4"],TSlist3).
openwrite(temp, "temp.txt"),
writedevice(temp),
expand_str_loop("C1/D1...+Cn/Dn" , 5,OutStr),
write("\nout=",Outstr),
closefile(temp).

%replace_str("E*A1*B1+c",["A1","B1"],["A2","B2"],"",NTOutStr).


*/