1:-include(library('ec_planner/ec_test_incl')).    2:-expects_dialect(pfc).    3 %  loading(always,'examples/Mueller2006/Chapter6/ShanahanCircuit.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{Shanahan:1999a,
   15%;   author = "Murray Shanahan",
   16%;   year = "1999",
   17%;   title = "The ramification problem in the event calculus",
   18%;   booktitle = "\uppercase{P}roceedings of the \uppercase{S}ixteenth \uppercase{I}nternational \uppercase{J}oint \uppercase{C}onference on \uppercase{A}rtificial \uppercase{I}ntelligence",
   19%;   pages = "140--146",
   20%;   address = "San Mateo, CA",
   21%;   publisher = "Morgan Kaufmann",
   22%; }
   23%;
   24%; @book{Mueller:2006,
   25%;   author = "Erik T. Mueller",
   26%;   year = "2006",
   27%;   title = "Commonsense Reasoning",
   28%;   address = "San Francisco",
   29%;   publisher = "Morgan Kaufmann/Elsevier",
   30%; }
   31%;
   32
   33% load foundations/Root.e
   34
   35% load foundations/EC.e
   36
   37% sort switch
   38==> sort(switch).
   39
   40% sort relay
   41==> sort(relay).
   42
   43% sort light
   44==> sort(light).
   45
   46% switch S1, S2, S3
   47==> t(switch,s1).
   48==> t(switch,s2).
   49==> t(switch,s3).
   50
   51% relay R
   52==> t(relay,r).
   53
   54% light L
   55==> t(light,l).
   56
   57% event Light(light)
   58 %  event(light(light)).
   59==> mpred_prop(light(light),event).
   60==> meta_argtypes(light(light)).
   61
   62% event Unlight(light)
   63 %  event(unlight(light)).
   64==> mpred_prop(unlight(light),event).
   65==> meta_argtypes(unlight(light)).
   66
   67% event Close(switch)
   68 %  event(close(switch)).
   69==> mpred_prop(close(switch),event).
   70==> meta_argtypes(close(switch)).
   71
   72% event Open(switch)
   73 %  event(open(switch)).
   74==> mpred_prop(open(switch),event).
   75==> meta_argtypes(open(switch)).
   76
   77% event Activate(relay)
   78 %  event(activate(relay)).
   79==> mpred_prop(activate(relay),event).
   80==> meta_argtypes(activate(relay)).
   81
   82% event Deactivate(relay)
   83 %  event(deactivate(relay)).
   84==> mpred_prop(deactivate(relay),event).
   85==> meta_argtypes(deactivate(relay)).
   86
   87% fluent Lit(light)
   88 %  fluent(lit(light)).
   89==> mpred_prop(lit(light),fluent).
   90==> meta_argtypes(lit(light)).
   91
   92% fluent Closed(switch)
   93 %  fluent(closed(switch)).
   94==> mpred_prop(closed(switch),fluent).
   95==> meta_argtypes(closed(switch)).
   96
   97% fluent Activated(relay)
   98 %  fluent(activated(relay)).
   99==> mpred_prop(activated(relay),fluent).
  100==> meta_argtypes(activated(relay)).
  101
  102
  103% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:51
  104% [time]
  105% !HoldsAt(Lit(L),time) &
  106% HoldsAt(Closed(S1),time) &
  107% HoldsAt(Closed(S2),time) ->
  108% Happens(Light(L),time).
  109% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:55
  110axiom(happens(light(l), Time),
  111   
  112    [ not(holds_at(lit(l), Time)),
  113      holds_at(closed(s1), Time),
  114      holds_at(closed(s2), Time)
  115    ]).
  116
  117
  118% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:57
  119% [time]
  120% HoldsAt(Lit(L),time) &
  121% (!HoldsAt(Closed(S1),time) | !HoldsAt(Closed(S2),time)) ->
  122% Happens(Unlight(L),time).
  123% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:60
  124axiom(happens(unlight(l), Time),
  125    [not(holds_at(closed(s1), Time)), holds_at(lit(l), Time)]).
  126axiom(happens(unlight(l), Time),
  127    [not(holds_at(closed(s2), Time)), holds_at(lit(l), Time)]).
  128
  129
  130% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:62
  131% [time]
  132% HoldsAt(Closed(S2),time) &
  133% HoldsAt(Activated(R),time) ->
  134% Happens(Open(S2),time).
  135% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:65
  136axiom(happens(open(s2), Time),
  137    [holds_at(closed(s2), Time), holds_at(activated(r), Time)]).
  138
  139
  140% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:67
  141% [time]
  142% !HoldsAt(Activated(R),time) &
  143% HoldsAt(Closed(S1),time) &
  144% HoldsAt(Closed(S2),time) &
  145% HoldsAt(Closed(S3),time) ->
  146% Happens(Activate(R),time).
  147% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:72
  148axiom(happens(activate(r), Time),
  149   
  150    [ not(holds_at(activated(r), Time)),
  151      holds_at(closed(s1), Time),
  152      holds_at(closed(s2), Time),
  153      holds_at(closed(s3), Time)
  154    ]).
  155
  156
  157% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:74
  158% [time]
  159% HoldsAt(Activated(R),time) &
  160% (!HoldsAt(Closed(S1),time) |
  161%  !HoldsAt(Closed(S2),time) |
  162%  !HoldsAt(Closed(S3),time)) ->
  163% Happens(Deactivate(R),time).
  164% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:79
  165axiom(happens(deactivate(r), Time),
  166    [not(holds_at(closed(s1), Time)), holds_at(activated(r), Time)]).
  167axiom(happens(deactivate(r), Time),
  168    [not(holds_at(closed(s2), Time)), holds_at(activated(r), Time)]).
  169axiom(happens(deactivate(r), Time),
  170    [not(holds_at(closed(s3), Time)), holds_at(activated(r), Time)]).
  171
  172
  173% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:81
  174% [switch,time]
  175 % Initiates(Close(switch),Closed(switch),time).
  176axiom(initiates(close(Switch), closed(Switch), Time),
  177    []).
  178
  179
  180% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:82
  181% [switch,time]
  182 % Terminates(Open(switch),Closed(switch),time).
  183axiom(terminates(open(Switch), closed(Switch), Time),
  184    []).
  185
  186
  187% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:83
  188% [relay,time]
  189 % Initiates(Activate(relay),Activated(relay),time).
  190axiom(initiates(activate(Relay), activated(Relay), Time),
  191    []).
  192
  193
  194% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:84
  195% [relay,time]
  196 % Terminates(Deactivate(relay),Activated(relay),time).
  197axiom(terminates(deactivate(Relay), activated(Relay), Time),
  198    []).
  199
  200
  201% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:85
  202% [light,time]
  203 % Initiates(Light(light),Lit(light),time).
  204axiom(initiates(light(Light), lit(Light), Time),
  205    []).
  206
  207
  208% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:86
  209% [light,time]
  210 % Terminates(Unlight(light),Lit(light),time).
  211axiom(terminates(unlight(Light), lit(Light), Time),
  212    []).
  213
  214
  215% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:88
  216% !HoldsAt(Closed(S1),0).
  217 %  not(initially(closed(s1))).
  218axiom(not(initially(closed(s1))),
  219    []).
  220
  221
  222% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:89
  223% HoldsAt(Closed(S2),0).
  224axiom(initially(closed(s2)),
  225    []).
  226
  227
  228% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:90
  229% HoldsAt(Closed(S3),0).
  230axiom(initially(closed(s3)),
  231    []).
  232
  233
  234% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:91
  235% !HoldsAt(Activated(R),0).
  236 %  not(initially(activated(r))).
  237axiom(not(initially(activated(r))),
  238    []).
  239
  240
  241% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:92
  242% !HoldsAt(Lit(L),0).
  243 %  not(initially(lit(l))).
  244axiom(not(initially(lit(l))),
  245    []).
  246
  247
  248% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:94
  249% Happens(Close(S1),0).
  250axiom(happens(close(s1), t),
  251    [is_time(0)]).
  252
  253% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:96
  254% completion Happens
  255% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:97
  256==> completion(happens).
  257
  258% range time 0 4
  259% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:99
  260==> range(time,0,4).
  261
  262% range offset 1 1
  263% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2006/Chapter6/ShanahanCircuit.e:100
  264==> range(offset,1,1).
  265%; End of file.