1:-include(library('ec_planner/ec_test_incl')).    2:-expects_dialect(pfc).    3 %  loading(always,'examples/Mueller2004b/PickUp.e').
    4%;
    5%; Copyright (c) 2005 IBM Corporation and others.
    6%; All rights reserved. This program and the accompanying materials
    7%; are made available under the terms of the Common Public License v1.0
    8%; which accompanies this distribution, and is available at
    9%; http://www.eclipse.org/legal/cpl-v10.html
   10%;
   11%; Contributors:
   12%; IBM - Initial implementation
   13%;
   14%; @inproceedings{Mueller:2004b,
   15%;   author = "Erik T. Mueller",
   16%;   year = "2004",
   17%;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
   18%;   editor = "Valerie Barr and Zdravko Markov",
   19%;   booktitle = "\uppercase{P}roceedings of the \uppercase{S}eventeenth \uppercase{I}nternational \uppercase{F}lorida \uppercase{A}rtificial \uppercase{I}ntelligence \uppercase{R}esearch \uppercase{S}ociety \uppercase{C}onference",
   20%;   pages = "147--152",
   21%;   address = "Menlo Park, CA",
   22%;   publisher = "AAAI Press",
   23%; }
   24%;
   25
   26% load foundations/Root.e
   27
   28% load foundations/EC.e
   29
   30% sort object
   31==> sort(object).
   32
   33% sort agent: object
   34==> subsort(agent,object).
   35
   36% sort physobj: object
   37==> subsort(physobj,object).
   38
   39% sort location
   40==> sort(location).
   41
   42% fluent At(object,location)
   43 %  fluent(at(object,location)).
   44==> mpred_prop(at(object,location),fluent).
   45==> meta_argtypes(at(object,location)).
   46
   47% fluent Holding(agent,physobj)
   48 %  fluent(holding(agent,physobj)).
   49==> mpred_prop(holding(agent,physobj),fluent).
   50==> meta_argtypes(holding(agent,physobj)).
   51
   52% event PickUp(agent,physobj)
   53 %  event(pickUp(agent,physobj)).
   54==> mpred_prop(pickUp(agent,physobj),event).
   55==> meta_argtypes(pickUp(agent,physobj)).
   56
   57% event SetDown(agent,physobj)
   58 %  event(setDown(agent,physobj)).
   59==> mpred_prop(setDown(agent,physobj),event).
   60==> meta_argtypes(setDown(agent,physobj)).
   61
   62% event Move(agent,location,location)
   63 %  event(move(agent,location,location)).
   64==> mpred_prop(move(agent,location,location),event).
   65==> meta_argtypes(move(agent,location,location)).
   66
   67
   68% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:36
   69%; state constraints
   70% [agent,location,physobj,time]
   71% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:39
   72% HoldsAt(At(agent,location),time) &
   73% HoldsAt(Holding(agent,physobj),time) ->
   74% HoldsAt(At(physobj,location),time).
   75% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:41
   76axiom(holds_at(at(Physobj, Location), Time),
   77   
   78    [ holds_at(at(Agent, Location), Time),
   79      holds_at(holding(Agent, Physobj), Time)
   80    ]).
   81
   82
   83% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:43
   84% [object,location1,location2,time]
   85% HoldsAt(At(object,location1),time) &
   86% HoldsAt(At(object,location2),time) ->
   87% location1=location2.
   88% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:46
   89axiom(Location1=Location2,
   90   
   91    [ holds_at(at(Object, Location1), Time),
   92      holds_at(at(Object, Location2), Time)
   93    ]).
   94
   95
   96% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:48
   97%; effect axioms
   98% [agent,location1,location2,time]
   99% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:51
  100% Initiates(Move(agent,location1,location2),At(agent,location2),time).
  101axiom(initiates(move(Agent, Location1, Location2), at(Agent, Location2), Time),
  102    []).
  103
  104
  105% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:53
  106% [agent,location1,location2,time]
  107% Terminates(Move(agent,location1,location2),At(agent,location1),time).
  108% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:54
  109axiom(terminates(move(Agent, Location1, Location2), at(Agent, Location1), Time),
  110    []).
  111
  112
  113% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:56
  114% [agent,physobj,time]
  115% Initiates(PickUp(agent,physobj),Holding(agent,physobj),time).
  116% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:57
  117axiom(initiates(pickUp(Agent, Physobj), holding(Agent, Physobj), Time),
  118    []).
  119
  120
  121% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:59
  122% [agent,physobj,time]
  123% Terminates(SetDown(agent,physobj),Holding(agent,physobj),time).
  124% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:60
  125axiom(terminates(setDown(Agent, Physobj), holding(Agent, Physobj), Time),
  126    []).
  127
  128
  129% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:62
  130%; preconditions
  131% [agent,location1,location2,time]
  132% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:65
  133% Happens(Move(agent,location1,location2),time) ->
  134% HoldsAt(At(agent,location1),time).
  135% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:66
  136axiom(requires(move(Agent, Location1, Location2), Time),
  137    [holds_at(at(Agent, Location1), Time)]).
  138
  139
  140% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:68
  141% [agent,physobj,time]
  142% Happens(PickUp(agent,physobj),time) ->
  143% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:70
  144% {location}%  HoldsAt(At(agent,location),time) &
  145%            HoldsAt(At(physobj,location),time).
  146
  147 /*   exists([Location],
  148             if(happens(pickUp(Agent, Physobj), Time),
  149                 (holds_at(at(Agent, Location), Time), holds_at(at(Physobj, Location), Time)))).
  150 */
  151
  152 /*  not(some(Location6, '$kolem_Fn_123'(Fn_123_Param, At_Param, Maptime))) :-
  153       happens(pickUp(Fn_123_Param, At_Param), Maptime),
  154       (   not(holds_at(at(Fn_123_Param, Location6), Maptime))
  155       ;   not(holds_at(at(At_Param, Location6), Maptime))
  156       ).
  157 */
  158% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:71
  159axiom(not(some(Location6, '$kolem_Fn_123'(Fn_123_Param, At_Param, Maptime))),
  160   
  161    [ not(holds_at(at(Fn_123_Param, Location6), Maptime)),
  162      happens(pickUp(Fn_123_Param, At_Param), Maptime)
  163    ]).
  164axiom(not(some(Location6, '$kolem_Fn_123'(Fn_123_Param, At_Param, Maptime))),
  165   
  166    [ not(holds_at(at(At_Param, Location6), Maptime)),
  167      happens(pickUp(Fn_123_Param, At_Param), Maptime)
  168    ]).
  169
  170 /*  not(happens(pickUp(PickUp_Param, At_Param12), Maptime9)) :-
  171       (   not(holds_at(at(PickUp_Param, Location10), Maptime9))
  172       ;   not(holds_at(at(At_Param12, Location10), Maptime9))
  173       ),
  174       some(Location10,
  175            '$kolem_Fn_123'(PickUp_Param, At_Param12, Maptime9)).
  176 */
  177axiom(not(happens(pickUp(PickUp_Param, At_Param12), Maptime9)),
  178   
  179    [ not(holds_at(at(PickUp_Param, Location10), Maptime9)),
  180      some(Location10,
  181           '$kolem_Fn_123'(PickUp_Param, At_Param12, Maptime9))
  182    ]).
  183axiom(not(happens(pickUp(PickUp_Param, At_Param12), Maptime9)),
  184   
  185    [ not(holds_at(at(At_Param12, Location10), Maptime9)),
  186      some(Location10,
  187           '$kolem_Fn_123'(PickUp_Param, At_Param12, Maptime9))
  188    ]).
  189
  190 /*  holds_at(at(At_Param15, Location13), Time14) :-
  191       happens(pickUp(At_Param15, PickUp_Ret), Time14),
  192       some(Location13,
  193            '$kolem_Fn_123'(At_Param15, PickUp_Ret, Time14)).
  194 */
  195axiom(holds_at(at(At_Param15, Location13), Time14),
  196   
  197    [ happens(pickUp(At_Param15, PickUp_Ret), Time14),
  198      some(Location13,
  199           '$kolem_Fn_123'(At_Param15, PickUp_Ret, Time14))
  200    ]).
  201
  202 /*  holds_at(at(At_Param19, Location17), Time18) :-
  203       happens(pickUp(PickUp_Param20, At_Param19), Time18),
  204       some(Location17,
  205            '$kolem_Fn_123'(PickUp_Param20, At_Param19, Time18)).
  206 */
  207axiom(holds_at(at(At_Param19, Location17), Time18),
  208   
  209    [ happens(pickUp(PickUp_Param20, At_Param19), Time18),
  210      some(Location17,
  211           '$kolem_Fn_123'(PickUp_Param20, At_Param19, Time18))
  212    ]).
  213
  214
  215% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:73
  216%; releases
  217% [agent,physobj,location,time]
  218% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:76
  219% Releases(PickUp(agent,physobj),At(physobj,location),time).
  220axiom(releases(pickUp(Agent, Physobj), at(Physobj, Location), Time),
  221    []).
  222
  223
  224% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:78
  225% [agent,physobj,location,time]
  226% HoldsAt(At(agent,location),time) ->
  227% Initiates(SetDown(agent,physobj),At(physobj,location),time).
  228% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:80
  229axiom(initiates(setDown(Agent, Physobj), at(Physobj, Location), Time),
  230    [holds_at(at(Agent, Location), Time)]).
  231
  232
  233% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:82
  234%;[agent,physobj,location1,location2,time]
  235%;HoldsAt(At(agent,location1),time) &
  236%;location1 != location2 ->
  237%;Terminates(SetDown(agent,physobj),At(physobj,location2),time).
  238
  239% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:87
  240% agent James
  241% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:88
  242==> t(agent,james).
  243
  244% physobj Coin
  245% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:89
  246==> t(physobj,coin).
  247
  248% location L1, L2, L3, L4
  249% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:90
  250==> t(location,l1).
  251==> t(location,l2).
  252==> t(location,l3).
  253==> t(location,l4).
  254
  255
  256% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:91
  257% !HoldsAt(Holding(James,Coin),0).
  258 %  not(initially(holding(james,coin))).
  259axiom(not(initially(holding(james, coin))),
  260    []).
  261
  262
  263% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:92
  264% HoldsAt(At(Coin,L4),0).
  265axiom(initially(at(coin, l4)),
  266    []).
  267
  268
  269% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:93
  270% HoldsAt(At(James,L1),0).
  271axiom(initially(at(james, l1)),
  272    []).
  273
  274
  275% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:94
  276% Happens(Move(James,L1,L2),0).
  277axiom(happens(move(james, l1, l2), t),
  278    [is_time(0)]).
  279
  280
  281% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:95
  282% Happens(Move(James,L2,L3),1).
  283axiom(happens(move(james, l2, l3), start),
  284    [is_time(1), b(t, start), ignore(t+1=start)]).
  285
  286
  287% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:96
  288% Happens(Move(James,L3,L4),2).
  289axiom(happens(move(james, l3, l4), t2),
  290    [is_time(2), b(t, t2), ignore(t+2=t2)]).
  291
  292
  293% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:97
  294% Happens(PickUp(James,Coin),3).
  295axiom(happens(pickUp(james, coin), t3),
  296    [is_time(3), b(t, t3), ignore(t+3=t3)]).
  297
  298
  299% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:98
  300% Happens(Move(James,L4,L3),4).
  301axiom(happens(move(james, l4, l3), t4),
  302    [is_time(4), b(t, t4), ignore(t+4=t4)]).
  303
  304
  305% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:99
  306% Happens(Move(James,L3,L2),5).
  307axiom(happens(move(james, l3, l2), t5),
  308    [is_time(5), b(t, t5), ignore(t+5=t5)]).
  309
  310
  311% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:100
  312% Happens(SetDown(James,Coin),6).
  313axiom(happens(setDown(james, coin), t6),
  314    [is_time(6), b(t, t6), ignore(t+6=t6)]).
  315
  316
  317% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:101
  318% Happens(Move(James,L2,L3),7).
  319axiom(happens(move(james, l2, l3), t7),
  320    [is_time(7), b(t, t7), ignore(t+7=t7)]).
  321
  322
  323% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:102
  324% Happens(Move(James,L3,L4),8).
  325axiom(happens(move(james, l3, l4), t8),
  326    [is_time(8), b(t, t8), ignore(t+8=t8)]).
  327
  328% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:104
  329% completion Happens
  330% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:105
  331==> completion(happens).
  332
  333% range time 0 9
  334% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:107
  335==> range(time,0,9).
  336
  337% range offset 1 1
  338% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004b/PickUp.e:108
  339==> range(offset,1,1).
  340%; End of file.