jxl6120.pro

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

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

      call  in foxplus
        :-run jxl.exe
*/
include "ronerec.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)
 foxrec(Dbase3rec)
DATABASE-public 
 rel(integer,string)  
predicates
 start
 initdbf
 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)
 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),
            clearwindow,
            makewindow(1,3,4,S1,5,5,18,75,1,255,"++++-|"),
            edit(Str,Sout,S2,"","",0,"",1,1,1,00,_,_),
            file_str(S3,Sout),removewindow(1,0).
 start:-initdbf,initgraph(9,0,New,New1,""),
  
        makewindow(2,3,4,"",20,2,5,70,1,255,"++++-|"),
        select(67,char(Ss)),
        select(66,char(Ss2)),
        init(Ss),/*write(Ss,"  ",Ss2),*/
        process(Ss2,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("M",Name):-Str="Modify",/*write(Name,"    "),*/ ed(Str,Name),!.
 process("I",Name):-concat(Name,".dat",Name1),
                    consult(Name1),!.
 process("D",Name):-Str="delete",ed(Str,Name),!.
 process("A",Name):-Str="Appand",ed(Str,Name),!.
 process("S", Name):-concat(Name,".dat",Name1),
                     file_str(Name1,Ss),display(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),!.
 process(_,Name):-question(_,L,N,LL),
                qandorrule(LL,LL1,Baserulelist),
                test(L,N,N1),
                writeresult(N1),
                study(Name,L,N1,LL1,Baserulelist),!.
 process(_,Name):-shiftwindow(2),clearwindow,
                write("sorry your ",Name,"  cann't be proved!").
 test(L,[],N1):-askwrite(L,N1),!.
 test(L,N,N).
 askwrite([],[]).
 askwrite([X|_],N):- shiftwindow(2),
                       clearwindow,
                       write("is this "),
		       writeresult1(X),	
                       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).
 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,V)|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(" ",S1,R,V,"?"),
                   ask(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:-openread(fp,"inter.dbf"),
	    readdevice(fp),	
            filemode(fp,0),
            init_dbase3(Totel,_,Flddl,Headlen,Reclen),/*write("filee---",Headlen,"  ",Reclen),*/
            readonerec(Totel,Headlen ,Reclen,Flddl,1,Rec),/*write(rec),*/
            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(no,n).
 check_ans(y,y).
 check_ans(n,n).
 resphone(y,V1,V2):-shiftwindow(2),clearwindow,
                    write("standart data is:",V1,"?"),
		    ask(Ask,_),
		    resphone1(Ask,V1,V2).
 resphone1(y,_,V2):-!,shiftwindow(2),clearwindow,
 		   write("please input New data:"),
 		   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  start.