jxl6222.bak

prolog,人工智能推理程序,运行环境prolog

nowarnings
TRACE askwrite
/*TRACE start initdbf readonerec init_Dbase3 rd_dbase3_DbaseHeader rd_dbase3_datarec process  select
*//*
trace process qandorrule  ASKWRITE TEST /*start initdbf init  disp andorrule andrule*/ /*deside deside1 qandorrule qandrule question
*/*/ /* rule  reduce system */
/*  autheror  jxl
     date     1991  6 3
     time

      call  in foxplus
	:-run jxl.exe
*/
include "ronerec.pro"
include "meundss.pro"
domains
  list=integer*
  list1=list*
  base=base(integer,integer,symbol,integer,real)
  baselist=base*
DATABASE -privdbase
 base1(integer,integer,integer,real)
 base(integer,integer,symbol,integer,real)
 rule(symbol,list1,list,list1)
 question(symbol,list1,list,list1)
 topic(string,string)
 result(integer,string)
 totels(integer)
 yes(integer)
 no(integer)

DATABASE-public
 rel(integer,string)
 foxrec(Dbase3rec)
predicates
 start
 initdbf(integer)
 init(symbol)
 study(symbol,list1,list,list1,baselist)
 saveknownledge(string)
 insertbase(baselist,list1,list1)
 ask(symbol,symbol)
 check_ans(symbol,symbol)
 resphone(symbol,real,real)
 resphone1(symbol,real,real)
 askwrite(list1,list)
 process(string,string)
 test(list1,list,list)
 qandorrule(list1,list1,baselist)
 qandrule(list,list,baselist,integer,integer)
 andorrule(list1)
 andrule(list)
 deside(integer,real,real)
 deside1(symbol,real,real)
 writeresult(list)
 writeresult1(list)
 del(list,list)
 member(integer,list)
 select(integer,Dbase3Elem)
 select1(Dbase3rec,integer,Dbase3Elem)
 ed(string,string)
 display1(string,string)
 change(integer,string)
 disp(integer,integer,real,real,string)
 repeat
 choice(string)
clauses
 choice(">").
 choice("<").
 choice("=").
 choice(">=").
 choice("<=").
 ed(S1,S2):-concat(S2,".dat",S3),file_str(S3,Str),
	    makewindow(1,3,4,S1,3,5,18,70,1,255,"++++-|"),
	    edit(Str,Sout,S2,"Esc-exit","",0,"",1,1,1,00,_,_),
	    file_str(S3,Sout),process("I",S2),
	    removewindow(1,0),
	    shift(2),shift(3),shift(4),shift(5).
 display1(S1,S2):-makewindow(1,3,4,S1,3,5,18,70,1,255,"++++-|"),
		  display(S2),removewindow(1,0),
		  shift(2),
		  shift(3),
		  shift(4),
		  shift(5).
 start:-initdbf(1),/*initgraph(9,0,New,New1,""),*/
	shiftwindow(2),
/*	makewindow(2,3,4,"",20,2,5,70,1,255,"++++-|"),*/
	select(67,char(Ss)),
	select(66,char(Ss2)),
	init(Ss),/*write(Ss,"  ",Ss2),*/
	upper_lower(Ss22,Ss2),
	process(Ss22,Ss),
