home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / b / binprolog / !BinPro330 / progs / bfmeta < prev    next >
Encoding:
Text File  |  1993-09-19  |  1.9 KB  |  79 lines
  1. :-op(600,xfx,<=).
  2.  
  3. clauses([
  4.     app([],A,A,B)<=B,
  5.     app([C|D],E,[C|F],G)<=app(D,E,F,G),
  6.  
  7.     nrev([],[],H)<=H,
  8.     nrev([I|J],K,L)<=nrev(J,M,app(M,[I],K,L)),
  9.  
  10.     perm([],[],N)<=N,
  11.     perm([O|P],Q,R)<=perm(P,S,ins(O,S,Q,R)),
  12.  
  13.     ins(T,U,[T|U],V)<=V,
  14.     ins(W,[X|Y],[X|Z],X0)<=ins(W,Y,Z,X0)
  15. ]).
  16.  
  17. all(G,R):-clauses(C),all_instances(G,C,R).
  18.  
  19. all_instances(Goal,Clauses,Answers):-
  20.         derive_all([Goal<=Goal],Clauses,[],Answers).
  21.  
  22. % derives all answers until there is no Arrow=(Answer<=Goal) left
  23.  
  24. derive_all([],_,As,As).
  25. derive_all([Arrow|Fs],Cs,OldAs,NewAs):-
  26.         derive_one(Arrow,Cs,Fs,NewFs,OldAs,As),
  27.         derive_all(NewFs,Cs,As,NewAs).
  28.  
  29. % if Answer<=true has been deduced then keep answer
  30. % else replace Answer<=Goal with its consequences Answer<=Body
  31. % obtained from input clauses of the form Goal<=Body
  32.  
  33. derive_one(Answer<=true,_,Fs,Fs,As,[Answer|As]).
  34. derive_one(Answer<=Goal,Cs,Fs,NewFs,As,As):-Goal\==true,
  35.         match_all(Cs,Answer<=Goal,Fs,NewFs).
  36.  
  37. match_all([],_,Fs,Fs).
  38. match_all([Clause|Cs],Arrow,Fs1,Fs3):- 
  39.         match_one(Arrow,Clause,Fs1,Fs2),
  40.         match_all(Cs,Arrow,Fs2,Fs3).
  41.  
  42. % basic inference step
  43.  
  44. match_one(F1,F2,Fs,[F3|Fs]):-compose(F1,F2,F3),!.
  45. match_one(_,_,Fs,Fs).
  46.  
  47. /*
  48. compose(F1,F2,A<=C):-
  49.     write(F1+F2=before),nl,
  50.         copy_term(F1,A<=B),
  51.     write(after(A<=B)),nl,
  52.         copy_term(F2,B<=C),write(F1+F2=(A<=C)),nl
  53. .
  54. */
  55.  
  56. compose(A<=B1,B2<=C,R):-findall(A<=C,B1=B2,[R]).
  57.  
  58. time(G,T):-statistics(runtime,_),G,!,statistics(runtime,[_,T]).
  59.  
  60. i1:-G=nrev([a(X),b,c(X)],_,true), all(G,R),write(R),nl.
  61.  
  62. i2:-G=app(_,_,[a,b],true), all(G,R),statistics,write(R),nl.
  63.  
  64. i3:-G=perm([a,b,c],_,true), all(G,R),statistics,write(R),nl.
  65.      
  66. integers([],I,I):-!.
  67. integers([I0|L],I0,I):-I0<I,I1 is I0+1,integers(L,I1,I).
  68.  
  69. bm(N):-
  70.     Len is N+1,
  71.     integers(Is,1,Len),
  72.     G=nrev(Is,_,true), 
  73.      time(all(G,_),T),
  74.      L is 1000*(N+1)*(N+2)//(2*T),
  75.      statistics, 
  76.      write(time-T+lips-L),nl.
  77.      
  78. go:-bm(20).
  79.