1:-include(library('ec_planner/ec_test_incl')).    2:-expects_dialect(pfc).    3 %  loading(always,'examples/Mueller2004a/Leaf.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{Mueller:2004a,
   15%;   author = "Erik T. Mueller",
   16%;   year = "2004",
   17%;   title = "Event calculus reasoning through satisfiability",
   18%;   journal = "Journal of Logic and Computation",
   19%;   volume = "14",
   20%;   number = "5",
   21%;   pages = "703--730",
   22%; }
   23%;
   24
   25% option trajectory on
   26:- set_ec_option(trajectory, on).   27
   28% load foundations/Root.e
   29
   30% load foundations/EC.e
   31
   32% sort object
   33==> sort(object).
   34
   35% sort height: integer
   36==> subsort(height,integer).
   37
   38% fluent Height(object,height)
   39 %  fluent(height(object,height)).
   40==> mpred_prop(height(object,height),fluent).
   41==> meta_argtypes(height(object,height)).
   42
   43% fluent Falling(object)
   44 %  fluent(falling(object)).
   45==> mpred_prop(falling(object),fluent).
   46==> meta_argtypes(falling(object)).
   47
   48% event StartFalling(object)
   49 %  event(startFalling(object)).
   50==> mpred_prop(startFalling(object),event).
   51==> meta_argtypes(startFalling(object)).
   52
   53% event HitsGround(object)
   54 %  event(hitsGround(object)).
   55==> mpred_prop(hitsGround(object),event).
   56==> meta_argtypes(hitsGround(object)).
   57
   58
   59% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:34
   60% [object,height1,height2,time]
   61% HoldsAt(Height(object,height1),time) &
   62% HoldsAt(Height(object,height2),time) ->
   63% height1=height2.
   64% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:37
   65axiom(Height1=Height2,
   66   
   67    [ holds_at(height(Object, Height1), Time),
   68      holds_at(height(Object, Height2), Time)
   69    ]).
   70
   71
   72% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:39
   73% [object,time]
   74% Initiates(StartFalling(object),Falling(object),time).
   75% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:40
   76axiom(initiates(startFalling(Object), falling(Object), Time),
   77    []).
   78
   79
   80% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:42
   81% [object,height,time]
   82% Releases(StartFalling(object),Height(object,height),time).
   83% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:43
   84axiom(releases(startFalling(Object), height(Object, Height), Time),
   85    []).
   86
   87
   88% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:45
   89% [object,height1,height2,offset,time]
   90% HoldsAt(Height(object,height1),time) &
   91% height2=height1-offset*offset ->
   92% Trajectory(Falling(object),time,Height(object,height2),offset).
   93% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:48
   94axiom(trajectory(falling(Object), Time, height(Object, Height2), Offset),
   95   
   96    [ holds_at(height(Object, Height1), Time),
   97      equals(Height2, Height1-Offset*Offset)
   98    ]).
   99
  100
  101% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:50
  102% [object,time]
  103% HoldsAt(Falling(object),time) &
  104% HoldsAt(Height(object,0),time) ->
  105% Happens(HitsGround(object),time).
  106% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:53
  107axiom(happens(hitsGround(Object), Time),
  108   
  109    [ holds_at(falling(Object), Time),
  110      holds_at(height(Object, 0), Time)
  111    ]).
  112
  113
  114% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:55
  115%;[object,height1,height2,time]
  116%;HoldsAt(Height(object,height1),time) &
  117%;height1 != height2 ->
  118%;Terminates(HitsGround(object),Height(object,height2),time).
  119% [object,height,time]
  120% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:61
  121% HoldsAt(Height(object,height),time) ->
  122% Initiates(HitsGround(object),Height(object,height),time).
  123% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:62
  124axiom(initiates(hitsGround(Object), height(Object, Height), Time),
  125    [holds_at(height(Object, Height), Time)]).
  126
  127
  128% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:64
  129% [object,time]
  130% Terminates(HitsGround(object),Falling(object),time).
  131% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:65
  132axiom(terminates(hitsGround(Object), falling(Object), Time),
  133    []).
  134
  135% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:67
  136% object Leaf
  137% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:68
  138==> t(object,leaf).
  139
  140
  141% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:69
  142% !HoldsAt(Falling(Leaf),0).
  143 %  not(initially(falling(leaf))).
  144axiom(not(initially(falling(leaf))),
  145    []).
  146
  147
  148% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:70
  149% HoldsAt(Height(Leaf,9),0).
  150axiom(initially(height(leaf, 9)),
  151    []).
  152
  153
  154% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:71
  155% Happens(StartFalling(Leaf),0).
  156axiom(happens(startFalling(leaf), t),
  157    [is_time(0)]).
  158
  159% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:73
  160% completion Happens
  161% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:74
  162==> completion(happens).
  163
  164% range time 0 4
  165% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:76
  166==> range(time,0,4).
  167
  168% range offset 1 9
  169% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:77
  170==> range(offset,1,9).
  171
  172% range height 0 9
  173% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Mueller2004a/Leaf.e:78
  174==> range(height,0,9).
  175%; End of file.