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