1:- include('../ec_test_incl').    2/*
    3
    4   Formulae for the mail delivery domain.
    5
    6   Example queries:
    7
    8
    9*/
   10
   11do_test(mail1)   :- abdemo_special(loops,[holds_at(inRoom(p1,r2),t)],R).
   12do_test(mail2)   :- abdemo_special(loops,[holds_at(inRoom(p1,r3),t)],R).
   13
   14/* Compound actions */
   15
   16
   17axiom(happens(shift_pack(Agnt,P,R1,R2,R3),T1,T6),
   18     [happens(go_to_room(Agnt,R1,R2),T1,T2),
   19     b(T2,T3), not(clipped(T2,atRoom(Agnt,R2),T3)), not(clipped(T1,inRoom(P,R2),T3)),
   20     happens(pick_up(Agnt,P),T3), b(T3,T4), happens(go_to_room(Agnt,R2,R3),T4,T5),
   21     b(T5,T6), not(clipped(T3,got(Agnt,P),T6)), not(clipped(T5,atRoom(Agnt,R3),T6)),
   22     happens(put_down(Agnt,P),T6)]).
   23
   24axiom(initiates(shift_pack(Agnt,P,R1,R2,R3),inRoom(P,R3),T),
   25     [holds_at(atRoom(Agnt,R1),T), holds_at(inRoom(P,R2),T)]).
   26
   27                                            
   28axiom(happens(go_to_room(Agnt,R,R),T,T),[]).
   29
   30axiom(happens(go_to_room(Agnt,R1,R3),T1,T3),
   31     [connects(D,R1,R2), towards(R2,R3,R1),
   32     happens(go_to_room(Agnt,R2,R3),T2,T3), b(T1,T2), happens(go_through(Agnt,D),T1),
   33     not(clipped(T1,atRoom(Agnt,R2),T2))]).
   34
   35axiom(happens(go_to_room(Agnt,R1,R3),T1,T3),
   36     [connects(D,R1,R2), happens(go_through(Agnt,D),T1),
   37     happens(go_to_room(Agnt,R2,R3),T2,T3), b(T1,T2),
   38     not(clipped(T1,atRoom(Agnt,R2),T2))]).
   39
   40axiom(initiates(go_to_room(Agnt,R1,R2),atRoom(Agnt,R2),T),[holds_at(atRoom(Agnt,R1),T)]).
   41
   42
   43
   44/* Primitive actions */
   45
   46
   47axiom(initiates(pick_up(Agnt,P),got(Agnt,P),T),
   48     [diff(P,robot), holds_at(inRoom(P,R),T), holds_at(atRoom(Agnt,R),T)]).
   49
   50axiom(releases(pick_up(Agnt,P),inRoom(P,R),T),
   51     [diff(P,robot), holds_at(inRoom(P,R),T), holds_at(atRoom(Agnt,R),T)]).
   52
   53
   54axiom(initiates(put_down(Agnt,P),inRoom(P,R),T),
   55     [diff(P,robot), holds_at(got(Agnt,P),T), holds_at(atRoom(Agnt,R),T)]).
   56
   57axiom(terminates(put_down(Agnt,P),got(Agnt,P),T),[]).
   58
   59
   60axiom(initiates(go_through(Agnt,D),atRoom(Agnt,R1),T),
   61     [connects(D,R2,R1), holds_at(atRoom(Agnt,R2),T)]).
   62
   63axiom(terminates(go_through(Agnt,D),atRoom(Agnt,R),T),[holds_at(atRoom(Agnt,R),T)]).
   64
   65
   66
   67
   68/* Narrative */
   69
   70
   71axiom(initially(atRoom(a1,r3)),[]).
   72
   73axiom(initially(neg(atRoom(a1,r1))),[]).
   74
   75axiom(initially(neg(atRoom(a1,r2))),[]).
   76
   77axiom(initially(inRoom(p1,r1)),[]).
   78
   79axiom(initially(neg(inRoom(p1,r2))),[]).
   80
   81axiom(initially(neg(inRoom(p1,r3))),[]).
   82
   83
   84
   85/* Room connectivity */
   86
   87
   88axiom(connects(d1,r1,r2),[]).
   89
   90axiom(connects(d1,r2,r1),[]).
   91
   92axiom(connects(d2,r2,r3),[]).
   93
   94axiom(connects(d2,r3,r2),[]).
   95
   96
   97/* towards(R1,R2,R3) means that room R1 is towards room R2 from room R3. */
   98
   99axiom(towards(R1,R1,R2),[]).
  100
  101axiom(towards(r2,r1,r3),[]).
  102
  103axiom(towards(r2,r3,r1),[]).
  104
  105
  106
  107/* Abduction policy */
  108
  109
  110abducible(dummy).
  111
  112
  113executable(pick_up(Agnt,P)).
  114
  115executable(put_down(Agnt,P)).
  116
  117executable(go_through(Agnt,D))