jxl531.pro

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

nowarnings
/*TRACE start initdbf readonerec init_Dbase3 rd_dbase3_DbaseHeader rd_dbase3_datarec process  select
*//*
trace 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
 base1(integer,integer,integer,real)
 base(integer,integer,symbol,integer,real)
 rule(symbol,list,integer,list1)
 question(symbol,list,integer,list1)
 topic(string,string)
 result(integer,string)
 totels(integer)
 yes(integer)
 no(integer)
 foxrec(Dbase3rec)
 rel(integer,string)  
predicates
 start
 initdbf
 init(symbol)
 study(symbol,list,integer,list1,baselist)
 saveknownledge(string)
 insertbase(baselist,list1,list1)
 ask(symbol,symbol)
 check_ans(symbol,symbol)
 resphone(symbol,real,real)
 resphone1(symbol,real,real)
 askwrite(list,integer,integer)
 process(string,string)
 test(list,integer,integer)
 qandorrule(list1,list1,baselist)
 qandrule(list,list,baselist,integer,integer)
 andorrule(list1)
 andrule(list)
 deside(integer,real,real)
 deside1(symbol,real,real)
 writeresult(integer)
 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,8,3,60,1,255,"++++-|"),
        select(6,char(Ss)),
        select(5,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),
	      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,0,N1):-askwrite(L,N1,1),!.
 test(L,N,N).
 askwrite([],0,_).
 askwrite([X|_],N,_):-shiftwindow(2),clearwindow,
                       result(X,Ss),
                       write("is this ",Ss),
                       ask(Ask,_),
                       Ask="y",
                       N=X,!.
 askwrite([_|Y],N,N1):-N2=N1+1,askwrite(Y,N,N2).
 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),
            readonerec(Totel,Headlen ,Reclen,Flddl,1,Rec),/*write(rec),*/
            assertz(foxrec(Rec)),readdevice(keyboard).
 init(Name):-
       concat(Name,".dat",Name1),
       consult(Name1).
 saveknownledge(Name):-concat(Name,".dat",Name1),
		      retract(foxrec(_)),
                      save(Name1).
 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,result(N,Ss),write(Ss).
 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.