home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / b / binprolog / !BinPro330 / progs / war < prev   
Encoding:
Text File  |  1993-04-30  |  4.9 KB  |  181 lines
  1. % RATIO 1-5 WITH SICSTUS: work on indexing or rewrite add, del etc in "war"
  2. % WARPLAN : a system for generating plans
  3.  
  4. go:-test4.
  5.  
  6. :- op(800,xfy,&).
  7. :- op(900,yfx,:).
  8.  
  9. plans(C,_) :- unless(consistent(C,true)), !, nl, write('impossible'), nl.
  10. plans(C,T) :- time(M0), plan(C,true,T,T1), time(M1), nl, output(T1), nl,
  11.    Time is M1-M0, write(Time), write(' microsecs.'), nl.
  12.  
  13. time(T) :- statistics(runtime,[T,_]).
  14.  
  15. output(T:U) :- !, output1(T), write(U), write('.'), nl.
  16. output(T) :- write(T), write('.'), nl.
  17.  
  18. output1(T:U) :- !, output1(T), write(U), write(';'), nl.
  19. output1(T) :- write(T), write(';'), nl.
  20.  
  21. plan(X&C,P,T,T2) :- !, solve(X,P,T,P1,T1), plan(C,P1,T1,T2).
  22. plan(X,P,T,T1) :- solve(X,P,T,_,T1).
  23.  
  24. solve(X,P,T,P,T) :- always(X).
  25. solve(X,P,T,P1,T) :- holds(X,T), and(X,P,P1).
  26. solve(X,P,T,X&P,T1) :- add(X,U), achieve(X,U,P,T,T1).
  27.  
  28. achieve(_,U,P,T,T1:U ) :- 
  29.    preserves(U,P),
  30.    can(U,C),
  31.    consistent(C,P),
  32.    plan(C,P,T,T1),
  33.    preserves(U,P).
  34. achieve(X,U,P,T:V,T1:V) :- 
  35.    preserved(X,V),
  36.    retrace(P,V,P1),
  37.    achieve(X,U,P1,T,T1),
  38.    preserved(X,V).
  39.  
  40. holds(X,_:V) :- add(X,V).
  41. holds(X,T:V) :- !, 
  42.    preserved(X,V),
  43.    holds(X,T),
  44.    preserved(X,V).
  45. holds(X,T) :- given(T,X).
  46.  
  47. preserved(X,V) :- mkground(X&V,0,_), del(X,V), !, fail.
  48. preserved(_,_).
  49.  
  50. preserves(U,X&C) :- preserved(X,U), preserves(U,C).
  51. preserves(_,true).
  52.  
  53. retrace(P,V,P2) :- 
  54.    can(V,C),
  55.    retrace1(P,V,C,P1),
  56.    conjoin(C,P1,P2).
  57.  
  58. retrace1(X&P,V,C,P1) :- add(Y,V), equiv(X,Y), !, retrace1(P,V,C,P1).
  59. retrace1(X&P,V,C,P1) :- elem(Y,C), equiv(X,Y), !, retrace1(P,V,C,P1).
  60. retrace1(X&P,V,C,X&P1) :- retrace1(P,V,C,P1).
  61. retrace1(true,_,_,true).
  62.  
  63. consistent(C,P) :- 
  64.    mkground(C&P,0,_),
  65.    imposs(S),
  66.    unless(unless(intersect(C,S))),
  67.    implied(S,C&P), 
  68.    !, fail.
  69. consistent(_,_).
  70.  
  71. and(X,P,P) :- elem(Y,P), equiv(X,Y), !.
  72. and(X,P,X&P).
  73.  
  74. conjoin(X&C,P,X&P1) :- !, conjoin(C,P,P1).
  75. conjoin(X,P,X&P).
  76.  
  77. elem(X,Y&_) :- elem(X,Y).
  78. elem(X,_&C) :- !, elem(X,C).
  79. elem(X,X).
  80.  
  81. intersect(S1,S2) :- elem(X,S1), elem(X,S2).
  82.  
  83. implied(S1&S2,C) :- !, implied(S1,C), implied(S2,C).
  84. implied(X,C) :- elem(X,C).
  85. implied(X,_) :- X.
  86.  
  87. notequal(X,Y) :- 
  88.    unless(X=Y),
  89.    unless(X=qqq(_)),
  90.    unless(Y=qqq(_)).
  91.  
  92. equiv(X,Y) :- unless(nonequiv(X,Y)).
  93.  
  94. nonequiv(X,Y) :- mkground(X&Y,0,_), X=Y, !, fail.
  95. nonequiv(_,_).
  96.  
  97. mkground(qqq(N1),N1,N2) :- !, N2 is N1+1.
  98. mkground(qqq(_),N1,N1) :- !.
  99. mkground(X,N1,N2) :- X =.. [_|L], mkgroundlist(L,N1,N2).
  100.  
  101. mkgroundlist([X|L],N1,N3) :- mkground(X,N1,N2), mkgroundlist(L,N2,N3).
  102. mkgroundlist([],N1,N1).
  103.  
  104. unless(X) :-  X, !, fail.
  105. unless(_).
  106.  
  107.  
  108.  
  109. % First STRIPS World
  110.  
  111. test1 :- plans( status(lightswitch(1),on), start).
  112. test2 :- plans( nextto(box(1),box(2)) & nextto(box(2),box(3)), start).
  113. test3 :- plans( at(robot,point(6)), start).
  114. test4 :- plans( nextto(box(2),box(3)) & nextto(box(3),door(1)) &
  115.         status(lightswitch(1),on) & nextto(box(1),box(2)) &
  116.         inroom(robot,room(2)), start).
  117.  
  118. imposs(_) :- fail.  % To stop Quintus complaining.
  119.  
  120. add( at(robot,P),     goto1(P,_)).
  121. add( nextto(robot,X),    goto2(X,_)).
  122. add( nextto(X,Y),     pushto(X,Y,_)).
  123. add( nextto(Y,X),    pushto(X,Y,_)).
  124. add( status(S,on),    turnon(S)).
  125. add( on(robot,B),    climbon(B)).
  126. add( onfloor,        climboff(_)).
  127. add( inroom(robot,R2),     gothru(_,_,R2)).
  128.  
  129. del( at(X,_),U) :- moved(X,U).
  130. del( nextto(Z,robot),U) :- !, del(nextto(robot,Z),U).
  131. del( nextto(robot,X), pushto(X,_,_)) :- !, fail.
  132. del( nextto(robot,B), climbon(B)) :- !, fail.
  133. del( nextto(robot,B), climboff(B)) :- !, fail.
  134. del( nextto(X,_),U) :- moved(X,U).
  135. del( nextto(_,X),U) :- moved(X,U).
  136. del( on(X,_),U) :- moved(X,U).
  137. del( onfloor,climbon(_)).
  138. del( inroom(robot,_), gothru(_,_,_)).
  139. del( status(S,_), turnon(S)).
  140.  
  141. moved( robot, goto1(_,_)).
  142. moved( robot, goto2(_,_)).
  143. moved( robot, pushto(_,_,_)).
  144. moved( X, pushto(X,_,_)).
  145. moved( robot, climbon(_)).
  146. moved( robot, climboff(_)).
  147. moved( robot, gothru(_,_,_)).
  148.  
  149.  
  150. can( goto1(P,R), locinroom(P,R) & inroom(robot,R) & onfloor).
  151. can( goto2(X,R), inroom(X,R) & inroom(robot,R) & onfloor).
  152. can( pushto(X,Y,R),
  153.     pushable(X) & inroom(Y,R) & inroom(X,R) & nextto(robot,X) & onfloor).
  154. can( turnon(lightswitch(S)),
  155.     on(robot,box(1)) & nextto(box(1), lightswitch(S))).
  156. can( climbon(box(B)), nextto(robot,box(B)) & onfloor).
  157. can( climboff(box(B)), on(robot,box(B))).
  158. can( gothru(D,R1,R2),
  159.     connects(D,R1,R2) & inroom(robot,R1) & nextto(robot,D) & onfloor).
  160.  
  161. always( connects(D,R1,R2)) :- connects1(D,R1,R2).
  162. always( connects(D,R2,R1)) :- connects1(D,R1,R2).
  163. always( inroom(D,R1)) :- always(connects(D,_,R1)).
  164. always( pushable(box(_))).
  165. always( locinroom(point(6),room(4))).
  166. always( inroom(lightswitch(1),room(1))).
  167. always( at(lightswitch(1),point(4))).
  168.  
  169. connects1(door(N),room(N),room(5)) :- range(N,1,4).
  170.  
  171. range(M,M,_).
  172. range(M,L,N) :- L < N, L1 is L+1, range(M,L1,N).
  173.  
  174. given( start, at(box(N), point(N))) :- range(N,1,3).
  175. given( start, at(robot,point(5))).
  176. given( start, inroom(box(N),room(1))) :- range(N,1,3).
  177. given( start, inroom(robot,room(1))).
  178. given( start, onfloor).
  179. given( start, status(lightswitch(1),off)).
  180.  
  181.