/*	removewindow(2,0),*/
	retract(foxrec(_)),readchar(_),closegraph.
 /*  M---------------modify knownledge		    */
 /*  i---------------init knownledge		    */
 /*  D---------------delte knowledge		    */
 /*  A---------------Appand knowledge		    */

 /*  S---------------Display rule		    */
 /*  Other-----------				    */
 process("R",Name):-repeat,writeinf(7),
		    readint(N),N<=4,!,initdbf(N),
		    select(66,char(S1)),
		    select(67,char(S2)),!,process("I",S2),
		    upper_lower(S11,S1),
		    !,process(" ",S2).
 process("E",Name):-closegraph,exit,!.
 process("O",Name):-repeat,shift(3),shift(4),shift(2),shift(5),
		    cursor(5,2),write("请点菜单"),nl,write(" (M,D,A,I,S,E)?_"),
		    readln(Ch),
		    upper_lower(Ch1,Ch),check_ans(Ch1,Ch1),
		    process(Ch1,Name),
		    Ch1="E",!.
 process("M",Name):-Str="修改窗", /*write(Name,"    "),*/ ed(Str,Name),!.
 process("I",Name):-concat(Name,".dat",Name1),
                    existfile(Name1),
                    retractall(_,privdbase),
		    consult(Name1,privdbase),!.
 process("I",Name):-!,shiftwindow(2),clearwindow,
                    cursor(1,2),write("Sorry file ",Name,".dat  not exist!"),
                    readchar(_),fail.		    
 process("D",Name):-Str="删除窗",ed(Str,Name),!.
 process("A",Name):-Str="增加窗",ed(Str,Name),!.
 process("S", Name):-Str="显示窗",
		     concat(Name,".dat",Name1),
		     file_str(Name1,Ss),
		     display1(Str,Ss),!.
 process(_,Name):-rule(_,L,N,LL),
		  andorrule(LL),
		  test(L,N,N1),
		  retract(rule(_,L,N,LL)),
		  asserta(rule(Name,L,N1,LL)),
		  saveknownledge(Name),
		  writeresult(N1),!,readchar(_).
 process(_,Name):-question(_,L,N,LL),
		qandorrule(LL,LL1,Baserulelist),
		test(L,N,N1),
		writeresult(N1),
		study(Name,L,N1,LL1,Baserulelist),
		!,process("I",Name).
 process(_,Name):-shiftwindow(2),clearwindow,cursor(1,1),
		write("很抱歉!我不能回答你的",Name," 问题!"),
		readchar(_).
 test(L,[],N1):-!,askwrite(L,N1).
 test(L,N,N).
 askwrite([],[]):-!,fail.
 askwrite([X|_],N):- shiftwindow(2),
		       clearwindow,
		     /*  write("结论 : "),*/
		       writeresult1(X),nl,
		       write(" <结论正 确 吗 ?>"),
		       ask(Ask,_),
		       Ask="y",
		       N=X,!.
 askwrite([_|Y],N):-askwrite(Y,N).
 study(Name,L,N,LL1,Baserule):-not(rule(_,L,N,LL1)),
		      !,
		      insertbase(Baserule,LL1,LL2),
		      assert(rule(Name,L,N,LL2)),
		      saveknownledge(Name).
 study(_,_,_,_,_).
 insertbase([],[[]],[[]]).
 insertbase([base(A,B,C,D,E)|Y],[[X|Y0]],[[X|Y1]]):-not(base(_,B,C,D,E)),!,
				  assertz(base(A,B,C,D,E)),
				  insertbase(Y,[Y0],[Y1]).
 insertbase([base(A,B,C,D,E)|Y],[[X|Y0]],[[A1|Y1]]):-base(A1,B,C,D,E),
				   insertbase(Y,[Y0],[Y1]).
 qandorrule([],[],[]):-!,fail.
 qandorrule([X|_],[X1],L1):-totels(Totel),
				  qandrule(X,X1,L1,Totel,TT),
				  retract(totels(_)),!,
				  assertz(totels(TT)).
 qandorrule([_|Y],L1,L2):-qandorrule(Y,L1,L2).
 qandrule([],[],[],X,X).
 qandrule([X|Y],[XX1|L1],[base(XX1,A,R,B,V1)|L2],XX,X2):-base1(X,A,B,V),
			   XX1=XX+1,
			   disp(A,B,V,V1,R),
			   deside(B,V3,V1),
			   deside(A,V4,V1),
			   deside1(R,V4,V3),
			   qandrule(Y,L1,L2,XX1,X2).
 disp(0,A,V,V1,R):-shiftwindow(2),clearwindow,
		   change(A,S1),
		   choice(R),
		   write(" ",V,R,S1,"?"),
		   ask(Ask,_),/*write(Ask),*/
		   resphone(Ask,V,V1).
 disp(A,B,V,V1,R):-shiftwindow(2),
		    clearwindow,
		    change(A,S1),
		    change(B,S2),
		    choice(R),
		    write(S1,R,S2,"?"),
		    ask(Ask,_),
		    Ask="y" ,V>=0,V1=0.
 initdbf(N):-openread(fp,"inter.dbf"),
	    readdevice(fp),
	    filemode(fp,0),
	    init_dbase3(Totel,_,Flddl,Headlen,Reclen),/*write("filee---",Headlen,"  ",Reclen),*/
	    readonerec(Totel,Headlen ,Reclen,Flddl,N,Rec),/*write(rec),*/
	    closefile(fp),
	    retractall(foxrec(_),public) ,
	    assertz(foxrec(Rec)),
	    readdevice(keyboard).
 init(Name):-
       concat(Name,".dat",Name1),
       consult(Name1,privdbase),
       consult("public.dat",public).
 saveknownledge(Name):-concat(Name,".dat",Name1),
		   /*	retract(foxrec(_)),*/
		      save(Name1,privdbase).
 andorrule([]):-!,fail.
 andorrule([X|_]):-andrule(X),!.
 andorrule([_|Y]):-andorrule(Y).
 andrule([]).
 andrule([X|Y]):-base(X,A,R,B,Value),
		 deside(B,V1,Value),
		 deside(A,V2,Value),
		 deside1(R,V2,V1),
		 andrule(Y).
 deside(0,V1,V2):-V1=V2,!.
 deside(A,V1,_):-select(A,real( V1 )).
 deside1(">",V1,V2):-V1>V2,!.
 deside1("=",V1,V2):-V1=V2,!.
 deside1("<",V1,V2):-V1<V2,!.
 deside1("<=",V1,V2):-V1<=V2,!.
 deside1(">=",V1,V2):-V1>=V2,!.
 del([],[]).
 del([X|Y],[X|L]):-not(member(X,Y)),!,del(Y,L).
 del([_|Y], L):-del(Y,L).
 member(X,[X|_]):-!.
 member(X,[_|Y]):-member(X,Y).
 ask(X,S ):-repeat,
	    readln(Y),check_ans(Y,X),S=Y,!.
 check_ans(yes,y ).
 check_ans("YES",y).
 check_ans(no,n).
 check_ans("NO",n).
 check_ans(y,y).
 check_ans("Y",y).
 check_ans(n,n).
 check_ans("N",n).
 check_ans("M","M").
 check_ans("A","A"). 
 check_ans("D","D").
 check_ans("R","R").
 check_ans("I","I").
 check_ans("S","S").
 check_ans("E","E").
 resphone(y,V,V).
 resphone(n,V1,V2):-shiftwindow(2),clearwindow,
		    write("标准数据是:",V1," :吗?"),
		    ask(Ask,_),
		    resphone1(Ask,V1,V2).
 resphone1(n,_,V2):-!,shiftwindow(2),clearwindow,
		   write(" 请输入新的标准数据:"),
		   readreal(V2).
 resphone1(y,V,V).
 repeat.
 repeat:-repeat.
 writeresult(N):-shiftwindow(2),clearwindow,writeresult1(N).
 writeresult1([]).
 writeresult1([X|Y]):-result(X,Ss),
		      write(Ss),
		      writeresult1(Y).
 select(N,X):-foxrec(X1),select1(X1,N,X).
 select1([X|_],1,X):-!.
 select1([_|Y],N,X):-N1=N-1,select1(Y,N1,X).
 change(I,Str):-rel(I,Str).

goal  meun,start,readchar(_).