1% ectest/ec_reader_test_examples.e:1
    2% translate: begining  File: ectest/ec_reader_test_examples.e.pro 
    3% 
    4% 
    5% 
    6% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    7% ; FILE: examples/Mueller2004a/Holding.e
    8% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    9% ;
   10% ; Copyright (c) 2005 IBM Corporation and others.
   11% ; All rights reserved. This program and the accompanying materials
   12% ; are made available under the terms of the Common Public License v1.0
   13% ; which accompanies this distribution, and is available at
   14% ; http://www.eclipse.org/legal/cpl-v10.html
   15% ;
   16% ; Contributors:
   17% ; IBM - Initial implementation
   18% ;
   19% ; @article{Mueller:2004a,
   20% ;   author = "Erik T. Mueller",
   21% ;   year = "2004",
   22% ;   title = "Event calculus reasoning through satisfiability",
   23% ;   journal = "Journal of Logic and Computation",
   24% ;   volume = "14",
   25% ;   number = "5",
   26% ;   pages = "703--730",
   27% ; }
   28% ;
   29% ectest/ec_reader_test_examples.e:27
   30% 
   31% option encoding 3
   32option(encoding, 3).
   33
   34% 
   35% load foundations/Root.e
   36load('foundations/Root.e').
   37
   38% load foundations/EC.e
   39load('foundations/EC.e').
   40
   41% 
   42% ectest/ec_reader_test_examples.e:33
   43% sort person
   44sort(person).
   45
   46% sort object
   47sort(object).
   48
   49% 
   50% event Hold(person,object)
   51event(hold(person, object)).
   52
   53% fluent Holding(person,object)
   54fluent(holding(person, object)).
   55
   56% 
   57% ectest/ec_reader_test_examples.e:39
   58% person P1
   59t(person, p1).
   60
   61% object O1
   62t(object, o1).
   63
   64% 
   65% Happens(Hold(P1,O1),0).
   66happens(hold(p1, o1), 0).
   67
   68% 
   69% 
   70% ectest/ec_reader_test_examples.e:44
   71% [person,object,time]% 
   72% Initiates(Hold(person,object),Holding(person,object),time).
   73initiates(hold(Person, Object), holding(Person, Object), Time).
   74
   75% 
   76% 
   77% !HoldsAt(Holding(P1,O1),0).
   78not(holds_at(holding(p1, o1), 0)).
   79
   80% 
   81% ;;; AUTO !ReleasedAt(Holding(P1,O1),0).
   82% 
   83% ectest/ec_reader_test_examples.e:50
   84% completion Happens
   85completion(happens).
   86
   87% 
   88% range time 0 1
   89range(time, 0, 1).
   90
   91% range offset 1 1
   92range(offset, 1, 1).
   93
   94% 
   95% ; End of file.
   96% ectest/ec_reader_test_examples.e:56
   97% 
   98% 
   99% 
  100% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  101% ; FILE: examples/Mueller2004a/Leaf.e
  102% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103% ;
  104% ; Copyright (c) 2005 IBM Corporation and others.
  105% ; All rights reserved. This program and the accompanying materials
  106% ; are made available under the terms of the Common Public License v1.0
  107% ; which accompanies this distribution, and is available at
  108% ; http://www.eclipse.org/legal/cpl-v10.html
  109% ;
  110% ; Contributors:
  111% ; IBM - Initial implementation
  112% ;
  113% ; @article{Mueller:2004a,
  114% ;   author = "Erik T. Mueller",
  115% ;   year = "2004",
  116% ;   title = "Event calculus reasoning through satisfiability",
  117% ;   journal = "Journal of Logic and Computation",
  118% ;   volume = "14",
  119% ;   number = "5",
  120% ;   pages = "703--730",
  121% ; }
  122% ;
  123% ectest/ec_reader_test_examples.e:82
  124% 
  125% option trajectory on
  126option(trajectory, on).
  127
  128% 
  129% load foundations/Root.e
  130load('foundations/Root.e').
  131
  132% load foundations/EC.e
  133load('foundations/EC.e').
  134
  135% 
  136% ectest/ec_reader_test_examples.e:88
  137% sort object
  138sort(object).
  139
  140% sort height: integer
  141subsort(height, integer).
  142
  143% 
  144% fluent Height(object,height)
  145fluent(height(object, height)).
  146
  147% fluent Falling(object)
  148fluent(falling(object)).
  149
  150% event StartFalling(object)
  151event(startFalling(object)).
  152
  153% ectest/ec_reader_test_examples.e:94
  154% event HitsGround(object)
  155event(hitsGround(object)).
  156
  157% 
  158% ectest/ec_reader_test_examples.e:96
  159% [object,height1,height2,time]% 
  160% HoldsAt(Height(object,height1),time) &
  161% HoldsAt(Height(object,height2),time) ->
  162% height1=height2.
  163holds_at(height(Object, Height1), Time), holds_at(height(Object, Height2), Time) ->
  164	Height1=Height2.
  165
  166% 
  167% 
  168% ectest/ec_reader_test_examples.e:101
  169% [object,time]% 
  170% Initiates(StartFalling(object),Falling(object),time).
  171initiates(startFalling(Object), falling(Object), Time).
  172
  173% 
  174% 
  175% ectest/ec_reader_test_examples.e:104
  176% [object,height,time]% 
  177% Releases(StartFalling(object),Height(object,height),time).
  178releases(startFalling(Object), height(Object, Height), Time).
  179
  180% 
  181% 
  182% ectest/ec_reader_test_examples.e:107
  183% [object,height1,height2,offset,time]% 
  184% HoldsAt(Height(object,height1),time) &
  185% height2=height1-offset*offset ->
  186% Trajectory(Falling(object),time,Height(object,height2),offset).
  187holds_at(height(Object, Height1), Time), Height2=Height1-Offset*Offset ->
  188	trajectory(falling(Object),
  189		   Time,
  190		   height(Object, Height2),
  191		   Offset).
  192
  193% 
  194% 
  195% ectest/ec_reader_test_examples.e:112
  196% [object,time]% 
  197% HoldsAt(Falling(object),time) &
  198% HoldsAt(Height(object,0),time) ->
  199% Happens(HitsGround(object),time).
  200holds_at(falling(Object), Time), holds_at(height(Object, 0), Time) ->
  201	happens(hitsGround(Object), Time).
  202
  203% 
  204% 
  205% ;[object,height1,height2,time]
  206% ;HoldsAt(Height(object,height1),time) &
  207% ;height1 != height2 ->
  208% ;Terminates(HitsGround(object),Height(object,height2),time).
  209% ectest/ec_reader_test_examples.e:121
  210% 
  211% ectest/ec_reader_test_examples.e:122
  212% [object,height,time]% 
  213% HoldsAt(Height(object,height),time) ->
  214% Initiates(HitsGround(object),Height(object,height),time).
  215holds_at(height(Object, Height), Time) ->
  216	initiates(hitsGround(Object),
  217		  height(Object, Height),
  218		  Time).
  219
  220% 
  221% 
  222% ectest/ec_reader_test_examples.e:126
  223% [object,time]% 
  224% Terminates(HitsGround(object),Falling(object),time).
  225terminates(hitsGround(Object), falling(Object), Time).
  226
  227% 
  228% 
  229% object Leaf
  230t(object, leaf).
  231
  232% 
  233% !HoldsAt(Falling(Leaf),0).
  234not(holds_at(falling(leaf), 0)).
  235
  236% 
  237% ectest/ec_reader_test_examples.e:132
  238% HoldsAt(Height(Leaf,9),0).
  239holds_at(height(leaf, 9), 0).
  240
  241% 
  242% Happens(StartFalling(Leaf),0).
  243happens(startFalling(leaf), 0).
  244
  245% 
  246% 
  247% completion Happens
  248completion(happens).
  249
  250% 
  251% range time 0 4
  252range(time, 0, 4).
  253
  254% ectest/ec_reader_test_examples.e:138
  255% range offset 1 9
  256range(offset, 1, 9).
  257
  258% range height 0 9
  259range(height, 0, 9).
  260
  261% 
  262% ; End of file.
  263% 
  264% 
  265% ectest/ec_reader_test_examples.e:144
  266% 
  267% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  268% ; FILE: examples/Cassimatis2002/PolySpace.e
  269% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  270% ;
  271% ; Copyright (c) 2005 IBM Corporation and others.
  272% ; All rights reserved. This program and the accompanying materials
  273% ; are made available under the terms of the Common Public License v1.0
  274% ; which accompanies this distribution, and is available at
  275% ; http://www.eclipse.org/legal/cpl-v10.html
  276% ;
  277% ; Contributors:
  278% ; IBM - Initial implementation
  279% ;
  280% ; @phdthesis{Cassimatis:2002,
  281% ;   author = "Nicholas L. Cassimatis",
  282% ;   year = "2002",
  283% ;   title = "Polyscheme: A Cognitive Architecture for Integrating Multiple Representation and Inference Schemes",
  284% ;   address = "Cambridge, MA",
  285% ;   school = "Program in Media Arts and Sciences, School of Architecture and Planning, Massachusetts Institute of Technology",
  286% ; }
  287% ;
  288% ectest/ec_reader_test_examples.e:166
  289% 
  290% ; sorts
  291% sort object
  292sort(object).
  293
  294% sort xcoord: integer
  295subsort(xcoord, integer).
  296
  297% sort ycoord: integer
  298subsort(ycoord, integer).
  299
  300% sort grid
  301sort(grid).
  302
  303% ectest/ec_reader_test_examples.e:172
  304% sort shape
  305sort(shape).
  306
  307% sort color
  308sort(color).
  309
  310% 
  311% ; constants
  312% shape Round,Square
  313t(shape, round).
  314
  315t(shape, square).
  316
  317% color Red,Green
  318t(color, red).
  319
  320t(color, green).
  321
  322% ectest/ec_reader_test_examples.e:178
  323% 
  324% ; predicates, fluents, and events
  325% predicate Equal(object,object)
  326predicate(equal(object, object)).
  327
  328% predicate Shape(object,shape)
  329predicate(shape(object, shape)).
  330
  331% predicate Color(object,color)
  332predicate(color(object, color)).
  333
  334% fluent Location(grid,object,xcoord,ycoord)
  335fluent(location(grid, object, xcoord, ycoord)).
  336
  337% ectest/ec_reader_test_examples.e:184
  338% event Move(grid,object,xcoord,ycoord,xcoord,ycoord)
  339event(move(grid, object, xcoord, ycoord, xcoord, ycoord)).
  340
  341% 
  342% ; axioms
  343% 
  344% ectest/ec_reader_test_examples.e:188
  345% [object1,object2] % Equal(object1,object2) -> Equal(object2,object1).
  346equal(Object1, Object2) ->
  347	equal(Object2, Object1).
  348
  349% 
  350% 
  351% ; objects have unique shape
  352% ectest/ec_reader_test_examples.e:191
  353% [object,shape1,shape2]% 
  354% Shape(object,shape1) & Shape(object,shape2) ->
  355% shape1=shape2.
  356shape(Object, Shape1), shape(Object, Shape2) ->
  357	Shape1=Shape2.
  358
  359% 
  360% 
  361% ; objects have unique color
  362% ectest/ec_reader_test_examples.e:196
  363% [object,color1,color2]% 
  364% Color(object,color1) & Color(object,color2) ->
  365% color1=color2.
  366color(Object, Color1), color(Object, Color2) ->
  367	Color1=Color2.
  368
  369% 
  370% 
  371% ; if objects are the same, they have the same shape
  372% ectest/ec_reader_test_examples.e:201
  373% [object1,object2]% 
  374% Equal(object1,object2) ->
  375% ({shape} Shape(object1,shape) & Shape(object2,shape)).
  376equal(Object1, Object2) ->
  377	exists([Shape],
  378	       (shape(Object1, Shape), shape(Object2, Shape))).
  379
  380% 
  381% 
  382% ; if objects are the same, they have the same color
  383% ectest/ec_reader_test_examples.e:206
  384% [object1,object2]% 
  385% Equal(object1,object2) ->
  386% ({color} Color(object1,color) & Color(object2,color)).
  387equal(Object1, Object2) ->
  388	exists([Color],
  389	       (color(Object1, Color), color(Object2, Color))).
  390
  391% 
  392% 
  393% ; if objects are the same, they have the same location
  394% ectest/ec_reader_test_examples.e:211
  395% [grid,object1,object2,xcoord1,ycoord1,xcoord2,ycoord2,time]% 
  396% Equal(object1,object2) ->
  397% (HoldsAt(Location(grid,object1,xcoord1,ycoord1),time) &
  398%  HoldsAt(Location(grid,object2,xcoord2,ycoord2),time) ->
  399%  xcoord1=xcoord2 & ycoord1=ycoord2).
  400equal(Object1, Object2) ->
  401	( holds_at(location(Grid, Object1, Xcoord1, Ycoord1), Time), holds_at(location(Grid, Object2, Xcoord2, Ycoord2), Time)->Xcoord1=Xcoord2, Ycoord1=Ycoord2
  402	).
  403
  404% 
  405% 
  406% ; object in one location at a time
  407% ectest/ec_reader_test_examples.e:218
  408% [grid,object,xcoord1,ycoord1,xcoord2,ycoord2,time]% 
  409% HoldsAt(Location(grid,object,xcoord1,ycoord1),time) &
  410% HoldsAt(Location(grid,object,xcoord2,ycoord2),time) ->
  411% xcoord1=xcoord2 & ycoord1=ycoord2.
  412holds_at(location(Grid, Object, Xcoord1, Ycoord1), Time), holds_at(location(Grid, Object, Xcoord2, Ycoord2), Time) ->
  413	Xcoord1=Xcoord2,
  414	Ycoord1=Ycoord2.
  415
  416% 
  417% 
  418% ; objects have locations
  419% ectest/ec_reader_test_examples.e:224
  420% [grid,object,time]% 
  421% (
  422% ectest/ec_reader_test_examples.e:225
  423% {xcoord,ycoord} HoldsAt(Location(grid,object,xcoord,ycoord),time)).
  424exists([Xcoord, Ycoord], holds_at(location(Grid, Object, Xcoord, Ycoord), Time)).
  425
  426% 
  427% 
  428% ; different objects are not at same location
  429% ectest/ec_reader_test_examples.e:228
  430% [grid,object1,object2,xcoord1,ycoord1,time]% 
  431% HoldsAt(Location(grid,object1,xcoord1,ycoord1),time) &
  432% HoldsAt(Location(grid,object2,xcoord1,ycoord1),time) ->
  433% Equal(object1,object2).
  434holds_at(location(Grid, Object1, Xcoord1, Ycoord1), Time), holds_at(location(Grid, Object2, Xcoord1, Ycoord1), Time) ->
  435	equal(Object1, Object2).
  436
  437% 
  438% 
  439% ; moving to a location causes an object to be at that location
  440% ectest/ec_reader_test_examples.e:234
  441% [grid,object,xcoord1,ycoord1,xcoord2,ycoord2,time]% 
  442% Initiates(Move(grid,object,xcoord1,ycoord1,xcoord2,ycoord2),
  443%           Location(grid,object,xcoord2,ycoord2),
  444%           time).
  445initiates(move(Grid, Object, Xcoord1, Ycoord1, Xcoord2, Ycoord2), location(Grid, Object, Xcoord2, Ycoord2), Time).
  446
  447% 
  448% 
  449% ; moving to a location causes the object no longer to be at its previous
  450% ; location
  451% ectest/ec_reader_test_examples.e:241
  452% [grid,object,xcoord1,ycoord1,xcoord2,ycoord2,time]% 
  453% Terminates(Move(grid,object,xcoord1,ycoord1,xcoord2,ycoord2),
  454%            Location(grid,object,xcoord1,ycoord1),
  455%            time).
  456terminates(move(Grid, Object, Xcoord1, Ycoord1, Xcoord2, Ycoord2), location(Grid, Object, Xcoord1, Ycoord1), Time).
  457
  458% 
  459% 
  460% ;; allow diagonal movements
  461% ;[grid,object,xcoord1,ycoord1,xcoord2,ycoord2,time]
  462% ;Happens(Move(grid,object,xcoord1,ycoord1,xcoord2,ycoord2),time) ->
  463% ;HoldsAt(Location(grid,object,xcoord1,ycoord1),time) &
  464% ;(xcoord1=xcoord2 |
  465% ; xcoord1=xcoord2+1 |
  466% ; xcoord1=xcoord2-1) &
  467% ;(ycoord1=ycoord2 |
  468% ; ycoord1=ycoord2+1 |
  469% ; ycoord1=ycoord2-1).
  470% ectest/ec_reader_test_examples.e:256
  471% 
  472% ; only allow right angle movements
  473% ectest/ec_reader_test_examples.e:258
  474% [grid,object,xcoord1,ycoord1,xcoord2,ycoord2,time]% 
  475% Happens(Move(grid,object,xcoord1,ycoord1,xcoord2,ycoord2),time) ->
  476% HoldsAt(Location(grid,object,xcoord1,ycoord1),time) &
  477% ((xcoord1=xcoord2 & (ycoord1=ycoord2+1 | ycoord1=ycoord2-1)) |
  478%  (ycoord1=ycoord2 & (xcoord1=xcoord2+1 | xcoord1=xcoord2-1))).
  479happens(move(Grid, Object, Xcoord1, Ycoord1, Xcoord2, Ycoord2), Time) ->
  480	holds_at(location(Grid, Object, Xcoord1, Ycoord1),
  481		 Time),
  482	(   Xcoord1=Xcoord2,
  483	    (   Ycoord1=Ycoord2+1
  484	    ;   Ycoord1=Ycoord2-1
  485	    )
  486	;   Ycoord1=Ycoord2,
  487	    (   Xcoord1=Xcoord2+1
  488	    ;   Xcoord1=Xcoord2-1
  489	    )
  490	).
  491
  492% 
  493% 
  494% ; End of file.
  495% ectest/ec_reader_test_examples.e:265
  496% 
  497% 
  498% 
  499% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  500% ; FILE: examples/Cassimatis2002/TwoScreens.e
  501% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  502% ;
  503% ; Copyright (c) 2005 IBM Corporation and others.
  504% ; All rights reserved. This program and the accompanying materials
  505% ; are made available under the terms of the Common Public License v1.0
  506% ; which accompanies this distribution, and is available at
  507% ; http://www.eclipse.org/legal/cpl-v10.html
  508% ;
  509% ; Contributors:
  510% ; IBM - Initial implementation
  511% ;
  512% ; @phdthesis{Cassimatis:2002,
  513% ;   author = "Nicholas L. Cassimatis",
  514% ;   year = "2002",
  515% ;   title = "Polyscheme: A Cognitive Architecture for Integrating Multiple Representation and Inference Schemes",
  516% ;   address = "Cambridge, MA",
  517% ;   school = "Program in Media Arts and Sciences, School of Architecture and Planning, Massachusetts Institute of Technology",
  518% ; }
  519% ;
  520% ectest/ec_reader_test_examples.e:289
  521% 
  522% load foundations/Root.e
  523load('foundations/Root.e').
  524
  525% load foundations/EC.e
  526load('foundations/EC.e').
  527
  528% load examples/Cassimatis2002/PolySpace.e
  529load('examples/Cassimatis2002/PolySpace.e').
  530
  531% 
  532% grid G1
  533t(grid, g1).
  534
  535% ectest/ec_reader_test_examples.e:295
  536% object X,Y,Screen1,Screen2
  537t(object, x).
  538
  539t(object, y).
  540
  541t(object, screen1).
  542
  543t(object, screen2).
  544
  545% 
  546% ; perceptions:
  547% Shape(X,Round).
  548shape(x, round).
  549
  550% 
  551% Color(X,Red).
  552color(x, red).
  553
  554% 
  555% Shape(Y,Round).
  556shape(y, round).
  557
  558% 
  559% ectest/ec_reader_test_examples.e:301
  560% Color(Y,Red).
  561color(y, red).
  562
  563% 
  564% Shape(Screen1,Square).
  565shape(screen1, square).
  566
  567% 
  568% Color(Screen1,Green).
  569color(screen1, green).
  570
  571% 
  572% Shape(Screen2,Square).
  573shape(screen2, square).
  574
  575% 
  576% Color(Screen2,Green).
  577color(screen2, green).
  578
  579% 
  580% ectest/ec_reader_test_examples.e:306
  581% [time] % HoldsAt(Location(G1,Screen1,2,0),time).
  582holds_at(location(g1, screen1, 2, 0), Time).
  583
  584% 
  585% ectest/ec_reader_test_examples.e:307
  586% [time] % HoldsAt(Location(G1,Screen2,4,0),time).
  587holds_at(location(g1, screen2, 4, 0), Time).
  588
  589% 
  590% HoldsAt(Location(G1,X,1,1),0).
  591holds_at(location(g1, x, 1, 1), 0).
  592
  593% 
  594% HoldsAt(Location(G1,Y,5,1),4).
  595holds_at(location(g1, y, 5, 1), 4).
  596
  597% 
  598% 
  599% ectest/ec_reader_test_examples.e:311
  600% [xcoord,ycoord,time]% 
  601% xcoord!=% 2 & xcoord!=4 & !(xcoord=1 & ycoord=1 & time=0) ->
  602% !HoldsAt(Location(G1,X,xcoord,ycoord),time) |
  603% xcoord=5 & ycoord=1 & time=4 & Equal(X,Y).
  604(   ( Xcoord\=2, Xcoord\=4, not((Xcoord=1, Ycoord=1, Time=0))->not(holds_at(location(g1, x, Xcoord, Ycoord), Time))
  605    )
  606;   Xcoord=5,
  607    Ycoord=1,
  608    Time=4,
  609    equal(x, y)
  610).
  611
  612% 
  613% 
  614% ectest/ec_reader_test_examples.e:316
  615% [xcoord,ycoord,time]% 
  616% xcoord!=% 2 & xcoord!=4 & !(xcoord=5 & ycoord=1 & time=4) ->
  617% !HoldsAt(Location(G1,Y,xcoord,ycoord),time) |
  618% xcoord=1 & ycoord=1 & time=0 & Equal(X,Y).
  619(   ( Xcoord\=2, Xcoord\=4, not((Xcoord=5, Ycoord=1, Time=4))->not(holds_at(location(g1, y, Xcoord, Ycoord), Time))
  620    )
  621;   Xcoord=1,
  622    Ycoord=1,
  623    Time=0,
  624    equal(x, y)
  625).
  626
  627% 
  628% 
  629% range time 0 4
  630range(time, 0, 4).
  631
  632% ectest/ec_reader_test_examples.e:322
  633% range xcoord 0 5
  634range(xcoord, 0, 5).
  635
  636% range ycoord 0 1
  637range(ycoord, 0, 1).
  638
  639% range offset 0 0
  640range(offset, 0, 0).
  641
  642% 
  643% ; End of file.
  644% 
  645% ectest/ec_reader_test_examples.e:328
  646% 
  647% 
  648% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  649% ; FILE: examples/Cassimatis2002/OneScreen.e
  650% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  651% ;
  652% ; Copyright (c) 2005 IBM Corporation and others.
  653% ; All rights reserved. This program and the accompanying materials
  654% ; are made available under the terms of the Common Public License v1.0
  655% ; which accompanies this distribution, and is available at
  656% ; http://www.eclipse.org/legal/cpl-v10.html
  657% ;
  658% ; Contributors:
  659% ; IBM - Initial implementation
  660% ;
  661% ; @phdthesis{Cassimatis:2002,
  662% ;   author = "Nicholas L. Cassimatis",
  663% ;   year = "2002",
  664% ;   title = "Polyscheme: A Cognitive Architecture for Integrating Multiple Representation and Inference Schemes",
  665% ;   address = "Cambridge, MA",
  666% ;   school = "Program in Media Arts and Sciences, School of Architecture and Planning, Massachusetts Institute of Technology",
  667% ; }
  668% ;
  669% ectest/ec_reader_test_examples.e:351
  670% 
  671% load foundations/Root.e
  672load('foundations/Root.e').
  673
  674% load foundations/EC.e
  675load('foundations/EC.e').
  676
  677% load examples/Cassimatis2002/PolySpace.e
  678load('examples/Cassimatis2002/PolySpace.e').
  679
  680% 
  681% grid G1
  682t(grid, g1).
  683
  684% ectest/ec_reader_test_examples.e:357
  685% object X,Y,Screen
  686t(object, x).
  687
  688t(object, y).
  689
  690t(object, screen).
  691
  692% 
  693% ; perceptions:
  694% Shape(X,Round).
  695shape(x, round).
  696
  697% 
  698% Color(X,Red).
  699color(x, red).
  700
  701% 
  702% Shape(Y,Round).
  703shape(y, round).
  704
  705% 
  706% ectest/ec_reader_test_examples.e:363
  707% Color(Y,Red).
  708color(y, red).
  709
  710% 
  711% Shape(Screen,Square).
  712shape(screen, square).
  713
  714% 
  715% Color(Screen,Green).
  716color(screen, green).
  717
  718% 
  719% ectest/ec_reader_test_examples.e:366
  720% [time] % HoldsAt(Location(G1,Screen,2,0),time).
  721holds_at(location(g1, screen, 2, 0), Time).
  722
  723% 
  724% HoldsAt(Location(G1,X,1,1),0).
  725holds_at(location(g1, x, 1, 1), 0).
  726
  727% 
  728% HoldsAt(Location(G1,Y,3,1),2).
  729holds_at(location(g1, y, 3, 1), 2).
  730
  731% 
  732% 
  733% ectest/ec_reader_test_examples.e:370
  734% [xcoord,ycoord,time]% 
  735% xcoord!=% 2 & !(xcoord=1 & ycoord=1 & time=0) ->
  736% !HoldsAt(Location(G1,X,xcoord,ycoord),time) |
  737% xcoord=3 & ycoord=1 & time=2 & Equal(X,Y).
  738(   ( Xcoord\=2, not((Xcoord=1, Ycoord=1, Time=0))->not(holds_at(location(g1, x, Xcoord, Ycoord), Time))
  739    )
  740;   Xcoord=3,
  741    Ycoord=1,
  742    Time=2,
  743    equal(x, y)
  744).
  745
  746% 
  747% 
  748% ectest/ec_reader_test_examples.e:375
  749% [xcoord,ycoord,time]% 
  750% xcoord!=% 2 & !(xcoord=3 & ycoord=1 & time=2) ->
  751% !HoldsAt(Location(G1,Y,xcoord,ycoord),time) |
  752% xcoord=1 & ycoord=1 & time=0 & Equal(X,Y).
  753(   ( Xcoord\=2, not((Xcoord=3, Ycoord=1, Time=2))->not(holds_at(location(g1, y, Xcoord, Ycoord), Time))
  754    )
  755;   Xcoord=1,
  756    Ycoord=1,
  757    Time=0,
  758    equal(x, y)
  759).
  760
  761% 
  762% 
  763% range time 0 2
  764range(time, 0, 2).
  765
  766% ectest/ec_reader_test_examples.e:381
  767% range xcoord 0 4
  768range(xcoord, 0, 4).
  769
  770% range ycoord 0 2
  771range(ycoord, 0, 2).
  772
  773% range offset 0 0
  774range(offset, 0, 0).
  775
  776% 
  777% ; End of file.
  778% 
  779% ectest/ec_reader_test_examples.e:387
  780% 
  781% 
  782% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  783% ; FILE: examples/BrewkaDixKonolige1997/Wine.e
  784% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  785% ;
  786% ; Copyright (c) 2005 IBM Corporation and others.
  787% ; All rights reserved. This program and the accompanying materials
  788% ; are made available under the terms of the Common Public License v1.0
  789% ; which accompanies this distribution, and is available at
  790% ; http://www.eclipse.org/legal/cpl-v10.html
  791% ;
  792% ; Contributors:
  793% ; IBM - Initial implementation
  794% ;
  795% ; reasoning by cases
  796% ; \fullciteA[p. 45]{BrewkaDixKonolige:1997}
  797% ;
  798% ; @book{BrewkaDixKonolige:1997,
  799% ;   author = "Gerhard Brewka and J{\"{u}}rgen Dix and Kurt Konolige",
  800% ;   year = "1997",
  801% ;   title = "Nonmonotonic Reasoning: An Overview",
  802% ;   address = "Stanford, CA",
  803% ;   publisher = "CSLI",
  804% ; }
  805% ;
  806% ectest/ec_reader_test_examples.e:413
  807% 
  808% load foundations/Root.e
  809load('foundations/Root.e').
  810
  811% load foundations/EC.e
  812load('foundations/EC.e').
  813
  814% 
  815% sort x
  816sort(x).
  817
  818% x Person
  819t(x, person).
  820
  821% ectest/ec_reader_test_examples.e:419
  822% 
  823% predicate LikesWine(x)
  824predicate(likesWine(x)).
  825
  826% predicate Italian(x)
  827predicate(italian(x)).
  828
  829% predicate French(x)
  830predicate(french(x)).
  831
  832% predicate Ab1(x)
  833predicate(ab1(x)).
  834
  835% predicate Ab2(x)
  836predicate(ab2(x)).
  837
  838% ectest/ec_reader_test_examples.e:425
  839% 
  840% ectest/ec_reader_test_examples.e:426
  841% [x] % Italian(x) & !Ab1(x) -> LikesWine(x).
  842italian(X), not(ab1(X)) ->
  843	likesWine(X).
  844
  845% 
  846% ectest/ec_reader_test_examples.e:427
  847% [x] % French(x) & !Ab2(x) -> LikesWine(x).
  848french(X), not(ab2(X)) ->
  849	likesWine(X).
  850
  851% 
  852% ectest/ec_reader_test_examples.e:428
  853% [x] % Italian(x) -> !French(x).
  854italian(X) ->
  855	not(french(X)).
  856
  857% 
  858% 
  859% Italian(Person) | French(Person).
  860(   italian(person)
  861;   french(person)
  862).
  863
  864% 
  865% 
  866% range time 0 0
  867range(time, 0, 0).
  868
  869% range offset 1 1
  870range(offset, 1, 1).
  871
  872% ectest/ec_reader_test_examples.e:434
  873% 
  874% completion Theta Ab1
  875completion(theta).
  876
  877completion(ab1).
  878
  879% completion Theta Ab2
  880completion(theta).
  881
  882completion(ab2).
  883
  884% 
  885% ; End of file.
  886% 
  887% ectest/ec_reader_test_examples.e:440
  888% 
  889% 
  890% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  891% ; FILE: examples/Shanahan1997/Yale.e
  892% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  893% ;
  894% ; Copyright (c) 2005 IBM Corporation and others.
  895% ; All rights reserved. This program and the accompanying materials
  896% ; are made available under the terms of the Common Public License v1.0
  897% ; which accompanies this distribution, and is available at
  898% ; http://www.eclipse.org/legal/cpl-v10.html
  899% ;
  900% ; Contributors:
  901% ; IBM - Initial implementation
  902% ;
  903% ; @article{HanksMcDermott:1987,
  904% ;   author = "Steve Hanks and Drew V. McDermott",
  905% ;   year = "1987",
  906% ;   title = "Nonmonotonic logic and temporal projection",
  907% ;   journal = "Artificial Intelligence",
  908% ;   volume = "33",
  909% ;   number = "3",
  910% ;   pages = "379--412",
  911% ; }
  912% ;
  913% ; \fullciteA[pp. 322--323]{Shanahan:1997}
  914% ;
  915% ; @book{Shanahan:1997,
  916% ;   author = "Murray Shanahan",
  917% ;   year = "1997",
  918% ;   title = "Solving the Frame Problem",
  919% ;   address = "Cambridge, MA",
  920% ;   publisher = "MIT Press",
  921% ; }
  922% ;
  923% ; deduction
  924% ;
  925% ; modifications from Shanahan's formulation:
  926% ; InitiallyP -> HoldsAt
  927% ; timestamps
  928% ; added [time] Terminates(Shoot(),Loaded(),time).
  929% ;
  930% ectest/ec_reader_test_examples.e:482
  931% 
  932% option showpred off
  933option(showpred, off).
  934
  935% 
  936% load foundations/Root.e
  937load('foundations/Root.e').
  938
  939% load foundations/EC.e
  940load('foundations/EC.e').
  941
  942% 
  943% ectest/ec_reader_test_examples.e:488
  944% event Load()
  945event(load()).
  946
  947% event Shoot()
  948event(shoot()).
  949
  950% event Sneeze()
  951event(sneeze()).
  952
  953% fluent Loaded()
  954fluent(loaded()).
  955
  956% fluent Alive()
  957fluent(alive()).
  958
  959% 
  960% ectest/ec_reader_test_examples.e:494
  961% [time] % Initiates(Load(),Loaded(),time).
  962initiates(load(), loaded(), Time).
  963
  964% 
  965% ectest/ec_reader_test_examples.e:495
  966% [time] % HoldsAt(Loaded(),time) -> Terminates(Shoot(),Alive(),time).
  967holds_at(loaded(), Time) ->
  968	terminates(shoot(), alive(), Time).
  969
  970% 
  971% ectest/ec_reader_test_examples.e:496
  972% [time] % Terminates(Shoot(),Loaded(),time).
  973terminates(shoot(), loaded(), Time).
  974
  975% 
  976% 
  977% HoldsAt(Alive(),0).
  978holds_at(alive(), 0).
  979
  980% 
  981% !HoldsAt(Loaded(),0).
  982not(holds_at(loaded(), 0)).
  983
  984% 
  985% Happens(Load(),0).
  986happens(load(), 0).
  987
  988% 
  989% Happens(Sneeze(),1).
  990happens(sneeze(), 1).
  991
  992% 
  993% ectest/ec_reader_test_examples.e:502
  994% Happens(Shoot(),2).
  995happens(shoot(), 2).
  996
  997% 
  998% 
  999% completion Happens
 1000completion(happens).
 1001
 1002% 
 1003% range time 0 3
 1004range(time, 0, 3).
 1005
 1006% range offset 1 1
 1007range(offset, 1, 1).
 1008
 1009% ectest/ec_reader_test_examples.e:508
 1010% 
 1011% ; End of file.
 1012% 
 1013% 
 1014% 
 1015% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1016% ; FILE: examples/Shanahan1997/StuffyRoom.e
 1017% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1018% ;
 1019% ; Copyright (c) 2005 IBM Corporation and others.
 1020% ; All rights reserved. This program and the accompanying materials
 1021% ; are made available under the terms of the Common Public License v1.0
 1022% ; which accompanies this distribution, and is available at
 1023% ; http://www.eclipse.org/legal/cpl-v10.html
 1024% ;
 1025% ; Contributors:
 1026% ; IBM - Initial implementation
 1027% ;
 1028% ; @article{GinsbergSmith:1988a,
 1029% ;   author = "Matthew L. Ginsberg and David E. Smith",
 1030% ;   year = "1988",
 1031% ;   title = "Reasoning about action \uppercase{I}: \uppercase{A} possible worlds approach",
 1032% ;   journal = "Artificial Intelligence",
 1033% ;   volume = "35",
 1034% ;   number = "2",
 1035% ;   pages = "165--195",
 1036% ; }
 1037% ;
 1038% ; \fullciteA[pp. 288--289]{Shanahan:1997}
 1039% ;
 1040% ; @book{Shanahan:1997,
 1041% ;   author = "Murray Shanahan",
 1042% ;   year = "1997",
 1043% ;   title = "Solving the Frame Problem",
 1044% ;   address = "Cambridge, MA",
 1045% ;   publisher = "MIT Press",
 1046% ; }
 1047% ;
 1048% ; deduction
 1049% ;
 1050% ; modifications from Shanahan's formulation:
 1051% ; timestamps
 1052% ; added:
 1053% ; !HoldsAt(Blocked1(),0).
 1054% ; !HoldsAt(Blocked2(),0).
 1055% ;
 1056% ectest/ec_reader_test_examples.e:554
 1057% 
 1058% load foundations/Root.e
 1059load('foundations/Root.e').
 1060
 1061% load foundations/EC.e
 1062load('foundations/EC.e').
 1063
 1064% 
 1065% event Close1()
 1066event(close1()).
 1067
 1068% event Close2()
 1069event(close2()).
 1070
 1071% ectest/ec_reader_test_examples.e:560
 1072% event Start()
 1073event(start()).
 1074
 1075% fluent Blocked1()
 1076fluent(blocked1()).
 1077
 1078% fluent Blocked2()
 1079fluent(blocked2()).
 1080
 1081% fluent Stuffy()
 1082fluent(stuffy()).
 1083
 1084% noninertial Stuffy
 1085noninertial(stuffy).
 1086
 1087% 
 1088% ectest/ec_reader_test_examples.e:566
 1089% [time] % Initiates(Close1(),Blocked1(),time).
 1090initiates(close1(), blocked1(), Time).
 1091
 1092% 
 1093% ectest/ec_reader_test_examples.e:567
 1094% [time] % Initiates(Close2(),Blocked2(),time).
 1095initiates(close2(), blocked2(), Time).
 1096
 1097% 
 1098% 
 1099% ectest/ec_reader_test_examples.e:569
 1100% [time]% 
 1101% HoldsAt(Stuffy(),time) <->
 1102% HoldsAt(Blocked1(),time)&HoldsAt(Blocked2(),time).
 1103holds_at(stuffy(), Time) <->
 1104	holds_at(blocked1(), Time),
 1105	holds_at(blocked2(), Time).
 1106
 1107% 
 1108% 
 1109% ectest/ec_reader_test_examples.e:573
 1110% [time] % Initiates(Start(),Blocked1(),time).
 1111initiates(start(), blocked1(), Time).
 1112
 1113% 
 1114% ectest/ec_reader_test_examples.e:574
 1115% [time] % Terminates(Start(),Blocked2(),time).
 1116terminates(start(), blocked2(), Time).
 1117
 1118% 
 1119% 
 1120% !HoldsAt(Blocked1(),0).
 1121not(holds_at(blocked1(), 0)).
 1122
 1123% 
 1124% !HoldsAt(Blocked2(),0).
 1125not(holds_at(blocked2(), 0)).
 1126
 1127% 
 1128% Happens(Start(),0).
 1129happens(start(), 0).
 1130
 1131% 
 1132% Happens(Close2(),1).
 1133happens(close2(), 1).
 1134
 1135% 
 1136% ectest/ec_reader_test_examples.e:580
 1137% 
 1138% completion Happens
 1139completion(happens).
 1140
 1141% 
 1142% range time 0 2
 1143range(time, 0, 2).
 1144
 1145% range offset 1 1
 1146range(offset, 1, 1).
 1147
 1148% 
 1149% ; End of file.
 1150% ectest/ec_reader_test_examples.e:587
 1151% 
 1152% 
 1153% 
 1154% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1155% ; FILE: examples/Shanahan1997/BusRide.e
 1156% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1157% ;
 1158% ; Copyright (c) 2005 IBM Corporation and others.
 1159% ; All rights reserved. This program and the accompanying materials
 1160% ; are made available under the terms of the Common Public License v1.0
 1161% ; which accompanies this distribution, and is available at
 1162% ; http://www.eclipse.org/legal/cpl-v10.html
 1163% ;
 1164% ; Contributors:
 1165% ; IBM - Initial implementation
 1166% ;
 1167% ; @article{Kartha:1994,
 1168% ;   author = "G. Neelakantan Kartha",
 1169% ;   year = "1994",
 1170% ;   title = "Two counterexamples related to \uppercase{B}aker's approach to the frame problem",
 1171% ;   journal = "Artificial Intelligence",
 1172% ;   volume = "69",
 1173% ;   number = "1--2",
 1174% ;   pages = "379--391",
 1175% ; }
 1176% ;
 1177% ; \fullciteA[pp. 359--361]{Shanahan:1997}
 1178% ;
 1179% ; @book{Shanahan:1997,
 1180% ;   author = "Murray Shanahan",
 1181% ;   year = "1997",
 1182% ;   title = "Solving the Frame Problem",
 1183% ;   address = "Cambridge, MA",
 1184% ;   publisher = "MIT Press",
 1185% ; }
 1186% ;
 1187% ; modifications from Shanahan's formulation:
 1188% ; InitiallyN -> !HoldsAt
 1189% ; timestamps
 1190% ;
 1191% ectest/ec_reader_test_examples.e:627
 1192% 
 1193% load foundations/Root.e
 1194load('foundations/Root.e').
 1195
 1196% load foundations/EC.e
 1197load('foundations/EC.e').
 1198
 1199% 
 1200% fluent HasTicket()
 1201fluent(hasTicket()).
 1202
 1203% fluent OnRed()
 1204fluent(onRed()).
 1205
 1206% ectest/ec_reader_test_examples.e:633
 1207% fluent OnYellow()
 1208fluent(onYellow()).
 1209
 1210% event Buy()
 1211event(buy()).
 1212
 1213% event Board()
 1214event(board()).
 1215
 1216% event BoardRed()
 1217event(boardRed()).
 1218
 1219% event BoardYellow()
 1220event(boardYellow()).
 1221
 1222% 
 1223% ectest/ec_reader_test_examples.e:639
 1224% [time] % Happens(Board(),time) -> Happens(BoardRed(),time) | Happens(BoardYellow(),time).
 1225(   ( happens(board(), Time)->happens(boardRed(), Time)
 1226    )
 1227;   happens(boardYellow(), Time)
 1228).
 1229
 1230% 
 1231% 
 1232% ectest/ec_reader_test_examples.e:641
 1233% [time] % Initiates(Buy(),HasTicket(),time).
 1234initiates(buy(), hasTicket(), Time).
 1235
 1236% 
 1237% ectest/ec_reader_test_examples.e:642
 1238% [time] % HoldsAt(HasTicket(),time) -> Initiates(BoardRed(),OnRed(),time).
 1239holds_at(hasTicket(), Time) ->
 1240	initiates(boardRed(), onRed(), Time).
 1241
 1242% 
 1243% ectest/ec_reader_test_examples.e:643
 1244% [time] % HoldsAt(HasTicket(),time) -> Initiates(BoardYellow(),OnYellow(),time).
 1245holds_at(hasTicket(), Time) ->
 1246	initiates(boardYellow(), onYellow(), Time).
 1247
 1248% 
 1249% 
 1250% ectest/ec_reader_test_examples.e:645
 1251% [time] % !(HoldsAt(OnRed(),time) & HoldsAt(OnYellow(),time)).
 1252not(( holds_at(onRed(), Time),
 1253      holds_at(onYellow(), Time)
 1254    )).
 1255
 1256% 
 1257% ectest/ec_reader_test_examples.e:646
 1258% [time] % HoldsAt(OnRed(),time) -> HoldsAt(HasTicket(),time).
 1259holds_at(onRed(), Time) ->
 1260	holds_at(hasTicket(), Time).
 1261
 1262% 
 1263% ectest/ec_reader_test_examples.e:647
 1264% [time] % HoldsAt(OnYellow(),time) -> HoldsAt(HasTicket(),time).
 1265holds_at(onYellow(), Time) ->
 1266	holds_at(hasTicket(), Time).
 1267
 1268% 
 1269% 
 1270% HoldsAt(OnRed(),2).
 1271holds_at(onRed(), 2).
 1272
 1273% 
 1274% 
 1275% !HoldsAt(HasTicket(),0).
 1276not(holds_at(hasTicket(), 0)).
 1277
 1278% 
 1279% Happens(Buy(),0).
 1280happens(buy(), 0).
 1281
 1282% 
 1283% ectest/ec_reader_test_examples.e:653
 1284% Happens(Board(),1).
 1285happens(board(), 1).
 1286
 1287% 
 1288% ; ABDUCED Happens(BoardRed(), 1).
 1289% 
 1290% completion Happens
 1291completion(happens).
 1292
 1293% 
 1294% range time 0 2
 1295range(time, 0, 2).
 1296
 1297% ectest/ec_reader_test_examples.e:659
 1298% range offset 1 1
 1299range(offset, 1, 1).
 1300
 1301% 
 1302% ; End of file.
 1303% 
 1304% 
 1305% 
 1306% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1307% ; FILE: examples/Shanahan1997/DeadOrAlive.e
 1308% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1309% ;
 1310% ; Copyright (c) 2005 IBM Corporation and others.
 1311% ; All rights reserved. This program and the accompanying materials
 1312% ; are made available under the terms of the Common Public License v1.0
 1313% ; which accompanies this distribution, and is available at
 1314% ; http://www.eclipse.org/legal/cpl-v10.html
 1315% ;
 1316% ; Contributors:
 1317% ; IBM - Initial implementation
 1318% ;
 1319% ; \fullciteA[p. 324]{Shanahan:1997}
 1320% ;
 1321% ; @book{Shanahan:1997,
 1322% ;   author = "Murray Shanahan",
 1323% ;   year = "1997",
 1324% ;   title = "Solving the Frame Problem",
 1325% ;   address = "Cambridge, MA",
 1326% ;   publisher = "MIT Press",
 1327% ; }
 1328% ;
 1329% ; deduction
 1330% ;
 1331% ; modifications from Shanahan's formulation:
 1332% ; InitiallyP -> HoldsAt
 1333% ; timestamps
 1334% ; added [time] Terminates(Shoot(),Loaded(),time).
 1335% ;
 1336% ectest/ec_reader_test_examples.e:695
 1337% 
 1338% load foundations/Root.e
 1339load('foundations/Root.e').
 1340
 1341% load foundations/EC.e
 1342load('foundations/EC.e').
 1343
 1344% 
 1345% event Load()
 1346event(load()).
 1347
 1348% event Shoot()
 1349event(shoot()).
 1350
 1351% ectest/ec_reader_test_examples.e:701
 1352% event Sneeze()
 1353event(sneeze()).
 1354
 1355% fluent Loaded()
 1356fluent(loaded()).
 1357
 1358% fluent Alive()
 1359fluent(alive()).
 1360
 1361% fluent Dead()
 1362fluent(dead()).
 1363
 1364% noninertial Dead
 1365noninertial(dead).
 1366
 1367% 
 1368% ectest/ec_reader_test_examples.e:707
 1369% [time] % Initiates(Load(),Loaded(),time).
 1370initiates(load(), loaded(), Time).
 1371
 1372% 
 1373% ectest/ec_reader_test_examples.e:708
 1374% [time] % HoldsAt(Loaded(),time) -> Terminates(Shoot(),Alive(),time).
 1375holds_at(loaded(), Time) ->
 1376	terminates(shoot(), alive(), Time).
 1377
 1378% 
 1379% ectest/ec_reader_test_examples.e:709
 1380% [time] % Terminates(Shoot(),Loaded(),time).
 1381terminates(shoot(), loaded(), Time).
 1382
 1383% 
 1384% ectest/ec_reader_test_examples.e:710
 1385% [time] % HoldsAt(Dead(),time) <-> !HoldsAt(Alive(),time).
 1386holds_at(dead(), Time) <->
 1387	not(holds_at(alive(), Time)).
 1388
 1389% 
 1390% 
 1391% HoldsAt(Alive(),0).
 1392holds_at(alive(), 0).
 1393
 1394% 
 1395% !HoldsAt(Loaded(),0).
 1396not(holds_at(loaded(), 0)).
 1397
 1398% 
 1399% Happens(Load(),0).
 1400happens(load(), 0).
 1401
 1402% 
 1403% Happens(Sneeze(),1).
 1404happens(sneeze(), 1).
 1405
 1406% 
 1407% ectest/ec_reader_test_examples.e:716
 1408% Happens(Shoot(),2).
 1409happens(shoot(), 2).
 1410
 1411% 
 1412% 
 1413% completion Happens
 1414completion(happens).
 1415
 1416% 
 1417% range time 0 3
 1418range(time, 0, 3).
 1419
 1420% range offset 1 1
 1421range(offset, 1, 1).
 1422
 1423% ectest/ec_reader_test_examples.e:722
 1424% 
 1425% ; End of file.
 1426% 
 1427% 
 1428% 
 1429% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1430% ; FILE: examples/Shanahan1997/Supermarket.e
 1431% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1432% ;
 1433% ; Copyright (c) 2005 IBM Corporation and others.
 1434% ; All rights reserved. This program and the accompanying materials
 1435% ; are made available under the terms of the Common Public License v1.0
 1436% ; which accompanies this distribution, and is available at
 1437% ; http://www.eclipse.org/legal/cpl-v10.html
 1438% ;
 1439% ; Contributors:
 1440% ; IBM - Initial implementation
 1441% ;
 1442% ; \fullciteA[pp. 302--304]{Shanahan:1997}
 1443% ;
 1444% ; @book{Shanahan:1997,
 1445% ;   author = "Murray Shanahan",
 1446% ;   year = "1997",
 1447% ;   title = "Solving the Frame Problem",
 1448% ;   address = "Cambridge, MA",
 1449% ;   publisher = "MIT Press",
 1450% ; }
 1451% ;
 1452% ; deduction
 1453% ;
 1454% ; modifications from Shanahan's formulation:
 1455% ; reformulated using the method of \fullciteA[pp. 460--461]{MillerShanahan:2002}
 1456% ;
 1457% ; @incollection{MillerShanahan:2002,
 1458% ;   author = "Rob Miller and Murray Shanahan",
 1459% ;   year = "2002",
 1460% ;   title = "Some alternative formulations of the event calculus",
 1461% ;   editor = "Antonis C. Kakas and Fariba Sadri",
 1462% ;   booktitle = "Computational Logic: Logic Programming and Beyond: Essays in Honour of \uppercase{R}obert \uppercase{A}. \uppercase{K}owalski, Part \uppercase{II}",
 1463% ;   series = "Lecture Notes in Computer Science",
 1464% ;   volume = "2408",
 1465% ;   pages = "452--490",
 1466% ;   address = "Berlin",
 1467% ;   publisher = "Springer",
 1468% ; }
 1469% ;
 1470% ; added:
 1471% ; !HoldsAt(Forwards(), 0).
 1472% ; !HoldsAt(Backwards(), 0).
 1473% ; !HoldsAt(Spinning(), 0).
 1474% ;
 1475% ectest/ec_reader_test_examples.e:773
 1476% 
 1477% load foundations/Root.e
 1478load('foundations/Root.e').
 1479
 1480% load foundations/EC.e
 1481load('foundations/EC.e').
 1482
 1483% 
 1484% event Push()
 1485event(push()).
 1486
 1487% event Pull()
 1488event(pull()).
 1489
 1490% ectest/ec_reader_test_examples.e:779
 1491% fluent Forwards()
 1492fluent(forwards()).
 1493
 1494% fluent Backwards()
 1495fluent(backwards()).
 1496
 1497% fluent Spinning()
 1498fluent(spinning()).
 1499
 1500% 
 1501% ectest/ec_reader_test_examples.e:783
 1502% [time]% 
 1503% !Happens(Pull(), time) ->
 1504% Initiates(Push(), Forwards(), time).
 1505not(happens(pull(), Time)) ->
 1506	initiates(push(), forwards(), Time).
 1507
 1508% 
 1509% 
 1510% ectest/ec_reader_test_examples.e:787
 1511% [time]% 
 1512% !Happens(Pull(), time) ->
 1513% Terminates(Push(), Backwards(), time).
 1514not(happens(pull(), Time)) ->
 1515	terminates(push(), backwards(), Time).
 1516
 1517% 
 1518% 
 1519% ectest/ec_reader_test_examples.e:791
 1520% [time]% 
 1521% !Happens(Push(), time) ->
 1522% Initiates(Pull(), Backwards(), time).
 1523not(happens(push(), Time)) ->
 1524	initiates(pull(), backwards(), Time).
 1525
 1526% 
 1527% 
 1528% ectest/ec_reader_test_examples.e:795
 1529% [time]% 
 1530% !Happens(Push(), time) ->
 1531% Terminates(Pull(), Forwards(), time).
 1532not(happens(push(), Time)) ->
 1533	terminates(pull(), forwards(), Time).
 1534
 1535% 
 1536% 
 1537% ectest/ec_reader_test_examples.e:799
 1538% [time]% 
 1539% Happens(Push(), time) ->
 1540% Initiates(Pull(), Spinning(), time).
 1541happens(push(), Time) ->
 1542	initiates(pull(), spinning(), Time).
 1543
 1544% 
 1545% 
 1546% ectest/ec_reader_test_examples.e:803
 1547% [time]% 
 1548% Happens(Push(), time) ->
 1549% Terminates(Pull(), Forwards(), time).
 1550happens(push(), Time) ->
 1551	terminates(pull(), forwards(), Time).
 1552
 1553% 
 1554% 
 1555% ectest/ec_reader_test_examples.e:807
 1556% [time]% 
 1557% Happens(Push(), time) ->
 1558% Terminates(Pull(), Backwards(), time).
 1559happens(push(), Time) ->
 1560	terminates(pull(), backwards(), Time).
 1561
 1562% 
 1563% 
 1564% ectest/ec_reader_test_examples.e:811
 1565% [time]% 
 1566% !Happens(Pull(), time) ->
 1567% Terminates(Push(), Spinning(), time).
 1568not(happens(pull(), Time)) ->
 1569	terminates(push(), spinning(), Time).
 1570
 1571% 
 1572% 
 1573% ectest/ec_reader_test_examples.e:815
 1574% [time]% 
 1575% !Happens(Push(), time) ->
 1576% Terminates(Pull(), Spinning(), time).
 1577not(happens(push(), Time)) ->
 1578	terminates(pull(), spinning(), Time).
 1579
 1580% 
 1581% 
 1582% !HoldsAt(Forwards(), 0).
 1583not(holds_at(forwards(), 0)).
 1584
 1585% 
 1586% !HoldsAt(Backwards(), 0).
 1587not(holds_at(backwards(), 0)).
 1588
 1589% 
 1590% ectest/ec_reader_test_examples.e:821
 1591% !HoldsAt(Spinning(), 0).
 1592not(holds_at(spinning(), 0)).
 1593
 1594% 
 1595% 
 1596% Happens(Push(), 5).
 1597happens(push(), 5).
 1598
 1599% 
 1600% Happens(Pull(), 5).
 1601happens(pull(), 5).
 1602
 1603% 
 1604% Happens(Pull(), 10).
 1605happens(pull(), 10).
 1606
 1607% 
 1608% Happens(Push(), 10).
 1609happens(push(), 10).
 1610
 1611% 
 1612% ectest/ec_reader_test_examples.e:827
 1613% 
 1614% completion Happens
 1615completion(happens).
 1616
 1617% 
 1618% range time 0 12
 1619range(time, 0, 12).
 1620
 1621% range offset 1 1
 1622range(offset, 1, 1).
 1623
 1624% 
 1625% ; End of file.
 1626% ectest/ec_reader_test_examples.e:834
 1627% 
 1628% 
 1629% 
 1630% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1631% ; FILE: examples/Shanahan1997/StolenCar.e
 1632% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1633% ;
 1634% ; Copyright (c) 2005 IBM Corporation and others.
 1635% ; All rights reserved. This program and the accompanying materials
 1636% ; are made available under the terms of the Common Public License v1.0
 1637% ; which accompanies this distribution, and is available at
 1638% ; http://www.eclipse.org/legal/cpl-v10.html
 1639% ;
 1640% ; Contributors:
 1641% ; IBM - Initial implementation
 1642% ;
 1643% ; @inproceedings{Kautz:1986,
 1644% ;   author = "Henry A. Kautz",
 1645% ;   year = "1986",
 1646% ;   title = "The Logic of Persistence",
 1647% ;   booktitle = "\uppercase{P}roceedings of the \uppercase{F}ifth \uppercase{N}ational \uppercase{C}onference on \uppercase{A}rtificial \uppercase{I}ntelligence",
 1648% ;   pages = "401--405",
 1649% ;   address = "Los Altos, CA",
 1650% ;   publisher = "Morgan Kaufmann",
 1651% ; }
 1652% ;
 1653% ; \fullciteA[p. 359]{Shanahan:1997}
 1654% ;
 1655% ; @book{Shanahan:1997,
 1656% ;   author = "Murray Shanahan",
 1657% ;   year = "1997",
 1658% ;   title = "Solving the Frame Problem",
 1659% ;   address = "Cambridge, MA",
 1660% ;   publisher = "MIT Press",
 1661% ; }
 1662% ;
 1663% ; abduction
 1664% ;
 1665% ; modifications from Shanahan's formulation:
 1666% ; timestamps
 1667% ; added !HoldsAt(CarParked(),0).
 1668% ;
 1669% ectest/ec_reader_test_examples.e:876
 1670% 
 1671% load foundations/Root.e
 1672load('foundations/Root.e').
 1673
 1674% load foundations/EC.e
 1675load('foundations/EC.e').
 1676
 1677% 
 1678% event Park()
 1679event(park()).
 1680
 1681% event Steal()
 1682event(steal()).
 1683
 1684% ectest/ec_reader_test_examples.e:882
 1685% fluent CarParked()
 1686fluent(carParked()).
 1687
 1688% 
 1689% ectest/ec_reader_test_examples.e:884
 1690% [time] % Initiates(Park(),CarParked(),time).
 1691initiates(park(), carParked(), Time).
 1692
 1693% 
 1694% ectest/ec_reader_test_examples.e:885
 1695% [time] % Terminates(Steal(),CarParked(),time).
 1696terminates(steal(), carParked(), Time).
 1697
 1698% 
 1699% 
 1700% !HoldsAt(CarParked(),0).
 1701not(holds_at(carParked(), 0)).
 1702
 1703% 
 1704% Happens(Park(),0).
 1705happens(park(), 0).
 1706
 1707% 
 1708% ; ABDUCED Happens(Steal(), 1).
 1709% !HoldsAt(CarParked(),2).
 1710not(holds_at(carParked(), 2)).
 1711
 1712% 
 1713% ectest/ec_reader_test_examples.e:891
 1714% 
 1715% range time 0 2
 1716range(time, 0, 2).
 1717
 1718% range offset 1 1
 1719range(offset, 1, 1).
 1720
 1721% 
 1722% ; End of file.
 1723% 
 1724% ectest/ec_reader_test_examples.e:897
 1725% 
 1726% 
 1727% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1728% ; FILE: examples/MillerShanahan2002/Bowl.e
 1729% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1730% ;
 1731% ; Copyright (c) 2005 IBM Corporation and others.
 1732% ; All rights reserved. This program and the accompanying materials
 1733% ; are made available under the terms of the Common Public License v1.0
 1734% ; which accompanies this distribution, and is available at
 1735% ; http://www.eclipse.org/legal/cpl-v10.html
 1736% ;
 1737% ; Contributors:
 1738% ; IBM - Initial implementation
 1739% ;
 1740% ; \fullciteA[p. 461]{MillerShanahan:2002}
 1741% ;
 1742% ; @incollection{MillerShanahan:2002,
 1743% ;   author = "Rob Miller and Murray Shanahan",
 1744% ;   year = "2002",
 1745% ;   title = "Some alternative formulations of the event calculus",
 1746% ;   editor = "Antonis C. Kakas and Fariba Sadri",
 1747% ;   booktitle = "Computational Logic: Logic Programming and Beyond: Essays in Honour of \uppercase{R}obert \uppercase{A}. \uppercase{K}owalski, Part \uppercase{II}",
 1748% ;   series = "Lecture Notes in Computer Science",
 1749% ;   volume = "2408",
 1750% ;   pages = "452--490",
 1751% ;   address = "Berlin",
 1752% ;   publisher = "Springer",
 1753% ; }
 1754% ;
 1755% ectest/ec_reader_test_examples.e:927
 1756% 
 1757% load foundations/Root.e
 1758load('foundations/Root.e').
 1759
 1760% load foundations/EC.e
 1761load('foundations/EC.e').
 1762
 1763% 
 1764% event LiftLeft()
 1765event(liftLeft()).
 1766
 1767% event LiftRight()
 1768event(liftRight()).
 1769
 1770% ectest/ec_reader_test_examples.e:933
 1771% fluent Spilt()
 1772fluent(spilt()).
 1773
 1774% fluent Raised()
 1775fluent(raised()).
 1776
 1777% 
 1778% ectest/ec_reader_test_examples.e:936
 1779% [time]% 
 1780% !Happens(LiftRight(), time) ->
 1781% Initiates(LiftLeft(), Spilt(), time).
 1782not(happens(liftRight(), Time)) ->
 1783	initiates(liftLeft(), spilt(), Time).
 1784
 1785% 
 1786% 
 1787% ectest/ec_reader_test_examples.e:940
 1788% [time]% 
 1789% !Happens(LiftLeft(), time) ->
 1790% Initiates(LiftRight(), Spilt(), time).
 1791not(happens(liftLeft(), Time)) ->
 1792	initiates(liftRight(), spilt(), Time).
 1793
 1794% 
 1795% 
 1796% ectest/ec_reader_test_examples.e:944
 1797% [time]% 
 1798% Happens(LiftLeft(), time) ->
 1799% Initiates(LiftRight(), Raised(), time).
 1800happens(liftLeft(), Time) ->
 1801	initiates(liftRight(), raised(), Time).
 1802
 1803% 
 1804% 
 1805% !HoldsAt(Spilt(), 0).
 1806not(holds_at(spilt(), 0)).
 1807
 1808% 
 1809% !HoldsAt(Raised(), 0).
 1810not(holds_at(raised(), 0)).
 1811
 1812% 
 1813% ectest/ec_reader_test_examples.e:950
 1814% Happens(LiftLeft(), 2).
 1815happens(liftLeft(), 2).
 1816
 1817% 
 1818% Happens(LiftRight(), 2).
 1819happens(liftRight(), 2).
 1820
 1821% 
 1822% 
 1823% completion Happens
 1824completion(happens).
 1825
 1826% 
 1827% range time 0 3
 1828range(time, 0, 3).
 1829
 1830% ectest/ec_reader_test_examples.e:956
 1831% range offset 1 1
 1832range(offset, 1, 1).
 1833
 1834% 
 1835% ; End of file.
 1836% 
 1837% 
 1838% 
 1839% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1840% ; FILE: examples/ReiterCriscuolo1981/NixonDiamond1.e
 1841% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1842% ;
 1843% ; Copyright (c) 2005 IBM Corporation and others.
 1844% ; All rights reserved. This program and the accompanying materials
 1845% ; are made available under the terms of the Common Public License v1.0
 1846% ; which accompanies this distribution, and is available at
 1847% ; http://www.eclipse.org/legal/cpl-v10.html
 1848% ;
 1849% ; Contributors:
 1850% ; IBM - Initial implementation
 1851% ;
 1852% ; conflicting defaults: showing that inconsistency results
 1853% ; without a cancellation rule
 1854% ; \fullciteA[p. 274]{ReiterCriscuolo:1981}
 1855% ; \fullciteA[pp. 98--99]{McCarthy:1986}
 1856% ;
 1857% ; @inproceedings{ReiterCriscuolo:1981,
 1858% ;   author = "Raymond Reiter and Giovanni Criscuolo",
 1859% ;   year = "1981",
 1860% ;   title = "On interacting defaults",
 1861% ;   booktitle = "\uppercase{P}roceedings of the \uppercase{S}eventh \uppercase{I}nternational \uppercase{J}oint \uppercase{C}onference on \uppercase{A}rtificial \uppercase{I}ntelligence",
 1862% ;   volume = "1",
 1863% ;   pages = "270--276",
 1864% ;   address = "Los Altos, CA",
 1865% ;   publisher = "William Kaufmann",
 1866% ; }
 1867% ;
 1868% ; @article{McCarthy:1986,
 1869% ;   author = "John McCarthy",
 1870% ;   year = "1986",
 1871% ;   title = "Applications of circumscription to formalizing common-sense knowledge",
 1872% ;   journal = "Artificial Intelligence",
 1873% ;   volume = "28",
 1874% ;   pages = "89--116".
 1875% ; }
 1876% ;
 1877% ectest/ec_reader_test_examples.e:1000
 1878% 
 1879% load foundations/Root.e
 1880load('foundations/Root.e').
 1881
 1882% load foundations/EC.e
 1883load('foundations/EC.e').
 1884
 1885% 
 1886% sort x
 1887sort(x).
 1888
 1889% 
 1890% ectest/ec_reader_test_examples.e:1006
 1891% predicate Republican(x)
 1892predicate(republican(x)).
 1893
 1894% predicate Quaker(x)
 1895predicate(quaker(x)).
 1896
 1897% predicate Pacifist(x)
 1898predicate(pacifist(x)).
 1899
 1900% predicate Ab1(x)
 1901predicate(ab1(x)).
 1902
 1903% predicate Ab2(x)
 1904predicate(ab2(x)).
 1905
 1906% 
 1907% ectest/ec_reader_test_examples.e:1012
 1908% x John
 1909t(x, john).
 1910
 1911% 
 1912% Republican(John).
 1913republican(john).
 1914
 1915% 
 1916% Quaker(John).
 1917quaker(john).
 1918
 1919% 
 1920% 
 1921% ectest/ec_reader_test_examples.e:1017
 1922% [x] % Republican(x) & !Ab1(x) -> !Pacifist(x).
 1923republican(X), not(ab1(X)) ->
 1924	not(pacifist(X)).
 1925
 1926% 
 1927% ectest/ec_reader_test_examples.e:1018
 1928% [x] % Quaker(x) & !Ab2(x) -> Pacifist(x).
 1929quaker(X), not(ab2(X)) ->
 1930	pacifist(X).
 1931
 1932% 
 1933% 
 1934% range time 0 0
 1935range(time, 0, 0).
 1936
 1937% range offset 1 1
 1938range(offset, 1, 1).
 1939
 1940% 
 1941% completion Theta Ab1
 1942completion(theta).
 1943
 1944completion(ab1).
 1945
 1946% ectest/ec_reader_test_examples.e:1024
 1947% completion Theta Ab2
 1948completion(theta).
 1949
 1950completion(ab2).
 1951
 1952% 
 1953% ; End of file.
 1954% 
 1955% 
 1956% 
 1957% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1958% ; FILE: examples/ReiterCriscuolo1981/NixonDiamond2.e
 1959% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 1960% ;
 1961% ; Copyright (c) 2005 IBM Corporation and others.
 1962% ; All rights reserved. This program and the accompanying materials
 1963% ; are made available under the terms of the Common Public License v1.0
 1964% ; which accompanies this distribution, and is available at
 1965% ; http://www.eclipse.org/legal/cpl-v10.html
 1966% ;
 1967% ; Contributors:
 1968% ; IBM - Initial implementation
 1969% ;
 1970% ; conflicting defaults: method (D)
 1971% ; \fullciteA[p. 274]{ReiterCriscuolo:1981}
 1972% ; \fullciteA[pp. 98--99]{McCarthy:1986}
 1973% ; \fullciteA[p. 18]{BrewkaDixKonolige:1997}
 1974% ;
 1975% ; @inproceedings{ReiterCriscuolo:1981,
 1976% ;   author = "Raymond Reiter and Giovanni Criscuolo",
 1977% ;   year = "1981",
 1978% ;   title = "On interacting defaults",
 1979% ;   booktitle = "\uppercase{P}roceedings of the \uppercase{S}eventh \uppercase{I}nternational \uppercase{J}oint \uppercase{C}onference on \uppercase{A}rtificial \uppercase{I}ntelligence",
 1980% ;   volume = "1",
 1981% ;   pages = "270--276",
 1982% ;   address = "Los Altos, CA",
 1983% ;   publisher = "William Kaufmann",
 1984% ; }
 1985% ;
 1986% ; @article{McCarthy:1986,
 1987% ;   author = "John McCarthy",
 1988% ;   year = "1986",
 1989% ;   title = "Applications of circumscription to formalizing common-sense knowledge",
 1990% ;   journal = "Artificial Intelligence",
 1991% ;   volume = "28",
 1992% ;   pages = "89--116".
 1993% ; }
 1994% ;
 1995% ; @book{BrewkaDixKonolige:1997,
 1996% ;   author = "Gerhard Brewka and J{\"{u}}rgen Dix and Kurt Konolige",
 1997% ;   year = "1997",
 1998% ;   title = "Nonmonotonic Reasoning: An Overview",
 1999% ;   address = "Stanford, CA",
 2000% ;   publisher = "CSLI",
 2001% ; }
 2002% ;
 2003% ectest/ec_reader_test_examples.e:1076
 2004% 
 2005% load foundations/Root.e
 2006load('foundations/Root.e').
 2007
 2008% load foundations/EC.e
 2009load('foundations/EC.e').
 2010
 2011% 
 2012% sort x
 2013sort(x).
 2014
 2015% 
 2016% ectest/ec_reader_test_examples.e:1082
 2017% predicate Republican(x)
 2018predicate(republican(x)).
 2019
 2020% predicate Quaker(x)
 2021predicate(quaker(x)).
 2022
 2023% predicate Pacifist(x)
 2024predicate(pacifist(x)).
 2025
 2026% predicate Ab1(x)
 2027predicate(ab1(x)).
 2028
 2029% predicate Ab2(x)
 2030predicate(ab2(x)).
 2031
 2032% 
 2033% ectest/ec_reader_test_examples.e:1088
 2034% x John
 2035t(x, john).
 2036
 2037% 
 2038% Republican(John).
 2039republican(john).
 2040
 2041% 
 2042% Quaker(John).
 2043quaker(john).
 2044
 2045% 
 2046% 
 2047% ectest/ec_reader_test_examples.e:1093
 2048% [x] % Republican(x) & !Ab1(x) -> !Pacifist(x).
 2049republican(X), not(ab1(X)) ->
 2050	not(pacifist(X)).
 2051
 2052% 
 2053% ectest/ec_reader_test_examples.e:1094
 2054% [x] % Quaker(x) & !Ab2(x) -> Pacifist(x).
 2055quaker(X), not(ab2(X)) ->
 2056	pacifist(X).
 2057
 2058% 
 2059% Theta:
 2060directive(theta).
 2061
 2062 
 2063% ectest/ec_reader_test_examples.e:1095
 2064% [x] % Republican(x) -> Ab2(x).
 2065republican(X) ->
 2066	ab2(X).
 2067
 2068% 
 2069% 
 2070% range time 0 0
 2071range(time, 0, 0).
 2072
 2073% range offset 1 1
 2074range(offset, 1, 1).
 2075
 2076% 
 2077% completion Theta Ab1
 2078completion(theta).
 2079
 2080completion(ab1).
 2081
 2082% ectest/ec_reader_test_examples.e:1101
 2083% completion Theta Ab2
 2084completion(theta).
 2085
 2086completion(ab2).
 2087
 2088% 
 2089% ; End of file.
 2090% 
 2091% 
 2092% 
 2093% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2094% ; FILE: examples/Mueller2006/Chapter2/Sleep2.e
 2095% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2096% ;
 2097% ; Copyright (c) 2005 IBM Corporation and others.
 2098% ; All rights reserved. This program and the accompanying materials
 2099% ; are made available under the terms of the Common Public License v1.0
 2100% ; which accompanies this distribution, and is available at
 2101% ; http://www.eclipse.org/legal/cpl-v10.html
 2102% ;
 2103% ; Contributors:
 2104% ; IBM - Initial implementation
 2105% ;
 2106% ; @book{Mueller:2006,
 2107% ;   author = "Erik T. Mueller",
 2108% ;   year = "2006",
 2109% ;   title = "Commonsense Reasoning",
 2110% ;   address = "San Francisco",
 2111% ;   publisher = "Morgan Kaufmann/Elsevier",
 2112% ; }
 2113% ;
 2114% ectest/ec_reader_test_examples.e:1128
 2115% 
 2116% load foundations/Root.e
 2117load('foundations/Root.e').
 2118
 2119% load foundations/EC.e
 2120load('foundations/EC.e').
 2121
 2122% 
 2123% sort agent
 2124sort(agent).
 2125
 2126% 
 2127% ectest/ec_reader_test_examples.e:1134
 2128% agent Nathan
 2129t(agent, nathan).
 2130
 2131% 
 2132% fluent Awake(agent)
 2133fluent(awake(agent)).
 2134
 2135% 
 2136% event WakeUp(agent)
 2137event(wakeUp(agent)).
 2138
 2139% event FallAsleep(agent)
 2140event(fallAsleep(agent)).
 2141
 2142% ectest/ec_reader_test_examples.e:1140
 2143% 
 2144% ; Sigma
 2145% 
 2146% ectest/ec_reader_test_examples.e:1143
 2147% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
 2148initiates(wakeUp(Agent), awake(Agent), Time).
 2149
 2150% 
 2151% ectest/ec_reader_test_examples.e:1144
 2152% [agent,time] % Terminates(FallAsleep(agent),Awake(agent),time).
 2153terminates(fallAsleep(Agent), awake(Agent), Time).
 2154
 2155% 
 2156% 
 2157% ; Gamma
 2158% 
 2159% !HoldsAt(Awake(Nathan),0).
 2160not(holds_at(awake(nathan), 0)).
 2161
 2162% 
 2163% HoldsAt(Awake(Nathan),1).
 2164holds_at(awake(nathan), 1).
 2165
 2166% 
 2167% ectest/ec_reader_test_examples.e:1150
 2168% 
 2169% ; abduced:
 2170% ; Happens(WakeUp(Nathan),0).
 2171% 
 2172% range time 0 1
 2173range(time, 0, 1).
 2174
 2175% range offset 1 1
 2176range(offset, 1, 1).
 2177
 2178% ectest/ec_reader_test_examples.e:1156
 2179% 
 2180% ; End of file.
 2181% 
 2182% 
 2183% 
 2184% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2185% ; FILE: examples/Mueller2006/Chapter2/Sleep1.e
 2186% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2187% ;
 2188% ; Copyright (c) 2005 IBM Corporation and others.
 2189% ; All rights reserved. This program and the accompanying materials
 2190% ; are made available under the terms of the Common Public License v1.0
 2191% ; which accompanies this distribution, and is available at
 2192% ; http://www.eclipse.org/legal/cpl-v10.html
 2193% ;
 2194% ; Contributors:
 2195% ; IBM - Initial implementation
 2196% ;
 2197% ; @book{Mueller:2006,
 2198% ;   author = "Erik T. Mueller",
 2199% ;   year = "2006",
 2200% ;   title = "Commonsense Reasoning",
 2201% ;   address = "San Francisco",
 2202% ;   publisher = "Morgan Kaufmann/Elsevier",
 2203% ; }
 2204% ;
 2205% ectest/ec_reader_test_examples.e:1182
 2206% 
 2207% load foundations/Root.e
 2208load('foundations/Root.e').
 2209
 2210% load foundations/EC.e
 2211load('foundations/EC.e').
 2212
 2213% 
 2214% sort agent
 2215sort(agent).
 2216
 2217% 
 2218% ectest/ec_reader_test_examples.e:1188
 2219% agent Nathan
 2220t(agent, nathan).
 2221
 2222% 
 2223% fluent Awake(agent)
 2224fluent(awake(agent)).
 2225
 2226% 
 2227% event WakeUp(agent)
 2228event(wakeUp(agent)).
 2229
 2230% event FallAsleep(agent)
 2231event(fallAsleep(agent)).
 2232
 2233% ectest/ec_reader_test_examples.e:1194
 2234% 
 2235% ; Sigma
 2236% 
 2237% ectest/ec_reader_test_examples.e:1197
 2238% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
 2239initiates(wakeUp(Agent), awake(Agent), Time).
 2240
 2241% 
 2242% ectest/ec_reader_test_examples.e:1198
 2243% [agent,time] % Terminates(FallAsleep(agent),Awake(agent),time).
 2244terminates(fallAsleep(Agent), awake(Agent), Time).
 2245
 2246% 
 2247% 
 2248% ; Delta
 2249% 
 2250% Happens(WakeUp(Nathan),1).
 2251happens(wakeUp(nathan), 1).
 2252
 2253% 
 2254% 
 2255% ; Gamma
 2256% ectest/ec_reader_test_examples.e:1205
 2257% 
 2258% !HoldsAt(Awake(Nathan),0).
 2259not(holds_at(awake(nathan), 0)).
 2260
 2261% 
 2262% 
 2263% ; entailed:
 2264% ; HoldsAt(Awake(Nathan),3).
 2265% 
 2266% ectest/ec_reader_test_examples.e:1211
 2267% completion Happens
 2268completion(happens).
 2269
 2270% 
 2271% range time 0 3
 2272range(time, 0, 3).
 2273
 2274% range offset 1 1
 2275range(offset, 1, 1).
 2276
 2277% 
 2278% ; End of file.
 2279% ectest/ec_reader_test_examples.e:1217
 2280% 
 2281% 
 2282% 
 2283% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2284% ; FILE: examples/Mueller2006/Chapter2/Sleep3.e
 2285% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2286% ;
 2287% ; Copyright (c) 2005 IBM Corporation and others.
 2288% ; All rights reserved. This program and the accompanying materials
 2289% ; are made available under the terms of the Common Public License v1.0
 2290% ; which accompanies this distribution, and is available at
 2291% ; http://www.eclipse.org/legal/cpl-v10.html
 2292% ;
 2293% ; Contributors:
 2294% ; IBM - Initial implementation
 2295% ;
 2296% ; @book{Mueller:2006,
 2297% ;   author = "Erik T. Mueller",
 2298% ;   year = "2006",
 2299% ;   title = "Commonsense Reasoning",
 2300% ;   address = "San Francisco",
 2301% ;   publisher = "Morgan Kaufmann/Elsevier",
 2302% ; }
 2303% ;
 2304% ectest/ec_reader_test_examples.e:1241
 2305% 
 2306% load foundations/Root.e
 2307load('foundations/Root.e').
 2308
 2309% load foundations/EC.e
 2310load('foundations/EC.e').
 2311
 2312% 
 2313% sort agent
 2314sort(agent).
 2315
 2316% 
 2317% ectest/ec_reader_test_examples.e:1247
 2318% agent Nathan
 2319t(agent, nathan).
 2320
 2321% 
 2322% fluent Awake(agent)
 2323fluent(awake(agent)).
 2324
 2325% 
 2326% event WakeUp(agent)
 2327event(wakeUp(agent)).
 2328
 2329% event FallAsleep(agent)
 2330event(fallAsleep(agent)).
 2331
 2332% ectest/ec_reader_test_examples.e:1253
 2333% 
 2334% ; Sigma
 2335% 
 2336% ectest/ec_reader_test_examples.e:1256
 2337% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
 2338initiates(wakeUp(Agent), awake(Agent), Time).
 2339
 2340% 
 2341% ectest/ec_reader_test_examples.e:1257
 2342% [agent,time] % Terminates(FallAsleep(agent),Awake(agent),time).
 2343terminates(fallAsleep(Agent), awake(Agent), Time).
 2344
 2345% 
 2346% 
 2347% ; Delta
 2348% 
 2349% ectest/ec_reader_test_examples.e:1261
 2350% [agent,time]% 
 2351% Happens(WakeUp(agent),time) ->
 2352% !HoldsAt(Awake(agent),time).
 2353happens(wakeUp(Agent), Time) ->
 2354	not(holds_at(awake(Agent), Time)).
 2355
 2356% 
 2357% 
 2358% Happens(WakeUp(Nathan),0).
 2359happens(wakeUp(nathan), 0).
 2360
 2361% 
 2362% 
 2363% ; Gamma
 2364% ectest/ec_reader_test_examples.e:1268
 2365% 
 2366% HoldsAt(Awake(Nathan),1).
 2367holds_at(awake(nathan), 1).
 2368
 2369% 
 2370% 
 2371% ; inferred:
 2372% ; !HoldsAt(Awake(Nathan),0).
 2373% 
 2374% ectest/ec_reader_test_examples.e:1274
 2375% completion Happens
 2376completion(happens).
 2377
 2378% 
 2379% range time 0 1
 2380range(time, 0, 1).
 2381
 2382% range offset 1 1
 2383range(offset, 1, 1).
 2384
 2385% 
 2386% ; End of file.
 2387% ectest/ec_reader_test_examples.e:1280
 2388% 
 2389% 
 2390% 
 2391% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2392% ; FILE: examples/Mueller2006/Chapter2/Inconsistency3.e
 2393% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2394% ;
 2395% ; Copyright (c) 2005 IBM Corporation and others.
 2396% ; All rights reserved. This program and the accompanying materials
 2397% ; are made available under the terms of the Common Public License v1.0
 2398% ; which accompanies this distribution, and is available at
 2399% ; http://www.eclipse.org/legal/cpl-v10.html
 2400% ;
 2401% ; Contributors:
 2402% ; IBM - Initial implementation
 2403% ;
 2404% ; @book{Mueller:2006,
 2405% ;   author = "Erik T. Mueller",
 2406% ;   year = "2006",
 2407% ;   title = "Commonsense Reasoning",
 2408% ;   address = "San Francisco",
 2409% ;   publisher = "Morgan Kaufmann/Elsevier",
 2410% ; }
 2411% ;
 2412% ectest/ec_reader_test_examples.e:1304
 2413% 
 2414% load foundations/Root.e
 2415load('foundations/Root.e').
 2416
 2417% load foundations/EC.e
 2418load('foundations/EC.e').
 2419
 2420% 
 2421% sort object
 2422sort(object).
 2423
 2424% object O1
 2425t(object, o1).
 2426
 2427% ectest/ec_reader_test_examples.e:1310
 2428% 
 2429% fluent F(object)
 2430fluent(f(object)).
 2431
 2432% 
 2433% event E(object)
 2434event(e(object)).
 2435
 2436% 
 2437% ectest/ec_reader_test_examples.e:1315
 2438% [object,time] % Releases(E(object),F(object),time).
 2439releases(e(Object), f(Object), Time).
 2440
 2441% 
 2442% ectest/ec_reader_test_examples.e:1316
 2443% [object,time] % Terminates(E(object),F(object),time).
 2444terminates(e(Object), f(Object), Time).
 2445
 2446% 
 2447% 
 2448% Happens(E(O1),0).
 2449happens(e(o1), 0).
 2450
 2451% 
 2452% 
 2453% range time 0 1
 2454range(time, 0, 1).
 2455
 2456% range offset 1 1
 2457range(offset, 1, 1).
 2458
 2459% ectest/ec_reader_test_examples.e:1322
 2460% 
 2461% ; End of file.
 2462% 
 2463% 
 2464% 
 2465% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2466% ; FILE: examples/Mueller2006/Chapter2/Sleep4.e
 2467% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2468% ;
 2469% ; Copyright (c) 2005 IBM Corporation and others.
 2470% ; All rights reserved. This program and the accompanying materials
 2471% ; are made available under the terms of the Common Public License v1.0
 2472% ; which accompanies this distribution, and is available at
 2473% ; http://www.eclipse.org/legal/cpl-v10.html
 2474% ;
 2475% ; Contributors:
 2476% ; IBM - Initial implementation
 2477% ;
 2478% ; @book{Mueller:2006,
 2479% ;   author = "Erik T. Mueller",
 2480% ;   year = "2006",
 2481% ;   title = "Commonsense Reasoning",
 2482% ;   address = "San Francisco",
 2483% ;   publisher = "Morgan Kaufmann/Elsevier",
 2484% ; }
 2485% ;
 2486% ectest/ec_reader_test_examples.e:1348
 2487% 
 2488% load foundations/Root.e
 2489load('foundations/Root.e').
 2490
 2491% load foundations/EC.e
 2492load('foundations/EC.e').
 2493
 2494% 
 2495% sort agent
 2496sort(agent).
 2497
 2498% 
 2499% ectest/ec_reader_test_examples.e:1354
 2500% agent Nathan
 2501t(agent, nathan).
 2502
 2503% 
 2504% fluent Awake(agent)
 2505fluent(awake(agent)).
 2506
 2507% 
 2508% event WakeUp(agent)
 2509event(wakeUp(agent)).
 2510
 2511% event FallAsleep(agent)
 2512event(fallAsleep(agent)).
 2513
 2514% ectest/ec_reader_test_examples.e:1360
 2515% 
 2516% ; Sigma
 2517% 
 2518% ectest/ec_reader_test_examples.e:1363
 2519% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
 2520initiates(wakeUp(Agent), awake(Agent), Time).
 2521
 2522% 
 2523% ectest/ec_reader_test_examples.e:1364
 2524% [agent,time] % Terminates(FallAsleep(agent),Awake(agent),time).
 2525terminates(fallAsleep(Agent), awake(Agent), Time).
 2526
 2527% 
 2528% 
 2529% ; Delta
 2530% 
 2531% Happens(WakeUp(Nathan),1).
 2532happens(wakeUp(nathan), 1).
 2533
 2534% 
 2535% 
 2536% ; entailed:
 2537% ; HoldsAt(Awake(Nathan),3).
 2538% ectest/ec_reader_test_examples.e:1372
 2539% 
 2540% completion Happens
 2541completion(happens).
 2542
 2543% 
 2544% range time 0 3
 2545range(time, 0, 3).
 2546
 2547% range offset 1 1
 2548range(offset, 1, 1).
 2549
 2550% 
 2551% ; End of file.
 2552% ectest/ec_reader_test_examples.e:1379
 2553% 
 2554% 
 2555% 
 2556% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2557% ; FILE: examples/Mueller2006/Chapter2/Inconsistency4.e
 2558% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2559% ;
 2560% ; Copyright (c) 2005 IBM Corporation and others.
 2561% ; All rights reserved. This program and the accompanying materials
 2562% ; are made available under the terms of the Common Public License v1.0
 2563% ; which accompanies this distribution, and is available at
 2564% ; http://www.eclipse.org/legal/cpl-v10.html
 2565% ;
 2566% ; Contributors:
 2567% ; IBM - Initial implementation
 2568% ;
 2569% ; @book{Mueller:2006,
 2570% ;   author = "Erik T. Mueller",
 2571% ;   year = "2006",
 2572% ;   title = "Commonsense Reasoning",
 2573% ;   address = "San Francisco",
 2574% ;   publisher = "Morgan Kaufmann/Elsevier",
 2575% ; }
 2576% ;
 2577% ectest/ec_reader_test_examples.e:1403
 2578% 
 2579% load foundations/Root.e
 2580load('foundations/Root.e').
 2581
 2582% load foundations/EC.e
 2583load('foundations/EC.e').
 2584
 2585% 
 2586% sort object
 2587sort(object).
 2588
 2589% object O1
 2590t(object, o1).
 2591
 2592% ectest/ec_reader_test_examples.e:1409
 2593% 
 2594% event E(object)
 2595event(e(object)).
 2596
 2597% 
 2598% fluent F1(object)
 2599fluent(f1(object)).
 2600
 2601% fluent F2(object)
 2602fluent(f2(object)).
 2603
 2604% 
 2605% ectest/ec_reader_test_examples.e:1415
 2606% [object,time]% 
 2607% Initiates(E(object),F1(object),time).
 2608initiates(e(Object), f1(Object), Time).
 2609
 2610% 
 2611% 
 2612% ectest/ec_reader_test_examples.e:1418
 2613% [object,time]% 
 2614% HoldsAt(F1(object),time) <-> HoldsAt(F2(object),time).
 2615holds_at(f1(Object), Time) <->
 2616	holds_at(f2(Object), Time).
 2617
 2618% 
 2619% 
 2620% !HoldsAt(F2(O1),0).
 2621not(holds_at(f2(o1), 0)).
 2622
 2623% 
 2624% Happens(E(O1),0).
 2625happens(e(o1), 0).
 2626
 2627% 
 2628% 
 2629% ectest/ec_reader_test_examples.e:1424
 2630% range time 0 1
 2631range(time, 0, 1).
 2632
 2633% range offset 1 1
 2634range(offset, 1, 1).
 2635
 2636% 
 2637% ; End of file.
 2638% 
 2639% 
 2640% ectest/ec_reader_test_examples.e:1430
 2641% 
 2642% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2643% ; FILE: examples/Mueller2006/Chapter2/Inconsistency1.e
 2644% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2645% ;
 2646% ; Copyright (c) 2005 IBM Corporation and others.
 2647% ; All rights reserved. This program and the accompanying materials
 2648% ; are made available under the terms of the Common Public License v1.0
 2649% ; which accompanies this distribution, and is available at
 2650% ; http://www.eclipse.org/legal/cpl-v10.html
 2651% ;
 2652% ; Contributors:
 2653% ; IBM - Initial implementation
 2654% ;
 2655% ; @book{Mueller:2006,
 2656% ;   author = "Erik T. Mueller",
 2657% ;   year = "2006",
 2658% ;   title = "Commonsense Reasoning",
 2659% ;   address = "San Francisco",
 2660% ;   publisher = "Morgan Kaufmann/Elsevier",
 2661% ; }
 2662% ;
 2663% ectest/ec_reader_test_examples.e:1452
 2664% 
 2665% load foundations/Root.e
 2666load('foundations/Root.e').
 2667
 2668% load foundations/EC.e
 2669load('foundations/EC.e').
 2670
 2671% 
 2672% sort object
 2673sort(object).
 2674
 2675% object O1
 2676t(object, o1).
 2677
 2678% ectest/ec_reader_test_examples.e:1458
 2679% 
 2680% fluent F(object)
 2681fluent(f(object)).
 2682
 2683% 
 2684% event E(object)
 2685event(e(object)).
 2686
 2687% 
 2688% ectest/ec_reader_test_examples.e:1463
 2689% [object,time] % Initiates(E(object),F(object),time).
 2690initiates(e(Object), f(Object), Time).
 2691
 2692% 
 2693% ectest/ec_reader_test_examples.e:1464
 2694% [object,time] % Terminates(E(object),F(object),time).
 2695terminates(e(Object), f(Object), Time).
 2696
 2697% 
 2698% 
 2699% Happens(E(O1),0).
 2700happens(e(o1), 0).
 2701
 2702% 
 2703% 
 2704% range time 0 1
 2705range(time, 0, 1).
 2706
 2707% range offset 1 1
 2708range(offset, 1, 1).
 2709
 2710% ectest/ec_reader_test_examples.e:1470
 2711% 
 2712% ; End of file.
 2713% 
 2714% 
 2715% 
 2716% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2717% ; FILE: examples/Mueller2006/Chapter2/Inconsistency2.e
 2718% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2719% ;
 2720% ; Copyright (c) 2005 IBM Corporation and others.
 2721% ; All rights reserved. This program and the accompanying materials
 2722% ; are made available under the terms of the Common Public License v1.0
 2723% ; which accompanies this distribution, and is available at
 2724% ; http://www.eclipse.org/legal/cpl-v10.html
 2725% ;
 2726% ; Contributors:
 2727% ; IBM - Initial implementation
 2728% ;
 2729% ; @book{Mueller:2006,
 2730% ;   author = "Erik T. Mueller",
 2731% ;   year = "2006",
 2732% ;   title = "Commonsense Reasoning",
 2733% ;   address = "San Francisco",
 2734% ;   publisher = "Morgan Kaufmann/Elsevier",
 2735% ; }
 2736% ;
 2737% ectest/ec_reader_test_examples.e:1496
 2738% 
 2739% load foundations/Root.e
 2740load('foundations/Root.e').
 2741
 2742% load foundations/EC.e
 2743load('foundations/EC.e').
 2744
 2745% 
 2746% sort object
 2747sort(object).
 2748
 2749% object O1
 2750t(object, o1).
 2751
 2752% ectest/ec_reader_test_examples.e:1502
 2753% 
 2754% fluent F(object)
 2755fluent(f(object)).
 2756
 2757% 
 2758% event E(object)
 2759event(e(object)).
 2760
 2761% 
 2762% ectest/ec_reader_test_examples.e:1507
 2763% [object,time] % Releases(E(object),F(object),time).
 2764releases(e(Object), f(Object), Time).
 2765
 2766% 
 2767% ectest/ec_reader_test_examples.e:1508
 2768% [object,time] % Initiates(E(object),F(object),time).
 2769initiates(e(Object), f(Object), Time).
 2770
 2771% 
 2772% 
 2773% Happens(E(O1),0).
 2774happens(e(o1), 0).
 2775
 2776% 
 2777% 
 2778% range time 0 1
 2779range(time, 0, 1).
 2780
 2781% range offset 1 1
 2782range(offset, 1, 1).
 2783
 2784% ectest/ec_reader_test_examples.e:1514
 2785% 
 2786% ; End of file.
 2787% 
 2788% 
 2789% 
 2790% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2791% ; FILE: examples/Mueller2006/Chapter8/CameraWithFlash.e
 2792% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2793% ;
 2794% ; Copyright (c) 2005 IBM Corporation and others.
 2795% ; All rights reserved. This program and the accompanying materials
 2796% ; are made available under the terms of the Common Public License v1.0
 2797% ; which accompanies this distribution, and is available at
 2798% ; http://www.eclipse.org/legal/cpl-v10.html
 2799% ;
 2800% ; Contributors:
 2801% ; IBM - Initial implementation
 2802% ;
 2803% ; @book{Mueller:2006,
 2804% ;   author = "Erik T. Mueller",
 2805% ;   year = "2006",
 2806% ;   title = "Commonsense Reasoning",
 2807% ;   address = "San Francisco",
 2808% ;   publisher = "Morgan Kaufmann/Elsevier",
 2809% ; }
 2810% ;
 2811% ectest/ec_reader_test_examples.e:1540
 2812% 
 2813% load foundations/Root.e
 2814load('foundations/Root.e').
 2815
 2816% load foundations/EC.e
 2817load('foundations/EC.e').
 2818
 2819% 
 2820% sort camera
 2821sort(camera).
 2822
 2823% 
 2824% ectest/ec_reader_test_examples.e:1546
 2825% camera Camera1
 2826t(camera, camera1).
 2827
 2828% 
 2829% fluent ProperlyExposedPicture(camera)
 2830fluent(properlyExposedPicture(camera)).
 2831
 2832% fluent ImproperlyExposedPicture(camera)
 2833fluent(improperlyExposedPicture(camera)).
 2834
 2835% 
 2836% event ReleaseShutter(camera)
 2837event(releaseShutter(camera)).
 2838
 2839% ectest/ec_reader_test_examples.e:1552
 2840% event TriggerFlash(camera)
 2841event(triggerFlash(camera)).
 2842
 2843% 
 2844% ; Sigma
 2845% 
 2846% ectest/ec_reader_test_examples.e:1556
 2847% [camera,time]% 
 2848% Happens(TriggerFlash(camera),time) ->
 2849% Initiates(ReleaseShutter(camera),ProperlyExposedPicture(camera),time).
 2850happens(triggerFlash(Camera), Time) ->
 2851	initiates(releaseShutter(Camera),
 2852		  properlyExposedPicture(Camera),
 2853		  Time).
 2854
 2855% 
 2856% 
 2857% ectest/ec_reader_test_examples.e:1560
 2858% [camera,time]% 
 2859% !Happens(TriggerFlash(camera),time) ->
 2860% Initiates(ReleaseShutter(camera),ImproperlyExposedPicture(camera),time).
 2861not(happens(triggerFlash(Camera), Time)) ->
 2862	initiates(releaseShutter(Camera),
 2863		  improperlyExposedPicture(Camera),
 2864		  Time).
 2865
 2866% 
 2867% 
 2868% ; Delta
 2869% 
 2870% ectest/ec_reader_test_examples.e:1566
 2871% Delta:
 2872directive(delta).
 2873
 2874 % Happens(ReleaseShutter(Camera1),0).
 2875happens(releaseShutter(camera1), 0).
 2876
 2877% 
 2878% Delta:
 2879directive(delta).
 2880
 2881 % Happens(TriggerFlash(Camera1),1).
 2882happens(triggerFlash(camera1), 1).
 2883
 2884% 
 2885% Delta:
 2886directive(delta).
 2887
 2888 % Happens(ReleaseShutter(Camera1),1).
 2889happens(releaseShutter(camera1), 1).
 2890
 2891% 
 2892% 
 2893% ; added:
 2894% ectest/ec_reader_test_examples.e:1571
 2895% [camera] % !HoldsAt(ImproperlyExposedPicture(camera),0).
 2896not(holds_at(improperlyExposedPicture(Camera), 0)).
 2897
 2898% 
 2899% ectest/ec_reader_test_examples.e:1572
 2900% [camera] % !HoldsAt(ProperlyExposedPicture(camera),0).
 2901not(holds_at(properlyExposedPicture(Camera), 0)).
 2902
 2903% 
 2904% 
 2905% completion Delta Happens
 2906completion(delta).
 2907
 2908completion(happens).
 2909
 2910% 
 2911% range time 0 2
 2912range(time, 0, 2).
 2913
 2914% range offset 1 1
 2915range(offset, 1, 1).
 2916
 2917% ectest/ec_reader_test_examples.e:1578
 2918% 
 2919% ; End of file.
 2920% 
 2921% 
 2922% 
 2923% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2924% ; FILE: examples/Mueller2006/Chapter8/MovingRobot.e
 2925% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 2926% ;
 2927% ; Copyright (c) 2005 IBM Corporation and others.
 2928% ; All rights reserved. This program and the accompanying materials
 2929% ; are made available under the terms of the Common Public License v1.0
 2930% ; which accompanies this distribution, and is available at
 2931% ; http://www.eclipse.org/legal/cpl-v10.html
 2932% ;
 2933% ; Contributors:
 2934% ; IBM - Initial implementation
 2935% ;
 2936% ; @inproceedings{Shanahan:1996,
 2937% ;   author = "Murray Shanahan",
 2938% ;   year = "1996",
 2939% ;   title = "Robotics and the common sense informatic situation",
 2940% ;   editor = "Wolfgang Wahlster",
 2941% ;   booktitle = "\uppercase{P}roceedings of the \uppercase{T}welfth \uppercase{E}uropean \uppercase{C}onference on \uppercase{A}rtificial \uppercase{I}ntelligence",
 2942% ;   pages = "684--688",
 2943% ;   address = "Chichester, UK",
 2944% ;   publisher = "John Wiley",
 2945% ; }
 2946% ;
 2947% ; @book{Mueller:2006,
 2948% ;   author = "Erik T. Mueller",
 2949% ;   year = "2006",
 2950% ;   title = "Commonsense Reasoning",
 2951% ;   address = "San Francisco",
 2952% ;   publisher = "Morgan Kaufmann/Elsevier",
 2953% ; }
 2954% ;
 2955% ectest/ec_reader_test_examples.e:1615
 2956% 
 2957% option renaming off
 2958option(renaming, off).
 2959
 2960% 
 2961% load foundations/Root.e
 2962load('foundations/Root.e').
 2963
 2964% load foundations/EC.e
 2965load('foundations/EC.e').
 2966
 2967% 
 2968% ectest/ec_reader_test_examples.e:1621
 2969% sort coord: integer
 2970subsort(coord, integer).
 2971
 2972% 
 2973% sort direction: integer
 2974subsort(direction, integer).
 2975
 2976% ; 0 -> 0, 1 -> 90, 2 -> 180, 3 -> 370
 2977% 
 2978% sort robot
 2979sort(robot).
 2980
 2981% ectest/ec_reader_test_examples.e:1627
 2982% 
 2983% robot Robot1
 2984t(robot, robot1).
 2985
 2986% 
 2987% function Sin(direction): coord
 2988function(sin(direction), coord).
 2989
 2990% function Cos(direction): coord
 2991function(cos(direction), coord).
 2992
 2993% 
 2994% ectest/ec_reader_test_examples.e:1633
 2995% Sin(0)=0.
 2996sin(0)=0.
 2997
 2998% 
 2999% Sin(1)=1.
 3000sin(1)=1.
 3001
 3002% 
 3003% Sin(2)=2.
 3004sin(2)=2.
 3005
 3006% 
 3007% Sin(3)=3.
 3008sin(3)=3.
 3009
 3010% 
 3011% 
 3012% Cos(0)=1.
 3013cos(0)=1.
 3014
 3015% 
 3016% ectest/ec_reader_test_examples.e:1639
 3017% Cos(1)=2.
 3018cos(1)=2.
 3019
 3020% 
 3021% Cos(2)=3.
 3022cos(2)=3.
 3023
 3024% 
 3025% Cos(3)=4.
 3026cos(3)=4.
 3027
 3028% 
 3029% 
 3030% fluent Direction(robot,direction)
 3031fluent(direction(robot, direction)).
 3032
 3033% fluent Location(robot,coord,coord)
 3034fluent(location(robot, coord, coord)).
 3035
 3036% ectest/ec_reader_test_examples.e:1645
 3037% 
 3038% event MoveLeftWheel(robot)
 3039event(moveLeftWheel(robot)).
 3040
 3041% event MoveRightWheel(robot)
 3042event(moveRightWheel(robot)).
 3043
 3044% 
 3045% ; Sigma
 3046% 
 3047% ectest/ec_reader_test_examples.e:1651
 3048% [robot,direction1,direction2,time]% 
 3049% !Happens(MoveRightWheel(robot),time) &
 3050% HoldsAt(Direction(robot,direction1),time) &
 3051% direction2 = (direction1-1)->
 3052% Initiates(MoveLeftWheel(robot),Direction(robot,direction2),time).
 3053not(happens(moveRightWheel(Robot), Time)), holds_at(direction(Robot, Direction1), Time), Direction2=Direction1-1 ->
 3054	initiates(moveLeftWheel(Robot),
 3055		  direction(Robot, Direction2),
 3056		  Time).
 3057
 3058% 
 3059% 
 3060% ectest/ec_reader_test_examples.e:1657
 3061% [robot,direction,time]% 
 3062% !Happens(MoveRightWheel(robot),time) &
 3063% HoldsAt(Direction(robot,direction),time) ->
 3064% Terminates(MoveLeftWheel(robot),Direction(robot,direction),time).
 3065not(happens(moveRightWheel(Robot), Time)), holds_at(direction(Robot, Direction), Time) ->
 3066	terminates(moveLeftWheel(Robot),
 3067		   direction(Robot, Direction),
 3068		   Time).
 3069
 3070% 
 3071% 
 3072% ectest/ec_reader_test_examples.e:1662
 3073% [robot,direction1,direction2,time]% 
 3074% !Happens(MoveLeftWheel(robot),time) &
 3075% HoldsAt(Direction(robot,direction1),time) &
 3076% direction2 = (direction1+1)->
 3077% Initiates(MoveRightWheel(robot),Direction(robot,direction2),time).
 3078not(happens(moveLeftWheel(Robot), Time)), holds_at(direction(Robot, Direction1), Time), Direction2=Direction1+1 ->
 3079	initiates(moveRightWheel(Robot),
 3080		  direction(Robot, Direction2),
 3081		  Time).
 3082
 3083% 
 3084% 
 3085% ectest/ec_reader_test_examples.e:1668
 3086% [robot,direction,time]% 
 3087% !Happens(MoveLeftWheel(robot),time) &
 3088% HoldsAt(Direction(robot,direction),time) ->
 3089% Terminates(MoveRightWheel(robot),Direction(robot,direction),time).
 3090not(happens(moveLeftWheel(Robot), Time)), holds_at(direction(Robot, Direction), Time) ->
 3091	terminates(moveRightWheel(Robot),
 3092		   direction(Robot, Direction),
 3093		   Time).
 3094
 3095% 
 3096% 
 3097% ectest/ec_reader_test_examples.e:1673
 3098% [robot,direction,coord1,coord2,coord3,coord4,time]% 
 3099% Happens(MoveLeftWheel(robot),time) &
 3100% HoldsAt(Location(robot,coord1,coord2),time) &
 3101% HoldsAt(Direction(robot,direction),time) &
 3102% coord3 = coord1+Cos(direction) &
 3103% coord4 = coord2+Sin(direction) ->
 3104% Initiates(MoveRightWheel(robot),
 3105%           Location(robot,coord3,coord4),
 3106%           time).
 3107happens(moveLeftWheel(Robot), Time), holds_at(location(Robot, Coord1, Coord2), Time), holds_at(direction(Robot, Direction), Time), Coord3=Coord1+cos(Direction), Coord4=Coord2+sin(Direction) ->
 3108	initiates(moveRightWheel(Robot),
 3109		  location(Robot, Coord3, Coord4),
 3110		  Time).
 3111
 3112% ectest/ec_reader_test_examples.e:1681
 3113% 
 3114% 
 3115% ectest/ec_reader_test_examples.e:1683
 3116% [robot,coord1,coord2,time]% 
 3117% Happens(MoveLeftWheel(robot),time) &
 3118% HoldsAt(Location(robot,coord1,coord2),time) ->
 3119% ; FIX: Direction not needed!!
 3120% ; HoldsAt(Direction(robot,direction),time) ->
 3121% Terminates(MoveRightWheel(robot),Location(robot,coord1,coord2),time).
 3122happens(moveLeftWheel(Robot), Time), holds_at(location(Robot, Coord1, Coord2), Time) ->
 3123	terminates(moveRightWheel(Robot),
 3124		   location(Robot, Coord1, Coord2),
 3125		   Time).
 3126
 3127% 
 3128% ectest/ec_reader_test_examples.e:1689
 3129% 
 3130% ; Delta
 3131% 
 3132% Happens(MoveRightWheel(Robot1),0).
 3133happens(moveRightWheel(robot1), 0).
 3134
 3135% 
 3136% Happens(MoveLeftWheel(Robot1),1).
 3137happens(moveLeftWheel(robot1), 1).
 3138
 3139% 
 3140% Happens(MoveRightWheel(Robot1),1).
 3141happens(moveRightWheel(robot1), 1).
 3142
 3143% 
 3144% ectest/ec_reader_test_examples.e:1695
 3145% 
 3146% ; Psi
 3147% 
 3148% 
 3149% ectest/ec_reader_test_examples.e:1699
 3150% [robot,coord1,coord2,coord3,coord4,time]% 
 3151% HoldsAt(Location(robot,coord1,coord2),time) &
 3152% HoldsAt(Location(robot,coord3,coord4),time) ->
 3153% coord1=coord3 &
 3154% coord2=coord4.
 3155holds_at(location(Robot, Coord1, Coord2), Time), holds_at(location(Robot, Coord3, Coord4), Time) ->
 3156	Coord1=Coord3,
 3157	Coord2=Coord4.
 3158
 3159% 
 3160% 
 3161% ectest/ec_reader_test_examples.e:1705
 3162% [robot,direction1,direction2,time]% 
 3163% HoldsAt(Direction(robot,direction1),time) &
 3164% HoldsAt(Direction(robot,direction2),time) ->
 3165% direction1=direction2.
 3166holds_at(direction(Robot, Direction1), Time), holds_at(direction(Robot, Direction2), Time) ->
 3167	Direction1=Direction2.
 3168
 3169% 
 3170% 
 3171% ; Gamma
 3172% ectest/ec_reader_test_examples.e:1711
 3173% 
 3174% HoldsAt(Location(Robot1,0,0),0).
 3175holds_at(location(robot1, 0, 0), 0).
 3176
 3177% 
 3178% HoldsAt(Direction(Robot1,0),0).
 3179holds_at(direction(robot1, 0), 0).
 3180
 3181% 
 3182% 
 3183% completion Happens
 3184completion(happens).
 3185
 3186% 
 3187% ectest/ec_reader_test_examples.e:1717
 3188% range time 0 3
 3189range(time, 0, 3).
 3190
 3191% range coord 0 3
 3192range(coord, 0, 3).
 3193
 3194% range direction 0 3
 3195range(direction, 0, 3).
 3196
 3197% range offset 1 1
 3198range(offset, 1, 1).
 3199
 3200% 
 3201% ; End of file.
 3202% ectest/ec_reader_test_examples.e:1723
 3203% 
 3204% 
 3205% 
 3206% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3207% ; FILE: examples/Mueller2006/Chapter8/PatHeadRubStomach.e
 3208% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3209% ;
 3210% ; Copyright (c) 2005 IBM Corporation and others.
 3211% ; All rights reserved. This program and the accompanying materials
 3212% ; are made available under the terms of the Common Public License v1.0
 3213% ; which accompanies this distribution, and is available at
 3214% ; http://www.eclipse.org/legal/cpl-v10.html
 3215% ;
 3216% ; Contributors:
 3217% ; IBM - Initial implementation
 3218% ;
 3219% ; @book{Mueller:2006,
 3220% ;   author = "Erik T. Mueller",
 3221% ;   year = "2006",
 3222% ;   title = "Commonsense Reasoning",
 3223% ;   address = "San Francisco",
 3224% ;   publisher = "Morgan Kaufmann/Elsevier",
 3225% ; }
 3226% ;
 3227% ectest/ec_reader_test_examples.e:1747
 3228% 
 3229% load foundations/Root.e
 3230load('foundations/Root.e').
 3231
 3232% load foundations/EC.e
 3233load('foundations/EC.e').
 3234
 3235% 
 3236% sort agent
 3237sort(agent).
 3238
 3239% 
 3240% ectest/ec_reader_test_examples.e:1753
 3241% event PatHead(agent)
 3242event(patHead(agent)).
 3243
 3244% event RubStomach(agent)
 3245event(rubStomach(agent)).
 3246
 3247% 
 3248% agent Nathan
 3249t(agent, nathan).
 3250
 3251% 
 3252% ; Delta
 3253% ectest/ec_reader_test_examples.e:1759
 3254% 
 3255% ectest/ec_reader_test_examples.e:1760
 3256% [agent,time]% 
 3257% Happens(PatHead(agent),time) ->
 3258% !Happens(RubStomach(agent),time).
 3259happens(patHead(Agent), Time) ->
 3260	not(happens(rubStomach(Agent), Time)).
 3261
 3262% 
 3263% 
 3264% Happens(PatHead(Nathan),0) & Happens(RubStomach(Nathan),0).
 3265happens(patHead(nathan), 0),
 3266happens(rubStomach(nathan), 0).
 3267
 3268% 
 3269% 
 3270% ectest/ec_reader_test_examples.e:1766
 3271% range time 0 1
 3272range(time, 0, 1).
 3273
 3274% range offset 1 1
 3275range(offset, 1, 1).
 3276
 3277% 
 3278% ; End of file.
 3279% 
 3280% 
 3281% ectest/ec_reader_test_examples.e:1772
 3282% 
 3283% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3284% ; FILE: examples/Mueller2006/Chapter10/MovingNewspaperAndBox.e
 3285% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3286% ;
 3287% ; Copyright (c) 2005 IBM Corporation and others.
 3288% ; All rights reserved. This program and the accompanying materials
 3289% ; are made available under the terms of the Common Public License v1.0
 3290% ; which accompanies this distribution, and is available at
 3291% ; http://www.eclipse.org/legal/cpl-v10.html
 3292% ;
 3293% ; Contributors:
 3294% ; IBM - Initial implementation
 3295% ;
 3296% ; @book{Mueller:2006,
 3297% ;   author = "Erik T. Mueller",
 3298% ;   year = "2006",
 3299% ;   title = "Commonsense Reasoning",
 3300% ;   address = "San Francisco",
 3301% ;   publisher = "Morgan Kaufmann/Elsevier",
 3302% ; }
 3303% ;
 3304% ectest/ec_reader_test_examples.e:1794
 3305% 
 3306% load foundations/Root.e
 3307load('foundations/Root.e').
 3308
 3309% load foundations/EC.e
 3310load('foundations/EC.e').
 3311
 3312% 
 3313% sort object
 3314sort(object).
 3315
 3316% sort agent: object
 3317subsort(agent, object).
 3318
 3319% ectest/ec_reader_test_examples.e:1800
 3320% sort physobj: object
 3321subsort(physobj, object).
 3322
 3323% sort room: object
 3324subsort(room, object).
 3325
 3326% 
 3327% fluent IN(object,object)
 3328fluent(in(object, object)).
 3329
 3330% fluent INROOM(object,room)
 3331fluent(inroom(object, room)).
 3332
 3333% noninertial INROOM
 3334noninertial(inroom).
 3335
 3336% ectest/ec_reader_test_examples.e:1806
 3337% 
 3338% event MOVE(agent,object,object,object)
 3339event(move(agent, object, object, object)).
 3340
 3341% 
 3342% agent Lisa
 3343t(agent, lisa).
 3344
 3345% physobj Box, Newspaper
 3346t(physobj, box).
 3347
 3348t(physobj, newspaper).
 3349
 3350% room Kitchen, LivingRoom
 3351t(room, kitchen).
 3352
 3353t(room, livingRoom).
 3354
 3355% ectest/ec_reader_test_examples.e:1812
 3356% 
 3357% ; Sigma
 3358% 
 3359% ; RS10
 3360% ectest/ec_reader_test_examples.e:1816
 3361% [agent,physobj1,physobj2,room,time]% 
 3362% HoldsAt(IN(agent,room),time) &
 3363% HoldsAt(IN(physobj1,room),time) &
 3364% HoldsAt(INROOM(physobj2,room),time) ->
 3365% Initiates(MOVE(agent,physobj1,room,physobj2),IN(physobj1,physobj2),time).
 3366holds_at(in(Agent, Room), Time), holds_at(in(Physobj1, Room), Time), holds_at(inroom(Physobj2, Room), Time) ->
 3367	initiates(move(Agent, Physobj1, Room, Physobj2),
 3368		  in(Physobj1, Physobj2),
 3369		  Time).
 3370
 3371% 
 3372% 
 3373% ; RS11
 3374% ectest/ec_reader_test_examples.e:1823
 3375% [agent,physobj1,physobj2,room,time]% 
 3376% HoldsAt(IN(agent,room),time) &
 3377% HoldsAt(IN(physobj1,room),time) &
 3378% HoldsAt(INROOM(physobj2,room),time) ->
 3379% Terminates(MOVE(agent,physobj1,room,physobj2),IN(physobj1,room),time).
 3380holds_at(in(Agent, Room), Time), holds_at(in(Physobj1, Room), Time), holds_at(inroom(Physobj2, Room), Time) ->
 3381	terminates(move(Agent, Physobj1, Room, Physobj2),
 3382		   in(Physobj1, Room),
 3383		   Time).
 3384
 3385% 
 3386% 
 3387% ; RS12
 3388% ectest/ec_reader_test_examples.e:1830
 3389% [agent,physobj1,physobj2,room,time]% 
 3390% HoldsAt(IN(agent,room),time) ->
 3391% Initiates(MOVE(agent,physobj1,physobj2,room),IN(physobj1,room),time).
 3392holds_at(in(Agent, Room), Time) ->
 3393	initiates(move(Agent, Physobj1, Physobj2, Room),
 3394		  in(Physobj1, Room),
 3395		  Time).
 3396
 3397% 
 3398% 
 3399% ; RS13
 3400% ectest/ec_reader_test_examples.e:1835
 3401% [agent,physobj1,physobj2,room,time]% 
 3402% HoldsAt(IN(agent,room),time) ->
 3403% Terminates(MOVE(agent,physobj1,physobj2,room),IN(physobj1,physobj2),time).
 3404holds_at(in(Agent, Room), Time) ->
 3405	terminates(move(Agent, Physobj1, Physobj2, Room),
 3406		   in(Physobj1, Physobj2),
 3407		   Time).
 3408
 3409% 
 3410% 
 3411% ; RS14
 3412% ectest/ec_reader_test_examples.e:1840
 3413% [agent,room1,room2,time]% 
 3414% HoldsAt(IN(agent,room1),time) ->
 3415% Initiates(MOVE(agent,agent,room1,room2),IN(agent,room2),time).
 3416holds_at(in(Agent, Room1), Time) ->
 3417	initiates(move(Agent, Agent, Room1, Room2),
 3418		  in(Agent, Room2),
 3419		  Time).
 3420
 3421% 
 3422% 
 3423% ; RS15
 3424% ectest/ec_reader_test_examples.e:1845
 3425% [agent,room1,room2,time]% 
 3426% HoldsAt(IN(agent,room1),time) ->
 3427% Terminates(MOVE(agent,agent,room1,room2),IN(agent,room1),time).
 3428holds_at(in(Agent, Room1), Time) ->
 3429	terminates(move(Agent, Agent, Room1, Room2),
 3430		   in(Agent, Room1),
 3431		   Time).
 3432
 3433% 
 3434% 
 3435% ; RS16
 3436% ectest/ec_reader_test_examples.e:1850
 3437% [agent,physobj,room,time]% 
 3438% HoldsAt(IN(agent,room),time) &
 3439% HoldsAt(IN(physobj,room),time) ->
 3440% Initiates(MOVE(agent,physobj,room,agent),IN(physobj,agent),time).
 3441holds_at(in(Agent, Room), Time), holds_at(in(Physobj, Room), Time) ->
 3442	initiates(move(Agent, Physobj, Room, Agent),
 3443		  in(Physobj, Agent),
 3444		  Time).
 3445
 3446% 
 3447% 
 3448% ; RS17
 3449% ectest/ec_reader_test_examples.e:1856
 3450% [agent,physobj,room,time]% 
 3451% HoldsAt(IN(agent,room),time) &
 3452% HoldsAt(IN(physobj,room),time) ->
 3453% Terminates(MOVE(agent,physobj,room,agent),IN(physobj,room),time).
 3454holds_at(in(Agent, Room), Time), holds_at(in(Physobj, Room), Time) ->
 3455	terminates(move(Agent, Physobj, Room, Agent),
 3456		   in(Physobj, Room),
 3457		   Time).
 3458
 3459% 
 3460% 
 3461% ; RS18
 3462% ectest/ec_reader_test_examples.e:1862
 3463% [agent,physobj,room,time]% 
 3464% HoldsAt(IN(physobj,agent),time) &
 3465% HoldsAt(IN(agent,room),time) ->
 3466% Initiates(MOVE(agent,physobj,agent,room),IN(physobj,room),time).
 3467holds_at(in(Physobj, Agent), Time), holds_at(in(Agent, Room), Time) ->
 3468	initiates(move(Agent, Physobj, Agent, Room),
 3469		  in(Physobj, Room),
 3470		  Time).
 3471
 3472% 
 3473% 
 3474% ; RS19
 3475% ectest/ec_reader_test_examples.e:1868
 3476% [agent,physobj,room,time]% 
 3477% HoldsAt(IN(physobj,agent),time) &
 3478% HoldsAt(IN(agent,room),time) ->
 3479% Terminates(MOVE(agent,physobj,agent,room),IN(physobj,agent),time).
 3480holds_at(in(Physobj, Agent), Time), holds_at(in(Agent, Room), Time) ->
 3481	terminates(move(Agent, Physobj, Agent, Room),
 3482		   in(Physobj, Agent),
 3483		   Time).
 3484
 3485% 
 3486% 
 3487% ; Delta
 3488% ectest/ec_reader_test_examples.e:1874
 3489% 
 3490% Happens(MOVE(Lisa,Newspaper,LivingRoom,Box),0).
 3491happens(move(lisa, newspaper, livingRoom, box), 0).
 3492
 3493% 
 3494% Happens(MOVE(Lisa,Box,LivingRoom,Lisa),1).
 3495happens(move(lisa, box, livingRoom, lisa), 1).
 3496
 3497% 
 3498% Happens(MOVE(Lisa,Lisa,LivingRoom,Kitchen),2).
 3499happens(move(lisa, lisa, livingRoom, kitchen), 2).
 3500
 3501% 
 3502% Happens(MOVE(Lisa,Box,Lisa,Kitchen),3).
 3503happens(move(lisa, box, lisa, kitchen), 3).
 3504
 3505% 
 3506% Happens(MOVE(Lisa,Lisa,Kitchen,LivingRoom),4).
 3507happens(move(lisa, lisa, kitchen, livingRoom), 4).
 3508
 3509% 
 3510% ectest/ec_reader_test_examples.e:1880
 3511% 
 3512% ; Psi
 3513% 
 3514% ; RS1
 3515% ectest/ec_reader_test_examples.e:1884
 3516% [object,time] % !HoldsAt(IN(object,object),time).
 3517not(holds_at(in(Object, Object), Time)).
 3518
 3519% 
 3520% 
 3521% ; RS2
 3522% ectest/ec_reader_test_examples.e:1887
 3523% [object1,object2,time]% 
 3524% HoldsAt(IN(object1,object2),time) ->
 3525% !HoldsAt(IN(object2,object1),time).
 3526holds_at(in(Object1, Object2), Time) ->
 3527	not(holds_at(in(Object2, Object1), Time)).
 3528
 3529% 
 3530% 
 3531% ; RS3
 3532% ectest/ec_reader_test_examples.e:1892
 3533% [object1,object2,object3,time]% 
 3534% HoldsAt(IN(object1,object2),time) &
 3535% HoldsAt(IN(object2,object3),time) ->
 3536% !HoldsAt(IN(object1,object3),time).
 3537holds_at(in(Object1, Object2), Time), holds_at(in(Object2, Object3), Time) ->
 3538	not(holds_at(in(Object1, Object3), Time)).
 3539
 3540% 
 3541% 
 3542% ; RS4
 3543% ectest/ec_reader_test_examples.e:1898
 3544% [object,object1,object2,time]% 
 3545% HoldsAt(IN(object,object1),time) &
 3546% HoldsAt(IN(object,object2),time) ->
 3547% object1=object2.
 3548holds_at(in(Object, Object1), Time), holds_at(in(Object, Object2), Time) ->
 3549	Object1=Object2.
 3550
 3551% 
 3552% 
 3553% ; RS7
 3554% ectest/ec_reader_test_examples.e:1904
 3555% [object,room,time]% 
 3556% HoldsAt(IN(object,room),time) ->
 3557% HoldsAt(INROOM(object,room),time).
 3558holds_at(in(Object, Room), Time) ->
 3559	holds_at(inroom(Object, Room), Time).
 3560
 3561% 
 3562% 
 3563% ; RS8
 3564% ectest/ec_reader_test_examples.e:1909
 3565% [object1,object2,room,time]% 
 3566% HoldsAt(IN(object1,object2),time) &
 3567% HoldsAt(INROOM(object2,room),time) ->
 3568% HoldsAt(INROOM(object1,room),time).
 3569holds_at(in(Object1, Object2), Time), holds_at(inroom(Object2, Room), Time) ->
 3570	holds_at(inroom(Object1, Room), Time).
 3571
 3572% 
 3573% 
 3574% ; RS9
 3575% ectest/ec_reader_test_examples.e:1915
 3576% [object,room1,room2,time]% 
 3577% HoldsAt(INROOM(object,room1),time) &
 3578% HoldsAt(INROOM(object,room2),time) ->
 3579% room1=room2.
 3580holds_at(inroom(Object, Room1), Time), holds_at(inroom(Object, Room2), Time) ->
 3581	Room1=Room2.
 3582
 3583% 
 3584% 
 3585% ; Gamma
 3586% ectest/ec_reader_test_examples.e:1921
 3587% 
 3588% HoldsAt(IN(Lisa,LivingRoom),0).
 3589holds_at(in(lisa, livingRoom), 0).
 3590
 3591% 
 3592% HoldsAt(IN(Newspaper,LivingRoom),0).
 3593holds_at(in(newspaper, livingRoom), 0).
 3594
 3595% 
 3596% HoldsAt(IN(Box,LivingRoom),0).
 3597holds_at(in(box, livingRoom), 0).
 3598
 3599% 
 3600% 
 3601% ; added:
 3602% ectest/ec_reader_test_examples.e:1927
 3603% [room1,room2,time] % !HoldsAt(INROOM(room1,room2),time).
 3604not(holds_at(inroom(Room1, Room2), Time)).
 3605
 3606% 
 3607% ectest/ec_reader_test_examples.e:1928
 3608% [room,object,time] % !HoldsAt(IN(room,object),time).
 3609not(holds_at(in(Room, Object), Time)).
 3610
 3611% 
 3612% 
 3613% ; entailed:
 3614% ; HoldsAt(IN(Lisa,LivingRoom),5).
 3615% ; HoldsAt(IN(Box,Kitchen),5).
 3616% ; HoldsAt(INROOM(Newspaper,Kitchen),5).
 3617% ectest/ec_reader_test_examples.e:1934
 3618% 
 3619% completion Happens
 3620completion(happens).
 3621
 3622% 
 3623% range time 0 5
 3624range(time, 0, 5).
 3625
 3626% range offset 1 1
 3627range(offset, 1, 1).
 3628
 3629% 
 3630% ; End of file.
 3631% ectest/ec_reader_test_examples.e:1941
 3632% 
 3633% 
 3634% 
 3635% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3636% ; FILE: examples/Mueller2006/Chapter10/TwoScreens.e
 3637% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3638% ;
 3639% ; Copyright (c) 2005 IBM Corporation and others.
 3640% ; All rights reserved. This program and the accompanying materials
 3641% ; are made available under the terms of the Common Public License v1.0
 3642% ; which accompanies this distribution, and is available at
 3643% ; http://www.eclipse.org/legal/cpl-v10.html
 3644% ;
 3645% ; Contributors:
 3646% ; IBM - Initial implementation
 3647% ;
 3648% ; @phdthesis{Cassimatis:2002,
 3649% ;   author = "Nicholas L. Cassimatis",
 3650% ;   year = "2002",
 3651% ;   title = "Polyscheme: A Cognitive Architecture for Integrating Multiple Representation and Inference Schemes",
 3652% ;   address = "Cambridge, MA",
 3653% ;   school = "Program in Media Arts and Sciences, School of Architecture and Planning, Massachusetts Institute of Technology",
 3654% ; }
 3655% ;
 3656% ; @book{Mueller:2006,
 3657% ;   author = "Erik T. Mueller",
 3658% ;   year = "2006",
 3659% ;   title = "Commonsense Reasoning",
 3660% ;   address = "San Francisco",
 3661% ;   publisher = "Morgan Kaufmann/Elsevier",
 3662% ; }
 3663% ;
 3664% ectest/ec_reader_test_examples.e:1973
 3665% 
 3666% load foundations/Root.e
 3667load('foundations/Root.e').
 3668
 3669% load foundations/EC.e
 3670load('foundations/EC.e').
 3671
 3672% 
 3673% sort object
 3674sort(object).
 3675
 3676% sort location
 3677sort(location).
 3678
 3679% ectest/ec_reader_test_examples.e:1979
 3680% 
 3681% object O1, O2
 3682t(object, o1).
 3683
 3684t(object, o2).
 3685
 3686% location L1, L2, L3, L4, L5
 3687t(location, l1).
 3688
 3689t(location, l2).
 3690
 3691t(location, l3).
 3692
 3693t(location, l4).
 3694
 3695t(location, l5).
 3696
 3697% 
 3698% predicate Adjacent(location,location)
 3699predicate(adjacent(location, location)).
 3700
 3701% predicate Equal(object,object)
 3702predicate(equal(object, object)).
 3703
 3704% ectest/ec_reader_test_examples.e:1985
 3705% 
 3706% fluent At(object,location)
 3707fluent(at(object, location)).
 3708
 3709% event Move(object,location,location)
 3710event(move(object, location, location)).
 3711
 3712% 
 3713% ; Sigma
 3714% 
 3715% ectest/ec_reader_test_examples.e:1991
 3716% [object,location1,location2,time]% 
 3717% HoldsAt(At(object,location1),time) &
 3718% Adjacent(location1,location2) ->
 3719% Initiates(Move(object,location1,location2),At(object,location2),time).
 3720holds_at(at(Object, Location1), Time), adjacent(Location1, Location2) ->
 3721	initiates(move(Object, Location1, Location2),
 3722		  at(Object, Location2),
 3723		  Time).
 3724
 3725% 
 3726% 
 3727% ectest/ec_reader_test_examples.e:1996
 3728% [object,location1,location2,time]% 
 3729% HoldsAt(At(object,location1),time) &
 3730% Adjacent(location1,location2) ->
 3731% Terminates(Move(object,location1,location2),At(object,location1),time).
 3732holds_at(at(Object, Location1), Time), adjacent(Location1, Location2) ->
 3733	terminates(move(Object, Location1, Location2),
 3734		   at(Object, Location1),
 3735		   Time).
 3736
 3737% 
 3738% 
 3739% ; Psi
 3740% ectest/ec_reader_test_examples.e:2002
 3741% 
 3742% ectest/ec_reader_test_examples.e:2003
 3743% [object,location1,location2,time]% 
 3744% HoldsAt(At(object,location1),time) &
 3745% HoldsAt(At(object,location2),time) ->
 3746% location1=location2.
 3747holds_at(at(Object, Location1), Time), holds_at(at(Object, Location2), Time) ->
 3748	Location1=Location2.
 3749
 3750% 
 3751% 
 3752% ectest/ec_reader_test_examples.e:2008
 3753% [object,time]% 
 3754% ectest/ec_reader_test_examples.e:2009
 3755% {location} % HoldsAt(At(object,location),time).
 3756exists([Location], holds_at(at(Object, Location), Time)).
 3757
 3758% 
 3759% 
 3760% ectest/ec_reader_test_examples.e:2011
 3761% [object1,object2,location,time]% 
 3762% HoldsAt(At(object1,location),time) &
 3763% HoldsAt(At(object2,location),time) ->
 3764% Equal(object1,object2).
 3765holds_at(at(Object1, Location), Time), holds_at(at(Object2, Location), Time) ->
 3766	equal(Object1, Object2).
 3767
 3768% 
 3769% 
 3770% ectest/ec_reader_test_examples.e:2016
 3771% [location1, location2]% 
 3772% Adjacent(location1,location2) <->
 3773% Adjacent(location2,location1).
 3774adjacent(Location1, Location2) <->
 3775	adjacent(Location2, Location1).
 3776
 3777% 
 3778% 
 3779% ectest/ec_reader_test_examples.e:2020
 3780% [object1,object2]% 
 3781% Equal(object1,object2) <->
 3782% Equal(object2,object1).
 3783equal(Object1, Object2) <->
 3784	equal(Object2, Object1).
 3785
 3786% 
 3787% 
 3788% ; Gamma
 3789% 
 3790% ectest/ec_reader_test_examples.e:2026
 3791% [location1,location2]% 
 3792% Adjacent(location1,location2) <->
 3793% (location1=L1 & location2=L2) |
 3794% (location1=L2 & location2=L1) |
 3795% (location1=L2 & location2=L3) |
 3796% (location1=L3 & location2=L2) |
 3797% (location1=L3 & location2=L4) |
 3798% (location1=L4 & location2=L3) |
 3799% (location1=L4 & location2=L5) |
 3800% (location1=L5 & location2=L4).
 3801adjacent(Location1, Location2) <->
 3802	(   Location1=l1,
 3803	    Location2=l2
 3804	;   Location1=l2,
 3805	    Location2=l1
 3806	;   Location1=l2,
 3807	    Location2=l3
 3808	;   Location1=l3,
 3809	    Location2=l2
 3810	;   Location1=l3,
 3811	    Location2=l4
 3812	;   Location1=l4,
 3813	    Location2=l3
 3814	;   Location1=l4,
 3815	    Location2=l5
 3816	;   Location1=l5,
 3817	    Location2=l4
 3818	).
 3819
 3820% ectest/ec_reader_test_examples.e:2035
 3821% 
 3822% 
 3823% HoldsAt(At(O1,L1),0).
 3824holds_at(at(o1, l1), 0).
 3825
 3826% 
 3827% ectest/ec_reader_test_examples.e:2038
 3828% [object] % !HoldsAt(At(object,L5),0).
 3829not(holds_at(at(Object, l5), 0)).
 3830
 3831% 
 3832% 
 3833% HoldsAt(At(O2,L5),4).
 3834holds_at(at(o2, l5), 4).
 3835
 3836% 
 3837% ectest/ec_reader_test_examples.e:2041
 3838% [object] % !HoldsAt(At(object,L1),4).
 3839not(holds_at(at(Object, l1), 4)).
 3840
 3841% 
 3842% 
 3843% ectest/ec_reader_test_examples.e:2043
 3844% [object,time] % !HoldsAt(At(object,L3),time).
 3845not(holds_at(at(Object, l3), Time)).
 3846
 3847% 
 3848% 
 3849% ; ADDED:
 3850% ectest/ec_reader_test_examples.e:2046
 3851% [object,location1,location2,time]% 
 3852% Happens(Move(object,location1,location2),time) ->
 3853% HoldsAt(At(object,location1),time) &
 3854% Adjacent(location1,location2).
 3855happens(move(Object, Location1, Location2), Time) ->
 3856	holds_at(at(Object, Location1), Time),
 3857	adjacent(Location1, Location2).
 3858
 3859% 
 3860% 
 3861% ectest/ec_reader_test_examples.e:2051
 3862% [object1,object2,location1,location2,time]% 
 3863% Equal(object1,object2) &
 3864% Happens(Move(object1,location1,location2),time) ->
 3865% Happens(Move(object2,location1,location2),time).
 3866equal(Object1, Object2), happens(move(Object1, Location1, Location2), Time) ->
 3867	happens(move(Object2, Location1, Location2),
 3868		Time).
 3869
 3870% 
 3871% 
 3872% ; entailed: !Equal(O1,O2).
 3873% ectest/ec_reader_test_examples.e:2057
 3874% 
 3875% range time 0 4
 3876range(time, 0, 4).
 3877
 3878% range offset 1 1
 3879range(offset, 1, 1).
 3880
 3881% 
 3882% ; End of file.
 3883% 
 3884% ectest/ec_reader_test_examples.e:2063
 3885% 
 3886% 
 3887% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3888% ; FILE: examples/Mueller2006/Chapter10/OneScreen.e
 3889% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3890% ;
 3891% ; Copyright (c) 2005 IBM Corporation and others.
 3892% ; All rights reserved. This program and the accompanying materials
 3893% ; are made available under the terms of the Common Public License v1.0
 3894% ; which accompanies this distribution, and is available at
 3895% ; http://www.eclipse.org/legal/cpl-v10.html
 3896% ;
 3897% ; Contributors:
 3898% ; IBM - Initial implementation
 3899% ;
 3900% ; @phdthesis{Cassimatis:2002,
 3901% ;   author = "Nicholas L. Cassimatis",
 3902% ;   year = "2002",
 3903% ;   title = "Polyscheme: A Cognitive Architecture for Integrating Multiple Representation and Inference Schemes",
 3904% ;   address = "Cambridge, MA",
 3905% ;   school = "Program in Media Arts and Sciences, School of Architecture and Planning, Massachusetts Institute of Technology",
 3906% ; }
 3907% ;
 3908% ; @book{Mueller:2006,
 3909% ;   author = "Erik T. Mueller",
 3910% ;   year = "2006",
 3911% ;   title = "Commonsense Reasoning",
 3912% ;   address = "San Francisco",
 3913% ;   publisher = "Morgan Kaufmann/Elsevier",
 3914% ; }
 3915% ;
 3916% ectest/ec_reader_test_examples.e:2094
 3917% 
 3918% load foundations/Root.e
 3919load('foundations/Root.e').
 3920
 3921% load foundations/EC.e
 3922load('foundations/EC.e').
 3923
 3924% 
 3925% sort object
 3926sort(object).
 3927
 3928% sort location
 3929sort(location).
 3930
 3931% ectest/ec_reader_test_examples.e:2100
 3932% 
 3933% object O1, O2
 3934t(object, o1).
 3935
 3936t(object, o2).
 3937
 3938% location L1, L2, L3
 3939t(location, l1).
 3940
 3941t(location, l2).
 3942
 3943t(location, l3).
 3944
 3945% 
 3946% predicate Adjacent(location,location)
 3947predicate(adjacent(location, location)).
 3948
 3949% predicate Equal(object,object)
 3950predicate(equal(object, object)).
 3951
 3952% ectest/ec_reader_test_examples.e:2106
 3953% 
 3954% fluent At(object,location)
 3955fluent(at(object, location)).
 3956
 3957% event Move(object,location,location)
 3958event(move(object, location, location)).
 3959
 3960% 
 3961% ; Sigma
 3962% 
 3963% ectest/ec_reader_test_examples.e:2112
 3964% [object,location1,location2,time]% 
 3965% HoldsAt(At(object,location1),time) &
 3966% Adjacent(location1,location2) ->
 3967% Initiates(Move(object,location1,location2),At(object,location2),time).
 3968holds_at(at(Object, Location1), Time), adjacent(Location1, Location2) ->
 3969	initiates(move(Object, Location1, Location2),
 3970		  at(Object, Location2),
 3971		  Time).
 3972
 3973% 
 3974% 
 3975% ectest/ec_reader_test_examples.e:2117
 3976% [object,location1,location2,time]% 
 3977% HoldsAt(At(object,location1),time) &
 3978% Adjacent(location1,location2) ->
 3979% Terminates(Move(object,location1,location2),At(object,location1),time).
 3980holds_at(at(Object, Location1), Time), adjacent(Location1, Location2) ->
 3981	terminates(move(Object, Location1, Location2),
 3982		   at(Object, Location1),
 3983		   Time).
 3984
 3985% 
 3986% 
 3987% ; Psi
 3988% ectest/ec_reader_test_examples.e:2123
 3989% 
 3990% ectest/ec_reader_test_examples.e:2124
 3991% [object,location1,location2,time]% 
 3992% HoldsAt(At(object,location1),time) &
 3993% HoldsAt(At(object,location2),time) ->
 3994% location1=location2.
 3995holds_at(at(Object, Location1), Time), holds_at(at(Object, Location2), Time) ->
 3996	Location1=Location2.
 3997
 3998% 
 3999% 
 4000% ectest/ec_reader_test_examples.e:2129
 4001% [object,time]% 
 4002% ectest/ec_reader_test_examples.e:2130
 4003% {location} % HoldsAt(At(object,location),time).
 4004exists([Location], holds_at(at(Object, Location), Time)).
 4005
 4006% 
 4007% 
 4008% ectest/ec_reader_test_examples.e:2132
 4009% [object1,object2,location,time]% 
 4010% HoldsAt(At(object1,location),time) &
 4011% HoldsAt(At(object2,location),time) ->
 4012% Equal(object1,object2).
 4013holds_at(at(Object1, Location), Time), holds_at(at(Object2, Location), Time) ->
 4014	equal(Object1, Object2).
 4015
 4016% 
 4017% 
 4018% ectest/ec_reader_test_examples.e:2137
 4019% [location1, location2]% 
 4020% Adjacent(location1,location2) <->
 4021% Adjacent(location2,location1).
 4022adjacent(Location1, Location2) <->
 4023	adjacent(Location2, Location1).
 4024
 4025% 
 4026% 
 4027% ectest/ec_reader_test_examples.e:2141
 4028% [object1,object2]% 
 4029% Equal(object1,object2) <->
 4030% Equal(object2,object1).
 4031equal(Object1, Object2) <->
 4032	equal(Object2, Object1).
 4033
 4034% 
 4035% 
 4036% ; Gamma
 4037% 
 4038% ectest/ec_reader_test_examples.e:2147
 4039% [location1,location2]% 
 4040% Adjacent(location1,location2) <->
 4041% (location1=L1 & location2=L2) |
 4042% (location1=L2 & location2=L1) |
 4043% (location1=L2 & location2=L3) |
 4044% (location1=L3 & location2=L2).
 4045adjacent(Location1, Location2) <->
 4046	(   Location1=l1,
 4047	    Location2=l2
 4048	;   Location1=l2,
 4049	    Location2=l1
 4050	;   Location1=l2,
 4051	    Location2=l3
 4052	;   Location1=l3,
 4053	    Location2=l2
 4054	).
 4055
 4056% 
 4057% ectest/ec_reader_test_examples.e:2153
 4058% 
 4059% HoldsAt(At(O1,L1),0).
 4060holds_at(at(o1, l1), 0).
 4061
 4062% 
 4063% ectest/ec_reader_test_examples.e:2155
 4064% [object] % !HoldsAt(At(object,L3),0).
 4065not(holds_at(at(Object, l3), 0)).
 4066
 4067% 
 4068% 
 4069% ectest/ec_reader_test_examples.e:2157
 4070% [object] % !HoldsAt(At(object,L1),1).
 4071not(holds_at(at(Object, l1), 1)).
 4072
 4073% 
 4074% ectest/ec_reader_test_examples.e:2158
 4075% [object] % !HoldsAt(At(object,L3),1).
 4076not(holds_at(at(Object, l3), 1)).
 4077
 4078% 
 4079% 
 4080% HoldsAt(At(O2,L3),2).
 4081holds_at(at(o2, l3), 2).
 4082
 4083% 
 4084% ectest/ec_reader_test_examples.e:2161
 4085% [object] % !HoldsAt(At(object,L1),2).
 4086not(holds_at(at(Object, l1), 2)).
 4087
 4088% 
 4089% 
 4090% ; ADDED:
 4091% ectest/ec_reader_test_examples.e:2164
 4092% [object,location1,location2,time]% 
 4093% Happens(Move(object,location1,location2),time) ->
 4094% HoldsAt(At(object,location1),time) &
 4095% Adjacent(location1,location2).
 4096happens(move(Object, Location1, Location2), Time) ->
 4097	holds_at(at(Object, Location1), Time),
 4098	adjacent(Location1, Location2).
 4099
 4100% 
 4101% 
 4102% ectest/ec_reader_test_examples.e:2169
 4103% [object1,object2,location1,location2,time]% 
 4104% Equal(object1,object2) &
 4105% Happens(Move(object1,location1,location2),time) ->
 4106% Happens(Move(object2,location1,location2),time).
 4107equal(Object1, Object2), happens(move(Object1, Location1, Location2), Time) ->
 4108	happens(move(Object2, Location1, Location2),
 4109		Time).
 4110
 4111% 
 4112% 
 4113% range time 0 2
 4114range(time, 0, 2).
 4115
 4116% ectest/ec_reader_test_examples.e:2175
 4117% range offset 1 1
 4118range(offset, 1, 1).
 4119
 4120% 
 4121% ; End of file.
 4122% 
 4123% 
 4124% 
 4125% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4126% ; FILE: examples/Mueller2006/Chapter9/RunningAndDriving.e
 4127% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4128% ;
 4129% ; Copyright (c) 2005 IBM Corporation and others.
 4130% ; All rights reserved. This program and the accompanying materials
 4131% ; are made available under the terms of the Common Public License v1.0
 4132% ; which accompanies this distribution, and is available at
 4133% ; http://www.eclipse.org/legal/cpl-v10.html
 4134% ;
 4135% ; Contributors:
 4136% ; IBM - Initial implementation
 4137% ;
 4138% ; @book{Mueller:2006,
 4139% ;   author = "Erik T. Mueller",
 4140% ;   year = "2006",
 4141% ;   title = "Commonsense Reasoning",
 4142% ;   address = "San Francisco",
 4143% ;   publisher = "Morgan Kaufmann/Elsevier",
 4144% ; }
 4145% ;
 4146% ectest/ec_reader_test_examples.e:2202
 4147% 
 4148% load foundations/Root.e
 4149load('foundations/Root.e').
 4150
 4151% load foundations/EC.e
 4152load('foundations/EC.e').
 4153
 4154% 
 4155% sort agent
 4156sort(agent).
 4157
 4158% sort location
 4159sort(location).
 4160
 4161% ectest/ec_reader_test_examples.e:2208
 4162% 
 4163% agent James
 4164t(agent, james).
 4165
 4166% location Bookstore
 4167t(location, bookstore).
 4168
 4169% 
 4170% fluent Tired(agent)
 4171fluent(tired(agent)).
 4172
 4173% 
 4174% ectest/ec_reader_test_examples.e:2214
 4175% event Go(agent,location)
 4176event(go(agent, location)).
 4177
 4178% event Run(agent,location)
 4179event(run(agent, location)).
 4180
 4181% event Drive(agent,location)
 4182event(drive(agent, location)).
 4183
 4184% 
 4185% ectest/ec_reader_test_examples.e:2218
 4186% [agent,location,time]% 
 4187% Happens(Go(agent,location),time) ->
 4188% Happens(Run(agent,location),time) | Happens(Drive(agent,location),time).
 4189(   ( happens(go(Agent, Location), Time)->happens(run(Agent, Location), Time)
 4190    )
 4191;   happens(drive(Agent, Location), Time)
 4192).
 4193
 4194% 
 4195% 
 4196% xor Run, Drive
 4197xor([run, drive]).
 4198
 4199% 
 4200% ectest/ec_reader_test_examples.e:2224
 4201% [agent,location,time] % Initiates(Run(agent,location),Tired(agent),time).
 4202initiates(run(Agent, Location), tired(Agent), Time).
 4203
 4204% 
 4205% 
 4206% !HoldsAt(Tired(James),0).
 4207not(holds_at(tired(james), 0)).
 4208
 4209% 
 4210% Happens(Go(James,Bookstore),0).
 4211happens(go(james, bookstore), 0).
 4212
 4213% 
 4214% HoldsAt(Tired(James),1).
 4215holds_at(tired(james), 1).
 4216
 4217% 
 4218% 
 4219% ectest/ec_reader_test_examples.e:2230
 4220% range time 0 1
 4221range(time, 0, 1).
 4222
 4223% range offset 1 1
 4224range(offset, 1, 1).
 4225
 4226% 
 4227% ; End of file.
 4228% 
 4229% 
 4230% ectest/ec_reader_test_examples.e:2236
 4231% 
 4232% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4233% ; FILE: examples/Mueller2006/Chapter9/RouletteWheel.e
 4234% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4235% ;
 4236% ; Copyright (c) 2005 IBM Corporation and others.
 4237% ; All rights reserved. This program and the accompanying materials
 4238% ; are made available under the terms of the Common Public License v1.0
 4239% ; which accompanies this distribution, and is available at
 4240% ; http://www.eclipse.org/legal/cpl-v10.html
 4241% ;
 4242% ; Contributors:
 4243% ; IBM - Initial implementation
 4244% ;
 4245% ; @book{Mueller:2006,
 4246% ;   author = "Erik T. Mueller",
 4247% ;   year = "2006",
 4248% ;   title = "Commonsense Reasoning",
 4249% ;   address = "San Francisco",
 4250% ;   publisher = "Morgan Kaufmann/Elsevier",
 4251% ; }
 4252% ;
 4253% ectest/ec_reader_test_examples.e:2258
 4254% 
 4255% option modeldiff on
 4256option(modeldiff, on).
 4257
 4258% 
 4259% load foundations/Root.e
 4260load('foundations/Root.e').
 4261
 4262% load foundations/EC.e
 4263load('foundations/EC.e').
 4264
 4265% 
 4266% ectest/ec_reader_test_examples.e:2264
 4267% sort dealer
 4268sort(dealer).
 4269
 4270% sort wheel
 4271sort(wheel).
 4272
 4273% sort value: integer
 4274subsort(value, integer).
 4275
 4276% 
 4277% wheel Wheel1
 4278t(wheel, wheel1).
 4279
 4280% dealer Dealer1
 4281t(dealer, dealer1).
 4282
 4283% ectest/ec_reader_test_examples.e:2270
 4284% 
 4285% fluent WheelNumberDeterminer(wheel,value)
 4286fluent(wheelNumberDeterminer(wheel, value)).
 4287
 4288% fluent WheelNumber(wheel,value)
 4289fluent(wheelNumber(wheel, value)).
 4290
 4291% noninertial WheelNumberDeterminer
 4292noninertial(wheelNumberDeterminer).
 4293
 4294% 
 4295% event Spin(dealer,wheel)
 4296event(spin(dealer, wheel)).
 4297
 4298% ectest/ec_reader_test_examples.e:2276
 4299% event Reset(dealer,wheel)
 4300event(reset(dealer, wheel)).
 4301
 4302% 
 4303% ectest/ec_reader_test_examples.e:2278
 4304% [wheel,time]% 
 4305% ectest/ec_reader_test_examples.e:2279
 4306% {value}% 
 4307% HoldsAt(WheelNumberDeterminer(wheel,value),time).
 4308exists([Value], holds_at(wheelNumberDeterminer(Wheel, Value), Time)).
 4309
 4310% 
 4311% 
 4312% ectest/ec_reader_test_examples.e:2282
 4313% [wheel,value1,value2,time]% 
 4314% HoldsAt(WheelNumberDeterminer(wheel,value1),time) &
 4315% HoldsAt(WheelNumberDeterminer(wheel,value2),time) ->
 4316% value1=value2.
 4317holds_at(wheelNumberDeterminer(Wheel, Value1), Time), holds_at(wheelNumberDeterminer(Wheel, Value2), Time) ->
 4318	Value1=Value2.
 4319
 4320% 
 4321% 
 4322% ectest/ec_reader_test_examples.e:2287
 4323% [dealer,wheel,value,time]% 
 4324% HoldsAt(WheelNumberDeterminer(wheel,value),time) ->
 4325% Initiates(Spin(dealer,wheel),WheelNumber(wheel,value),time).
 4326holds_at(wheelNumberDeterminer(Wheel, Value), Time) ->
 4327	initiates(spin(Dealer, Wheel),
 4328		  wheelNumber(Wheel, Value),
 4329		  Time).
 4330
 4331% 
 4332% 
 4333% ectest/ec_reader_test_examples.e:2291
 4334% [dealer,wheel,value1,value2,time]% 
 4335% HoldsAt(WheelNumber(wheel,value1),time) &
 4336% HoldsAt(WheelNumberDeterminer(wheel,value2),time) &
 4337% value1!=value2 ->
 4338% Terminates(Spin(dealer,wheel),WheelNumber(wheel,value1),time).
 4339holds_at(wheelNumber(Wheel, Value1), Time), holds_at(wheelNumberDeterminer(Wheel, Value2), Time), Value1\=Value2 ->
 4340	terminates(spin(Dealer, Wheel),
 4341		   wheelNumber(Wheel, Value1),
 4342		   Time).
 4343
 4344% 
 4345% 
 4346% ectest/ec_reader_test_examples.e:2297
 4347% [dealer,wheel,value,time]% 
 4348% Terminates(Reset(dealer,wheel),WheelNumber(wheel,value),time).
 4349terminates(reset(Dealer, Wheel), wheelNumber(Wheel, Value), Time).
 4350
 4351% 
 4352% 
 4353% ectest/ec_reader_test_examples.e:2300
 4354% [wheel,value1,value2,time]% 
 4355% HoldsAt(WheelNumber(wheel,value1),time) &
 4356% HoldsAt(WheelNumber(wheel,value2),time) ->
 4357% value1=value2.
 4358holds_at(wheelNumber(Wheel, Value1), Time), holds_at(wheelNumber(Wheel, Value2), Time) ->
 4359	Value1=Value2.
 4360
 4361% 
 4362% 
 4363% ectest/ec_reader_test_examples.e:2305
 4364% [value] % !HoldsAt(WheelNumber(Wheel1,value),0).
 4365not(holds_at(wheelNumber(wheel1, Value), 0)).
 4366
 4367% 
 4368% 
 4369% Happens(Spin(Dealer1,Wheel1),0).
 4370happens(spin(dealer1, wheel1), 0).
 4371
 4372% 
 4373% ;Happens(Reset(Dealer1,Wheel1),1).
 4374% 
 4375% ; added to prune models
 4376% ectest/ec_reader_test_examples.e:2311
 4377% HoldsAt(WheelNumberDeterminer(Wheel1, 1),1).
 4378holds_at(wheelNumberDeterminer(wheel1, 1), 1).
 4379
 4380% 
 4381% 
 4382% completion Happens
 4383completion(happens).
 4384
 4385% 
 4386% range value 1 3
 4387range(value, 1, 3).
 4388
 4389% range time 0 1
 4390range(time, 0, 1).
 4391
 4392% ectest/ec_reader_test_examples.e:2317
 4393% range offset 1 1
 4394range(offset, 1, 1).
 4395
 4396% 
 4397% ; End of file.
 4398% 
 4399% 
 4400% 
 4401% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4402% ; FILE: examples/Mueller2006/Chapter14/NetBill1.e
 4403% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4404% ;
 4405% ; Copyright (c) 2005 IBM Corporation and others.
 4406% ; All rights reserved. This program and the accompanying materials
 4407% ; are made available under the terms of the Common Public License v1.0
 4408% ; which accompanies this distribution, and is available at
 4409% ; http://www.eclipse.org/legal/cpl-v10.html
 4410% ;
 4411% ; Contributors:
 4412% ; IBM - Initial implementation
 4413% ;
 4414% ; @inproceedings{SirbuTygar:1995,
 4415% ;   author = "Marvin A. Sirbu and J. D. Tygar",
 4416% ;   year = "1995",
 4417% ;   title = "Net\uppercase{B}ill: An \uppercase{I}nternet commerce system optimized for network delivered services",
 4418% ;   editor = "
 4419% ;   booktitle = "40th \uppercase{IEEE} \uppercase{C}omputer \uppercase{S}ociety \uppercase{I}nternational \uppercase{C}onference",
 4420% ;   pages = "20--25",
 4421% ;   publisher = "
 4422% ;   address = "
 4423% ; }
 4424% ;
 4425% ; @book{Mueller:2006,
 4426% ;   author = "Erik T. Mueller",
 4427% ;   year = "2006",
 4428% ;   title = "Commonsense Reasoning",
 4429% ;   address = "San Francisco",
 4430% ;   publisher = "Morgan Kaufmann/Elsevier",
 4431% ; }
 4432% ;
 4433% ectest/ec_reader_test_examples.e:2355
 4434% 
 4435% option modeldiff on
 4436option(modeldiff, on).
 4437
 4438% 
 4439% load foundations/Root.e
 4440load('foundations/Root.e').
 4441
 4442% load foundations/EC.e
 4443load('foundations/EC.e').
 4444
 4445% 
 4446% ectest/ec_reader_test_examples.e:2361
 4447% sort agent
 4448sort(agent).
 4449
 4450% agent MusicStore, Jen
 4451t(agent, musicStore).
 4452
 4453t(agent, jen).
 4454
 4455% 
 4456% sort product
 4457sort(product).
 4458
 4459% product BritneyCD
 4460t(product, britneyCD).
 4461
 4462% 
 4463% ectest/ec_reader_test_examples.e:2367
 4464% sort f
 4465sort(f).
 4466
 4467% f PurchaseRequestedJenMusicStoreBritneyCD1
 4468t(f, purchaseRequestedJenMusicStoreBritneyCD1).
 4469
 4470% f DeliveredMusicStoreJenBritneyCD
 4471t(f, deliveredMusicStoreJenBritneyCD).
 4472
 4473% f EPOSentJenMusicStore1
 4474t(f, ePOSentJenMusicStore1).
 4475
 4476% 
 4477% sort amount: integer
 4478subsort(amount, integer).
 4479
 4480% ectest/ec_reader_test_examples.e:2373
 4481% 
 4482% fluent C(agent,agent,f)
 4483fluent(c(agent, agent, f)).
 4484
 4485% fluent CC(agent,agent,f,f)
 4486fluent(cc(agent, agent, f, f)).
 4487
 4488% 
 4489% event CreateC(agent,agent,f)
 4490event(createC(agent, agent, f)).
 4491
 4492% event CreateCC(agent,agent,f,f)
 4493event(createCC(agent, agent, f, f)).
 4494
 4495% ectest/ec_reader_test_examples.e:2379
 4496% event DischargeC(agent,agent,f)
 4497event(dischargeC(agent, agent, f)).
 4498
 4499% event DischargeCC(agent,agent,f,f)
 4500event(dischargeCC(agent, agent, f, f)).
 4501
 4502% 
 4503% fluent QuoteSent(agent,agent,product,amount)
 4504fluent(quoteSent(agent, agent, product, amount)).
 4505
 4506% fluent PurchaseRequested(agent,agent,product,amount)
 4507fluent(purchaseRequested(agent, agent, product, amount)).
 4508
 4509% fluent Delivered(agent,agent,product)
 4510fluent(delivered(agent, agent, product)).
 4511
 4512% ectest/ec_reader_test_examples.e:2385
 4513% fluent EPOSent(agent,agent,amount)
 4514fluent(ePOSent(agent, agent, amount)).
 4515
 4516% 
 4517% event SendQuote(agent,agent,product,amount)
 4518event(sendQuote(agent, agent, product, amount)).
 4519
 4520% event RequestPurchase(agent,agent,product,amount)
 4521event(requestPurchase(agent, agent, product, amount)).
 4522
 4523% event Deliver(agent,agent,product)
 4524event(deliver(agent, agent, product)).
 4525
 4526% event SendEPO(agent,agent,amount)
 4527event(sendEPO(agent, agent, amount)).
 4528
 4529% ectest/ec_reader_test_examples.e:2391
 4530% 
 4531% ; Sigma
 4532% 
 4533% ectest/ec_reader_test_examples.e:2394
 4534% [agent1,agent2,f,time]% 
 4535% Initiates(CreateC(agent1,agent2,f),C(agent1,agent2,f),time).
 4536initiates(createC(Agent1, Agent2, F), c(Agent1, Agent2, F), Time).
 4537
 4538% 
 4539% 
 4540% ectest/ec_reader_test_examples.e:2397
 4541% [agent1,agent2,f1,f2,time]% 
 4542% Initiates(CreateCC(agent1,agent2,f1,f2),CC(agent1,agent2,f1,f2),time).
 4543initiates(createCC(Agent1, Agent2, F1, F2), cc(Agent1, Agent2, F1, F2), Time).
 4544
 4545% 
 4546% 
 4547% ectest/ec_reader_test_examples.e:2400
 4548% [agent1,agent2,f,time]% 
 4549% Terminates(DischargeC(agent1,agent2,f),C(agent1,agent2,f),time).
 4550terminates(dischargeC(Agent1, Agent2, F), c(Agent1, Agent2, F), Time).
 4551
 4552% 
 4553% 
 4554% ectest/ec_reader_test_examples.e:2403
 4555% [agent1,agent2,f1,f2,time]% 
 4556% Terminates(DischargeCC(agent1,agent2,f1,f2),CC(agent1,agent2,f1,f2),time).
 4557terminates(dischargeCC(Agent1, Agent2, F1, F2), cc(Agent1, Agent2, F1, F2), Time).
 4558
 4559% 
 4560% 
 4561% ectest/ec_reader_test_examples.e:2406
 4562% [agent1,agent2,product,amount,time]% 
 4563% Initiates(SendQuote(agent1,agent2,product,amount),
 4564%           QuoteSent(agent1,agent2,product,amount),
 4565%           time).
 4566initiates(sendQuote(Agent1, Agent2, Product, Amount), quoteSent(Agent1, Agent2, Product, Amount), Time).
 4567
 4568% 
 4569% 
 4570% ectest/ec_reader_test_examples.e:2411
 4571% [agent1,agent2,product,amount,time]% 
 4572% Initiates(RequestPurchase(agent1,agent2,product,amount),
 4573%           PurchaseRequested(agent1,agent2,product,amount),
 4574%           time).
 4575initiates(requestPurchase(Agent1, Agent2, Product, Amount), purchaseRequested(Agent1, Agent2, Product, Amount), Time).
 4576
 4577% 
 4578% 
 4579% ectest/ec_reader_test_examples.e:2416
 4580% [agent1,agent2,product,time]% 
 4581% Initiates(Deliver(agent1,agent2,product),
 4582%           Delivered(agent1,agent2,product),
 4583%           time).
 4584initiates(deliver(Agent1, Agent2, Product), delivered(Agent1, Agent2, Product), Time).
 4585
 4586% 
 4587% 
 4588% ectest/ec_reader_test_examples.e:2421
 4589% [agent1,agent2,amount,time]% 
 4590% Initiates(SendEPO(agent1,agent2,amount),
 4591%           EPOSent(agent1,agent2,amount),
 4592%           time).
 4593initiates(sendEPO(Agent1, Agent2, Amount), ePOSent(Agent1, Agent2, Amount), Time).
 4594
 4595% 
 4596% 
 4597% ectest/ec_reader_test_examples.e:2426
 4598% [agent1,agent2,product,amount,f1,f2,time]% 
 4599% agent1=% MusicStore &
 4600% agent2=Jen &
 4601% product=BritneyCD &
 4602% amount=1 &
 4603% f1=PurchaseRequestedJenMusicStoreBritneyCD1 &
 4604% f2=DeliveredMusicStoreJenBritneyCD ->
 4605% Initiates(SendQuote(agent1,agent2,product,amount),
 4606%           CC(agent1,agent2,f1,f2),
 4607%           time).
 4608Agent1=musicStore, Agent2=jen, Product=britneyCD, Amount=1, F1=purchaseRequestedJenMusicStoreBritneyCD1, F2=deliveredMusicStoreJenBritneyCD ->
 4609	initiates(sendQuote(Agent1,
 4610			    Agent2,
 4611			    Product,
 4612			    Amount),
 4613		  cc(Agent1, Agent2, F1, F2),
 4614		  Time).
 4615
 4616% ectest/ec_reader_test_examples.e:2435
 4617% 
 4618% 
 4619% ectest/ec_reader_test_examples.e:2437
 4620% [agent1,agent2,product,amount,f1,f2,time]% 
 4621% agent1=% Jen &
 4622% agent2=MusicStore &
 4623% product=BritneyCD &
 4624% amount=1 &
 4625% f1=DeliveredMusicStoreJenBritneyCD &
 4626% f2=EPOSentJenMusicStore1 &
 4627% !HoldsAt(Delivered(agent2,agent1,product),time) ->
 4628% Initiates(RequestPurchase(agent1,agent2,product,amount),
 4629%           CC(agent1,agent2,f1,f2),
 4630%           time).
 4631Agent1=jen, Agent2=musicStore, Product=britneyCD, Amount=1, F1=deliveredMusicStoreJenBritneyCD, F2=ePOSentJenMusicStore1, not(holds_at(delivered(Agent2, Agent1, Product), Time)) ->
 4632	initiates(requestPurchase(Agent1,
 4633				  Agent2,
 4634				  Product,
 4635				  Amount),
 4636		  cc(Agent1, Agent2, F1, F2),
 4637		  Time).
 4638
 4639% ectest/ec_reader_test_examples.e:2447
 4640% 
 4641% 
 4642% ; Delta
 4643% 
 4644% Delta:
 4645directive(delta).
 4646
 4647 
 4648% ectest/ec_reader_test_examples.e:2451
 4649% [time]% 
 4650% HoldsAt(CC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time) &
 4651% HoldsAt(PurchaseRequested(Jen,MusicStore,BritneyCD,1),time) ->
 4652% Happens(CreateC(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time).
 4653holds_at(cc(musicStore, jen, purchaseRequestedJenMusicStoreBritneyCD1, deliveredMusicStoreJenBritneyCD), Time), holds_at(purchaseRequested(jen, musicStore, britneyCD, 1), Time) ->
 4654	happens(createC(musicStore, jen, deliveredMusicStoreJenBritneyCD),
 4655		Time).
 4656
 4657% 
 4658% 
 4659% Delta:
 4660directive(delta).
 4661
 4662 
 4663% ectest/ec_reader_test_examples.e:2456
 4664% [time]% 
 4665% HoldsAt(CC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time) &
 4666% HoldsAt(PurchaseRequested(Jen, MusicStore, BritneyCD, 1),time) ->
 4667% Happens(DischargeCC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time).
 4668holds_at(cc(musicStore, jen, purchaseRequestedJenMusicStoreBritneyCD1, deliveredMusicStoreJenBritneyCD), Time), holds_at(purchaseRequested(jen, musicStore, britneyCD, 1), Time) ->
 4669	happens(dischargeCC(musicStore,
 4670			    jen,
 4671			    purchaseRequestedJenMusicStoreBritneyCD1,
 4672			    deliveredMusicStoreJenBritneyCD),
 4673		Time).
 4674
 4675% 
 4676% 
 4677% Delta:
 4678directive(delta).
 4679
 4680 
 4681% ectest/ec_reader_test_examples.e:2461
 4682% [time]% 
 4683% HoldsAt(CC(Jen, MusicStore, DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time) &
 4684% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 4685% Happens(CreateC(Jen,MusicStore,EPOSentJenMusicStore1),time).
 4686holds_at(cc(jen, musicStore, deliveredMusicStoreJenBritneyCD, ePOSentJenMusicStore1), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 4687	happens(createC(jen, musicStore, ePOSentJenMusicStore1), Time).
 4688
 4689% 
 4690% 
 4691% Delta:
 4692directive(delta).
 4693
 4694 
 4695% ectest/ec_reader_test_examples.e:2466
 4696% [time]% 
 4697% HoldsAt(CC(Jen, MusicStore, DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time) &
 4698% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 4699% Happens(DischargeCC(Jen,MusicStore,DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time).
 4700holds_at(cc(jen, musicStore, deliveredMusicStoreJenBritneyCD, ePOSentJenMusicStore1), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 4701	happens(dischargeCC(jen,
 4702			    musicStore,
 4703			    deliveredMusicStoreJenBritneyCD,
 4704			    ePOSentJenMusicStore1),
 4705		Time).
 4706
 4707% 
 4708% 
 4709% Delta:
 4710directive(delta).
 4711
 4712 
 4713% ectest/ec_reader_test_examples.e:2471
 4714% [time]% 
 4715% HoldsAt(C(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time) &
 4716% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 4717% Happens(DischargeC(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time).
 4718holds_at(c(musicStore, jen, deliveredMusicStoreJenBritneyCD), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 4719	happens(dischargeC(musicStore, jen, deliveredMusicStoreJenBritneyCD),
 4720		Time).
 4721
 4722% 
 4723% 
 4724% Delta:
 4725directive(delta).
 4726
 4727 
 4728% ectest/ec_reader_test_examples.e:2476
 4729% [time]% 
 4730% HoldsAt(C(Jen,MusicStore,EPOSentJenMusicStore1),time) &
 4731% HoldsAt(EPOSent(Jen,MusicStore,1),time) ->
 4732% Happens(DischargeC(Jen,MusicStore,EPOSentJenMusicStore1),time).
 4733holds_at(c(jen, musicStore, ePOSentJenMusicStore1), Time), holds_at(ePOSent(jen, musicStore, 1), Time) ->
 4734	happens(dischargeC(jen, musicStore, ePOSentJenMusicStore1), Time).
 4735
 4736% 
 4737% 
 4738% Delta:
 4739directive(delta).
 4740
 4741 % Happens(SendQuote(MusicStore,Jen,BritneyCD,1),0).
 4742happens(sendQuote(musicStore, jen, britneyCD, 1), 0).
 4743
 4744% 
 4745% ectest/ec_reader_test_examples.e:2482
 4746% Delta:
 4747directive(delta).
 4748
 4749 % Happens(RequestPurchase(Jen,MusicStore,BritneyCD,1),1).
 4750happens(requestPurchase(jen, musicStore, britneyCD, 1), 1).
 4751
 4752% 
 4753% Delta:
 4754directive(delta).
 4755
 4756 % Happens(Deliver(MusicStore,Jen,BritneyCD),3).
 4757happens(deliver(musicStore, jen, britneyCD), 3).
 4758
 4759% 
 4760% Delta:
 4761directive(delta).
 4762
 4763 % Happens(SendEPO(Jen,MusicStore,1),5).
 4764happens(sendEPO(jen, musicStore, 1), 5).
 4765
 4766% 
 4767% 
 4768% ; Gamma
 4769% 
 4770% ectest/ec_reader_test_examples.e:2488
 4771% [agent1,agent2,product,amount]% 
 4772% !HoldsAt(QuoteSent(agent1,agent2,product,amount),0).
 4773not(holds_at(quoteSent(Agent1, Agent2, Product, Amount), 0)).
 4774
 4775% 
 4776% 
 4777% ectest/ec_reader_test_examples.e:2491
 4778% [agent1,agent2,product,amount]% 
 4779% !HoldsAt(PurchaseRequested(agent1,agent2,product,amount),0).
 4780not(holds_at(purchaseRequested(Agent1, Agent2, Product, Amount), 0)).
 4781
 4782% 
 4783% 
 4784% ectest/ec_reader_test_examples.e:2494
 4785% [agent1,agent2,product]% 
 4786% !HoldsAt(Delivered(agent1,agent2,product),0).
 4787not(holds_at(delivered(Agent1, Agent2, Product), 0)).
 4788
 4789% 
 4790% 
 4791% ectest/ec_reader_test_examples.e:2497
 4792% [agent1,agent2,f]% 
 4793% !HoldsAt(C(agent1,agent2,f),0).
 4794not(holds_at(c(Agent1, Agent2, F), 0)).
 4795
 4796% 
 4797% 
 4798% ectest/ec_reader_test_examples.e:2500
 4799% [agent1,agent2,f1,f2]% 
 4800% !HoldsAt(CC(agent1,agent2,f1,f2),0).
 4801not(holds_at(cc(Agent1, Agent2, F1, F2), 0)).
 4802
 4803% 
 4804% 
 4805% ectest/ec_reader_test_examples.e:2503
 4806% [agent1,agent2,amount]% 
 4807% !HoldsAt(EPOSent(agent1,agent2,amount),0).
 4808not(holds_at(ePOSent(Agent1, Agent2, Amount), 0)).
 4809
 4810% 
 4811% 
 4812% completion Delta Happens
 4813completion(delta).
 4814
 4815completion(happens).
 4816
 4817% 
 4818% range time 0 7
 4819range(time, 0, 7).
 4820
 4821% ectest/ec_reader_test_examples.e:2509
 4822% range offset 1 1
 4823range(offset, 1, 1).
 4824
 4825% range amount 1 1
 4826range(amount, 1, 1).
 4827
 4828% 
 4829% ; End of file.
 4830% 
 4831% 
 4832% ectest/ec_reader_test_examples.e:2515
 4833% 
 4834% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4835% ; FILE: examples/Mueller2006/Chapter14/NetBill3.e
 4836% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 4837% ;
 4838% ; Copyright (c) 2005 IBM Corporation and others.
 4839% ; All rights reserved. This program and the accompanying materials
 4840% ; are made available under the terms of the Common Public License v1.0
 4841% ; which accompanies this distribution, and is available at
 4842% ; http://www.eclipse.org/legal/cpl-v10.html
 4843% ;
 4844% ; Contributors:
 4845% ; IBM - Initial implementation
 4846% ;
 4847% ; @inproceedings{SirbuTygar:1995,
 4848% ;   author = "Marvin A. Sirbu and J. D. Tygar",
 4849% ;   year = "1995",
 4850% ;   title = "Net\uppercase{B}ill: An \uppercase{I}nternet commerce system optimized for network delivered services",
 4851% ;   editor = "
 4852% ;   booktitle = "40th \uppercase{IEEE} \uppercase{C}omputer \uppercase{S}ociety \uppercase{I}nternational \uppercase{C}onference",
 4853% ;   pages = "20--25",
 4854% ;   publisher = "
 4855% ;   address = "
 4856% ; }
 4857% ;
 4858% ; @book{Mueller:2006,
 4859% ;   author = "Erik T. Mueller",
 4860% ;   year = "2006",
 4861% ;   title = "Commonsense Reasoning",
 4862% ;   address = "San Francisco",
 4863% ;   publisher = "Morgan Kaufmann/Elsevier",
 4864% ; }
 4865% ;
 4866% ectest/ec_reader_test_examples.e:2548
 4867% 
 4868% option modeldiff on
 4869option(modeldiff, on).
 4870
 4871% 
 4872% load foundations/Root.e
 4873load('foundations/Root.e').
 4874
 4875% load foundations/EC.e
 4876load('foundations/EC.e').
 4877
 4878% 
 4879% ectest/ec_reader_test_examples.e:2554
 4880% sort agent
 4881sort(agent).
 4882
 4883% agent MusicStore, Jen
 4884t(agent, musicStore).
 4885
 4886t(agent, jen).
 4887
 4888% 
 4889% sort product
 4890sort(product).
 4891
 4892% product BritneyCD
 4893t(product, britneyCD).
 4894
 4895% 
 4896% ectest/ec_reader_test_examples.e:2560
 4897% sort f
 4898sort(f).
 4899
 4900% f PurchaseRequestedJenMusicStoreBritneyCD1
 4901t(f, purchaseRequestedJenMusicStoreBritneyCD1).
 4902
 4903% f DeliveredMusicStoreJenBritneyCD
 4904t(f, deliveredMusicStoreJenBritneyCD).
 4905
 4906% f EPOSentJenMusicStore1
 4907t(f, ePOSentJenMusicStore1).
 4908
 4909% 
 4910% sort amount: integer
 4911subsort(amount, integer).
 4912
 4913% ectest/ec_reader_test_examples.e:2566
 4914% 
 4915% fluent C(agent,agent,f)
 4916fluent(c(agent, agent, f)).
 4917
 4918% fluent CC(agent,agent,f,f)
 4919fluent(cc(agent, agent, f, f)).
 4920
 4921% 
 4922% event CreateC(agent,agent,f)
 4923event(createC(agent, agent, f)).
 4924
 4925% event CreateCC(agent,agent,f,f)
 4926event(createCC(agent, agent, f, f)).
 4927
 4928% ectest/ec_reader_test_examples.e:2572
 4929% event DischargeC(agent,agent,f)
 4930event(dischargeC(agent, agent, f)).
 4931
 4932% event DischargeCC(agent,agent,f,f)
 4933event(dischargeCC(agent, agent, f, f)).
 4934
 4935% 
 4936% fluent QuoteSent(agent,agent,product,amount)
 4937fluent(quoteSent(agent, agent, product, amount)).
 4938
 4939% fluent PurchaseRequested(agent,agent,product,amount)
 4940fluent(purchaseRequested(agent, agent, product, amount)).
 4941
 4942% fluent Delivered(agent,agent,product)
 4943fluent(delivered(agent, agent, product)).
 4944
 4945% ectest/ec_reader_test_examples.e:2578
 4946% fluent EPOSent(agent,agent,amount)
 4947fluent(ePOSent(agent, agent, amount)).
 4948
 4949% 
 4950% event SendQuote(agent,agent,product,amount)
 4951event(sendQuote(agent, agent, product, amount)).
 4952
 4953% event RequestPurchase(agent,agent,product,amount)
 4954event(requestPurchase(agent, agent, product, amount)).
 4955
 4956% event Deliver(agent,agent,product)
 4957event(deliver(agent, agent, product)).
 4958
 4959% event SendEPO(agent,agent,amount)
 4960event(sendEPO(agent, agent, amount)).
 4961
 4962% ectest/ec_reader_test_examples.e:2584
 4963% 
 4964% ; Sigma
 4965% 
 4966% ectest/ec_reader_test_examples.e:2587
 4967% [agent1,agent2,f,time]% 
 4968% Initiates(CreateC(agent1,agent2,f),C(agent1,agent2,f),time).
 4969initiates(createC(Agent1, Agent2, F), c(Agent1, Agent2, F), Time).
 4970
 4971% 
 4972% 
 4973% ectest/ec_reader_test_examples.e:2590
 4974% [agent1,agent2,f1,f2,time]% 
 4975% Initiates(CreateCC(agent1,agent2,f1,f2),CC(agent1,agent2,f1,f2),time).
 4976initiates(createCC(Agent1, Agent2, F1, F2), cc(Agent1, Agent2, F1, F2), Time).
 4977
 4978% 
 4979% 
 4980% ectest/ec_reader_test_examples.e:2593
 4981% [agent1,agent2,f,time]% 
 4982% Terminates(DischargeC(agent1,agent2,f),C(agent1,agent2,f),time).
 4983terminates(dischargeC(Agent1, Agent2, F), c(Agent1, Agent2, F), Time).
 4984
 4985% 
 4986% 
 4987% ectest/ec_reader_test_examples.e:2596
 4988% [agent1,agent2,f1,f2,time]% 
 4989% Terminates(DischargeCC(agent1,agent2,f1,f2),CC(agent1,agent2,f1,f2),time).
 4990terminates(dischargeCC(Agent1, Agent2, F1, F2), cc(Agent1, Agent2, F1, F2), Time).
 4991
 4992% 
 4993% 
 4994% ectest/ec_reader_test_examples.e:2599
 4995% [agent1,agent2,product,amount,time]% 
 4996% Initiates(SendQuote(agent1,agent2,product,amount),
 4997%           QuoteSent(agent1,agent2,product,amount),
 4998%           time).
 4999initiates(sendQuote(Agent1, Agent2, Product, Amount), quoteSent(Agent1, Agent2, Product, Amount), Time).
 5000
 5001% 
 5002% 
 5003% ectest/ec_reader_test_examples.e:2604
 5004% [agent1,agent2,product,amount,time]% 
 5005% Initiates(RequestPurchase(agent1,agent2,product,amount),
 5006%           PurchaseRequested(agent1,agent2,product,amount),
 5007%           time).
 5008initiates(requestPurchase(Agent1, Agent2, Product, Amount), purchaseRequested(Agent1, Agent2, Product, Amount), Time).
 5009
 5010% 
 5011% 
 5012% ectest/ec_reader_test_examples.e:2609
 5013% [agent1,agent2,product,time]% 
 5014% Initiates(Deliver(agent1,agent2,product),
 5015%           Delivered(agent1,agent2,product),
 5016%           time).
 5017initiates(deliver(Agent1, Agent2, Product), delivered(Agent1, Agent2, Product), Time).
 5018
 5019% 
 5020% 
 5021% ectest/ec_reader_test_examples.e:2614
 5022% [agent1,agent2,amount,time]% 
 5023% Initiates(SendEPO(agent1,agent2,amount),
 5024%           EPOSent(agent1,agent2,amount),
 5025%           time).
 5026initiates(sendEPO(Agent1, Agent2, Amount), ePOSent(Agent1, Agent2, Amount), Time).
 5027
 5028% 
 5029% 
 5030% ectest/ec_reader_test_examples.e:2619
 5031% [agent1,agent2,product,amount,f1,f2,time]% 
 5032% agent1=% MusicStore &
 5033% agent2=Jen &
 5034% product=BritneyCD &
 5035% amount=1 &
 5036% f1=PurchaseRequestedJenMusicStoreBritneyCD1 &
 5037% f2=DeliveredMusicStoreJenBritneyCD ->
 5038% Initiates(SendQuote(agent1,agent2,product,amount),
 5039%           CC(agent1,agent2,f1,f2),
 5040%           time).
 5041Agent1=musicStore, Agent2=jen, Product=britneyCD, Amount=1, F1=purchaseRequestedJenMusicStoreBritneyCD1, F2=deliveredMusicStoreJenBritneyCD ->
 5042	initiates(sendQuote(Agent1,
 5043			    Agent2,
 5044			    Product,
 5045			    Amount),
 5046		  cc(Agent1, Agent2, F1, F2),
 5047		  Time).
 5048
 5049% ectest/ec_reader_test_examples.e:2628
 5050% 
 5051% 
 5052% ectest/ec_reader_test_examples.e:2630
 5053% [agent1,agent2,product,amount,f1,f2,time]% 
 5054% agent1=% Jen &
 5055% agent2=MusicStore &
 5056% product=BritneyCD &
 5057% amount=1 &
 5058% f1=DeliveredMusicStoreJenBritneyCD &
 5059% f2=EPOSentJenMusicStore1 &
 5060% !HoldsAt(Delivered(agent2,agent1,product),time) ->
 5061% Initiates(RequestPurchase(agent1,agent2,product,amount),
 5062%           CC(agent1,agent2,f1,f2),
 5063%           time).
 5064Agent1=jen, Agent2=musicStore, Product=britneyCD, Amount=1, F1=deliveredMusicStoreJenBritneyCD, F2=ePOSentJenMusicStore1, not(holds_at(delivered(Agent2, Agent1, Product), Time)) ->
 5065	initiates(requestPurchase(Agent1,
 5066				  Agent2,
 5067				  Product,
 5068				  Amount),
 5069		  cc(Agent1, Agent2, F1, F2),
 5070		  Time).
 5071
 5072% ectest/ec_reader_test_examples.e:2640
 5073% 
 5074% 
 5075% ; Delta
 5076% 
 5077% Delta:
 5078directive(delta).
 5079
 5080 
 5081% ectest/ec_reader_test_examples.e:2644
 5082% [time]% 
 5083% HoldsAt(CC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time) &
 5084% HoldsAt(PurchaseRequested(Jen,MusicStore,BritneyCD,1),time) ->
 5085% Happens(CreateC(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time).
 5086holds_at(cc(musicStore, jen, purchaseRequestedJenMusicStoreBritneyCD1, deliveredMusicStoreJenBritneyCD), Time), holds_at(purchaseRequested(jen, musicStore, britneyCD, 1), Time) ->
 5087	happens(createC(musicStore, jen, deliveredMusicStoreJenBritneyCD),
 5088		Time).
 5089
 5090% 
 5091% 
 5092% Delta:
 5093directive(delta).
 5094
 5095 
 5096% ectest/ec_reader_test_examples.e:2649
 5097% [time]% 
 5098% HoldsAt(CC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time) &
 5099% HoldsAt(PurchaseRequested(Jen, MusicStore, BritneyCD, 1),time) ->
 5100% Happens(DischargeCC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time).
 5101holds_at(cc(musicStore, jen, purchaseRequestedJenMusicStoreBritneyCD1, deliveredMusicStoreJenBritneyCD), Time), holds_at(purchaseRequested(jen, musicStore, britneyCD, 1), Time) ->
 5102	happens(dischargeCC(musicStore,
 5103			    jen,
 5104			    purchaseRequestedJenMusicStoreBritneyCD1,
 5105			    deliveredMusicStoreJenBritneyCD),
 5106		Time).
 5107
 5108% 
 5109% 
 5110% Delta:
 5111directive(delta).
 5112
 5113 
 5114% ectest/ec_reader_test_examples.e:2654
 5115% [time]% 
 5116% HoldsAt(CC(Jen, MusicStore, DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time) &
 5117% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 5118% Happens(CreateC(Jen,MusicStore,EPOSentJenMusicStore1),time).
 5119holds_at(cc(jen, musicStore, deliveredMusicStoreJenBritneyCD, ePOSentJenMusicStore1), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 5120	happens(createC(jen, musicStore, ePOSentJenMusicStore1), Time).
 5121
 5122% 
 5123% 
 5124% Delta:
 5125directive(delta).
 5126
 5127 
 5128% ectest/ec_reader_test_examples.e:2659
 5129% [time]% 
 5130% HoldsAt(CC(Jen, MusicStore, DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time) &
 5131% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 5132% Happens(DischargeCC(Jen,MusicStore,DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time).
 5133holds_at(cc(jen, musicStore, deliveredMusicStoreJenBritneyCD, ePOSentJenMusicStore1), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 5134	happens(dischargeCC(jen,
 5135			    musicStore,
 5136			    deliveredMusicStoreJenBritneyCD,
 5137			    ePOSentJenMusicStore1),
 5138		Time).
 5139
 5140% 
 5141% 
 5142% Delta:
 5143directive(delta).
 5144
 5145 
 5146% ectest/ec_reader_test_examples.e:2664
 5147% [time]% 
 5148% HoldsAt(C(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time) &
 5149% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 5150% Happens(DischargeC(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time).
 5151holds_at(c(musicStore, jen, deliveredMusicStoreJenBritneyCD), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 5152	happens(dischargeC(musicStore, jen, deliveredMusicStoreJenBritneyCD),
 5153		Time).
 5154
 5155% 
 5156% 
 5157% Delta:
 5158directive(delta).
 5159
 5160 
 5161% ectest/ec_reader_test_examples.e:2669
 5162% [time]% 
 5163% HoldsAt(C(Jen,MusicStore,EPOSentJenMusicStore1),time) &
 5164% HoldsAt(EPOSent(Jen,MusicStore,1),time) ->
 5165% Happens(DischargeC(Jen,MusicStore,EPOSentJenMusicStore1),time).
 5166holds_at(c(jen, musicStore, ePOSentJenMusicStore1), Time), holds_at(ePOSent(jen, musicStore, 1), Time) ->
 5167	happens(dischargeC(jen, musicStore, ePOSentJenMusicStore1), Time).
 5168
 5169% 
 5170% 
 5171% Delta:
 5172directive(delta).
 5173
 5174 % Happens(Deliver(MusicStore,Jen,BritneyCD),0).
 5175happens(deliver(musicStore, jen, britneyCD), 0).
 5176
 5177% 
 5178% ectest/ec_reader_test_examples.e:2675
 5179% Delta:
 5180directive(delta).
 5181
 5182 % Happens(SendEPO(Jen,MusicStore,1),2).
 5183happens(sendEPO(jen, musicStore, 1), 2).
 5184
 5185% 
 5186% 
 5187% ; Gamma
 5188% 
 5189% ectest/ec_reader_test_examples.e:2679
 5190% [agent1,agent2,product,amount]% 
 5191% !HoldsAt(QuoteSent(agent1,agent2,product,amount),0).
 5192not(holds_at(quoteSent(Agent1, Agent2, Product, Amount), 0)).
 5193
 5194% 
 5195% 
 5196% ectest/ec_reader_test_examples.e:2682
 5197% [agent1,agent2,product,amount]% 
 5198% !HoldsAt(PurchaseRequested(agent1,agent2,product,amount),0).
 5199not(holds_at(purchaseRequested(Agent1, Agent2, Product, Amount), 0)).
 5200
 5201% 
 5202% 
 5203% ectest/ec_reader_test_examples.e:2685
 5204% [agent1,agent2,product]% 
 5205% !HoldsAt(Delivered(agent1,agent2,product),0).
 5206not(holds_at(delivered(Agent1, Agent2, Product), 0)).
 5207
 5208% 
 5209% 
 5210% ectest/ec_reader_test_examples.e:2688
 5211% [agent1,agent2,f]% 
 5212% !HoldsAt(C(agent1,agent2,f),0).
 5213not(holds_at(c(Agent1, Agent2, F), 0)).
 5214
 5215% 
 5216% 
 5217% ectest/ec_reader_test_examples.e:2691
 5218% [agent1,agent2,f1,f2]% 
 5219% !HoldsAt(CC(agent1,agent2,f1,f2),0).
 5220not(holds_at(cc(Agent1, Agent2, F1, F2), 0)).
 5221
 5222% 
 5223% 
 5224% ectest/ec_reader_test_examples.e:2694
 5225% [agent1,agent2,amount]% 
 5226% !HoldsAt(EPOSent(agent1,agent2,amount),0).
 5227not(holds_at(ePOSent(Agent1, Agent2, Amount), 0)).
 5228
 5229% 
 5230% 
 5231% completion Delta Happens
 5232completion(delta).
 5233
 5234completion(happens).
 5235
 5236% 
 5237% range time 0 4
 5238range(time, 0, 4).
 5239
 5240% ectest/ec_reader_test_examples.e:2700
 5241% range offset 1 1
 5242range(offset, 1, 1).
 5243
 5244% range amount 1 1
 5245range(amount, 1, 1).
 5246
 5247% 
 5248% ; End of file.
 5249% 
 5250% 
 5251% ectest/ec_reader_test_examples.e:2706
 5252% 
 5253% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 5254% ; FILE: examples/Mueller2006/Chapter14/NetBill2.e
 5255% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 5256% ;
 5257% ; Copyright (c) 2005 IBM Corporation and others.
 5258% ; All rights reserved. This program and the accompanying materials
 5259% ; are made available under the terms of the Common Public License v1.0
 5260% ; which accompanies this distribution, and is available at
 5261% ; http://www.eclipse.org/legal/cpl-v10.html
 5262% ;
 5263% ; Contributors:
 5264% ; IBM - Initial implementation
 5265% ;
 5266% ; @inproceedings{SirbuTygar:1995,
 5267% ;   author = "Marvin A. Sirbu and J. D. Tygar",
 5268% ;   year = "1995",
 5269% ;   title = "Net\uppercase{B}ill: An \uppercase{I}nternet commerce system optimized for network delivered services",
 5270% ;   editor = "
 5271% ;   booktitle = "40th \uppercase{IEEE} \uppercase{C}omputer \uppercase{S}ociety \uppercase{I}nternational \uppercase{C}onference",
 5272% ;   pages = "20--25",
 5273% ;   publisher = "
 5274% ;   address = "
 5275% ; }
 5276% ;
 5277% ; @book{Mueller:2006,
 5278% ;   author = "Erik T. Mueller",
 5279% ;   year = "2006",
 5280% ;   title = "Commonsense Reasoning",
 5281% ;   address = "San Francisco",
 5282% ;   publisher = "Morgan Kaufmann/Elsevier",
 5283% ; }
 5284% ;
 5285% ectest/ec_reader_test_examples.e:2739
 5286% 
 5287% option modeldiff on
 5288option(modeldiff, on).
 5289
 5290% 
 5291% load foundations/Root.e
 5292load('foundations/Root.e').
 5293
 5294% load foundations/EC.e
 5295load('foundations/EC.e').
 5296
 5297% 
 5298% ectest/ec_reader_test_examples.e:2745
 5299% sort agent
 5300sort(agent).
 5301
 5302% agent MusicStore, Jen
 5303t(agent, musicStore).
 5304
 5305t(agent, jen).
 5306
 5307% 
 5308% sort product
 5309sort(product).
 5310
 5311% product BritneyCD
 5312t(product, britneyCD).
 5313
 5314% 
 5315% ectest/ec_reader_test_examples.e:2751
 5316% sort f
 5317sort(f).
 5318
 5319% f PurchaseRequestedJenMusicStoreBritneyCD1
 5320t(f, purchaseRequestedJenMusicStoreBritneyCD1).
 5321
 5322% f DeliveredMusicStoreJenBritneyCD
 5323t(f, deliveredMusicStoreJenBritneyCD).
 5324
 5325% f EPOSentJenMusicStore1
 5326t(f, ePOSentJenMusicStore1).
 5327
 5328% 
 5329% sort amount: integer
 5330subsort(amount, integer).
 5331
 5332% ectest/ec_reader_test_examples.e:2757
 5333% 
 5334% fluent C(agent,agent,f)
 5335fluent(c(agent, agent, f)).
 5336
 5337% fluent CC(agent,agent,f,f)
 5338fluent(cc(agent, agent, f, f)).
 5339
 5340% 
 5341% event CreateC(agent,agent,f)
 5342event(createC(agent, agent, f)).
 5343
 5344% event CreateCC(agent,agent,f,f)
 5345event(createCC(agent, agent, f, f)).
 5346
 5347% ectest/ec_reader_test_examples.e:2763
 5348% event DischargeC(agent,agent,f)
 5349event(dischargeC(agent, agent, f)).
 5350
 5351% event DischargeCC(agent,agent,f,f)
 5352event(dischargeCC(agent, agent, f, f)).
 5353
 5354% 
 5355% fluent QuoteSent(agent,agent,product,amount)
 5356fluent(quoteSent(agent, agent, product, amount)).
 5357
 5358% fluent PurchaseRequested(agent,agent,product,amount)
 5359fluent(purchaseRequested(agent, agent, product, amount)).
 5360
 5361% fluent Delivered(agent,agent,product)
 5362fluent(delivered(agent, agent, product)).
 5363
 5364% ectest/ec_reader_test_examples.e:2769
 5365% fluent EPOSent(agent,agent,amount)
 5366fluent(ePOSent(agent, agent, amount)).
 5367
 5368% 
 5369% event SendQuote(agent,agent,product,amount)
 5370event(sendQuote(agent, agent, product, amount)).
 5371
 5372% event RequestPurchase(agent,agent,product,amount)
 5373event(requestPurchase(agent, agent, product, amount)).
 5374
 5375% event Deliver(agent,agent,product)
 5376event(deliver(agent, agent, product)).
 5377
 5378% event SendEPO(agent,agent,amount)
 5379event(sendEPO(agent, agent, amount)).
 5380
 5381% ectest/ec_reader_test_examples.e:2775
 5382% 
 5383% ; Sigma
 5384% 
 5385% ectest/ec_reader_test_examples.e:2778
 5386% [agent1,agent2,f,time]% 
 5387% Initiates(CreateC(agent1,agent2,f),C(agent1,agent2,f),time).
 5388initiates(createC(Agent1, Agent2, F), c(Agent1, Agent2, F), Time).
 5389
 5390% 
 5391% 
 5392% ectest/ec_reader_test_examples.e:2781
 5393% [agent1,agent2,f1,f2,time]% 
 5394% Initiates(CreateCC(agent1,agent2,f1,f2),CC(agent1,agent2,f1,f2),time).
 5395initiates(createCC(Agent1, Agent2, F1, F2), cc(Agent1, Agent2, F1, F2), Time).
 5396
 5397% 
 5398% 
 5399% ectest/ec_reader_test_examples.e:2784
 5400% [agent1,agent2,f,time]% 
 5401% Terminates(DischargeC(agent1,agent2,f),C(agent1,agent2,f),time).
 5402terminates(dischargeC(Agent1, Agent2, F), c(Agent1, Agent2, F), Time).
 5403
 5404% 
 5405% 
 5406% ectest/ec_reader_test_examples.e:2787
 5407% [agent1,agent2,f1,f2,time]% 
 5408% Terminates(DischargeCC(agent1,agent2,f1,f2),CC(agent1,agent2,f1,f2),time).
 5409terminates(dischargeCC(Agent1, Agent2, F1, F2), cc(Agent1, Agent2, F1, F2), Time).
 5410
 5411% 
 5412% 
 5413% ectest/ec_reader_test_examples.e:2790
 5414% [agent1,agent2,product,amount,time]% 
 5415% Initiates(SendQuote(agent1,agent2,product,amount),
 5416%           QuoteSent(agent1,agent2,product,amount),
 5417%           time).
 5418initiates(sendQuote(Agent1, Agent2, Product, Amount), quoteSent(Agent1, Agent2, Product, Amount), Time).
 5419
 5420% 
 5421% 
 5422% ectest/ec_reader_test_examples.e:2795
 5423% [agent1,agent2,product,amount,time]% 
 5424% Initiates(RequestPurchase(agent1,agent2,product,amount),
 5425%           PurchaseRequested(agent1,agent2,product,amount),
 5426%           time).
 5427initiates(requestPurchase(Agent1, Agent2, Product, Amount), purchaseRequested(Agent1, Agent2, Product, Amount), Time).
 5428
 5429% 
 5430% 
 5431% ectest/ec_reader_test_examples.e:2800
 5432% [agent1,agent2,product,time]% 
 5433% Initiates(Deliver(agent1,agent2,product),
 5434%           Delivered(agent1,agent2,product),
 5435%           time).
 5436initiates(deliver(Agent1, Agent2, Product), delivered(Agent1, Agent2, Product), Time).
 5437
 5438% 
 5439% 
 5440% ectest/ec_reader_test_examples.e:2805
 5441% [agent1,agent2,amount,time]% 
 5442% Initiates(SendEPO(agent1,agent2,amount),
 5443%           EPOSent(agent1,agent2,amount),
 5444%           time).
 5445initiates(sendEPO(Agent1, Agent2, Amount), ePOSent(Agent1, Agent2, Amount), Time).
 5446
 5447% 
 5448% 
 5449% ectest/ec_reader_test_examples.e:2810
 5450% [agent1,agent2,product,amount,f1,f2,time]% 
 5451% agent1=% MusicStore &
 5452% agent2=Jen &
 5453% product=BritneyCD &
 5454% amount=1 &
 5455% f1=PurchaseRequestedJenMusicStoreBritneyCD1 &
 5456% f2=DeliveredMusicStoreJenBritneyCD ->
 5457% Initiates(SendQuote(agent1,agent2,product,amount),
 5458%           CC(agent1,agent2,f1,f2),
 5459%           time).
 5460Agent1=musicStore, Agent2=jen, Product=britneyCD, Amount=1, F1=purchaseRequestedJenMusicStoreBritneyCD1, F2=deliveredMusicStoreJenBritneyCD ->
 5461	initiates(sendQuote(Agent1,
 5462			    Agent2,
 5463			    Product,
 5464			    Amount),
 5465		  cc(Agent1, Agent2, F1, F2),
 5466		  Time).
 5467
 5468% ectest/ec_reader_test_examples.e:2819
 5469% 
 5470% 
 5471% ectest/ec_reader_test_examples.e:2821
 5472% [agent1,agent2,product,amount,f1,f2,time]% 
 5473% agent1=% Jen &
 5474% agent2=MusicStore &
 5475% product=BritneyCD &
 5476% amount=1 &
 5477% f1=DeliveredMusicStoreJenBritneyCD &
 5478% f2=EPOSentJenMusicStore1 &
 5479% !HoldsAt(Delivered(agent2,agent1,product),time) ->
 5480% Initiates(RequestPurchase(agent1,agent2,product,amount),
 5481%           CC(agent1,agent2,f1,f2),
 5482%           time).
 5483Agent1=jen, Agent2=musicStore, Product=britneyCD, Amount=1, F1=deliveredMusicStoreJenBritneyCD, F2=ePOSentJenMusicStore1, not(holds_at(delivered(Agent2, Agent1, Product), Time)) ->
 5484	initiates(requestPurchase(Agent1,
 5485				  Agent2,
 5486				  Product,
 5487				  Amount),
 5488		  cc(Agent1, Agent2, F1, F2),
 5489		  Time).
 5490
 5491% ectest/ec_reader_test_examples.e:2831
 5492% 
 5493% 
 5494% ; Delta
 5495% 
 5496% Delta:
 5497directive(delta).
 5498
 5499 
 5500% ectest/ec_reader_test_examples.e:2835
 5501% [time]% 
 5502% HoldsAt(CC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time) &
 5503% HoldsAt(PurchaseRequested(Jen,MusicStore,BritneyCD,1),time) ->
 5504% Happens(CreateC(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time).
 5505holds_at(cc(musicStore, jen, purchaseRequestedJenMusicStoreBritneyCD1, deliveredMusicStoreJenBritneyCD), Time), holds_at(purchaseRequested(jen, musicStore, britneyCD, 1), Time) ->
 5506	happens(createC(musicStore, jen, deliveredMusicStoreJenBritneyCD),
 5507		Time).
 5508
 5509% 
 5510% 
 5511% Delta:
 5512directive(delta).
 5513
 5514 
 5515% ectest/ec_reader_test_examples.e:2840
 5516% [time]% 
 5517% HoldsAt(CC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time) &
 5518% HoldsAt(PurchaseRequested(Jen, MusicStore, BritneyCD, 1),time) ->
 5519% Happens(DischargeCC(MusicStore,Jen,PurchaseRequestedJenMusicStoreBritneyCD1,DeliveredMusicStoreJenBritneyCD),time).
 5520holds_at(cc(musicStore, jen, purchaseRequestedJenMusicStoreBritneyCD1, deliveredMusicStoreJenBritneyCD), Time), holds_at(purchaseRequested(jen, musicStore, britneyCD, 1), Time) ->
 5521	happens(dischargeCC(musicStore,
 5522			    jen,
 5523			    purchaseRequestedJenMusicStoreBritneyCD1,
 5524			    deliveredMusicStoreJenBritneyCD),
 5525		Time).
 5526
 5527% 
 5528% 
 5529% Delta:
 5530directive(delta).
 5531
 5532 
 5533% ectest/ec_reader_test_examples.e:2845
 5534% [time]% 
 5535% HoldsAt(CC(Jen, MusicStore, DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time) &
 5536% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 5537% Happens(CreateC(Jen,MusicStore,EPOSentJenMusicStore1),time).
 5538holds_at(cc(jen, musicStore, deliveredMusicStoreJenBritneyCD, ePOSentJenMusicStore1), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 5539	happens(createC(jen, musicStore, ePOSentJenMusicStore1), Time).
 5540
 5541% 
 5542% 
 5543% Delta:
 5544directive(delta).
 5545
 5546 
 5547% ectest/ec_reader_test_examples.e:2850
 5548% [time]% 
 5549% HoldsAt(CC(Jen, MusicStore, DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time) &
 5550% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 5551% Happens(DischargeCC(Jen,MusicStore,DeliveredMusicStoreJenBritneyCD, EPOSentJenMusicStore1),time).
 5552holds_at(cc(jen, musicStore, deliveredMusicStoreJenBritneyCD, ePOSentJenMusicStore1), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 5553	happens(dischargeCC(jen,
 5554			    musicStore,
 5555			    deliveredMusicStoreJenBritneyCD,
 5556			    ePOSentJenMusicStore1),
 5557		Time).
 5558
 5559% 
 5560% 
 5561% Delta:
 5562directive(delta).
 5563
 5564 
 5565% ectest/ec_reader_test_examples.e:2855
 5566% [time]% 
 5567% HoldsAt(C(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time) &
 5568% HoldsAt(Delivered(MusicStore,Jen,BritneyCD),time) ->
 5569% Happens(DischargeC(MusicStore,Jen,DeliveredMusicStoreJenBritneyCD),time).
 5570holds_at(c(musicStore, jen, deliveredMusicStoreJenBritneyCD), Time), holds_at(delivered(musicStore, jen, britneyCD), Time) ->
 5571	happens(dischargeC(musicStore, jen, deliveredMusicStoreJenBritneyCD),
 5572		Time).
 5573
 5574% 
 5575% 
 5576% Delta:
 5577directive(delta).
 5578
 5579 
 5580% ectest/ec_reader_test_examples.e:2860
 5581% [time]% 
 5582% HoldsAt(C(Jen,MusicStore,EPOSentJenMusicStore1),time) &
 5583% HoldsAt(EPOSent(Jen,MusicStore,1),time) ->
 5584% Happens(DischargeC(Jen,MusicStore,EPOSentJenMusicStore1),time).
 5585holds_at(c(jen, musicStore, ePOSentJenMusicStore1), Time), holds_at(ePOSent(jen, musicStore, 1), Time) ->
 5586	happens(dischargeC(jen, musicStore, ePOSentJenMusicStore1), Time).
 5587
 5588% 
 5589% 
 5590% Delta:
 5591directive(delta).
 5592
 5593 % Happens(RequestPurchase(Jen,MusicStore,BritneyCD,1),0).
 5594happens(requestPurchase(jen, musicStore, britneyCD, 1), 0).
 5595
 5596% 
 5597% ectest/ec_reader_test_examples.e:2866
 5598% Delta:
 5599directive(delta).
 5600
 5601 % Happens(Deliver(MusicStore,Jen,BritneyCD),2).
 5602happens(deliver(musicStore, jen, britneyCD), 2).
 5603
 5604% 
 5605% Delta:
 5606directive(delta).
 5607
 5608 % Happens(SendEPO(Jen,MusicStore,1),4).
 5609happens(sendEPO(jen, musicStore, 1), 4).
 5610
 5611% 
 5612% 
 5613% ; Gamma
 5614% 
 5615% ectest/ec_reader_test_examples.e:2871
 5616% [agent1,agent2,product,amount]% 
 5617% !HoldsAt(QuoteSent(agent1,agent2,product,amount),0).
 5618not(holds_at(quoteSent(Agent1, Agent2, Product, Amount), 0)).
 5619
 5620% 
 5621% 
 5622% ectest/ec_reader_test_examples.e:2874
 5623% [agent1,agent2,product,amount]% 
 5624% !HoldsAt(PurchaseRequested(agent1,agent2,product,amount),0).
 5625not(holds_at(purchaseRequested(Agent1, Agent2, Product, Amount), 0)).
 5626
 5627% 
 5628% 
 5629% ectest/ec_reader_test_examples.e:2877
 5630% [agent1,agent2,product]% 
 5631% !HoldsAt(Delivered(agent1,agent2,product),0).
 5632not(holds_at(delivered(Agent1, Agent2, Product), 0)).
 5633
 5634% 
 5635% 
 5636% ectest/ec_reader_test_examples.e:2880
 5637% [agent1,agent2,f]% 
 5638% !HoldsAt(C(agent1,agent2,f),0).
 5639not(holds_at(c(Agent1, Agent2, F), 0)).
 5640
 5641% 
 5642% 
 5643% ectest/ec_reader_test_examples.e:2883
 5644% [agent1,agent2,f1,f2]% 
 5645% !HoldsAt(CC(agent1,agent2,f1,f2),0).
 5646not(holds_at(cc(Agent1, Agent2, F1, F2), 0)).
 5647
 5648% 
 5649% 
 5650% ectest/ec_reader_test_examples.e:2886
 5651% [agent1,agent2,amount]% 
 5652% !HoldsAt(EPOSent(agent1,agent2,amount),0).
 5653not(holds_at(ePOSent(Agent1, Agent2, Amount), 0)).
 5654
 5655% 
 5656% 
 5657% completion Delta Happens
 5658completion(delta).
 5659
 5660completion(happens).
 5661
 5662% 
 5663% range time 0 6
 5664range(time, 0, 6).
 5665
 5666% ectest/ec_reader_test_examples.e:2892
 5667% range offset 1 1
 5668range(offset, 1, 1).
 5669
 5670% range amount 1 1
 5671range(amount, 1, 1).
 5672
 5673% 
 5674% ; End of file.
 5675% 
 5676% 
 5677% ectest/ec_reader_test_examples.e:2898
 5678% 
 5679% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 5680% ; FILE: examples/Mueller2006/Chapter14/Vision.e
 5681% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 5682% ;
 5683% ; Copyright (c) 2005 IBM Corporation and others.
 5684% ; All rights reserved. This program and the accompanying materials
 5685% ; are made available under the terms of the Common Public License v1.0
 5686% ; which accompanies this distribution, and is available at
 5687% ; http://www.eclipse.org/legal/cpl-v10.html
 5688% ;
 5689% ; Contributors:
 5690% ; IBM - Initial implementation
 5691% ;
 5692% ; @inproceedings{ShanahanRandell:2004,
 5693% ;   author = "Murray Shanahan and David A. Randell",
 5694% ;   year = "2004",
 5695% ;   title = "A logic-based formulation of active visual perception",
 5696% ;   editor = "Didier Dubois and Christopher A. Welty and Mary-Anne Williams",
 5697% ;   booktitle = "\uppercase{P}roceedings of the \uppercase{N}inth \uppercase{I}nternational \uppercase{C}onference on \uppercase{P}rinciples of \uppercase{K}nowledge \uppercase{R}epresentation and \uppercase{R}easoning",
 5698% ;   pages = "64--72",
 5699% ;   address = "Menlo Park, CA",
 5700% ;   publisher = "AAAI Press",
 5701% ; }
 5702% ;
 5703% ; @book{Mueller:2006,
 5704% ;   author = "Erik T. Mueller",
 5705% ;   year = "2006",
 5706% ;   title = "Commonsense Reasoning",
 5707% ;   address = "San Francisco",
 5708% ;   publisher = "Morgan Kaufmann/Elsevier",
 5709% ; }
 5710% ;
 5711% ectest/ec_reader_test_examples.e:2931
 5712% 
 5713% option modeldiff on
 5714option(modeldiff, on).
 5715
 5716% 
 5717% load foundations/Root.e
 5718load('foundations/Root.e').
 5719
 5720% load foundations/EC.e
 5721load('foundations/EC.e').
 5722
 5723% 
 5724% ectest/ec_reader_test_examples.e:2937
 5725% sort object
 5726sort(object).
 5727
 5728% sort shape
 5729sort(shape).
 5730
 5731% sort aspect
 5732sort(aspect).
 5733
 5734% 
 5735% object Object1
 5736t(object, object1).
 5737
 5738% aspect Aspect1, Aspect2, Aspect3
 5739t(aspect, aspect1).
 5740
 5741t(aspect, aspect2).
 5742
 5743t(aspect, aspect3).
 5744
 5745% ectest/ec_reader_test_examples.e:2943
 5746% shape Shape1, Shape2
 5747t(shape, shape1).
 5748
 5749t(shape, shape2).
 5750
 5751% 
 5752% predicate Shape(object,shape)
 5753predicate(shape(object, shape)).
 5754
 5755% predicate Arc(shape,aspect,aspect)
 5756predicate(arc(shape, aspect, aspect)).
 5757
 5758% fluent Aspect(object,aspect)
 5759fluent(aspect(object, aspect)).
 5760
 5761% event Change(object,aspect,aspect)
 5762event(change(object, aspect, aspect)).
 5763
 5764% ectest/ec_reader_test_examples.e:2949
 5765% 
 5766% ; Sigma
 5767% 
 5768% ectest/ec_reader_test_examples.e:2952
 5769% [object,aspect1,aspect2,shape,time]% 
 5770% HoldsAt(Aspect(object,aspect1),time) &
 5771% Shape(object,shape) &
 5772% (Arc(shape,aspect1,aspect2) |
 5773%  Arc(shape,aspect2,aspect1)) ->
 5774% Initiates(Change(object,aspect1,aspect2),Aspect(object,aspect2),time).
 5775holds_at(aspect(Object, Aspect1), Time), shape(Object, Shape), (arc(Shape, Aspect1, Aspect2);arc(Shape, Aspect2, Aspect1)) ->
 5776	initiates(change(Object, Aspect1, Aspect2),
 5777		  aspect(Object, Aspect2),
 5778		  Time).
 5779
 5780% 
 5781% ectest/ec_reader_test_examples.e:2958
 5782% 
 5783% ectest/ec_reader_test_examples.e:2959
 5784% [object,aspect1,aspect2,shape,time]% 
 5785% HoldsAt(Aspect(object,aspect1),time) &
 5786% Shape(object,shape) &
 5787% (Arc(shape,aspect1,aspect2) |
 5788%  Arc(shape,aspect2,aspect1)) ->
 5789% Terminates(Change(object,aspect1,aspect2),Aspect(object,aspect1),time).
 5790holds_at(aspect(Object, Aspect1), Time), shape(Object, Shape), (arc(Shape, Aspect1, Aspect2);arc(Shape, Aspect2, Aspect1)) ->
 5791	terminates(change(Object, Aspect1, Aspect2),
 5792		   aspect(Object, Aspect1),
 5793		   Time).
 5794
 5795% 
 5796% ectest/ec_reader_test_examples.e:2965
 5797% 
 5798% ; preconditions (added)
 5799% 
 5800% ectest/ec_reader_test_examples.e:2968
 5801% [object,aspect1,aspect2,time]% 
 5802% Happens(Change(object,aspect1,aspect2),time) ->
 5803% HoldsAt(Aspect(object,aspect1),time).
 5804happens(change(Object, Aspect1, Aspect2), Time) ->
 5805	holds_at(aspect(Object, Aspect1), Time).
 5806
 5807% 
 5808% 
 5809% ectest/ec_reader_test_examples.e:2972
 5810% [object,aspect1,aspect2,aspect3,time]% 
 5811% Happens(Change(object,aspect1,aspect2),time) &
 5812% Happens(Change(object,aspect1,aspect3),time) ->
 5813% aspect2=aspect3.
 5814happens(change(Object, Aspect1, Aspect2), Time), happens(change(Object, Aspect1, Aspect3), Time) ->
 5815	Aspect2=Aspect3.
 5816
 5817% 
 5818% 
 5819% ; Psi
 5820% ectest/ec_reader_test_examples.e:2978
 5821% 
 5822% ectest/ec_reader_test_examples.e:2979
 5823% [object,shape1,shape2]% 
 5824% Shape(object,shape1) &
 5825% Shape(object,shape2) ->
 5826% shape1=shape2.
 5827shape(Object, Shape1), shape(Object, Shape2) ->
 5828	Shape1=Shape2.
 5829
 5830% 
 5831% 
 5832% ectest/ec_reader_test_examples.e:2984
 5833% [object,aspect1,aspect2,time]% 
 5834% HoldsAt(Aspect(object,aspect1),time) &
 5835% HoldsAt(Aspect(object,aspect2),time) ->
 5836% aspect1=aspect2.
 5837holds_at(aspect(Object, Aspect1), Time), holds_at(aspect(Object, Aspect2), Time) ->
 5838	Aspect1=Aspect2.
 5839
 5840% 
 5841% 
 5842% ectest/ec_reader_test_examples.e:2989
 5843% [aspect1,aspect2]% 
 5844% Arc(Shape1,aspect1,aspect2) <->
 5845% (aspect1=Aspect1 & aspect2=Aspect2).
 5846arc(shape1, Aspect1, Aspect2) <->
 5847	Aspect1=aspect1,
 5848	Aspect2=aspect2.
 5849
 5850% 
 5851% 
 5852% ectest/ec_reader_test_examples.e:2993
 5853% [aspect1,aspect2]% 
 5854% Arc(Shape2,aspect1,aspect2) <->
 5855% ((aspect1=Aspect1 & aspect2=Aspect3) |
 5856%  (aspect1=Aspect3 & aspect2=Aspect2)).
 5857arc(shape2, Aspect1, Aspect2) <->
 5858	(   Aspect1=aspect1,
 5859	    Aspect2=aspect3
 5860	;   Aspect1=aspect3,
 5861	    Aspect2=aspect2
 5862	).
 5863
 5864% 
 5865% 
 5866% ; Gamma
 5867% ectest/ec_reader_test_examples.e:2999
 5868% 
 5869% HoldsAt(Aspect(Object1,Aspect1),0).
 5870holds_at(aspect(object1, aspect1), 0).
 5871
 5872% 
 5873% HoldsAt(Aspect(Object1,Aspect2),1).
 5874holds_at(aspect(object1, aspect2), 1).
 5875
 5876% 
 5877% 
 5878% ;completion Delta Happens
 5879% 
 5880% ectest/ec_reader_test_examples.e:3005
 5881% range time 0 1
 5882range(time, 0, 1).
 5883
 5884% range offset 1 1
 5885range(offset, 1, 1).
 5886
 5887% 
 5888% ; End of file.
 5889% 
 5890% 
 5891% ectest/ec_reader_test_examples.e:3011
 5892% 
 5893% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 5894% ; FILE: examples/Mueller2006/Chapter14/Workflow.e
 5895% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 5896% ;
 5897% ; Copyright (c) 2005 IBM Corporation and others.
 5898% ; All rights reserved. This program and the accompanying materials
 5899% ; are made available under the terms of the Common Public License v1.0
 5900% ; which accompanies this distribution, and is available at
 5901% ; http://www.eclipse.org/legal/cpl-v10.html
 5902% ;
 5903% ; Contributors:
 5904% ; IBM - Initial implementation
 5905% ;
 5906% ; @incollection{CicekliYildirim:2000,
 5907% ;   author = "Nihan Kesim Cicekli and Yakup Yildirim",
 5908% ;   year = "2000",
 5909% ;   title = "Formalizing workflows using the event calculus",
 5910% ;   editor = "Mohamed T. Ibrahim and Josef K{\"{u}}ng and Norman Revell",
 5911% ;   booktitle = "Database and Expert Systems Applications",
 5912% ;   series = "Lecture Notes in Computer Science",
 5913% ;   volume = "1873",
 5914% ;   pages = "222--231",
 5915% ;   address = "Berlin",
 5916% ;   publisher = "Springer",
 5917% ; }
 5918% ;
 5919% ; @unpublished{WFMC:1999,
 5920% ;   author = "{Workflow Management Coalition}",
 5921% ;   year = "1999",
 5922% ;   title = "\uppercase{W}orkflow \uppercase{M}anagement \uppercase{C}oalition Terminology \& Glossary",
 5923% ;   howpublished = "Document Number WFMC-TC-1011, Document Status -- Issue 3.0, Workflow Management Coalition, Winchester, UK",
 5924% ; }
 5925% ;
 5926% ; @book{Mueller:2006,
 5927% ;   author = "Erik T. Mueller",
 5928% ;   year = "2006",
 5929% ;   title = "Commonsense Reasoning",
 5930% ;   address = "San Francisco",
 5931% ;   publisher = "Morgan Kaufmann/Elsevier",
 5932% ; }
 5933% ;
 5934% ectest/ec_reader_test_examples.e:3053
 5935% 
 5936% option modeldiff on
 5937option(modeldiff, on).
 5938
 5939% 
 5940% load foundations/Root.e
 5941load('foundations/Root.e').
 5942
 5943% load foundations/EC.e
 5944load('foundations/EC.e').
 5945
 5946% 
 5947% ectest/ec_reader_test_examples.e:3059
 5948% sort activity
 5949sort(activity).
 5950
 5951% sort condition
 5952sort(condition).
 5953
 5954% activity A, B, C1, C2, C3, D, E1, E2, E3, F, G
 5955t(activity, a).
 5956
 5957t(activity, b).
 5958
 5959t(activity, c1).
 5960
 5961t(activity, c2).
 5962
 5963t(activity, c3).
 5964
 5965t(activity, d).
 5966
 5967t(activity, e1).
 5968
 5969t(activity, e2).
 5970
 5971t(activity, e3).
 5972
 5973t(activity, f).
 5974
 5975t(activity, g).
 5976
 5977% condition E1C, E2C, E3C, FC
 5978t(condition, e1c).
 5979
 5980t(condition, e2c).
 5981
 5982t(condition, e3c).
 5983
 5984t(condition, fc).
 5985
 5986% 
 5987% fluent Active(activity)
 5988fluent(active(activity)).
 5989
 5990% ectest/ec_reader_test_examples.e:3065
 5991% fluent Completed(activity)
 5992fluent(completed(activity)).
 5993
 5994% fluent Condition(condition)
 5995fluent(condition(condition)).
 5996
 5997% noninertial Condition
 5998noninertial(condition).
 5999
 6000% 
 6001% event Start(activity)
 6002event(start(activity)).
 6003
 6004% event End(activity)
 6005event(end(activity)).
 6006
 6007% ectest/ec_reader_test_examples.e:3071
 6008% 
 6009% ; Sigma
 6010% 
 6011% ectest/ec_reader_test_examples.e:3074
 6012% [activity,time]% 
 6013% Initiates(Start(activity),Active(activity),time).
 6014initiates(start(Activity), active(Activity), Time).
 6015
 6016% 
 6017% 
 6018% ectest/ec_reader_test_examples.e:3077
 6019% [activity,time]% 
 6020% Terminates(Start(activity),Completed(activity),time).
 6021terminates(start(Activity), completed(Activity), Time).
 6022
 6023% 
 6024% 
 6025% ectest/ec_reader_test_examples.e:3080
 6026% [activity,time]% 
 6027% Initiates(End(activity),Completed(activity),time).
 6028initiates(end(Activity), completed(Activity), Time).
 6029
 6030% 
 6031% 
 6032% ectest/ec_reader_test_examples.e:3083
 6033% [activity,time]% 
 6034% Terminates(End(activity),Active(activity),time).
 6035terminates(end(Activity), active(Activity), Time).
 6036
 6037% 
 6038% 
 6039% ; Delta
 6040% 
 6041% ; A; B
 6042% ectest/ec_reader_test_examples.e:3089
 6043% Delta:
 6044directive(delta).
 6045
 6046 
 6047% ectest/ec_reader_test_examples.e:3089
 6048% [time]% 
 6049% !HoldsAt(Active(B),time) &
 6050% !HoldsAt(Completed(A),time-1) &
 6051% HoldsAt(Completed(A),time) ->
 6052% Happens(Start(B),time).
 6053not(holds_at(active(b), Time)), not(holds_at(completed(a), Time-1)), holds_at(completed(a), Time) ->
 6054	happens(start(b), Time).
 6055
 6056% 
 6057% 
 6058% ; B; AND-split C1, C2, C3
 6059% ectest/ec_reader_test_examples.e:3096
 6060% Delta:
 6061directive(delta).
 6062
 6063 
 6064% ectest/ec_reader_test_examples.e:3096
 6065% [time]% 
 6066% !HoldsAt(Active(C1),time) &
 6067% !HoldsAt(Completed(B),time-1) &
 6068% HoldsAt(Completed(B),time) ->
 6069% Happens(Start(C1),time).
 6070not(holds_at(active(c1), Time)), not(holds_at(completed(b), Time-1)), holds_at(completed(b), Time) ->
 6071	happens(start(c1), Time).
 6072
 6073% 
 6074% 
 6075% ectest/ec_reader_test_examples.e:3102
 6076% Delta:
 6077directive(delta).
 6078
 6079 
 6080% ectest/ec_reader_test_examples.e:3102
 6081% [time]% 
 6082% !HoldsAt(Active(C2),time) &
 6083% !HoldsAt(Completed(B),time-1) &
 6084% HoldsAt(Completed(B),time) ->
 6085% Happens(Start(C2),time).
 6086not(holds_at(active(c2), Time)), not(holds_at(completed(b), Time-1)), holds_at(completed(b), Time) ->
 6087	happens(start(c2), Time).
 6088
 6089% 
 6090% 
 6091% ectest/ec_reader_test_examples.e:3108
 6092% Delta:
 6093directive(delta).
 6094
 6095 
 6096% ectest/ec_reader_test_examples.e:3108
 6097% [time]% 
 6098% !HoldsAt(Active(C3),time) &
 6099% !HoldsAt(Completed(B),time-1) &
 6100% HoldsAt(Completed(B),time) ->
 6101% Happens(Start(C3),time).
 6102not(holds_at(active(c3), Time)), not(holds_at(completed(b), Time-1)), holds_at(completed(b), Time) ->
 6103	happens(start(c3), Time).
 6104
 6105% 
 6106% 
 6107% ; AND-join C1, C2, C3; D
 6108% ectest/ec_reader_test_examples.e:3115
 6109% Delta:
 6110directive(delta).
 6111
 6112 
 6113% ectest/ec_reader_test_examples.e:3115
 6114% [time]% 
 6115% !HoldsAt(Active(D),time) &
 6116% ((!HoldsAt(Completed(C1),time-1) & HoldsAt(Completed(C1),time))|
 6117%  (!HoldsAt(Completed(C2),time-1) & HoldsAt(Completed(C2),time))|
 6118%  (!HoldsAt(Completed(C3),time-1) & HoldsAt(Completed(C3),time))) &
 6119% HoldsAt(Completed(C1),time) &
 6120% HoldsAt(Completed(C2),time) &
 6121% HoldsAt(Completed(C3),time) ->
 6122% Happens(Start(D),time).
 6123not(holds_at(active(d), Time)), (not(holds_at(completed(c1), Time-1)), holds_at(completed(c1), Time);not(holds_at(completed(c2), Time-1)), holds_at(completed(c2), Time);not(holds_at(completed(c3), Time-1)), holds_at(completed(c3), Time)), holds_at(completed(c1), Time), holds_at(completed(c2), Time), holds_at(completed(c3), Time) ->
 6124	happens(start(d), Time).
 6125
 6126% ectest/ec_reader_test_examples.e:3123
 6127% 
 6128% 
 6129% ; D; XOR-split E1, E2, E3
 6130% Delta:
 6131directive(delta).
 6132
 6133 
 6134% ectest/ec_reader_test_examples.e:3126
 6135% [time]% 
 6136% !HoldsAt(Active(E1),time) &
 6137% !HoldsAt(Completed(D),time-1) &
 6138% HoldsAt(Completed(D),time) &
 6139% HoldsAt(Condition(E1C),time) ->
 6140% Happens(Start(E1),time).
 6141not(holds_at(active(e1), Time)), not(holds_at(completed(d), Time-1)), holds_at(completed(d), Time), holds_at(condition(e1c), Time) ->
 6142	happens(start(e1), Time).
 6143
 6144% 
 6145% ectest/ec_reader_test_examples.e:3132
 6146% 
 6147% Delta:
 6148directive(delta).
 6149
 6150 
 6151% ectest/ec_reader_test_examples.e:3133
 6152% [time]% 
 6153% !HoldsAt(Active(E2),time) &
 6154% !HoldsAt(Completed(D),time-1) &
 6155% HoldsAt(Completed(D),time) &
 6156% HoldsAt(Condition(E2C),time) ->
 6157% Happens(Start(E2),time).
 6158not(holds_at(active(e2), Time)), not(holds_at(completed(d), Time-1)), holds_at(completed(d), Time), holds_at(condition(e2c), Time) ->
 6159	happens(start(e2), Time).
 6160
 6161% 
 6162% ectest/ec_reader_test_examples.e:3139
 6163% 
 6164% Delta:
 6165directive(delta).
 6166
 6167 
 6168% ectest/ec_reader_test_examples.e:3140
 6169% [time]% 
 6170% !HoldsAt(Active(E3),time) &
 6171% !HoldsAt(Completed(D),time-1) &
 6172% HoldsAt(Completed(D),time) &
 6173% HoldsAt(Condition(E3C),time) ->
 6174% Happens(Start(E3),time).
 6175not(holds_at(active(e3), Time)), not(holds_at(completed(d), Time-1)), holds_at(completed(d), Time), holds_at(condition(e3c), Time) ->
 6176	happens(start(e3), Time).
 6177
 6178% 
 6179% ectest/ec_reader_test_examples.e:3146
 6180% 
 6181% ; XOR-join E1, E2, E3; F
 6182% Delta:
 6183directive(delta).
 6184
 6185 
 6186% ectest/ec_reader_test_examples.e:3148
 6187% [time]% 
 6188% !HoldsAt(Active(F),time) &
 6189% ((!HoldsAt(Completed(E1),time-1) & HoldsAt(Completed(E1),time))|
 6190%  (!HoldsAt(Completed(E2),time-1) & HoldsAt(Completed(E2),time))|
 6191%  (!HoldsAt(Completed(E3),time-1) & HoldsAt(Completed(E3),time))) ->
 6192% Happens(Start(F),time).
 6193not(holds_at(active(f), Time)), (not(holds_at(completed(e1), Time-1)), holds_at(completed(e1), Time);not(holds_at(completed(e2), Time-1)), holds_at(completed(e2), Time);not(holds_at(completed(e3), Time-1)), holds_at(completed(e3), Time)) ->
 6194	happens(start(f), Time).
 6195
 6196% 
 6197% ectest/ec_reader_test_examples.e:3154
 6198% 
 6199% ; while (FC) F; G
 6200% Delta:
 6201directive(delta).
 6202
 6203 
 6204% ectest/ec_reader_test_examples.e:3156
 6205% [time]% 
 6206% !HoldsAt(Active(F),time) &
 6207% !HoldsAt(Completed(F),time-1) &
 6208% HoldsAt(Completed(F),time) &
 6209% HoldsAt(Condition(FC),time) ->
 6210% Happens(Start(F),time).
 6211not(holds_at(active(f), Time)), not(holds_at(completed(f), Time-1)), holds_at(completed(f), Time), holds_at(condition(fc), Time) ->
 6212	happens(start(f), Time).
 6213
 6214% 
 6215% ectest/ec_reader_test_examples.e:3162
 6216% 
 6217% Delta:
 6218directive(delta).
 6219
 6220 
 6221% ectest/ec_reader_test_examples.e:3163
 6222% [time]% 
 6223% !HoldsAt(Active(G),time) &
 6224% !HoldsAt(Completed(F),time-1) &
 6225% HoldsAt(Completed(F),time) &
 6226% !HoldsAt(Condition(FC),time) ->
 6227% Happens(Start(G),time).
 6228not(holds_at(active(g), Time)), not(holds_at(completed(f), Time-1)), holds_at(completed(f), Time), not(holds_at(condition(fc), Time)) ->
 6229	happens(start(g), Time).
 6230
 6231% 
 6232% ectest/ec_reader_test_examples.e:3169
 6233% 
 6234% Delta:
 6235directive(delta).
 6236
 6237 % Happens(Start(A),0).
 6238happens(start(a), 0).
 6239
 6240% 
 6241% Delta:
 6242directive(delta).
 6243
 6244 % Happens(End(A),1).
 6245happens(end(a), 1).
 6246
 6247% 
 6248% Delta:
 6249directive(delta).
 6250
 6251 % Happens(End(B),3).
 6252happens(end(b), 3).
 6253
 6254% 
 6255% Delta:
 6256directive(delta).
 6257
 6258 % Happens(End(C1),5).
 6259happens(end(c1), 5).
 6260
 6261% 
 6262% Delta:
 6263directive(delta).
 6264
 6265 % Happens(End(C2),6).
 6266happens(end(c2), 6).
 6267
 6268% 
 6269% ectest/ec_reader_test_examples.e:3175
 6270% Delta:
 6271directive(delta).
 6272
 6273 % Happens(End(C3),7).
 6274happens(end(c3), 7).
 6275
 6276% 
 6277% Delta:
 6278directive(delta).
 6279
 6280 % Happens(End(D),9).
 6281happens(end(d), 9).
 6282
 6283% 
 6284% Delta:
 6285directive(delta).
 6286
 6287 % Happens(End(E2),11).
 6288happens(end(e2), 11).
 6289
 6290% 
 6291% Delta:
 6292directive(delta).
 6293
 6294 % Happens(End(F),13).
 6295happens(end(f), 13).
 6296
 6297% 
 6298% Delta:
 6299directive(delta).
 6300
 6301 % Happens(End(F),15).
 6302happens(end(f), 15).
 6303
 6304% 
 6305% 
 6306% ; Gamma
 6307% ectest/ec_reader_test_examples.e:3182
 6308% 
 6309% ectest/ec_reader_test_examples.e:3183
 6310% [activity] % !HoldsAt(Active(activity),0).
 6311not(holds_at(active(Activity), 0)).
 6312
 6313% 
 6314% ectest/ec_reader_test_examples.e:3184
 6315% [activity] % !HoldsAt(Completed(activity),0).
 6316not(holds_at(completed(Activity), 0)).
 6317
 6318% 
 6319% ectest/ec_reader_test_examples.e:3185
 6320% [time] % time=% 14 <-> HoldsAt(Condition(FC),time).
 6321Time=14 <->
 6322	holds_at(condition(fc), Time).
 6323
 6324% 
 6325% ectest/ec_reader_test_examples.e:3186
 6326% [time] % !HoldsAt(Condition(E1C),time).
 6327not(holds_at(condition(e1c), Time)).
 6328
 6329% 
 6330% ectest/ec_reader_test_examples.e:3187
 6331% [time] % time=% 10 <-> HoldsAt(Condition(E2C),time).
 6332Time=10 <->
 6333	holds_at(condition(e2c), Time).
 6334
 6335% 
 6336% ectest/ec_reader_test_examples.e:3188
 6337% [time] % !HoldsAt(Condition(E3C),time).
 6338not(holds_at(condition(e3c), Time)).
 6339
 6340% 
 6341% 
 6342% completion Delta Happens
 6343completion(delta).
 6344
 6345completion(happens).
 6346
 6347% 
 6348% range time 0 18
 6349range(time, 0, 18).
 6350
 6351% range offset 1 1
 6352range(offset, 1, 1).
 6353
 6354% ectest/ec_reader_test_examples.e:3194
 6355% 
 6356% ; End of file.
 6357% 
 6358% 
 6359% 
 6360% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6361% ; FILE: examples/Mueller2006/Chapter6/ThielscherCircuit1.e
 6362% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6363% ;
 6364% ; Copyright (c) 2005 IBM Corporation and others.
 6365% ; All rights reserved. This program and the accompanying materials
 6366% ; are made available under the terms of the Common Public License v1.0
 6367% ; which accompanies this distribution, and is available at
 6368% ; http://www.eclipse.org/legal/cpl-v10.html
 6369% ;
 6370% ; Contributors:
 6371% ; IBM - Initial implementation
 6372% ;
 6373% ; @article{Thielscher:1997,
 6374% ;   author = "Michael Thielscher",
 6375% ;   year = "1997",
 6376% ;   title = "Ramification and causality",
 6377% ;   journal = "Artificial Intelligence",
 6378% ;   volume = "89",
 6379% ;   pages = "317--364",
 6380% ; }
 6381% ;
 6382% ; @book{Mueller:2006,
 6383% ;   author = "Erik T. Mueller",
 6384% ;   year = "2006",
 6385% ;   title = "Commonsense Reasoning",
 6386% ;   address = "San Francisco",
 6387% ;   publisher = "Morgan Kaufmann/Elsevier",
 6388% ; }
 6389% ;
 6390% ectest/ec_reader_test_examples.e:3229
 6391% 
 6392% load foundations/Root.e
 6393load('foundations/Root.e').
 6394
 6395% load foundations/EC.e
 6396load('foundations/EC.e').
 6397
 6398% load foundations/ECCausal.e
 6399load('foundations/ECCausal.e').
 6400
 6401% 
 6402% sort switch
 6403sort(switch).
 6404
 6405% ectest/ec_reader_test_examples.e:3235
 6406% sort relay
 6407sort(relay).
 6408
 6409% sort light
 6410sort(light).
 6411
 6412% 
 6413% switch S1, S2, S3
 6414t(switch, s1).
 6415
 6416t(switch, s2).
 6417
 6418t(switch, s3).
 6419
 6420% relay R
 6421t(relay, r).
 6422
 6423% light L
 6424t(light, l).
 6425
 6426% ectest/ec_reader_test_examples.e:3241
 6427% 
 6428% event Light(light)
 6429event(light(light)).
 6430
 6431% event Close(switch)
 6432event(close(switch)).
 6433
 6434% event Open(switch)
 6435event(open(switch)).
 6436
 6437% event Activate(relay)
 6438event(activate(relay)).
 6439
 6440% 
 6441% ectest/ec_reader_test_examples.e:3247
 6442% fluent Lit(light)
 6443fluent(lit(light)).
 6444
 6445% fluent Closed(switch)
 6446fluent(closed(switch)).
 6447
 6448% fluent Activated(relay)
 6449fluent(activated(relay)).
 6450
 6451% 
 6452% ectest/ec_reader_test_examples.e:3251
 6453% [time]% 
 6454% Stopped(Lit(L),time) &
 6455% Initiated(Closed(S1),time) &
 6456% Initiated(Closed(S2),time) ->
 6457% Happens(Light(L),time).
 6458stopped(lit(l), Time), initiated(closed(s1), Time), initiated(closed(s2), Time) ->
 6459	happens(light(l), Time).
 6460
 6461% 
 6462% 
 6463% ectest/ec_reader_test_examples.e:3257
 6464% [time]% 
 6465% Started(Closed(S2),time) &
 6466% Initiated(Activated(R),time) ->
 6467% Happens(Open(S2),time).
 6468started(closed(s2), Time), initiated(activated(r), Time) ->
 6469	happens(open(s2), Time).
 6470
 6471% 
 6472% 
 6473% ectest/ec_reader_test_examples.e:3262
 6474% [time]% 
 6475% Stopped(Activated(R),time) &
 6476% Initiated(Closed(S1),time) &
 6477% Initiated(Closed(S3),time) ->
 6478% Happens(Activate(R),time).
 6479stopped(activated(r), Time), initiated(closed(s1), Time), initiated(closed(s3), Time) ->
 6480	happens(activate(r), Time).
 6481
 6482% 
 6483% 
 6484% ectest/ec_reader_test_examples.e:3268
 6485% [switch,time] % Initiates(Close(switch),Closed(switch),time).
 6486initiates(close(Switch), closed(Switch), Time).
 6487
 6488% 
 6489% ectest/ec_reader_test_examples.e:3269
 6490% [switch,time] % Terminates(Open(switch),Closed(switch),time).
 6491terminates(open(Switch), closed(Switch), Time).
 6492
 6493% 
 6494% ectest/ec_reader_test_examples.e:3270
 6495% [relay,time] % Initiates(Activate(relay),Activated(relay),time).
 6496initiates(activate(Relay), activated(Relay), Time).
 6497
 6498% 
 6499% ectest/ec_reader_test_examples.e:3271
 6500% [light,time] % Initiates(Light(light),Lit(light),time).
 6501initiates(light(Light), lit(Light), Time).
 6502
 6503% 
 6504% 
 6505% !HoldsAt(Closed(S1),0).
 6506not(holds_at(closed(s1), 0)).
 6507
 6508% 
 6509% HoldsAt(Closed(S2),0).
 6510holds_at(closed(s2), 0).
 6511
 6512% 
 6513% HoldsAt(Closed(S3),0).
 6514holds_at(closed(s3), 0).
 6515
 6516% 
 6517% !HoldsAt(Activated(R),0).
 6518not(holds_at(activated(r), 0)).
 6519
 6520% 
 6521% ectest/ec_reader_test_examples.e:3277
 6522% !HoldsAt(Lit(L),0).
 6523not(holds_at(lit(l), 0)).
 6524
 6525% 
 6526% 
 6527% Happens(Close(S1),0).
 6528happens(close(s1), 0).
 6529
 6530% 
 6531% 
 6532% completion Happens
 6533completion(happens).
 6534
 6535% 
 6536% ectest/ec_reader_test_examples.e:3283
 6537% range time 0 1
 6538range(time, 0, 1).
 6539
 6540% range offset 1 1
 6541range(offset, 1, 1).
 6542
 6543% 
 6544% ; End of file.
 6545% 
 6546% 
 6547% ectest/ec_reader_test_examples.e:3289
 6548% 
 6549% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6550% ; FILE: examples/Mueller2006/Chapter6/CarryingABook1.e
 6551% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6552% ;
 6553% ; Copyright (c) 2005 IBM Corporation and others.
 6554% ; All rights reserved. This program and the accompanying materials
 6555% ; are made available under the terms of the Common Public License v1.0
 6556% ; which accompanies this distribution, and is available at
 6557% ; http://www.eclipse.org/legal/cpl-v10.html
 6558% ;
 6559% ; Contributors:
 6560% ; IBM - Initial implementation
 6561% ;
 6562% ; Example: Carrying a Book (Effect Axioms)
 6563% ;
 6564% ; @book{Mueller:2006,
 6565% ;   author = "Erik T. Mueller",
 6566% ;   year = "2006",
 6567% ;   title = "Commonsense Reasoning",
 6568% ;   address = "San Francisco",
 6569% ;   publisher = "Morgan Kaufmann/Elsevier",
 6570% ; }
 6571% ;
 6572% ;
 6573% ectest/ec_reader_test_examples.e:3314
 6574% 
 6575% option modeldiff on
 6576option(modeldiff, on).
 6577
 6578% 
 6579% load foundations/Root.e
 6580load('foundations/Root.e').
 6581
 6582% load foundations/EC.e
 6583load('foundations/EC.e').
 6584
 6585% 
 6586% ectest/ec_reader_test_examples.e:3320
 6587% sort object
 6588sort(object).
 6589
 6590% sort agent: object
 6591subsort(agent, object).
 6592
 6593% sort room
 6594sort(room).
 6595
 6596% 
 6597% object Book
 6598t(object, book).
 6599
 6600% agent Nathan
 6601t(agent, nathan).
 6602
 6603% ectest/ec_reader_test_examples.e:3326
 6604% room LivingRoom, Kitchen
 6605t(room, livingRoom).
 6606
 6607t(room, kitchen).
 6608
 6609% 
 6610% event LetGoOf(agent,object)
 6611event(letGoOf(agent, object)).
 6612
 6613% event PickUp(agent,object)
 6614event(pickUp(agent, object)).
 6615
 6616% event Walk(agent,room,room)
 6617event(walk(agent, room, room)).
 6618
 6619% 
 6620% ectest/ec_reader_test_examples.e:3332
 6621% fluent InRoom(object,room)
 6622fluent(inRoom(object, room)).
 6623
 6624% fluent Holding(agent,object)
 6625fluent(holding(agent, object)).
 6626
 6627% 
 6628% ; Sigma
 6629% 
 6630% ectest/ec_reader_test_examples.e:3337
 6631% [agent,room1,room2,time]% 
 6632% Initiates(Walk(agent,room1,room2),InRoom(agent,room2),time).
 6633initiates(walk(Agent, Room1, Room2), inRoom(Agent, Room2), Time).
 6634
 6635% 
 6636% 
 6637% ectest/ec_reader_test_examples.e:3340
 6638% [agent,room1,room2,time]% 
 6639% room1!=% room2 ->
 6640% Terminates(Walk(agent,room1,room2),InRoom(agent,room1),time).
 6641Room1\=Room2 ->
 6642	terminates(walk(Agent, Room1, Room2),
 6643		   inRoom(Agent, Room1),
 6644		   Time).
 6645
 6646% 
 6647% 
 6648% ectest/ec_reader_test_examples.e:3344
 6649% [agent,object,room,time]% 
 6650% HoldsAt(InRoom(agent,room),time) &
 6651% HoldsAt(InRoom(object,room),time) ->
 6652% Initiates(PickUp(agent,object),Holding(agent,object),time).
 6653holds_at(inRoom(Agent, Room), Time), holds_at(inRoom(Object, Room), Time) ->
 6654	initiates(pickUp(Agent, Object),
 6655		  holding(Agent, Object),
 6656		  Time).
 6657
 6658% 
 6659% 
 6660% ectest/ec_reader_test_examples.e:3349
 6661% [agent,object,time]% 
 6662% HoldsAt(Holding(agent,object),time) ->
 6663% Terminates(LetGoOf(agent,object),Holding(agent,object),time).
 6664holds_at(holding(Agent, Object), Time) ->
 6665	terminates(letGoOf(Agent, Object),
 6666		   holding(Agent, Object),
 6667		   Time).
 6668
 6669% 
 6670% 
 6671% ectest/ec_reader_test_examples.e:3353
 6672% [agent,object,room1,room2,time]% 
 6673% HoldsAt(Holding(agent,object),time) ->
 6674% Initiates(Walk(agent,room1,room2),InRoom(object,room2),time).
 6675holds_at(holding(Agent, Object), Time) ->
 6676	initiates(walk(Agent, Room1, Room2),
 6677		  inRoom(Object, Room2),
 6678		  Time).
 6679
 6680% 
 6681% 
 6682% ectest/ec_reader_test_examples.e:3357
 6683% [agent,object,room1,room2,time]% 
 6684% HoldsAt(Holding(agent,object),time) &
 6685% room1!=room2 ->
 6686% Terminates(Walk(agent,room1,room2),InRoom(object,room1),time).
 6687holds_at(holding(Agent, Object), Time), Room1\=Room2 ->
 6688	terminates(walk(Agent, Room1, Room2),
 6689		   inRoom(Object, Room1),
 6690		   Time).
 6691
 6692% 
 6693% 
 6694% ; Delta
 6695% ectest/ec_reader_test_examples.e:3363
 6696% 
 6697% Happens(PickUp(Nathan,Book),0).
 6698happens(pickUp(nathan, book), 0).
 6699
 6700% 
 6701% Happens(Walk(Nathan,LivingRoom,Kitchen),1).
 6702happens(walk(nathan, livingRoom, kitchen), 1).
 6703
 6704% 
 6705% 
 6706% ; Psi
 6707% 
 6708% ectest/ec_reader_test_examples.e:3369
 6709% [object,room1,room2,time]% 
 6710% HoldsAt(InRoom(object,room1),time) &
 6711% HoldsAt(InRoom(object,room2),time) ->
 6712% room1=room2.
 6713holds_at(inRoom(Object, Room1), Time), holds_at(inRoom(Object, Room2), Time) ->
 6714	Room1=Room2.
 6715
 6716% 
 6717% 
 6718% ; Gamma
 6719% ectest/ec_reader_test_examples.e:3375
 6720% 
 6721% HoldsAt(InRoom(Nathan,LivingRoom),0).
 6722holds_at(inRoom(nathan, livingRoom), 0).
 6723
 6724% 
 6725% HoldsAt(InRoom(Book,LivingRoom),0).
 6726holds_at(inRoom(book, livingRoom), 0).
 6727
 6728% 
 6729% 
 6730% ; added:
 6731% !HoldsAt(Holding(Nathan,Book),0).
 6732not(holds_at(holding(nathan, book), 0)).
 6733
 6734% 
 6735% ectest/ec_reader_test_examples.e:3381
 6736% [agent,time] % !HoldsAt(Holding(agent,agent),time).
 6737not(holds_at(holding(Agent, Agent), Time)).
 6738
 6739% 
 6740% 
 6741% completion Happens
 6742completion(happens).
 6743
 6744% 
 6745% range time 0 2
 6746range(time, 0, 2).
 6747
 6748% range offset 1 1
 6749range(offset, 1, 1).
 6750
 6751% ectest/ec_reader_test_examples.e:3387
 6752% 
 6753% ; End of file.
 6754% 
 6755% 
 6756% 
 6757% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6758% ; FILE: examples/Mueller2006/Chapter6/ThielscherCircuit2.e
 6759% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6760% ;
 6761% ; Copyright (c) 2005 IBM Corporation and others.
 6762% ; All rights reserved. This program and the accompanying materials
 6763% ; are made available under the terms of the Common Public License v1.0
 6764% ; which accompanies this distribution, and is available at
 6765% ; http://www.eclipse.org/legal/cpl-v10.html
 6766% ;
 6767% ; Contributors:
 6768% ; IBM - Initial implementation
 6769% ;
 6770% ; @article{Thielscher:1997,
 6771% ;   author = "Michael Thielscher",
 6772% ;   year = "1997",
 6773% ;   title = "Ramification and causality",
 6774% ;   journal = "Artificial Intelligence",
 6775% ;   volume = "89",
 6776% ;   pages = "317--364",
 6777% ; }
 6778% ;
 6779% ; @book{Mueller:2006,
 6780% ;   author = "Erik T. Mueller",
 6781% ;   year = "2006",
 6782% ;   title = "Commonsense Reasoning",
 6783% ;   address = "San Francisco",
 6784% ;   publisher = "Morgan Kaufmann/Elsevier",
 6785% ; }
 6786% ;
 6787% ectest/ec_reader_test_examples.e:3422
 6788% 
 6789% load foundations/Root.e
 6790load('foundations/Root.e').
 6791
 6792% load foundations/EC.e
 6793load('foundations/EC.e').
 6794
 6795% 
 6796% sort switch
 6797sort(switch).
 6798
 6799% sort relay
 6800sort(relay).
 6801
 6802% ectest/ec_reader_test_examples.e:3428
 6803% sort light
 6804sort(light).
 6805
 6806% 
 6807% switch S1, S2, S3
 6808t(switch, s1).
 6809
 6810t(switch, s2).
 6811
 6812t(switch, s3).
 6813
 6814% relay R
 6815t(relay, r).
 6816
 6817% light L
 6818t(light, l).
 6819
 6820% 
 6821% ectest/ec_reader_test_examples.e:3434
 6822% event Light(light)
 6823event(light(light)).
 6824
 6825% event Unlight(light)
 6826event(unlight(light)).
 6827
 6828% event Close(switch)
 6829event(close(switch)).
 6830
 6831% event Open(switch)
 6832event(open(switch)).
 6833
 6834% event Activate(relay)
 6835event(activate(relay)).
 6836
 6837% 
 6838% ectest/ec_reader_test_examples.e:3440
 6839% fluent Lit(light)
 6840fluent(lit(light)).
 6841
 6842% fluent Closed(switch)
 6843fluent(closed(switch)).
 6844
 6845% fluent Activated(relay)
 6846fluent(activated(relay)).
 6847
 6848% 
 6849% ectest/ec_reader_test_examples.e:3444
 6850% [time]% 
 6851% !HoldsAt(Lit(L),time) &
 6852% HoldsAt(Closed(S1),time) &
 6853% HoldsAt(Closed(S2),time) ->
 6854% Happens(Light(L),time).
 6855not(holds_at(lit(l), Time)), holds_at(closed(s1), Time), holds_at(closed(s2), Time) ->
 6856	happens(light(l), Time).
 6857
 6858% 
 6859% 
 6860% ectest/ec_reader_test_examples.e:3450
 6861% [time]% 
 6862% HoldsAt(Lit(L),time) &
 6863% (!HoldsAt(Closed(S1),time) | !HoldsAt(Closed(S2),time)) ->
 6864% Happens(Unlight(L),time).
 6865holds_at(lit(l), Time), (not(holds_at(closed(s1), Time));not(holds_at(closed(s2), Time))) ->
 6866	happens(unlight(l), Time).
 6867
 6868% 
 6869% 
 6870% ectest/ec_reader_test_examples.e:3455
 6871% [time]% 
 6872% HoldsAt(Closed(S2),time) &
 6873% HoldsAt(Activated(R),time) ->
 6874% Happens(Open(S2),time).
 6875holds_at(closed(s2), Time), holds_at(activated(r), Time) ->
 6876	happens(open(s2), Time).
 6877
 6878% 
 6879% 
 6880% ectest/ec_reader_test_examples.e:3460
 6881% [time]% 
 6882% !HoldsAt(Activated(R),time) &
 6883% HoldsAt(Closed(S1),time) &
 6884% HoldsAt(Closed(S3),time) ->
 6885% Happens(Activate(R),time).
 6886not(holds_at(activated(r), Time)), holds_at(closed(s1), Time), holds_at(closed(s3), Time) ->
 6887	happens(activate(r), Time).
 6888
 6889% 
 6890% 
 6891% ectest/ec_reader_test_examples.e:3466
 6892% [switch,time] % Initiates(Close(switch),Closed(switch),time).
 6893initiates(close(Switch), closed(Switch), Time).
 6894
 6895% 
 6896% ectest/ec_reader_test_examples.e:3467
 6897% [switch,time] % Terminates(Open(switch),Closed(switch),time).
 6898terminates(open(Switch), closed(Switch), Time).
 6899
 6900% 
 6901% ectest/ec_reader_test_examples.e:3468
 6902% [relay,time] % Initiates(Activate(relay),Activated(relay),time).
 6903initiates(activate(Relay), activated(Relay), Time).
 6904
 6905% 
 6906% ectest/ec_reader_test_examples.e:3469
 6907% [light,time] % Initiates(Light(light),Lit(light),time).
 6908initiates(light(Light), lit(Light), Time).
 6909
 6910% 
 6911% ectest/ec_reader_test_examples.e:3470
 6912% [light,time] % Terminates(Unlight(light),Lit(light),time).
 6913terminates(unlight(Light), lit(Light), Time).
 6914
 6915% 
 6916% 
 6917% !HoldsAt(Closed(S1),0).
 6918not(holds_at(closed(s1), 0)).
 6919
 6920% 
 6921% HoldsAt(Closed(S2),0).
 6922holds_at(closed(s2), 0).
 6923
 6924% 
 6925% HoldsAt(Closed(S3),0).
 6926holds_at(closed(s3), 0).
 6927
 6928% 
 6929% !HoldsAt(Activated(R),0).
 6930not(holds_at(activated(r), 0)).
 6931
 6932% 
 6933% ectest/ec_reader_test_examples.e:3476
 6934% !HoldsAt(Lit(L),0).
 6935not(holds_at(lit(l), 0)).
 6936
 6937% 
 6938% 
 6939% Happens(Close(S1),0).
 6940happens(close(s1), 0).
 6941
 6942% 
 6943% 
 6944% completion Happens
 6945completion(happens).
 6946
 6947% 
 6948% ectest/ec_reader_test_examples.e:3482
 6949% range time 0 4
 6950range(time, 0, 4).
 6951
 6952% range offset 1 1
 6953range(offset, 1, 1).
 6954
 6955% 
 6956% ; End of file.
 6957% 
 6958% 
 6959% ectest/ec_reader_test_examples.e:3488
 6960% 
 6961% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6962% ; FILE: examples/Mueller2006/Chapter6/ShanahanCircuit.e
 6963% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 6964% ;
 6965% ; Copyright (c) 2005 IBM Corporation and others.
 6966% ; All rights reserved. This program and the accompanying materials
 6967% ; are made available under the terms of the Common Public License v1.0
 6968% ; which accompanies this distribution, and is available at
 6969% ; http://www.eclipse.org/legal/cpl-v10.html
 6970% ;
 6971% ; Contributors:
 6972% ; IBM - Initial implementation
 6973% ;
 6974% ; @inproceedings{Shanahan:1999a,
 6975% ;   author = "Murray Shanahan",
 6976% ;   year = "1999",
 6977% ;   title = "The ramification problem in the event calculus",
 6978% ;   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",
 6979% ;   pages = "140--146",
 6980% ;   address = "San Mateo, CA",
 6981% ;   publisher = "Morgan Kaufmann",
 6982% ; }
 6983% ;
 6984% ; @book{Mueller:2006,
 6985% ;   author = "Erik T. Mueller",
 6986% ;   year = "2006",
 6987% ;   title = "Commonsense Reasoning",
 6988% ;   address = "San Francisco",
 6989% ;   publisher = "Morgan Kaufmann/Elsevier",
 6990% ; }
 6991% ;
 6992% ectest/ec_reader_test_examples.e:3520
 6993% 
 6994% load foundations/Root.e
 6995load('foundations/Root.e').
 6996
 6997% load foundations/EC.e
 6998load('foundations/EC.e').
 6999
 7000% 
 7001% sort switch
 7002sort(switch).
 7003
 7004% sort relay
 7005sort(relay).
 7006
 7007% ectest/ec_reader_test_examples.e:3526
 7008% sort light
 7009sort(light).
 7010
 7011% 
 7012% switch S1, S2, S3
 7013t(switch, s1).
 7014
 7015t(switch, s2).
 7016
 7017t(switch, s3).
 7018
 7019% relay R
 7020t(relay, r).
 7021
 7022% light L
 7023t(light, l).
 7024
 7025% 
 7026% ectest/ec_reader_test_examples.e:3532
 7027% event Light(light)
 7028event(light(light)).
 7029
 7030% event Unlight(light)
 7031event(unlight(light)).
 7032
 7033% event Close(switch)
 7034event(close(switch)).
 7035
 7036% event Open(switch)
 7037event(open(switch)).
 7038
 7039% event Activate(relay)
 7040event(activate(relay)).
 7041
 7042% event Deactivate(relay)
 7043event(deactivate(relay)).
 7044
 7045% ectest/ec_reader_test_examples.e:3538
 7046% 
 7047% fluent Lit(light)
 7048fluent(lit(light)).
 7049
 7050% fluent Closed(switch)
 7051fluent(closed(switch)).
 7052
 7053% fluent Activated(relay)
 7054fluent(activated(relay)).
 7055
 7056% 
 7057% ectest/ec_reader_test_examples.e:3543
 7058% [time]% 
 7059% !HoldsAt(Lit(L),time) &
 7060% HoldsAt(Closed(S1),time) &
 7061% HoldsAt(Closed(S2),time) ->
 7062% Happens(Light(L),time).
 7063not(holds_at(lit(l), Time)), holds_at(closed(s1), Time), holds_at(closed(s2), Time) ->
 7064	happens(light(l), Time).
 7065
 7066% 
 7067% 
 7068% ectest/ec_reader_test_examples.e:3549
 7069% [time]% 
 7070% HoldsAt(Lit(L),time) &
 7071% (!HoldsAt(Closed(S1),time) | !HoldsAt(Closed(S2),time)) ->
 7072% Happens(Unlight(L),time).
 7073holds_at(lit(l), Time), (not(holds_at(closed(s1), Time));not(holds_at(closed(s2), Time))) ->
 7074	happens(unlight(l), Time).
 7075
 7076% 
 7077% 
 7078% ectest/ec_reader_test_examples.e:3554
 7079% [time]% 
 7080% HoldsAt(Closed(S2),time) &
 7081% HoldsAt(Activated(R),time) ->
 7082% Happens(Open(S2),time).
 7083holds_at(closed(s2), Time), holds_at(activated(r), Time) ->
 7084	happens(open(s2), Time).
 7085
 7086% 
 7087% 
 7088% ectest/ec_reader_test_examples.e:3559
 7089% [time]% 
 7090% !HoldsAt(Activated(R),time) &
 7091% HoldsAt(Closed(S1),time) &
 7092% HoldsAt(Closed(S2),time) &
 7093% HoldsAt(Closed(S3),time) ->
 7094% Happens(Activate(R),time).
 7095not(holds_at(activated(r), Time)), holds_at(closed(s1), Time), holds_at(closed(s2), Time), holds_at(closed(s3), Time) ->
 7096	happens(activate(r), Time).
 7097
 7098% 
 7099% ectest/ec_reader_test_examples.e:3565
 7100% 
 7101% ectest/ec_reader_test_examples.e:3566
 7102% [time]% 
 7103% HoldsAt(Activated(R),time) &
 7104% (!HoldsAt(Closed(S1),time) |
 7105%  !HoldsAt(Closed(S2),time) |
 7106%  !HoldsAt(Closed(S3),time)) ->
 7107% Happens(Deactivate(R),time).
 7108holds_at(activated(r), Time), (not(holds_at(closed(s1), Time));not(holds_at(closed(s2), Time));not(holds_at(closed(s3), Time))) ->
 7109	happens(deactivate(r), Time).
 7110
 7111% 
 7112% ectest/ec_reader_test_examples.e:3572
 7113% 
 7114% ectest/ec_reader_test_examples.e:3573
 7115% [switch,time] % Initiates(Close(switch),Closed(switch),time).
 7116initiates(close(Switch), closed(Switch), Time).
 7117
 7118% 
 7119% ectest/ec_reader_test_examples.e:3574
 7120% [switch,time] % Terminates(Open(switch),Closed(switch),time).
 7121terminates(open(Switch), closed(Switch), Time).
 7122
 7123% 
 7124% ectest/ec_reader_test_examples.e:3575
 7125% [relay,time] % Initiates(Activate(relay),Activated(relay),time).
 7126initiates(activate(Relay), activated(Relay), Time).
 7127
 7128% 
 7129% ectest/ec_reader_test_examples.e:3576
 7130% [relay,time] % Terminates(Deactivate(relay),Activated(relay),time).
 7131terminates(deactivate(Relay), activated(Relay), Time).
 7132
 7133% 
 7134% ectest/ec_reader_test_examples.e:3577
 7135% [light,time] % Initiates(Light(light),Lit(light),time).
 7136initiates(light(Light), lit(Light), Time).
 7137
 7138% 
 7139% ectest/ec_reader_test_examples.e:3578
 7140% [light,time] % Terminates(Unlight(light),Lit(light),time).
 7141terminates(unlight(Light), lit(Light), Time).
 7142
 7143% 
 7144% 
 7145% !HoldsAt(Closed(S1),0).
 7146not(holds_at(closed(s1), 0)).
 7147
 7148% 
 7149% HoldsAt(Closed(S2),0).
 7150holds_at(closed(s2), 0).
 7151
 7152% 
 7153% HoldsAt(Closed(S3),0).
 7154holds_at(closed(s3), 0).
 7155
 7156% 
 7157% !HoldsAt(Activated(R),0).
 7158not(holds_at(activated(r), 0)).
 7159
 7160% 
 7161% ectest/ec_reader_test_examples.e:3584
 7162% !HoldsAt(Lit(L),0).
 7163not(holds_at(lit(l), 0)).
 7164
 7165% 
 7166% 
 7167% Happens(Close(S1),0).
 7168happens(close(s1), 0).
 7169
 7170% 
 7171% 
 7172% completion Happens
 7173completion(happens).
 7174
 7175% 
 7176% ectest/ec_reader_test_examples.e:3590
 7177% range time 0 4
 7178range(time, 0, 4).
 7179
 7180% range offset 1 1
 7181range(offset, 1, 1).
 7182
 7183% 
 7184% ; End of file.
 7185% 
 7186% 
 7187% ectest/ec_reader_test_examples.e:3596
 7188% 
 7189% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7190% ; FILE: examples/Mueller2006/Chapter6/CarryingABook2.e
 7191% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7192% ;
 7193% ; Copyright (c) 2005 IBM Corporation and others.
 7194% ; All rights reserved. This program and the accompanying materials
 7195% ; are made available under the terms of the Common Public License v1.0
 7196% ; which accompanies this distribution, and is available at
 7197% ; http://www.eclipse.org/legal/cpl-v10.html
 7198% ;
 7199% ; Contributors:
 7200% ; IBM - Initial implementation
 7201% ;
 7202% ; Example: Carrying a Book (Release Axioms and State Constraints)
 7203% ;
 7204% ; @book{Mueller:2006,
 7205% ;   author = "Erik T. Mueller",
 7206% ;   year = "2006",
 7207% ;   title = "Commonsense Reasoning",
 7208% ;   address = "San Francisco",
 7209% ;   publisher = "Morgan Kaufmann/Elsevier",
 7210% ; }
 7211% ;
 7212% ectest/ec_reader_test_examples.e:3620
 7213% 
 7214% load foundations/Root.e
 7215load('foundations/Root.e').
 7216
 7217% load foundations/EC.e
 7218load('foundations/EC.e').
 7219
 7220% 
 7221% sort object
 7222sort(object).
 7223
 7224% sort agent: object
 7225subsort(agent, object).
 7226
 7227% ectest/ec_reader_test_examples.e:3626
 7228% sort room
 7229sort(room).
 7230
 7231% 
 7232% object Book
 7233t(object, book).
 7234
 7235% agent Nathan
 7236t(agent, nathan).
 7237
 7238% room LivingRoom, Kitchen
 7239t(room, livingRoom).
 7240
 7241t(room, kitchen).
 7242
 7243% 
 7244% ectest/ec_reader_test_examples.e:3632
 7245% event LetGoOf(agent,object)
 7246event(letGoOf(agent, object)).
 7247
 7248% event PickUp(agent,object)
 7249event(pickUp(agent, object)).
 7250
 7251% event Walk(agent,room,room)
 7252event(walk(agent, room, room)).
 7253
 7254% 
 7255% fluent InRoom(object,room)
 7256fluent(inRoom(object, room)).
 7257
 7258% fluent Holding(agent,object)
 7259fluent(holding(agent, object)).
 7260
 7261% ectest/ec_reader_test_examples.e:3638
 7262% 
 7263% ; Sigma
 7264% 
 7265% ectest/ec_reader_test_examples.e:3641
 7266% [agent,room1,room2,time]% 
 7267% Initiates(Walk(agent,room1,room2),InRoom(agent,room2),time).
 7268initiates(walk(Agent, Room1, Room2), inRoom(Agent, Room2), Time).
 7269
 7270% 
 7271% 
 7272% ectest/ec_reader_test_examples.e:3644
 7273% [agent,room1,room2,time]% 
 7274% room1!=% room2 ->
 7275% Terminates(Walk(agent,room1,room2),InRoom(agent,room1),time).
 7276Room1\=Room2 ->
 7277	terminates(walk(Agent, Room1, Room2),
 7278		   inRoom(Agent, Room1),
 7279		   Time).
 7280
 7281% 
 7282% 
 7283% ectest/ec_reader_test_examples.e:3648
 7284% [agent,object,room,time]% 
 7285% HoldsAt(InRoom(agent,room),time) &
 7286% HoldsAt(InRoom(object,room),time) ->
 7287% Initiates(PickUp(agent,object),Holding(agent,object),time).
 7288holds_at(inRoom(Agent, Room), Time), holds_at(inRoom(Object, Room), Time) ->
 7289	initiates(pickUp(Agent, Object),
 7290		  holding(Agent, Object),
 7291		  Time).
 7292
 7293% 
 7294% 
 7295% ectest/ec_reader_test_examples.e:3653
 7296% [agent,object,time]% 
 7297% HoldsAt(Holding(agent,object),time) ->
 7298% Terminates(LetGoOf(agent,object),Holding(agent,object),time).
 7299holds_at(holding(Agent, Object), Time) ->
 7300	terminates(letGoOf(Agent, Object),
 7301		   holding(Agent, Object),
 7302		   Time).
 7303
 7304% 
 7305% 
 7306% ectest/ec_reader_test_examples.e:3657
 7307% [agent,object,room,time]% 
 7308% Releases(PickUp(agent,object),InRoom(object,room),time).
 7309releases(pickUp(Agent, Object), inRoom(Object, Room), Time).
 7310
 7311% 
 7312% 
 7313% ectest/ec_reader_test_examples.e:3660
 7314% [agent,object,room,time]% 
 7315% HoldsAt(InRoom(agent,room),time) ->
 7316% Initiates(LetGoOf(agent,object),InRoom(object,room),time).
 7317holds_at(inRoom(Agent, Room), Time) ->
 7318	initiates(letGoOf(Agent, Object),
 7319		  inRoom(Object, Room),
 7320		  Time).
 7321
 7322% 
 7323% 
 7324% ; Delta
 7325% 
 7326% ectest/ec_reader_test_examples.e:3666
 7327% Happens(PickUp(Nathan,Book),0).
 7328happens(pickUp(nathan, book), 0).
 7329
 7330% 
 7331% Happens(Walk(Nathan,LivingRoom,Kitchen),1).
 7332happens(walk(nathan, livingRoom, kitchen), 1).
 7333
 7334% 
 7335% 
 7336% ; Psi
 7337% 
 7338% ectest/ec_reader_test_examples.e:3671
 7339% [object,room1,room2,time]% 
 7340% HoldsAt(InRoom(object,room1),time) &
 7341% HoldsAt(InRoom(object,room2),time) ->
 7342% room1=room2.
 7343holds_at(inRoom(Object, Room1), Time), holds_at(inRoom(Object, Room2), Time) ->
 7344	Room1=Room2.
 7345
 7346% 
 7347% 
 7348% ectest/ec_reader_test_examples.e:3676
 7349% [agent,object,room,time]% 
 7350% HoldsAt(Holding(agent,object),time) &
 7351% HoldsAt(InRoom(agent,room),time) ->
 7352% HoldsAt(InRoom(object,room),time).
 7353holds_at(holding(Agent, Object), Time), holds_at(inRoom(Agent, Room), Time) ->
 7354	holds_at(inRoom(Object, Room), Time).
 7355
 7356% 
 7357% 
 7358% ; Gamma
 7359% ectest/ec_reader_test_examples.e:3682
 7360% 
 7361% HoldsAt(InRoom(Nathan,LivingRoom),0).
 7362holds_at(inRoom(nathan, livingRoom), 0).
 7363
 7364% 
 7365% HoldsAt(InRoom(Book,LivingRoom),0).
 7366holds_at(inRoom(book, livingRoom), 0).
 7367
 7368% 
 7369% 
 7370% ; added:
 7371% !HoldsAt(Holding(Nathan,Book),0).
 7372not(holds_at(holding(nathan, book), 0)).
 7373
 7374% 
 7375% ectest/ec_reader_test_examples.e:3688
 7376% [agent,time] % !HoldsAt(Holding(agent,agent),time).
 7377not(holds_at(holding(Agent, Agent), Time)).
 7378
 7379% 
 7380% 
 7381% completion Happens
 7382completion(happens).
 7383
 7384% 
 7385% range time 0 2
 7386range(time, 0, 2).
 7387
 7388% range offset 1 1
 7389range(offset, 1, 1).
 7390
 7391% ectest/ec_reader_test_examples.e:3694
 7392% 
 7393% ; End of file.
 7394% 
 7395% 
 7396% 
 7397% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7398% ; FILE: examples/Mueller2006/Chapter7/HotAirBalloon.e
 7399% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7400% ;
 7401% ; Copyright (c) 2005 IBM Corporation and others.
 7402% ; All rights reserved. This program and the accompanying materials
 7403% ; are made available under the terms of the Common Public License v1.0
 7404% ; which accompanies this distribution, and is available at
 7405% ; http://www.eclipse.org/legal/cpl-v10.html
 7406% ;
 7407% ; Contributors:
 7408% ; IBM - Initial implementation
 7409% ;
 7410% ; @article{MillerShanahan:1999,
 7411% ;   author = "Rob Miller and Murray Shanahan",
 7412% ;   year = "1999",
 7413% ;   title = "The event calculus in classical logic---\uppercase{A}lternative axiomatisations",
 7414% ;   journal = "Link{\"{o}}ping Electronic Articles in Computer and Information Science",
 7415% ;   volume = "4",
 7416% ;   number = "016",
 7417% ; }
 7418% ;
 7419% ; @book{Mueller:2006,
 7420% ;   author = "Erik T. Mueller",
 7421% ;   year = "2006",
 7422% ;   title = "Commonsense Reasoning",
 7423% ;   address = "San Francisco",
 7424% ;   publisher = "Morgan Kaufmann/Elsevier",
 7425% ; }
 7426% ;
 7427% ectest/ec_reader_test_examples.e:3729
 7428% 
 7429% option encoding 3
 7430option(encoding, 3).
 7431
 7432% option trajectory on
 7433option(trajectory, on).
 7434
 7435% 
 7436% load foundations/Root.e
 7437load('foundations/Root.e').
 7438
 7439% load foundations/EC.e
 7440load('foundations/EC.e').
 7441
 7442% ectest/ec_reader_test_examples.e:3735
 7443% 
 7444% sort balloon
 7445sort(balloon).
 7446
 7447% sort agent
 7448sort(agent).
 7449
 7450% sort height: integer
 7451subsort(height, integer).
 7452
 7453% 
 7454% agent Nathan
 7455t(agent, nathan).
 7456
 7457% ectest/ec_reader_test_examples.e:3741
 7458% balloon Balloon
 7459t(balloon, balloon).
 7460
 7461% 
 7462% fluent HeaterOn(balloon)
 7463fluent(heaterOn(balloon)).
 7464
 7465% fluent Height(balloon,height)
 7466fluent(height(balloon, height)).
 7467
 7468% noninertial Height
 7469noninertial(height).
 7470
 7471% 
 7472% ectest/ec_reader_test_examples.e:3747
 7473% event TurnOnHeater(agent,balloon)
 7474event(turnOnHeater(agent, balloon)).
 7475
 7476% event TurnOffHeater(agent,balloon)
 7477event(turnOffHeater(agent, balloon)).
 7478
 7479% 
 7480% ; Sigma
 7481% 
 7482% ectest/ec_reader_test_examples.e:3752
 7483% [agent,balloon,time]% 
 7484% Initiates(TurnOnHeater(agent,balloon),HeaterOn(balloon),time).
 7485initiates(turnOnHeater(Agent, Balloon), heaterOn(Balloon), Time).
 7486
 7487% 
 7488% 
 7489% ectest/ec_reader_test_examples.e:3755
 7490% [agent,balloon,time]% 
 7491% Terminates(TurnOffHeater(agent,balloon),HeaterOn(balloon),time).
 7492terminates(turnOffHeater(Agent, Balloon), heaterOn(Balloon), Time).
 7493
 7494% 
 7495% 
 7496% ; Delta
 7497% 
 7498% Delta:
 7499directive(delta).
 7500
 7501 % Happens(TurnOnHeater(Nathan,Balloon),0).
 7502happens(turnOnHeater(nathan, balloon), 0).
 7503
 7504% 
 7505% ectest/ec_reader_test_examples.e:3761
 7506% Delta:
 7507directive(delta).
 7508
 7509 % Happens(TurnOffHeater(Nathan,Balloon),2).
 7510happens(turnOffHeater(nathan, balloon), 2).
 7511
 7512% 
 7513% 
 7514% ; Psi
 7515% 
 7516% ectest/ec_reader_test_examples.e:3765
 7517% [balloon,height1,height2,time]% 
 7518% HoldsAt(Height(balloon,height1),time) &
 7519% HoldsAt(Height(balloon,height2),time) ->
 7520% height1=height2.
 7521holds_at(height(Balloon, Height1), Time), holds_at(height(Balloon, Height2), Time) ->
 7522	Height1=Height2.
 7523
 7524% 
 7525% 
 7526% ; Pi
 7527% ectest/ec_reader_test_examples.e:3771
 7528% 
 7529% ectest/ec_reader_test_examples.e:3772
 7530% [balloon,height1,height2,offset,time]% 
 7531% HoldsAt(Height(balloon,height1),time) &
 7532% height2 = (height1 + offset) ->
 7533% Trajectory(HeaterOn(balloon),time,Height(balloon,height2),offset).
 7534holds_at(height(Balloon, Height1), Time), Height2=Height1+Offset ->
 7535	trajectory(heaterOn(Balloon),
 7536		   Time,
 7537		   height(Balloon, Height2),
 7538		   Offset).
 7539
 7540% 
 7541% 
 7542% ectest/ec_reader_test_examples.e:3777
 7543% [balloon,height1,height2,offset,time]% 
 7544% HoldsAt(Height(balloon,height1),time) &
 7545% height2 = (height1 - offset) ->
 7546% AntiTrajectory(HeaterOn(balloon),time,Height(balloon,height2),offset).
 7547holds_at(height(Balloon, Height1), Time), Height2=Height1-Offset ->
 7548	antiTrajectory(heaterOn(Balloon),
 7549		       Time,
 7550		       height(Balloon, Height2),
 7551		       Offset).
 7552
 7553% 
 7554% 
 7555% ; Gamma
 7556% ectest/ec_reader_test_examples.e:3783
 7557% 
 7558% HoldsAt(Height(Balloon,0),0).
 7559holds_at(height(balloon, 0), 0).
 7560
 7561% 
 7562% 
 7563% ; added:
 7564% !HoldsAt(HeaterOn(Balloon),0).
 7565not(holds_at(heaterOn(balloon), 0)).
 7566
 7567% 
 7568% 
 7569% ectest/ec_reader_test_examples.e:3789
 7570% completion Delta Happens
 7571completion(delta).
 7572
 7573completion(happens).
 7574
 7575% 
 7576% range time 0 3
 7577range(time, 0, 3).
 7578
 7579% range height 0 2
 7580range(height, 0, 2).
 7581
 7582% range offset 1 2
 7583range(offset, 1, 2).
 7584
 7585% 
 7586% ; End of file.
 7587% ectest/ec_reader_test_examples.e:3796
 7588% 
 7589% 
 7590% 
 7591% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7592% ; FILE: examples/Mueller2006/Chapter7/FallingObjectWithEvents.e
 7593% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7594% ;
 7595% ; Copyright (c) 2005 IBM Corporation and others.
 7596% ; All rights reserved. This program and the accompanying materials
 7597% ; are made available under the terms of the Common Public License v1.0
 7598% ; which accompanies this distribution, and is available at
 7599% ; http://www.eclipse.org/legal/cpl-v10.html
 7600% ;
 7601% ; Contributors:
 7602% ; IBM - Initial implementation
 7603% ;
 7604% ; @book{Mueller:2006,
 7605% ;   author = "Erik T. Mueller",
 7606% ;   year = "2006",
 7607% ;   title = "Commonsense Reasoning",
 7608% ;   address = "San Francisco",
 7609% ;   publisher = "Morgan Kaufmann/Elsevier",
 7610% ; }
 7611% ;
 7612% ectest/ec_reader_test_examples.e:3820
 7613% 
 7614% load foundations/Root.e
 7615load('foundations/Root.e').
 7616
 7617% load foundations/EC.e
 7618load('foundations/EC.e').
 7619
 7620% 
 7621% sort object
 7622sort(object).
 7623
 7624% sort agent
 7625sort(agent).
 7626
 7627% ectest/ec_reader_test_examples.e:3826
 7628% sort height: integer
 7629subsort(height, integer).
 7630
 7631% 
 7632% agent Nathan
 7633t(agent, nathan).
 7634
 7635% object Apple
 7636t(object, apple).
 7637
 7638% 
 7639% fluent Falling(object)
 7640fluent(falling(object)).
 7641
 7642% ectest/ec_reader_test_examples.e:3832
 7643% fluent Height(object,height)
 7644fluent(height(object, height)).
 7645
 7646% 
 7647% event Drop(agent,object)
 7648event(drop(agent, object)).
 7649
 7650% event HitGround(object)
 7651event(hitGround(object)).
 7652
 7653% 
 7654% ; Sigma
 7655% ectest/ec_reader_test_examples.e:3838
 7656% 
 7657% ectest/ec_reader_test_examples.e:3839
 7658% [agent,object,time]% 
 7659% Initiates(Drop(agent,object),Falling(object),time).
 7660initiates(drop(Agent, Object), falling(Object), Time).
 7661
 7662% 
 7663% 
 7664% ectest/ec_reader_test_examples.e:3842
 7665% [agent,object,height,time]% 
 7666% Releases(Drop(agent,object),Height(object,height),time).
 7667releases(drop(Agent, Object), height(Object, Height), Time).
 7668
 7669% 
 7670% 
 7671% ectest/ec_reader_test_examples.e:3845
 7672% [object,time]% 
 7673% Terminates(HitGround(object),Falling(object),time).
 7674terminates(hitGround(Object), falling(Object), Time).
 7675
 7676% 
 7677% 
 7678% ectest/ec_reader_test_examples.e:3848
 7679% [object,height,time]% 
 7680% HoldsAt(Height(object,height),time) ->
 7681% Initiates(HitGround(object),Height(object,height),time).
 7682holds_at(height(Object, Height), Time) ->
 7683	initiates(hitGround(Object),
 7684		  height(Object, Height),
 7685		  Time).
 7686
 7687% 
 7688% 
 7689% ; Delta
 7690% 
 7691% ectest/ec_reader_test_examples.e:3854
 7692% Delta:
 7693directive(delta).
 7694
 7695 
 7696% ectest/ec_reader_test_examples.e:3854
 7697% [object,time]% 
 7698% HoldsAt(Falling(object),time) &
 7699% HoldsAt(Height(object,0),time) ->
 7700% Happens(HitGround(object),time).
 7701holds_at(falling(Object), Time), holds_at(height(Object, 0), Time) ->
 7702	happens(hitGround(Object), Time).
 7703
 7704% 
 7705% 
 7706% Delta:
 7707directive(delta).
 7708
 7709 % Happens(Drop(Nathan,Apple),0).
 7710happens(drop(nathan, apple), 0).
 7711
 7712% 
 7713% ectest/ec_reader_test_examples.e:3860
 7714% 
 7715% ; Psi
 7716% 
 7717% ectest/ec_reader_test_examples.e:3863
 7718% [object,height1,height2,time]% 
 7719% HoldsAt(Height(object,height1),time) &
 7720% HoldsAt(Height(object,height2),time) ->
 7721% height1=height2.
 7722holds_at(height(Object, Height1), Time), holds_at(height(Object, Height2), Time) ->
 7723	Height1=Height2.
 7724
 7725% 
 7726% 
 7727% ; Pi
 7728% ectest/ec_reader_test_examples.e:3869
 7729% 
 7730% ectest/ec_reader_test_examples.e:3870
 7731% [object,height1,height2,offset,time]% 
 7732% HoldsAt(Height(object,height1),time) &
 7733% height2 = (height1 - offset) ->
 7734% Trajectory(Falling(object),time,Height(object,height2),offset).
 7735holds_at(height(Object, Height1), Time), Height2=Height1-Offset ->
 7736	trajectory(falling(Object),
 7737		   Time,
 7738		   height(Object, Height2),
 7739		   Offset).
 7740
 7741% 
 7742% 
 7743% ; Gamma
 7744% ectest/ec_reader_test_examples.e:3876
 7745% 
 7746% !HoldsAt(Falling(Apple),0).
 7747not(holds_at(falling(apple), 0)).
 7748
 7749% 
 7750% HoldsAt(Height(Apple,3),0).
 7751holds_at(height(apple, 3), 0).
 7752
 7753% 
 7754% 
 7755% completion Delta Happens
 7756completion(delta).
 7757
 7758completion(happens).
 7759
 7760% 
 7761% ectest/ec_reader_test_examples.e:3882
 7762% range time 0 5
 7763range(time, 0, 5).
 7764
 7765% range height 0 3
 7766range(height, 0, 3).
 7767
 7768% range offset 1 3
 7769range(offset, 1, 3).
 7770
 7771% 
 7772% ; End of file.
 7773% 
 7774% ectest/ec_reader_test_examples.e:3888
 7775% 
 7776% 
 7777% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7778% ; FILE: examples/Mueller2006/Chapter7/FallingObjectWithAntiTrajectory.e
 7779% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7780% ;
 7781% ; Copyright (c) 2005 IBM Corporation and others.
 7782% ; All rights reserved. This program and the accompanying materials
 7783% ; are made available under the terms of the Common Public License v1.0
 7784% ; which accompanies this distribution, and is available at
 7785% ; http://www.eclipse.org/legal/cpl-v10.html
 7786% ;
 7787% ; Contributors:
 7788% ; IBM - Initial implementation
 7789% ;
 7790% ; @book{Mueller:2006,
 7791% ;   author = "Erik T. Mueller",
 7792% ;   year = "2006",
 7793% ;   title = "Commonsense Reasoning",
 7794% ;   address = "San Francisco",
 7795% ;   publisher = "Morgan Kaufmann/Elsevier",
 7796% ; }
 7797% ;
 7798% ectest/ec_reader_test_examples.e:3911
 7799% 
 7800% option encoding 3
 7801option(encoding, 3).
 7802
 7803% option trajectory on
 7804option(trajectory, on).
 7805
 7806% 
 7807% load foundations/Root.e
 7808load('foundations/Root.e').
 7809
 7810% load foundations/EC.e
 7811load('foundations/EC.e').
 7812
 7813% ectest/ec_reader_test_examples.e:3917
 7814% 
 7815% sort object
 7816sort(object).
 7817
 7818% sort agent
 7819sort(agent).
 7820
 7821% sort height: integer
 7822subsort(height, integer).
 7823
 7824% 
 7825% agent Nathan
 7826t(agent, nathan).
 7827
 7828% ectest/ec_reader_test_examples.e:3923
 7829% object Apple
 7830t(object, apple).
 7831
 7832% 
 7833% fluent Falling(object)
 7834fluent(falling(object)).
 7835
 7836% fluent Height(object,height)
 7837fluent(height(object, height)).
 7838
 7839% noninertial Height
 7840noninertial(height).
 7841
 7842% 
 7843% ectest/ec_reader_test_examples.e:3929
 7844% event Drop(agent,object)
 7845event(drop(agent, object)).
 7846
 7847% event HitGround(object)
 7848event(hitGround(object)).
 7849
 7850% 
 7851% ; Sigma
 7852% 
 7853% ectest/ec_reader_test_examples.e:3934
 7854% [agent,object,time]% 
 7855% Initiates(Drop(agent,object),Falling(object),time).
 7856initiates(drop(Agent, Object), falling(Object), Time).
 7857
 7858% 
 7859% 
 7860% ectest/ec_reader_test_examples.e:3937
 7861% [object,time]% 
 7862% Terminates(HitGround(object),Falling(object),time).
 7863terminates(hitGround(Object), falling(Object), Time).
 7864
 7865% 
 7866% 
 7867% ; Delta
 7868% 
 7869% Delta:
 7870directive(delta).
 7871
 7872 
 7873% ectest/ec_reader_test_examples.e:3942
 7874% [object,time]% 
 7875% HoldsAt(Falling(object),time) &
 7876% HoldsAt(Height(object,0),time) ->
 7877% Happens(HitGround(object),time).
 7878holds_at(falling(Object), Time), holds_at(height(Object, 0), Time) ->
 7879	happens(hitGround(Object), Time).
 7880
 7881% 
 7882% 
 7883% Delta:
 7884directive(delta).
 7885
 7886 % Happens(Drop(Nathan,Apple),0).
 7887happens(drop(nathan, apple), 0).
 7888
 7889% 
 7890% ectest/ec_reader_test_examples.e:3948
 7891% 
 7892% ; Psi
 7893% 
 7894% ectest/ec_reader_test_examples.e:3951
 7895% [object,height1,height2,time]% 
 7896% HoldsAt(Height(object,height1),time) &
 7897% HoldsAt(Height(object,height2),time) ->
 7898% height1=height2.
 7899holds_at(height(Object, Height1), Time), holds_at(height(Object, Height2), Time) ->
 7900	Height1=Height2.
 7901
 7902% 
 7903% 
 7904% ; Pi
 7905% ectest/ec_reader_test_examples.e:3957
 7906% 
 7907% ectest/ec_reader_test_examples.e:3958
 7908% [object,height1,height2,offset,time]% 
 7909% HoldsAt(Height(object,height1),time) &
 7910% height2 = (height1 - offset) ->
 7911% Trajectory(Falling(object),time,Height(object,height2),offset).
 7912holds_at(height(Object, Height1), Time), Height2=Height1-Offset ->
 7913	trajectory(falling(Object),
 7914		   Time,
 7915		   height(Object, Height2),
 7916		   Offset).
 7917
 7918% 
 7919% 
 7920% ectest/ec_reader_test_examples.e:3963
 7921% [object,height,offset,time]% 
 7922% HoldsAt(Height(object,height),time) ->
 7923% AntiTrajectory(Falling(object),time,Height(object,height),offset).
 7924holds_at(height(Object, Height), Time) ->
 7925	antiTrajectory(falling(Object),
 7926		       Time,
 7927		       height(Object, Height),
 7928		       Offset).
 7929
 7930% 
 7931% 
 7932% ; Gamma
 7933% 
 7934% ectest/ec_reader_test_examples.e:3969
 7935% !HoldsAt(Falling(Apple),0).
 7936not(holds_at(falling(apple), 0)).
 7937
 7938% 
 7939% HoldsAt(Height(Apple,3),0).
 7940holds_at(height(apple, 3), 0).
 7941
 7942% 
 7943% 
 7944% completion Delta Happens
 7945completion(delta).
 7946
 7947completion(happens).
 7948
 7949% 
 7950% range time 0 5
 7951range(time, 0, 5).
 7952
 7953% ectest/ec_reader_test_examples.e:3975
 7954% range height 0 3
 7955range(height, 0, 3).
 7956
 7957% range offset 1 3
 7958range(offset, 1, 3).
 7959
 7960% 
 7961% ; End of file.
 7962% 
 7963% 
 7964% ectest/ec_reader_test_examples.e:3981
 7965% 
 7966% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7967% ; FILE: examples/Mueller2006/Chapter3/Telephone2.e
 7968% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7969% ;
 7970% ; Copyright (c) 2005 IBM Corporation and others.
 7971% ; All rights reserved. This program and the accompanying materials
 7972% ; are made available under the terms of the Common Public License v1.0
 7973% ; which accompanies this distribution, and is available at
 7974% ; http://www.eclipse.org/legal/cpl-v10.html
 7975% ;
 7976% ; Contributors:
 7977% ; IBM - Initial implementation
 7978% ;
 7979% ; @book{Mueller:2006,
 7980% ;   author = "Erik T. Mueller",
 7981% ;   year = "2006",
 7982% ;   title = "Commonsense Reasoning",
 7983% ;   address = "San Francisco",
 7984% ;   publisher = "Morgan Kaufmann/Elsevier",
 7985% ; }
 7986% ;
 7987% ectest/ec_reader_test_examples.e:4003
 7988% 
 7989% load foundations/Root.e
 7990load('foundations/Root.e').
 7991
 7992% load foundations/EC.e
 7993load('foundations/EC.e').
 7994
 7995% 
 7996% sort agent
 7997sort(agent).
 7998
 7999% sort phone
 8000sort(phone).
 8001
 8002% ectest/ec_reader_test_examples.e:4009
 8003% 
 8004% agent Agent1, Agent2
 8005t(agent, agent1).
 8006
 8007t(agent, agent2).
 8008
 8009% phone Phone1, Phone2
 8010t(phone, phone1).
 8011
 8012t(phone, phone2).
 8013
 8014% 
 8015% fluent Ringing(phone,phone)
 8016fluent(ringing(phone, phone)).
 8017
 8018% fluent DialTone(phone)
 8019fluent(dialTone(phone)).
 8020
 8021% ectest/ec_reader_test_examples.e:4015
 8022% fluent BusySignal(phone)
 8023fluent(busySignal(phone)).
 8024
 8025% fluent Idle(phone)
 8026fluent(idle(phone)).
 8027
 8028% fluent Connected(phone,phone)
 8029fluent(connected(phone, phone)).
 8030
 8031% fluent Disconnected(phone)
 8032fluent(disconnected(phone)).
 8033
 8034% 
 8035% event PickUp(agent,phone)
 8036event(pickUp(agent, phone)).
 8037
 8038% ectest/ec_reader_test_examples.e:4021
 8039% event SetDown(agent,phone)
 8040event(setDown(agent, phone)).
 8041
 8042% event Dial(agent,phone,phone)
 8043event(dial(agent, phone, phone)).
 8044
 8045% 
 8046% ; Sigma
 8047% 
 8048% ectest/ec_reader_test_examples.e:4026
 8049% [agent,phone,time]% 
 8050% HoldsAt(Idle(phone),time) ->
 8051% Initiates(PickUp(agent,phone),DialTone(phone),time).
 8052holds_at(idle(Phone), Time) ->
 8053	initiates(pickUp(Agent, Phone),
 8054		  dialTone(Phone),
 8055		  Time).
 8056
 8057% 
 8058% 
 8059% ectest/ec_reader_test_examples.e:4030
 8060% [agent,phone,time]% 
 8061% HoldsAt(Idle(phone),time) ->
 8062% Terminates(PickUp(agent,phone),Idle(phone),time).
 8063holds_at(idle(Phone), Time) ->
 8064	terminates(pickUp(Agent, Phone),
 8065		   idle(Phone),
 8066		   Time).
 8067
 8068% 
 8069% 
 8070% ectest/ec_reader_test_examples.e:4034
 8071% [agent,phone,time]% 
 8072% HoldsAt(DialTone(phone),time) ->
 8073% Initiates(SetDown(agent,phone),Idle(phone),time).
 8074holds_at(dialTone(Phone), Time) ->
 8075	initiates(setDown(Agent, Phone),
 8076		  idle(Phone),
 8077		  Time).
 8078
 8079% 
 8080% 
 8081% ectest/ec_reader_test_examples.e:4038
 8082% [agent,phone,time]% 
 8083% HoldsAt(DialTone(phone),time) ->
 8084% Terminates(SetDown(agent,phone),DialTone(phone),time).
 8085holds_at(dialTone(Phone), Time) ->
 8086	terminates(setDown(Agent, Phone),
 8087		   dialTone(Phone),
 8088		   Time).
 8089
 8090% 
 8091% 
 8092% ectest/ec_reader_test_examples.e:4042
 8093% [agent,phone1,phone2,time]% 
 8094% HoldsAt(DialTone(phone1),time) &
 8095% HoldsAt(Idle(phone2),time) ->
 8096% Initiates(Dial(agent,phone1,phone2),Ringing(phone1,phone2),time).
 8097holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
 8098	initiates(dial(Agent, Phone1, Phone2),
 8099		  ringing(Phone1, Phone2),
 8100		  Time).
 8101
 8102% 
 8103% 
 8104% ectest/ec_reader_test_examples.e:4047
 8105% [agent,phone1,phone2,time]% 
 8106% HoldsAt(DialTone(phone1),time) &
 8107% HoldsAt(Idle(phone2),time) ->
 8108% Terminates(Dial(agent,phone1,phone2),DialTone(phone1),time).
 8109holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
 8110	terminates(dial(Agent, Phone1, Phone2),
 8111		   dialTone(Phone1),
 8112		   Time).
 8113
 8114% 
 8115% 
 8116% ectest/ec_reader_test_examples.e:4052
 8117% [agent,phone1,phone2,time]% 
 8118% HoldsAt(DialTone(phone1),time) &
 8119% HoldsAt(Idle(phone2),time) ->
 8120% Terminates(Dial(agent,phone1,phone2),Idle(phone2),time).
 8121holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
 8122	terminates(dial(Agent, Phone1, Phone2),
 8123		   idle(Phone2),
 8124		   Time).
 8125
 8126% 
 8127% 
 8128% ectest/ec_reader_test_examples.e:4057
 8129% [agent,phone1,phone2,time]% 
 8130% HoldsAt(DialTone(phone1),time) &
 8131% !HoldsAt(Idle(phone2),time) ->
 8132% Initiates(Dial(agent,phone1,phone2),BusySignal(phone1),time).
 8133holds_at(dialTone(Phone1), Time), not(holds_at(idle(Phone2), Time)) ->
 8134	initiates(dial(Agent, Phone1, Phone2),
 8135		  busySignal(Phone1),
 8136		  Time).
 8137
 8138% 
 8139% 
 8140% ectest/ec_reader_test_examples.e:4062
 8141% [agent,phone1,phone2,time]% 
 8142% HoldsAt(DialTone(phone1),time) &
 8143% !HoldsAt(Idle(phone2),time) ->
 8144% Terminates(Dial(agent,phone1,phone2),DialTone(phone1),time).
 8145holds_at(dialTone(Phone1), Time), not(holds_at(idle(Phone2), Time)) ->
 8146	terminates(dial(Agent, Phone1, Phone2),
 8147		   dialTone(Phone1),
 8148		   Time).
 8149
 8150% 
 8151% 
 8152% ectest/ec_reader_test_examples.e:4067
 8153% [agent,phone,time]% 
 8154% HoldsAt(BusySignal(phone),time) ->
 8155% Initiates(SetDown(agent,phone),Idle(phone),time).
 8156holds_at(busySignal(Phone), Time) ->
 8157	initiates(setDown(Agent, Phone),
 8158		  idle(Phone),
 8159		  Time).
 8160
 8161% 
 8162% 
 8163% ectest/ec_reader_test_examples.e:4071
 8164% [agent,phone,time]% 
 8165% HoldsAt(BusySignal(phone),time) ->
 8166% Terminates(SetDown(agent,phone),BusySignal(phone),time).
 8167holds_at(busySignal(Phone), Time) ->
 8168	terminates(setDown(Agent, Phone),
 8169		   busySignal(Phone),
 8170		   Time).
 8171
 8172% 
 8173% 
 8174% ectest/ec_reader_test_examples.e:4075
 8175% [agent,phone1,phone2,time]% 
 8176% HoldsAt(Ringing(phone1,phone2),time) ->
 8177% Initiates(SetDown(agent,phone1),Idle(phone1),time).
 8178holds_at(ringing(Phone1, Phone2), Time) ->
 8179	initiates(setDown(Agent, Phone1),
 8180		  idle(Phone1),
 8181		  Time).
 8182
 8183% 
 8184% 
 8185% ectest/ec_reader_test_examples.e:4079
 8186% [agent,phone1,phone2,time]% 
 8187% HoldsAt(Ringing(phone1,phone2),time) ->
 8188% Initiates(SetDown(agent,phone1),Idle(phone2),time).
 8189holds_at(ringing(Phone1, Phone2), Time) ->
 8190	initiates(setDown(Agent, Phone1),
 8191		  idle(Phone2),
 8192		  Time).
 8193
 8194% 
 8195% 
 8196% ectest/ec_reader_test_examples.e:4083
 8197% [agent,phone1,phone2,time]% 
 8198% HoldsAt(Ringing(phone1,phone2),time) ->
 8199% Terminates(SetDown(agent,phone1),Ringing(phone1,phone2),time).
 8200holds_at(ringing(Phone1, Phone2), Time) ->
 8201	terminates(setDown(Agent, Phone1),
 8202		   ringing(Phone1, Phone2),
 8203		   Time).
 8204
 8205% 
 8206% 
 8207% ectest/ec_reader_test_examples.e:4087
 8208% [agent,phone1,phone2,time]% 
 8209% HoldsAt(Ringing(phone1,phone2),time) ->
 8210% Initiates(PickUp(agent,phone2),Connected(phone1,phone2),time).
 8211holds_at(ringing(Phone1, Phone2), Time) ->
 8212	initiates(pickUp(Agent, Phone2),
 8213		  connected(Phone1, Phone2),
 8214		  Time).
 8215
 8216% 
 8217% 
 8218% ectest/ec_reader_test_examples.e:4091
 8219% [agent,phone1,phone2,time]% 
 8220% HoldsAt(Ringing(phone1,phone2),time) ->
 8221% Terminates(PickUp(agent,phone2),Ringing(phone1,phone2),time).
 8222holds_at(ringing(Phone1, Phone2), Time) ->
 8223	terminates(pickUp(Agent, Phone2),
 8224		   ringing(Phone1, Phone2),
 8225		   Time).
 8226
 8227% 
 8228% 
 8229% ectest/ec_reader_test_examples.e:4095
 8230% [agent,phone1,phone2,time]% 
 8231% HoldsAt(Connected(phone1,phone2),time) ->
 8232% Initiates(SetDown(agent,phone1),Idle(phone1),time).
 8233holds_at(connected(Phone1, Phone2), Time) ->
 8234	initiates(setDown(Agent, Phone1),
 8235		  idle(Phone1),
 8236		  Time).
 8237
 8238% 
 8239% 
 8240% ectest/ec_reader_test_examples.e:4099
 8241% [agent,phone1,phone2,time]% 
 8242% HoldsAt(Connected(phone1,phone2),time) ->
 8243% Initiates(SetDown(agent,phone1),Disconnected(phone2),time).
 8244holds_at(connected(Phone1, Phone2), Time) ->
 8245	initiates(setDown(Agent, Phone1),
 8246		  disconnected(Phone2),
 8247		  Time).
 8248
 8249% 
 8250% 
 8251% ectest/ec_reader_test_examples.e:4103
 8252% [agent,phone1,phone2,time]% 
 8253% HoldsAt(Connected(phone1,phone2),time) ->
 8254% Terminates(SetDown(agent,phone1),Connected(phone1,phone2),time).
 8255holds_at(connected(Phone1, Phone2), Time) ->
 8256	terminates(setDown(Agent, Phone1),
 8257		   connected(Phone1, Phone2),
 8258		   Time).
 8259
 8260% 
 8261% 
 8262% ectest/ec_reader_test_examples.e:4107
 8263% [agent,phone1,phone2,time]% 
 8264% HoldsAt(Connected(phone1,phone2),time) ->
 8265% Initiates(SetDown(agent,phone2),Idle(phone2),time).
 8266holds_at(connected(Phone1, Phone2), Time) ->
 8267	initiates(setDown(Agent, Phone2),
 8268		  idle(Phone2),
 8269		  Time).
 8270
 8271% 
 8272% 
 8273% ectest/ec_reader_test_examples.e:4111
 8274% [agent,phone1,phone2,time]% 
 8275% HoldsAt(Connected(phone1,phone2),time) ->
 8276% Initiates(SetDown(agent,phone2),Disconnected(phone1),time).
 8277holds_at(connected(Phone1, Phone2), Time) ->
 8278	initiates(setDown(Agent, Phone2),
 8279		  disconnected(Phone1),
 8280		  Time).
 8281
 8282% 
 8283% 
 8284% ectest/ec_reader_test_examples.e:4115
 8285% [agent,phone1,phone2,time]% 
 8286% HoldsAt(Connected(phone1,phone2),time) ->
 8287% Terminates(SetDown(agent,phone2),Connected(phone1,phone2),time).
 8288holds_at(connected(Phone1, Phone2), Time) ->
 8289	terminates(setDown(Agent, Phone2),
 8290		   connected(Phone1, Phone2),
 8291		   Time).
 8292
 8293% 
 8294% 
 8295% ectest/ec_reader_test_examples.e:4119
 8296% [agent,phone,time]% 
 8297% HoldsAt(Disconnected(phone),time) ->
 8298% Initiates(SetDown(agent,phone),Idle(phone),time).
 8299holds_at(disconnected(Phone), Time) ->
 8300	initiates(setDown(Agent, Phone),
 8301		  idle(Phone),
 8302		  Time).
 8303
 8304% 
 8305% 
 8306% ectest/ec_reader_test_examples.e:4123
 8307% [agent,phone,time]% 
 8308% HoldsAt(Disconnected(phone),time) ->
 8309% Terminates(SetDown(agent,phone),Disconnected(phone),time).
 8310holds_at(disconnected(Phone), Time) ->
 8311	terminates(setDown(Agent, Phone),
 8312		   disconnected(Phone),
 8313		   Time).
 8314
 8315% 
 8316% 
 8317% ; Delta
 8318% 
 8319% ectest/ec_reader_test_examples.e:4129
 8320% Happens(PickUp(Agent1,Phone1),0).
 8321happens(pickUp(agent1, phone1), 0).
 8322
 8323% 
 8324% Happens(Dial(Agent1,Phone1,Phone2),1).
 8325happens(dial(agent1, phone1, phone2), 1).
 8326
 8327% 
 8328% Happens(PickUp(Agent2,Phone2),2).
 8329happens(pickUp(agent2, phone2), 2).
 8330
 8331% 
 8332% 
 8333% ; Psi
 8334% 
 8335% ectest/ec_reader_test_examples.e:4135
 8336% [phone,time]% 
 8337% !HoldsAt(Ringing(phone,phone),time).
 8338not(holds_at(ringing(Phone, Phone), Time)).
 8339
 8340% 
 8341% 
 8342% ectest/ec_reader_test_examples.e:4138
 8343% [phone1,phone2,time]% 
 8344% HoldsAt(Ringing(phone1,phone2),time) &
 8345% phone1!=phone2 ->
 8346% !HoldsAt(Ringing(phone2,phone1),time).
 8347holds_at(ringing(Phone1, Phone2), Time), Phone1\=Phone2 ->
 8348	not(holds_at(ringing(Phone2, Phone1), Time)).
 8349
 8350% 
 8351% 
 8352% ectest/ec_reader_test_examples.e:4143
 8353% [phone,time]% 
 8354% !HoldsAt(Connected(phone,phone),time).
 8355not(holds_at(connected(Phone, Phone), Time)).
 8356
 8357% 
 8358% 
 8359% ectest/ec_reader_test_examples.e:4146
 8360% [phone1,phone2,time]% 
 8361% HoldsAt(Connected(phone1,phone2),time) &
 8362% phone1!=phone2 ->
 8363% !HoldsAt(Connected(phone2,phone1),time).
 8364holds_at(connected(Phone1, Phone2), Time), Phone1\=Phone2 ->
 8365	not(holds_at(connected(Phone2, Phone1), Time)).
 8366
 8367% 
 8368% 
 8369% mutex Idle, DialTone, BusySignal, Disconnected
 8370mutex(idle).
 8371
 8372mutex(dialTone).
 8373
 8374mutex(busySignal).
 8375
 8376mutex(disconnected).
 8377
 8378% ectest/ec_reader_test_examples.e:4152
 8379% 
 8380% ectest/ec_reader_test_examples.e:4153
 8381% [phone1,phone2,time]% 
 8382% HoldsAt(Idle(phone1),time) ->
 8383% !HoldsAt(Ringing(phone1,phone2),time) &
 8384% !HoldsAt(Connected(phone1,phone2),time).
 8385holds_at(idle(Phone1), Time) ->
 8386	not(holds_at(ringing(Phone1, Phone2), Time)),
 8387	not(holds_at(connected(Phone1, Phone2), Time)).
 8388
 8389% 
 8390% 
 8391% ; etc.
 8392% ectest/ec_reader_test_examples.e:4159
 8393% 
 8394% ; Gamma
 8395% 
 8396% ectest/ec_reader_test_examples.e:4162
 8397% [phone] % HoldsAt(Idle(phone),0).
 8398holds_at(idle(Phone), 0).
 8399
 8400% 
 8401% 
 8402% completion Happens
 8403completion(happens).
 8404
 8405% 
 8406% range time 0 3
 8407range(time, 0, 3).
 8408
 8409% range offset 1 1
 8410range(offset, 1, 1).
 8411
 8412% ectest/ec_reader_test_examples.e:4168
 8413% 
 8414% ; End of file.
 8415% 
 8416% 
 8417% 
 8418% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 8419% ; FILE: examples/Mueller2006/Chapter3/Telephone1.e
 8420% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 8421% ;
 8422% ; Copyright (c) 2005 IBM Corporation and others.
 8423% ; All rights reserved. This program and the accompanying materials
 8424% ; are made available under the terms of the Common Public License v1.0
 8425% ; which accompanies this distribution, and is available at
 8426% ; http://www.eclipse.org/legal/cpl-v10.html
 8427% ;
 8428% ; Contributors:
 8429% ; IBM - Initial implementation
 8430% ;
 8431% ; @book{Mueller:2006,
 8432% ;   author = "Erik T. Mueller",
 8433% ;   year = "2006",
 8434% ;   title = "Commonsense Reasoning",
 8435% ;   address = "San Francisco",
 8436% ;   publisher = "Morgan Kaufmann/Elsevier",
 8437% ; }
 8438% ;
 8439% ectest/ec_reader_test_examples.e:4194
 8440% 
 8441% load foundations/Root.e
 8442load('foundations/Root.e').
 8443
 8444% load foundations/EC.e
 8445load('foundations/EC.e').
 8446
 8447% 
 8448% sort agent
 8449sort(agent).
 8450
 8451% sort phone
 8452sort(phone).
 8453
 8454% ectest/ec_reader_test_examples.e:4200
 8455% 
 8456% agent Agent1, Agent2
 8457t(agent, agent1).
 8458
 8459t(agent, agent2).
 8460
 8461% phone Phone1, Phone2
 8462t(phone, phone1).
 8463
 8464t(phone, phone2).
 8465
 8466% 
 8467% fluent Ringing(phone,phone)
 8468fluent(ringing(phone, phone)).
 8469
 8470% fluent DialTone(phone)
 8471fluent(dialTone(phone)).
 8472
 8473% ectest/ec_reader_test_examples.e:4206
 8474% fluent BusySignal(phone)
 8475fluent(busySignal(phone)).
 8476
 8477% fluent Idle(phone)
 8478fluent(idle(phone)).
 8479
 8480% fluent Connected(phone,phone)
 8481fluent(connected(phone, phone)).
 8482
 8483% fluent Disconnected(phone)
 8484fluent(disconnected(phone)).
 8485
 8486% 
 8487% event PickUp(agent,phone)
 8488event(pickUp(agent, phone)).
 8489
 8490% ectest/ec_reader_test_examples.e:4212
 8491% event SetDown(agent,phone)
 8492event(setDown(agent, phone)).
 8493
 8494% event Dial(agent,phone,phone)
 8495event(dial(agent, phone, phone)).
 8496
 8497% 
 8498% ; Sigma
 8499% 
 8500% ectest/ec_reader_test_examples.e:4217
 8501% [agent,phone,time]% 
 8502% HoldsAt(Idle(phone),time) ->
 8503% Initiates(PickUp(agent,phone),DialTone(phone),time).
 8504holds_at(idle(Phone), Time) ->
 8505	initiates(pickUp(Agent, Phone),
 8506		  dialTone(Phone),
 8507		  Time).
 8508
 8509% 
 8510% 
 8511% ectest/ec_reader_test_examples.e:4221
 8512% [agent,phone,time]% 
 8513% HoldsAt(Idle(phone),time) ->
 8514% Terminates(PickUp(agent,phone),Idle(phone),time).
 8515holds_at(idle(Phone), Time) ->
 8516	terminates(pickUp(Agent, Phone),
 8517		   idle(Phone),
 8518		   Time).
 8519
 8520% 
 8521% 
 8522% ectest/ec_reader_test_examples.e:4225
 8523% [agent,phone,time]% 
 8524% HoldsAt(DialTone(phone),time) ->
 8525% Initiates(SetDown(agent,phone),Idle(phone),time).
 8526holds_at(dialTone(Phone), Time) ->
 8527	initiates(setDown(Agent, Phone),
 8528		  idle(Phone),
 8529		  Time).
 8530
 8531% 
 8532% 
 8533% ectest/ec_reader_test_examples.e:4229
 8534% [agent,phone,time]% 
 8535% HoldsAt(DialTone(phone),time) ->
 8536% Terminates(SetDown(agent,phone),DialTone(phone),time).
 8537holds_at(dialTone(Phone), Time) ->
 8538	terminates(setDown(Agent, Phone),
 8539		   dialTone(Phone),
 8540		   Time).
 8541
 8542% 
 8543% 
 8544% ectest/ec_reader_test_examples.e:4233
 8545% [agent,phone1,phone2,time]% 
 8546% HoldsAt(DialTone(phone1),time) &
 8547% HoldsAt(Idle(phone2),time) ->
 8548% Initiates(Dial(agent,phone1,phone2),Ringing(phone1,phone2),time).
 8549holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
 8550	initiates(dial(Agent, Phone1, Phone2),
 8551		  ringing(Phone1, Phone2),
 8552		  Time).
 8553
 8554% 
 8555% 
 8556% ectest/ec_reader_test_examples.e:4238
 8557% [agent,phone1,phone2,time]% 
 8558% HoldsAt(DialTone(phone1),time) &
 8559% HoldsAt(Idle(phone2),time) ->
 8560% Terminates(Dial(agent,phone1,phone2),DialTone(phone1),time).
 8561holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
 8562	terminates(dial(Agent, Phone1, Phone2),
 8563		   dialTone(Phone1),
 8564		   Time).
 8565
 8566% 
 8567% 
 8568% ectest/ec_reader_test_examples.e:4243
 8569% [agent,phone1,phone2,time]% 
 8570% HoldsAt(DialTone(phone1),time) &
 8571% HoldsAt(Idle(phone2),time) ->
 8572% Terminates(Dial(agent,phone1,phone2),Idle(phone2),time).
 8573holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
 8574	terminates(dial(Agent, Phone1, Phone2),
 8575		   idle(Phone2),
 8576		   Time).
 8577
 8578% 
 8579% 
 8580% ectest/ec_reader_test_examples.e:4248
 8581% [agent,phone1,phone2,time]% 
 8582% HoldsAt(DialTone(phone1),time) &
 8583% !HoldsAt(Idle(phone2),time) ->
 8584% Initiates(Dial(agent,phone1,phone2),BusySignal(phone1),time).
 8585holds_at(dialTone(Phone1), Time), not(holds_at(idle(Phone2), Time)) ->
 8586	initiates(dial(Agent, Phone1, Phone2),
 8587		  busySignal(Phone1),
 8588		  Time).
 8589
 8590% 
 8591% 
 8592% ectest/ec_reader_test_examples.e:4253
 8593% [agent,phone1,phone2,time]% 
 8594% HoldsAt(DialTone(phone1),time) &
 8595% !HoldsAt(Idle(phone2),time) ->
 8596% Terminates(Dial(agent,phone1,phone2),DialTone(phone1),time).
 8597holds_at(dialTone(Phone1), Time), not(holds_at(idle(Phone2), Time)) ->
 8598	terminates(dial(Agent, Phone1, Phone2),
 8599		   dialTone(Phone1),
 8600		   Time).
 8601
 8602% 
 8603% 
 8604% ectest/ec_reader_test_examples.e:4258
 8605% [agent,phone,time]% 
 8606% HoldsAt(BusySignal(phone),time) ->
 8607% Initiates(SetDown(agent,phone),Idle(phone),time).
 8608holds_at(busySignal(Phone), Time) ->
 8609	initiates(setDown(Agent, Phone),
 8610		  idle(Phone),
 8611		  Time).
 8612
 8613% 
 8614% 
 8615% ectest/ec_reader_test_examples.e:4262
 8616% [agent,phone,time]% 
 8617% HoldsAt(BusySignal(phone),time) ->
 8618% Terminates(SetDown(agent,phone),BusySignal(phone),time).
 8619holds_at(busySignal(Phone), Time) ->
 8620	terminates(setDown(Agent, Phone),
 8621		   busySignal(Phone),
 8622		   Time).
 8623
 8624% 
 8625% 
 8626% ectest/ec_reader_test_examples.e:4266
 8627% [agent,phone1,phone2,time]% 
 8628% HoldsAt(Ringing(phone1,phone2),time) ->
 8629% Initiates(SetDown(agent,phone1),Idle(phone1),time).
 8630holds_at(ringing(Phone1, Phone2), Time) ->
 8631	initiates(setDown(Agent, Phone1),
 8632		  idle(Phone1),
 8633		  Time).
 8634
 8635% 
 8636% 
 8637% ectest/ec_reader_test_examples.e:4270
 8638% [agent,phone1,phone2,time]% 
 8639% HoldsAt(Ringing(phone1,phone2),time) ->
 8640% Initiates(SetDown(agent,phone1),Idle(phone2),time).
 8641holds_at(ringing(Phone1, Phone2), Time) ->
 8642	initiates(setDown(Agent, Phone1),
 8643		  idle(Phone2),
 8644		  Time).
 8645
 8646% 
 8647% 
 8648% ectest/ec_reader_test_examples.e:4274
 8649% [agent,phone1,phone2,time]% 
 8650% HoldsAt(Ringing(phone1,phone2),time) ->
 8651% Terminates(SetDown(agent,phone1),Ringing(phone1,phone2),time).
 8652holds_at(ringing(Phone1, Phone2), Time) ->
 8653	terminates(setDown(Agent, Phone1),
 8654		   ringing(Phone1, Phone2),
 8655		   Time).
 8656
 8657% 
 8658% 
 8659% ectest/ec_reader_test_examples.e:4278
 8660% [agent,phone1,phone2,time]% 
 8661% HoldsAt(Ringing(phone1,phone2),time) ->
 8662% Initiates(PickUp(agent,phone2),Connected(phone1,phone2),time).
 8663holds_at(ringing(Phone1, Phone2), Time) ->
 8664	initiates(pickUp(Agent, Phone2),
 8665		  connected(Phone1, Phone2),
 8666		  Time).
 8667
 8668% 
 8669% 
 8670% ectest/ec_reader_test_examples.e:4282
 8671% [agent,phone1,phone2,time]% 
 8672% HoldsAt(Ringing(phone1,phone2),time) ->
 8673% Terminates(PickUp(agent,phone2),Ringing(phone1,phone2),time).
 8674holds_at(ringing(Phone1, Phone2), Time) ->
 8675	terminates(pickUp(Agent, Phone2),
 8676		   ringing(Phone1, Phone2),
 8677		   Time).
 8678
 8679% 
 8680% 
 8681% ectest/ec_reader_test_examples.e:4286
 8682% [agent,phone1,phone2,time]% 
 8683% HoldsAt(Connected(phone1,phone2),time) ->
 8684% Initiates(SetDown(agent,phone1),Idle(phone1),time).
 8685holds_at(connected(Phone1, Phone2), Time) ->
 8686	initiates(setDown(Agent, Phone1),
 8687		  idle(Phone1),
 8688		  Time).
 8689
 8690% 
 8691% 
 8692% ectest/ec_reader_test_examples.e:4290
 8693% [agent,phone1,phone2,time]% 
 8694% HoldsAt(Connected(phone1,phone2),time) ->
 8695% Initiates(SetDown(agent,phone1),Disconnected(phone2),time).
 8696holds_at(connected(Phone1, Phone2), Time) ->
 8697	initiates(setDown(Agent, Phone1),
 8698		  disconnected(Phone2),
 8699		  Time).
 8700
 8701% 
 8702% 
 8703% ectest/ec_reader_test_examples.e:4294
 8704% [agent,phone1,phone2,time]% 
 8705% HoldsAt(Connected(phone1,phone2),time) ->
 8706% Terminates(SetDown(agent,phone1),Connected(phone1,phone2),time).
 8707holds_at(connected(Phone1, Phone2), Time) ->
 8708	terminates(setDown(Agent, Phone1),
 8709		   connected(Phone1, Phone2),
 8710		   Time).
 8711
 8712% 
 8713% 
 8714% ectest/ec_reader_test_examples.e:4298
 8715% [agent,phone1,phone2,time]% 
 8716% HoldsAt(Connected(phone1,phone2),time) ->
 8717% Initiates(SetDown(agent,phone2),Idle(phone2),time).
 8718holds_at(connected(Phone1, Phone2), Time) ->
 8719	initiates(setDown(Agent, Phone2),
 8720		  idle(Phone2),
 8721		  Time).
 8722
 8723% 
 8724% 
 8725% ectest/ec_reader_test_examples.e:4302
 8726% [agent,phone1,phone2,time]% 
 8727% HoldsAt(Connected(phone1,phone2),time) ->
 8728% Initiates(SetDown(agent,phone2),Disconnected(phone1),time).
 8729holds_at(connected(Phone1, Phone2), Time) ->
 8730	initiates(setDown(Agent, Phone2),
 8731		  disconnected(Phone1),
 8732		  Time).
 8733
 8734% 
 8735% 
 8736% ectest/ec_reader_test_examples.e:4306
 8737% [agent,phone1,phone2,time]% 
 8738% HoldsAt(Connected(phone1,phone2),time) ->
 8739% Terminates(SetDown(agent,phone2),Connected(phone1,phone2),time).
 8740holds_at(connected(Phone1, Phone2), Time) ->
 8741	terminates(setDown(Agent, Phone2),
 8742		   connected(Phone1, Phone2),
 8743		   Time).
 8744
 8745% 
 8746% 
 8747% ectest/ec_reader_test_examples.e:4310
 8748% [agent,phone,time]% 
 8749% HoldsAt(Disconnected(phone),time) ->
 8750% Initiates(SetDown(agent,phone),Idle(phone),time).
 8751holds_at(disconnected(Phone), Time) ->
 8752	initiates(setDown(Agent, Phone),
 8753		  idle(Phone),
 8754		  Time).
 8755
 8756% 
 8757% 
 8758% ectest/ec_reader_test_examples.e:4314
 8759% [agent,phone,time]% 
 8760% HoldsAt(Disconnected(phone),time) ->
 8761% Terminates(SetDown(agent,phone),Disconnected(phone),time).
 8762holds_at(disconnected(Phone), Time) ->
 8763	terminates(setDown(Agent, Phone),
 8764		   disconnected(Phone),
 8765		   Time).
 8766
 8767% 
 8768% 
 8769% ; Delta
 8770% 
 8771% ectest/ec_reader_test_examples.e:4320
 8772% Delta:
 8773directive(delta).
 8774
 8775 % Happens(PickUp(Agent1,Phone1),0).
 8776happens(pickUp(agent1, phone1), 0).
 8777
 8778% 
 8779% Delta:
 8780directive(delta).
 8781
 8782 % Happens(Dial(Agent1,Phone1,Phone2),1).
 8783happens(dial(agent1, phone1, phone2), 1).
 8784
 8785% 
 8786% Delta:
 8787directive(delta).
 8788
 8789 % Happens(PickUp(Agent2,Phone2),2).
 8790happens(pickUp(agent2, phone2), 2).
 8791
 8792% 
 8793% 
 8794% ; Gamma
 8795% 
 8796% ectest/ec_reader_test_examples.e:4326
 8797% [phone] % HoldsAt(Idle(phone),0).
 8798holds_at(idle(Phone), 0).
 8799
 8800% 
 8801% ectest/ec_reader_test_examples.e:4327
 8802% [phone] % !HoldsAt(DialTone(phone),0).
 8803not(holds_at(dialTone(Phone), 0)).
 8804
 8805% 
 8806% ectest/ec_reader_test_examples.e:4328
 8807% [phone] % !HoldsAt(BusySignal(phone),0).
 8808not(holds_at(busySignal(Phone), 0)).
 8809
 8810% 
 8811% ectest/ec_reader_test_examples.e:4329
 8812% [phone1,phone2] % !HoldsAt(Ringing(phone1,phone2),0).
 8813not(holds_at(ringing(Phone1, Phone2), 0)).
 8814
 8815% 
 8816% ectest/ec_reader_test_examples.e:4330
 8817% [phone1,phone2] % !HoldsAt(Connected(phone1,phone2),0).
 8818not(holds_at(connected(Phone1, Phone2), 0)).
 8819
 8820% 
 8821% ectest/ec_reader_test_examples.e:4331
 8822% [phone] % !HoldsAt(Disconnected(phone),0).
 8823not(holds_at(disconnected(Phone), 0)).
 8824
 8825% 
 8826% 
 8827% completion Delta Happens
 8828completion(delta).
 8829
 8830completion(happens).
 8831
 8832% 
 8833% range time 0 3
 8834range(time, 0, 3).
 8835
 8836% range offset 1 1
 8837range(offset, 1, 1).
 8838
 8839% ectest/ec_reader_test_examples.e:4337
 8840% 
 8841% ; End of file.
 8842% 
 8843% 
 8844% 
 8845% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 8846% ; FILE: examples/Mueller2006/Chapter12/DefaultLocation.e
 8847% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 8848% ;
 8849% ; Copyright (c) 2005 IBM Corporation and others.
 8850% ; All rights reserved. This program and the accompanying materials
 8851% ; are made available under the terms of the Common Public License v1.0
 8852% ; which accompanies this distribution, and is available at
 8853% ; http://www.eclipse.org/legal/cpl-v10.html
 8854% ;
 8855% ; Contributors:
 8856% ; IBM - Initial implementation
 8857% ;
 8858% ; @book{Mueller:2006,
 8859% ;   author = "Erik T. Mueller",
 8860% ;   year = "2006",
 8861% ;   title = "Commonsense Reasoning",
 8862% ;   address = "San Francisco",
 8863% ;   publisher = "Morgan Kaufmann/Elsevier",
 8864% ; }
 8865% ;
 8866% ectest/ec_reader_test_examples.e:4363
 8867% 
 8868% load foundations/Root.e
 8869load('foundations/Root.e').
 8870
 8871% load foundations/EC.e
 8872load('foundations/EC.e').
 8873
 8874% 
 8875% sort object
 8876sort(object).
 8877
 8878% sort agent: object
 8879subsort(agent, object).
 8880
 8881% ectest/ec_reader_test_examples.e:4369
 8882% sort device: object
 8883subsort(device, object).
 8884
 8885% sort tv: device
 8886subsort(tv, device).
 8887
 8888% sort room
 8889sort(room).
 8890
 8891% 
 8892% agent Nathan
 8893t(agent, nathan).
 8894
 8895% tv TV
 8896t(tv, tv).
 8897
 8898% ectest/ec_reader_test_examples.e:4375
 8899% room LivingRoom, Kitchen
 8900t(room, livingRoom).
 8901
 8902t(room, kitchen).
 8903
 8904% 
 8905% event TurnOn(agent,device)
 8906event(turnOn(agent, device)).
 8907
 8908% event Walk(agent,room,room)
 8909event(walk(agent, room, room)).
 8910
 8911% 
 8912% fluent InRoom(object,room)
 8913fluent(inRoom(object, room)).
 8914
 8915% ectest/ec_reader_test_examples.e:4381
 8916% fluent On(device)
 8917fluent(on(device)).
 8918
 8919% fluent PluggedIn(device)
 8920fluent(pluggedIn(device)).
 8921
 8922% fluent BrokenSwitch(device)
 8923fluent(brokenSwitch(device)).
 8924
 8925% 
 8926% predicate Ab1(device,time)
 8927predicate(ab1(device, time)).
 8928
 8929% predicate Ab2(room,time)
 8930predicate(ab2(room, time)).
 8931
 8932% ectest/ec_reader_test_examples.e:4387
 8933% 
 8934% ; Sigma
 8935% 
 8936% ectest/ec_reader_test_examples.e:4390
 8937% [agent,room1,room2,time]% 
 8938% Initiates(Walk(agent,room1,room2),InRoom(agent,room2),time).
 8939initiates(walk(Agent, Room1, Room2), inRoom(Agent, Room2), Time).
 8940
 8941% 
 8942% 
 8943% ectest/ec_reader_test_examples.e:4393
 8944% [agent,room1,room2,time]% 
 8945% room1!=% room2 ->
 8946% Terminates(Walk(agent,room1,room2),InRoom(agent,room1),time).
 8947Room1\=Room2 ->
 8948	terminates(walk(Agent, Room1, Room2),
 8949		   inRoom(Agent, Room1),
 8950		   Time).
 8951
 8952% 
 8953% 
 8954% ectest/ec_reader_test_examples.e:4397
 8955% [agent,device,time]% 
 8956% !Ab1(device,time) ->
 8957% Initiates(TurnOn(agent,device),On(device),time).
 8958not(ab1(Device, Time)) ->
 8959	initiates(turnOn(Agent, Device),
 8960		  on(Device),
 8961		  Time).
 8962
 8963% 
 8964% 
 8965% ; Delta
 8966% 
 8967% ectest/ec_reader_test_examples.e:4403
 8968% [agent,room1,room2,time]% 
 8969% Happens(Walk(agent,room1,room2),time) ->
 8970% room1!=room2 &
 8971% HoldsAt(InRoom(agent,room1),time).
 8972happens(walk(Agent, Room1, Room2), Time) ->
 8973	Room1\=Room2,
 8974	holds_at(inRoom(Agent, Room1), Time).
 8975
 8976% 
 8977% 
 8978% ectest/ec_reader_test_examples.e:4408
 8979% [agent,device,time]% 
 8980% Happens(TurnOn(agent,device),time) ->
 8981% ectest/ec_reader_test_examples.e:4410
 8982% {room}%  HoldsAt(InRoom(agent,room),time) &
 8983%        HoldsAt(InRoom(device,room),time).
 8984exists([Room],  (happens(turnOn(Agent, Device), Time)->holds_at(inRoom(Agent, Room), Time), holds_at(inRoom(Device, Room), Time))).
 8985
 8986% 
 8987% 
 8988% ectest/ec_reader_test_examples.e:4413
 8989% [event1,event2,time]% 
 8990% Happens(event1,time) &
 8991% Happens(event2,time) ->
 8992% event1=event2.
 8993happens(Event1, Time), happens(Event2, Time) ->
 8994	Event1=Event2.
 8995
 8996% 
 8997% 
 8998% ; Theta
 8999% ectest/ec_reader_test_examples.e:4419
 9000% 
 9001% Theta:
 9002directive(theta).
 9003
 9004 
 9005% ectest/ec_reader_test_examples.e:4420
 9006% [device,time] % HoldsAt(BrokenSwitch(device),time) -> Ab1(device,time).
 9007holds_at(brokenSwitch(Device), Time) ->
 9008	ab1(Device, Time).
 9009
 9010% 
 9011% Theta:
 9012directive(theta).
 9013
 9014 
 9015% ectest/ec_reader_test_examples.e:4421
 9016% [device,time] % !HoldsAt(PluggedIn(device),time) -> Ab1(device,time).
 9017not(holds_at(pluggedIn(Device), Time)) ->
 9018	ab1(Device, Time).
 9019
 9020% 
 9021% 
 9022% ; Psi
 9023% 
 9024% ectest/ec_reader_test_examples.e:4425
 9025% [object,room1,room2,time]% 
 9026% HoldsAt(InRoom(object,room1),time) &
 9027% HoldsAt(InRoom(object,room2),time) ->
 9028% room1=room2.
 9029holds_at(inRoom(Object, Room1), Time), holds_at(inRoom(Object, Room2), Time) ->
 9030	Room1=Room2.
 9031
 9032% 
 9033% 
 9034% ; Gamma
 9035% ectest/ec_reader_test_examples.e:4431
 9036% 
 9037% ectest/ec_reader_test_examples.e:4432
 9038% [tv] % !HoldsAt(On(tv),0).
 9039not(holds_at(on(Tv), 0)).
 9040
 9041% 
 9042% ectest/ec_reader_test_examples.e:4433
 9043% [tv] % !HoldsAt(BrokenSwitch(tv),0).
 9044not(holds_at(brokenSwitch(Tv), 0)).
 9045
 9046% 
 9047% ectest/ec_reader_test_examples.e:4434
 9048% [tv] % HoldsAt(PluggedIn(tv),0).
 9049holds_at(pluggedIn(Tv), 0).
 9050
 9051% 
 9052% 
 9053% HoldsAt(InRoom(Nathan,Kitchen),0).
 9054holds_at(inRoom(nathan, kitchen), 0).
 9055
 9056% 
 9057% 
 9058% ectest/ec_reader_test_examples.e:4438
 9059% [time]% 
 9060% !Ab2(LivingRoom,time) ->
 9061% ectest/ec_reader_test_examples.e:4440
 9062% {tv}%  HoldsAt(InRoom(tv,LivingRoom),time).
 9063exists([Tv],  (not(ab2(livingRoom, Time))->holds_at(inRoom(Tv, livingRoom), Time))).
 9064
 9065% 
 9066% 
 9067% ; goal
 9068% 
 9069% ectest/ec_reader_test_examples.e:4444
 9070% {tv} % Happens(TurnOn(Nathan,tv),1).
 9071exists([Tv], happens(turnOn(nathan, Tv), 1)).
 9072
 9073% 
 9074% 
 9075% ; for two TVs:
 9076% ;[tv,time] !HoldsAt(InRoom(tv,Kitchen),time).
 9077% ;[tv,time] {room} HoldsAt(InRoom(tv,room),time).
 9078% 
 9079% ectest/ec_reader_test_examples.e:4450
 9080% completion Theta Ab1
 9081completion(theta).
 9082
 9083completion(ab1).
 9084
 9085% completion Theta Ab2
 9086completion(theta).
 9087
 9088completion(ab2).
 9089
 9090% 
 9091% range time 0 2
 9092range(time, 0, 2).
 9093
 9094% range offset 1 1
 9095range(offset, 1, 1).
 9096
 9097% 
 9098% ; End of file.
 9099% ectest/ec_reader_test_examples.e:4457
 9100% 
 9101% 
 9102% 
 9103% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9104% ; FILE: examples/Mueller2006/Chapter12/Device.e
 9105% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9106% ;
 9107% ; Copyright (c) 2005 IBM Corporation and others.
 9108% ; All rights reserved. This program and the accompanying materials
 9109% ; are made available under the terms of the Common Public License v1.0
 9110% ; which accompanies this distribution, and is available at
 9111% ; http://www.eclipse.org/legal/cpl-v10.html
 9112% ;
 9113% ; Contributors:
 9114% ; IBM - Initial implementation
 9115% ;
 9116% ; @book{Mueller:2006,
 9117% ;   author = "Erik T. Mueller",
 9118% ;   year = "2006",
 9119% ;   title = "Commonsense Reasoning",
 9120% ;   address = "San Francisco",
 9121% ;   publisher = "Morgan Kaufmann/Elsevier",
 9122% ; }
 9123% ;
 9124% ectest/ec_reader_test_examples.e:4481
 9125% 
 9126% load foundations/Root.e
 9127load('foundations/Root.e').
 9128
 9129% load foundations/EC.e
 9130load('foundations/EC.e').
 9131
 9132% 
 9133% sort agent
 9134sort(agent).
 9135
 9136% sort device
 9137sort(device).
 9138
 9139% ectest/ec_reader_test_examples.e:4487
 9140% 
 9141% agent Nathan
 9142t(agent, nathan).
 9143
 9144% device Device1, AntiqueDevice1
 9145t(device, device1).
 9146
 9147t(device, antiqueDevice1).
 9148
 9149% 
 9150% predicate Ab1(device,time)
 9151predicate(ab1(device, time)).
 9152
 9153% 
 9154% ectest/ec_reader_test_examples.e:4493
 9155% fluent On(device)
 9156fluent(on(device)).
 9157
 9158% fluent PluggedIn(device)
 9159fluent(pluggedIn(device)).
 9160
 9161% fluent BrokenSwitch(device)
 9162fluent(brokenSwitch(device)).
 9163
 9164% 
 9165% event TurnOn(agent,device)
 9166event(turnOn(agent, device)).
 9167
 9168% 
 9169% ; Sigma
 9170% ectest/ec_reader_test_examples.e:4500
 9171% 
 9172% ectest/ec_reader_test_examples.e:4501
 9173% [agent,device,time]% 
 9174% !Ab1(device,time) ->
 9175% Initiates(TurnOn(agent,device),On(device),time).
 9176not(ab1(Device, Time)) ->
 9177	initiates(turnOn(Agent, Device),
 9178		  on(Device),
 9179		  Time).
 9180
 9181% 
 9182% 
 9183% ; Delta
 9184% 
 9185% ectest/ec_reader_test_examples.e:4507
 9186% Happens(TurnOn(Nathan,Device1),0).
 9187happens(turnOn(nathan, device1), 0).
 9188
 9189% 
 9190% 
 9191% ; Theta
 9192% 
 9193% Theta:
 9194directive(theta).
 9195
 9196 
 9197% ectest/ec_reader_test_examples.e:4511
 9198% [device,time] % HoldsAt(BrokenSwitch(device),time) -> Ab1(device,time).
 9199holds_at(brokenSwitch(Device), Time) ->
 9200	ab1(Device, Time).
 9201
 9202% 
 9203% Theta:
 9204directive(theta).
 9205
 9206 
 9207% ectest/ec_reader_test_examples.e:4512
 9208% [device,time] % !HoldsAt(PluggedIn(device),time) -> Ab1(device,time).
 9209not(holds_at(pluggedIn(Device), Time)) ->
 9210	ab1(Device, Time).
 9211
 9212% 
 9213% Theta:
 9214directive(theta).
 9215
 9216 
 9217% ectest/ec_reader_test_examples.e:4513
 9218% [time] % Ab1(AntiqueDevice1,time).
 9219ab1(antiqueDevice1, Time).
 9220
 9221% 
 9222% 
 9223% ; Gamma
 9224% 
 9225% !HoldsAt(On(Device1),0).
 9226not(holds_at(on(device1), 0)).
 9227
 9228% 
 9229% !HoldsAt(BrokenSwitch(Device1),0).
 9230not(holds_at(brokenSwitch(device1), 0)).
 9231
 9232% 
 9233% ectest/ec_reader_test_examples.e:4519
 9234% HoldsAt(PluggedIn(Device1),0).
 9235holds_at(pluggedIn(device1), 0).
 9236
 9237% 
 9238% 
 9239% ; added:
 9240% ectest/ec_reader_test_examples.e:4522
 9241% [time] % !HoldsAt(On(AntiqueDevice1),time).
 9242not(holds_at(on(antiqueDevice1), Time)).
 9243
 9244% 
 9245% ectest/ec_reader_test_examples.e:4523
 9246% [time] % HoldsAt(PluggedIn(AntiqueDevice1),time).
 9247holds_at(pluggedIn(antiqueDevice1), Time).
 9248
 9249% 
 9250% 
 9251% ; entailed:
 9252% ; HoldsAt(On(Device1),1).
 9253% 
 9254% completion Theta Ab1
 9255completion(theta).
 9256
 9257completion(ab1).
 9258
 9259% ectest/ec_reader_test_examples.e:4529
 9260% completion Happens
 9261completion(happens).
 9262
 9263% 
 9264% range time 0 1
 9265range(time, 0, 1).
 9266
 9267% range offset 1 1
 9268range(offset, 1, 1).
 9269
 9270% 
 9271% ; End of file.
 9272% ectest/ec_reader_test_examples.e:4535
 9273% 
 9274% 
 9275% 
 9276% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9277% ; FILE: examples/Mueller2006/Chapter12/ErraticDevice.e
 9278% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9279% ;
 9280% ; Copyright (c) 2005 IBM Corporation and others.
 9281% ; All rights reserved. This program and the accompanying materials
 9282% ; are made available under the terms of the Common Public License v1.0
 9283% ; which accompanies this distribution, and is available at
 9284% ; http://www.eclipse.org/legal/cpl-v10.html
 9285% ;
 9286% ; Contributors:
 9287% ; IBM - Initial implementation
 9288% ;
 9289% ; @book{Mueller:2006,
 9290% ;   author = "Erik T. Mueller",
 9291% ;   year = "2006",
 9292% ;   title = "Commonsense Reasoning",
 9293% ;   address = "San Francisco",
 9294% ;   publisher = "Morgan Kaufmann/Elsevier",
 9295% ; }
 9296% ;
 9297% ectest/ec_reader_test_examples.e:4559
 9298% 
 9299% load foundations/Root.e
 9300load('foundations/Root.e').
 9301
 9302% load foundations/EC.e
 9303load('foundations/EC.e').
 9304
 9305% 
 9306% sort agent
 9307sort(agent).
 9308
 9309% sort device
 9310sort(device).
 9311
 9312% ectest/ec_reader_test_examples.e:4565
 9313% 
 9314% agent Nathan
 9315t(agent, nathan).
 9316
 9317% device Device1
 9318t(device, device1).
 9319
 9320% 
 9321% predicate Ab1(device,time)
 9322predicate(ab1(device, time)).
 9323
 9324% 
 9325% ectest/ec_reader_test_examples.e:4571
 9326% fluent On(device)
 9327fluent(on(device)).
 9328
 9329% fluent PluggedIn(device)
 9330fluent(pluggedIn(device)).
 9331
 9332% fluent BrokenSwitch(device)
 9333fluent(brokenSwitch(device)).
 9334
 9335% fluent Erratic(device)
 9336fluent(erratic(device)).
 9337
 9338% 
 9339% fluent DeterminingFluent(device)
 9340fluent(determiningFluent(device)).
 9341
 9342% ectest/ec_reader_test_examples.e:4577
 9343% noninertial DeterminingFluent
 9344noninertial(determiningFluent).
 9345
 9346% 
 9347% event TurnOn(agent,device)
 9348event(turnOn(agent, device)).
 9349
 9350% 
 9351% ; Sigma
 9352% 
 9353% ectest/ec_reader_test_examples.e:4583
 9354% [agent,device,time]% 
 9355% !Ab1(device,time) ->
 9356% Initiates(TurnOn(agent,device),On(device),time).
 9357not(ab1(Device, Time)) ->
 9358	initiates(turnOn(Agent, Device),
 9359		  on(Device),
 9360		  Time).
 9361
 9362% 
 9363% 
 9364% ; Delta
 9365% 
 9366% ectest/ec_reader_test_examples.e:4589
 9367% Happens(TurnOn(Nathan,Device1),0).
 9368happens(turnOn(nathan, device1), 0).
 9369
 9370% 
 9371% 
 9372% ; Theta
 9373% 
 9374% 
 9375% Theta:
 9376directive(theta).
 9377
 9378 
 9379% ectest/ec_reader_test_examples.e:4594
 9380% [device,time] % HoldsAt(BrokenSwitch(device),time) -> Ab1(device,time).
 9381holds_at(brokenSwitch(Device), Time) ->
 9382	ab1(Device, Time).
 9383
 9384% 
 9385% Theta:
 9386directive(theta).
 9387
 9388 
 9389% ectest/ec_reader_test_examples.e:4595
 9390% [device,time]% 
 9391% HoldsAt(Erratic(device),time) & HoldsAt(DeterminingFluent(device),time) ->
 9392% Ab1(device,time).
 9393holds_at(erratic(Device), Time), holds_at(determiningFluent(Device), Time) ->
 9394	ab1(Device, Time).
 9395
 9396% 
 9397% 
 9398% Theta:
 9399directive(theta).
 9400
 9401 
 9402% ectest/ec_reader_test_examples.e:4599
 9403% [device,time] % !HoldsAt(PluggedIn(device),time) -> Ab1(device,time).
 9404not(holds_at(pluggedIn(Device), Time)) ->
 9405	ab1(Device, Time).
 9406
 9407% 
 9408% 
 9409% ; Gamma
 9410% 
 9411% !HoldsAt(On(Device1),0).
 9412not(holds_at(on(device1), 0)).
 9413
 9414% 
 9415% !HoldsAt(BrokenSwitch(Device1),0).
 9416not(holds_at(brokenSwitch(device1), 0)).
 9417
 9418% 
 9419% ectest/ec_reader_test_examples.e:4605
 9420% HoldsAt(Erratic(Device1),0).
 9421holds_at(erratic(device1), 0).
 9422
 9423% 
 9424% HoldsAt(PluggedIn(Device1),0).
 9425holds_at(pluggedIn(device1), 0).
 9426
 9427% 
 9428% 
 9429% ; added:
 9430% HoldsAt(DeterminingFluent(Device1),1).
 9431holds_at(determiningFluent(device1), 1).
 9432
 9433% 
 9434% 
 9435% ectest/ec_reader_test_examples.e:4611
 9436% completion Theta Ab1
 9437completion(theta).
 9438
 9439completion(ab1).
 9440
 9441% completion Happens
 9442completion(happens).
 9443
 9444% 
 9445% range time 0 1
 9446range(time, 0, 1).
 9447
 9448% range offset 1 1
 9449range(offset, 1, 1).
 9450
 9451% 
 9452% ; End of file.
 9453% ectest/ec_reader_test_examples.e:4618
 9454% 
 9455% 
 9456% 
 9457% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9458% ; FILE: examples/Mueller2006/Chapter12/DefaultEvent.e
 9459% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9460% ;
 9461% ; Copyright (c) 2005 IBM Corporation and others.
 9462% ; All rights reserved. This program and the accompanying materials
 9463% ; are made available under the terms of the Common Public License v1.0
 9464% ; which accompanies this distribution, and is available at
 9465% ; http://www.eclipse.org/legal/cpl-v10.html
 9466% ;
 9467% ; Contributors:
 9468% ; IBM - Initial implementation
 9469% ;
 9470% ; @book{Mueller:2006,
 9471% ;   author = "Erik T. Mueller",
 9472% ;   year = "2006",
 9473% ;   title = "Commonsense Reasoning",
 9474% ;   address = "San Francisco",
 9475% ;   publisher = "Morgan Kaufmann/Elsevier",
 9476% ; }
 9477% ;
 9478% ectest/ec_reader_test_examples.e:4642
 9479% 
 9480% option modeldiff on
 9481option(modeldiff, on).
 9482
 9483% 
 9484% load foundations/Root.e
 9485load('foundations/Root.e').
 9486
 9487% load foundations/EC.e
 9488load('foundations/EC.e').
 9489
 9490% 
 9491% ectest/ec_reader_test_examples.e:4648
 9492% sort agent
 9493sort(agent).
 9494
 9495% sort clock
 9496sort(clock).
 9497
 9498% 
 9499% fluent Beeping(clock)
 9500fluent(beeping(clock)).
 9501
 9502% fluent AlarmTime(clock,time)
 9503fluent(alarmTime(clock, time)).
 9504
 9505% fluent AlarmOn(clock)
 9506fluent(alarmOn(clock)).
 9507
 9508% ectest/ec_reader_test_examples.e:4654
 9509% 
 9510% event SetAlarmTime(agent,clock,time)
 9511event(setAlarmTime(agent, clock, time)).
 9512
 9513% event StartBeeping(clock)
 9514event(startBeeping(clock)).
 9515
 9516% event TurnOnAlarm(agent,clock)
 9517event(turnOnAlarm(agent, clock)).
 9518
 9519% event TurnOffAlarm(agent,clock)
 9520event(turnOffAlarm(agent, clock)).
 9521
 9522% 
 9523% ectest/ec_reader_test_examples.e:4660
 9524% predicate Ab1(clock,time)
 9525predicate(ab1(clock, time)).
 9526
 9527% 
 9528% agent Nathan
 9529t(agent, nathan).
 9530
 9531% clock Clock
 9532t(clock, clock).
 9533
 9534% 
 9535% ; Sigma
 9536% ectest/ec_reader_test_examples.e:4666
 9537% 
 9538% ectest/ec_reader_test_examples.e:4667
 9539% [agent,clock,time1,time2,time]% 
 9540% HoldsAt(AlarmTime(clock,time1),time) &
 9541% time1!=time2 ->
 9542% Initiates(SetAlarmTime(agent,clock,time2),AlarmTime(clock,time2),time).
 9543holds_at(alarmTime(Clock, Time1), Time), Time1\=Time2 ->
 9544	initiates(setAlarmTime(Agent, Clock, Time2),
 9545		  alarmTime(Clock, Time2),
 9546		  Time).
 9547
 9548% 
 9549% 
 9550% ectest/ec_reader_test_examples.e:4672
 9551% [agent,clock,time1,time2,time]% 
 9552% HoldsAt(AlarmTime(clock,time1),time) &
 9553% time1!=time2 ->
 9554% Terminates(SetAlarmTime(agent,clock,time2),AlarmTime(clock,time1),time).
 9555holds_at(alarmTime(Clock, Time1), Time), Time1\=Time2 ->
 9556	terminates(setAlarmTime(Agent, Clock, Time2),
 9557		   alarmTime(Clock, Time1),
 9558		   Time).
 9559
 9560% 
 9561% 
 9562% ectest/ec_reader_test_examples.e:4677
 9563% [agent,clock,time]% 
 9564% Initiates(TurnOnAlarm(agent,clock),AlarmOn(clock),time).
 9565initiates(turnOnAlarm(Agent, Clock), alarmOn(Clock), Time).
 9566
 9567% 
 9568% 
 9569% ectest/ec_reader_test_examples.e:4680
 9570% [agent,clock,time]% 
 9571% Terminates(TurnOffAlarm(agent,clock),AlarmOn(clock),time).
 9572terminates(turnOffAlarm(Agent, Clock), alarmOn(Clock), Time).
 9573
 9574% 
 9575% 
 9576% ectest/ec_reader_test_examples.e:4683
 9577% [clock,time]% 
 9578% Initiates(StartBeeping(clock),Beeping(clock),time).
 9579initiates(startBeeping(Clock), beeping(Clock), Time).
 9580
 9581% 
 9582% 
 9583% ectest/ec_reader_test_examples.e:4686
 9584% [agent,clock,time]% 
 9585% Terminates(TurnOffAlarm(agent,clock),Beeping(clock),time).
 9586terminates(turnOffAlarm(Agent, Clock), beeping(Clock), Time).
 9587
 9588% 
 9589% 
 9590% ; Delta
 9591% 
 9592% ectest/ec_reader_test_examples.e:4691
 9593% [clock,time]% 
 9594% HoldsAt(AlarmTime(clock,time),time) &
 9595% HoldsAt(AlarmOn(clock),time) &
 9596% !Ab1(clock,time) ->
 9597% Happens(StartBeeping(clock),time).
 9598holds_at(alarmTime(Clock, Time), Time), holds_at(alarmOn(Clock), Time), not(ab1(Clock, Time)) ->
 9599	happens(startBeeping(Clock), Time).
 9600
 9601% 
 9602% 
 9603% ectest/ec_reader_test_examples.e:4697
 9604% Happens(SetAlarmTime(Nathan,Clock,2),0).
 9605happens(setAlarmTime(nathan, clock, 2), 0).
 9606
 9607% 
 9608% Happens(TurnOnAlarm(Nathan,Clock),1).
 9609happens(turnOnAlarm(nathan, clock), 1).
 9610
 9611% 
 9612% 
 9613% ; Psi
 9614% 
 9615% ectest/ec_reader_test_examples.e:4702
 9616% [clock,time1,time2,time]% 
 9617% HoldsAt(AlarmTime(clock,time1),time) &
 9618% HoldsAt(AlarmTime(clock,time2),time) ->
 9619% time1=time2.
 9620holds_at(alarmTime(Clock, Time1), Time), holds_at(alarmTime(Clock, Time2), Time) ->
 9621	Time1=Time2.
 9622
 9623% 
 9624% 
 9625% ; Gamma
 9626% ectest/ec_reader_test_examples.e:4708
 9627% 
 9628% !HoldsAt(AlarmOn(Clock),0).
 9629not(holds_at(alarmOn(clock), 0)).
 9630
 9631% 
 9632% !HoldsAt(Beeping(Clock),0).
 9633not(holds_at(beeping(clock), 0)).
 9634
 9635% 
 9636% HoldsAt(AlarmTime(Clock,3),0).
 9637holds_at(alarmTime(clock, 3), 0).
 9638
 9639% 
 9640% 
 9641% completion Happens
 9642completion(happens).
 9643
 9644% ectest/ec_reader_test_examples.e:4714
 9645% completion Theta Ab1
 9646completion(theta).
 9647
 9648completion(ab1).
 9649
 9650% 
 9651% range time 0 3
 9652range(time, 0, 3).
 9653
 9654% range offset 1 1
 9655range(offset, 1, 1).
 9656
 9657% 
 9658% ; End of file.
 9659% ectest/ec_reader_test_examples.e:4720
 9660% 
 9661% 
 9662% 
 9663% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9664% ; FILE: examples/Mueller2006/Chapter12/MethodD.e
 9665% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9666% ;
 9667% ; Copyright (c) 2005 IBM Corporation and others.
 9668% ; All rights reserved. This program and the accompanying materials
 9669% ; are made available under the terms of the Common Public License v1.0
 9670% ; which accompanies this distribution, and is available at
 9671% ; http://www.eclipse.org/legal/cpl-v10.html
 9672% ;
 9673% ; Contributors:
 9674% ; IBM - Initial implementation
 9675% ;
 9676% ; Method (D)
 9677% ;
 9678% ; @book{Mueller:2006,
 9679% ;   author = "Erik T. Mueller",
 9680% ;   year = "2006",
 9681% ;   title = "Commonsense Reasoning",
 9682% ;   address = "San Francisco",
 9683% ;   publisher = "Morgan Kaufmann/Elsevier",
 9684% ; }
 9685% ;
 9686% ectest/ec_reader_test_examples.e:4746
 9687% 
 9688% load foundations/Root.e
 9689load('foundations/Root.e').
 9690
 9691% load foundations/EC.e
 9692load('foundations/EC.e').
 9693
 9694% 
 9695% sort object
 9696sort(object).
 9697
 9698% 
 9699% ectest/ec_reader_test_examples.e:4752
 9700% object A,B
 9701t(object, a).
 9702
 9703t(object, b).
 9704
 9705% 
 9706% fluent P(object)
 9707fluent(p(object)).
 9708
 9709% fluent Q(object)
 9710fluent(q(object)).
 9711
 9712% fluent R(object)
 9713fluent(r(object)).
 9714
 9715% 
 9716% ectest/ec_reader_test_examples.e:4758
 9717% predicate Ab1(object,time)
 9718predicate(ab1(object, time)).
 9719
 9720% predicate Ab2(object,time)
 9721predicate(ab2(object, time)).
 9722
 9723% 
 9724% ectest/ec_reader_test_examples.e:4761
 9725% [object,time]% 
 9726% HoldsAt(P(object),time) & !Ab1(object,time) ->
 9727% HoldsAt(Q(object),time).
 9728holds_at(p(Object), Time), not(ab1(Object, Time)) ->
 9729	holds_at(q(Object), Time).
 9730
 9731% 
 9732% 
 9733% ectest/ec_reader_test_examples.e:4765
 9734% [object,time]% 
 9735% HoldsAt(R(object),time) & !Ab2(object,time) ->
 9736% !HoldsAt(Q(object),time).
 9737holds_at(r(Object), Time), not(ab2(Object, Time)) ->
 9738	not(holds_at(q(Object), Time)).
 9739
 9740% 
 9741% 
 9742% ectest/ec_reader_test_examples.e:4769
 9743% [object,time]% 
 9744% HoldsAt(R(object),time) -> HoldsAt(P(object),time).
 9745holds_at(r(Object), Time) ->
 9746	holds_at(p(Object), Time).
 9747
 9748% 
 9749% 
 9750% HoldsAt(R(A),0).
 9751holds_at(r(a), 0).
 9752
 9753% 
 9754% HoldsAt(P(B),0).
 9755holds_at(p(b), 0).
 9756
 9757% 
 9758% !HoldsAt(R(B),0).
 9759not(holds_at(r(b), 0)).
 9760
 9761% 
 9762% ectest/ec_reader_test_examples.e:4775
 9763% 
 9764% Theta:
 9765directive(theta).
 9766
 9767 % 
 9768% ectest/ec_reader_test_examples.e:4777
 9769% [object,time]% 
 9770% HoldsAt(R(object),time) -> Ab1(object,time).
 9771holds_at(r(Object), Time) ->
 9772	ab1(Object, Time).
 9773
 9774% 
 9775% 
 9776% range time 0 0
 9777range(time, 0, 0).
 9778
 9779% range offset 1 1
 9780range(offset, 1, 1).
 9781
 9782% 
 9783% ectest/ec_reader_test_examples.e:4783
 9784% completion Theta Ab1
 9785completion(theta).
 9786
 9787completion(ab1).
 9788
 9789% completion Theta Ab2
 9790completion(theta).
 9791
 9792completion(ab2).
 9793
 9794% 
 9795% ; End of file.
 9796% 
 9797% 
 9798% ectest/ec_reader_test_examples.e:4789
 9799% 
 9800% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9801% ; FILE: examples/Mueller2006/Chapter12/BrokenDevice.e
 9802% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9803% ;
 9804% ; Copyright (c) 2005 IBM Corporation and others.
 9805% ; All rights reserved. This program and the accompanying materials
 9806% ; are made available under the terms of the Common Public License v1.0
 9807% ; which accompanies this distribution, and is available at
 9808% ; http://www.eclipse.org/legal/cpl-v10.html
 9809% ;
 9810% ; Contributors:
 9811% ; IBM - Initial implementation
 9812% ;
 9813% ; @book{Mueller:2006,
 9814% ;   author = "Erik T. Mueller",
 9815% ;   year = "2006",
 9816% ;   title = "Commonsense Reasoning",
 9817% ;   address = "San Francisco",
 9818% ;   publisher = "Morgan Kaufmann/Elsevier",
 9819% ; }
 9820% ;
 9821% ectest/ec_reader_test_examples.e:4811
 9822% 
 9823% load foundations/Root.e
 9824load('foundations/Root.e').
 9825
 9826% load foundations/EC.e
 9827load('foundations/EC.e').
 9828
 9829% 
 9830% sort agent
 9831sort(agent).
 9832
 9833% sort device
 9834sort(device).
 9835
 9836% ectest/ec_reader_test_examples.e:4817
 9837% 
 9838% agent Nathan
 9839t(agent, nathan).
 9840
 9841% device Device1
 9842t(device, device1).
 9843
 9844% 
 9845% predicate Ab1(device,time)
 9846predicate(ab1(device, time)).
 9847
 9848% 
 9849% ectest/ec_reader_test_examples.e:4823
 9850% fluent On(device)
 9851fluent(on(device)).
 9852
 9853% fluent PluggedIn(device)
 9854fluent(pluggedIn(device)).
 9855
 9856% fluent BrokenSwitch(device)
 9857fluent(brokenSwitch(device)).
 9858
 9859% 
 9860% event TurnOn(agent,device)
 9861event(turnOn(agent, device)).
 9862
 9863% 
 9864% ; Sigma
 9865% ectest/ec_reader_test_examples.e:4830
 9866% 
 9867% ectest/ec_reader_test_examples.e:4831
 9868% [agent,device,time]% 
 9869% !Ab1(device,time) ->
 9870% Initiates(TurnOn(agent,device),On(device),time).
 9871not(ab1(Device, Time)) ->
 9872	initiates(turnOn(Agent, Device),
 9873		  on(Device),
 9874		  Time).
 9875
 9876% 
 9877% 
 9878% ; Delta
 9879% 
 9880% ectest/ec_reader_test_examples.e:4837
 9881% Happens(TurnOn(Nathan,Device1),0).
 9882happens(turnOn(nathan, device1), 0).
 9883
 9884% 
 9885% 
 9886% ; Theta
 9887% 
 9888% Theta:
 9889directive(theta).
 9890
 9891 
 9892% ectest/ec_reader_test_examples.e:4841
 9893% [device,time] % HoldsAt(BrokenSwitch(device),time) -> Ab1(device,time).
 9894holds_at(brokenSwitch(Device), Time) ->
 9895	ab1(Device, Time).
 9896
 9897% 
 9898% Theta:
 9899directive(theta).
 9900
 9901 
 9902% ectest/ec_reader_test_examples.e:4842
 9903% [device,time] % !HoldsAt(PluggedIn(device),time) -> Ab1(device,time).
 9904not(holds_at(pluggedIn(Device), Time)) ->
 9905	ab1(Device, Time).
 9906
 9907% 
 9908% 
 9909% ; Gamma
 9910% 
 9911% !HoldsAt(On(Device1),0).
 9912not(holds_at(on(device1), 0)).
 9913
 9914% 
 9915% HoldsAt(BrokenSwitch(Device1),0).
 9916holds_at(brokenSwitch(device1), 0).
 9917
 9918% 
 9919% ectest/ec_reader_test_examples.e:4848
 9920% 
 9921% ; added:
 9922% HoldsAt(PluggedIn(Device1),0).
 9923holds_at(pluggedIn(device1), 0).
 9924
 9925% 
 9926% 
 9927% ; entailed:
 9928% ; !HoldsAt(On(Device1),1).
 9929% ectest/ec_reader_test_examples.e:4854
 9930% 
 9931% completion Theta Ab1
 9932completion(theta).
 9933
 9934completion(ab1).
 9935
 9936% completion Happens
 9937completion(happens).
 9938
 9939% 
 9940% range time 0 1
 9941range(time, 0, 1).
 9942
 9943% range offset 1 1
 9944range(offset, 1, 1).
 9945
 9946% ectest/ec_reader_test_examples.e:4860
 9947% 
 9948% ; End of file.
 9949% 
 9950% 
 9951% 
 9952% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9953% ; FILE: examples/Mueller2006/Chapter12/MethodB.e
 9954% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9955% ;
 9956% ; Copyright (c) 2005 IBM Corporation and others.
 9957% ; All rights reserved. This program and the accompanying materials
 9958% ; are made available under the terms of the Common Public License v1.0
 9959% ; which accompanies this distribution, and is available at
 9960% ; http://www.eclipse.org/legal/cpl-v10.html
 9961% ;
 9962% ; Contributors:
 9963% ; IBM - Initial implementation
 9964% ;
 9965% ; Method (D)
 9966% ;
 9967% ; @book{Mueller:2006,
 9968% ;   author = "Erik T. Mueller",
 9969% ;   year = "2006",
 9970% ;   title = "Commonsense Reasoning",
 9971% ;   address = "San Francisco",
 9972% ;   publisher = "Morgan Kaufmann/Elsevier",
 9973% ; }
 9974% ;
 9975% ectest/ec_reader_test_examples.e:4888
 9976% 
 9977% load foundations/Root.e
 9978load('foundations/Root.e').
 9979
 9980% load foundations/EC.e
 9981load('foundations/EC.e').
 9982
 9983% 
 9984% sort object
 9985sort(object).
 9986
 9987% 
 9988% ectest/ec_reader_test_examples.e:4894
 9989% object A,B
 9990t(object, a).
 9991
 9992t(object, b).
 9993
 9994% 
 9995% fluent P(object)
 9996fluent(p(object)).
 9997
 9998% fluent Q(object)
 9999fluent(q(object)).
10000
10001% predicate Ab(object,time)
10002predicate(ab(object, time)).
10003
10004% 
10005% ectest/ec_reader_test_examples.e:4900
10006% [object,time]% 
10007% HoldsAt(P(object),time) & !Ab(object,time) ->
10008% HoldsAt(Q(object),time).
10009holds_at(p(Object), Time), not(ab(Object, Time)) ->
10010	holds_at(q(Object), Time).
10011
10012% 
10013% 
10014% HoldsAt(P(A),0).
10015holds_at(p(a), 0).
10016
10017% 
10018% HoldsAt(P(B),0).
10019holds_at(p(b), 0).
10020
10021% 
10022% ectest/ec_reader_test_examples.e:4906
10023% 
10024% Theta:
10025directive(theta).
10026
10027 % Ab(A,0).
10028ab(a, 0).
10029
10030% 
10031% 
10032% range time 0 0
10033range(time, 0, 0).
10034
10035% range offset 1 1
10036range(offset, 1, 1).
10037
10038% 
10039% ectest/ec_reader_test_examples.e:4912
10040% completion Theta Ab
10041completion(theta).
10042
10043completion(ab).
10044
10045% 
10046% ; End of file.
10047% 
10048% 
10049% 
10050% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10051% ; FILE: examples/Mueller2006/Chapter13/ModelFinding.e
10052% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10053% ;
10054% ; Copyright (c) 2005 IBM Corporation and others.
10055% ; All rights reserved. This program and the accompanying materials
10056% ; are made available under the terms of the Common Public License v1.0
10057% ; which accompanies this distribution, and is available at
10058% ; http://www.eclipse.org/legal/cpl-v10.html
10059% ;
10060% ; Contributors:
10061% ; IBM - Initial implementation
10062% ;
10063% ; @book{Mueller:2006,
10064% ;   author = "Erik T. Mueller",
10065% ;   year = "2006",
10066% ;   title = "Commonsense Reasoning",
10067% ;   address = "San Francisco",
10068% ;   publisher = "Morgan Kaufmann/Elsevier",
10069% ; }
10070% ;
10071% ectest/ec_reader_test_examples.e:4939
10072% 
10073% load foundations/Root.e
10074load('foundations/Root.e').
10075
10076% load foundations/EC.e
10077load('foundations/EC.e').
10078
10079% 
10080% sort agent
10081sort(agent).
10082
10083% 
10084% ectest/ec_reader_test_examples.e:4945
10085% fluent Awake(agent)
10086fluent(awake(agent)).
10087
10088% event WakeUp(agent)
10089event(wakeUp(agent)).
10090
10091% 
10092% ectest/ec_reader_test_examples.e:4948
10093% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
10094initiates(wakeUp(Agent), awake(Agent), Time).
10095
10096% 
10097% ectest/ec_reader_test_examples.e:4949
10098% [agent,time] % Happens(WakeUp(agent),time) -> !HoldsAt(Awake(agent),time).
10099happens(wakeUp(Agent), Time) ->
10100	not(holds_at(awake(Agent), Time)).
10101
10102% 
10103% 
10104% agent James
10105t(agent, james).
10106
10107% 
10108% range time 0 1
10109range(time, 0, 1).
10110
10111% range offset 1 1
10112range(offset, 1, 1).
10113
10114% ectest/ec_reader_test_examples.e:4955
10115% 
10116% 
10117% 
10118% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10119% ; FILE: examples/Mueller2006/Chapter13/Postdiction.e
10120% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10121% ;
10122% ; Copyright (c) 2005 IBM Corporation and others.
10123% ; All rights reserved. This program and the accompanying materials
10124% ; are made available under the terms of the Common Public License v1.0
10125% ; which accompanies this distribution, and is available at
10126% ; http://www.eclipse.org/legal/cpl-v10.html
10127% ;
10128% ; Contributors:
10129% ; IBM - Initial implementation
10130% ;
10131% ; @book{Mueller:2006,
10132% ;   author = "Erik T. Mueller",
10133% ;   year = "2006",
10134% ;   title = "Commonsense Reasoning",
10135% ;   address = "San Francisco",
10136% ;   publisher = "Morgan Kaufmann/Elsevier",
10137% ; }
10138% ;
10139% ectest/ec_reader_test_examples.e:4979
10140% 
10141% load foundations/Root.e
10142load('foundations/Root.e').
10143
10144% load foundations/EC.e
10145load('foundations/EC.e').
10146
10147% 
10148% sort agent
10149sort(agent).
10150
10151% 
10152% ectest/ec_reader_test_examples.e:4985
10153% fluent Awake(agent)
10154fluent(awake(agent)).
10155
10156% event WakeUp(agent)
10157event(wakeUp(agent)).
10158
10159% 
10160% ectest/ec_reader_test_examples.e:4988
10161% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
10162initiates(wakeUp(Agent), awake(Agent), Time).
10163
10164% 
10165% ectest/ec_reader_test_examples.e:4989
10166% [agent,time] % Happens(WakeUp(agent),time) -> !HoldsAt(Awake(agent),time).
10167happens(wakeUp(Agent), Time) ->
10168	not(holds_at(awake(Agent), Time)).
10169
10170% 
10171% 
10172% agent James
10173t(agent, james).
10174
10175% Delta:
10176directive(delta).
10177
10178 % Happens(WakeUp(James),0).
10179happens(wakeUp(james), 0).
10180
10181% 
10182% HoldsAt(Awake(James),1).
10183holds_at(awake(james), 1).
10184
10185% 
10186% 
10187% ectest/ec_reader_test_examples.e:4995
10188% completion Delta Happens
10189completion(delta).
10190
10191completion(happens).
10192
10193% 
10194% range time 0 1
10195range(time, 0, 1).
10196
10197% range offset 1 1
10198range(offset, 1, 1).
10199
10200% 
10201% 
10202% ectest/ec_reader_test_examples.e:5001
10203% 
10204% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10205% ; FILE: examples/Mueller2006/Chapter13/Deduction2.e
10206% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10207% ;
10208% ; Copyright (c) 2005 IBM Corporation and others.
10209% ; All rights reserved. This program and the accompanying materials
10210% ; are made available under the terms of the Common Public License v1.0
10211% ; which accompanies this distribution, and is available at
10212% ; http://www.eclipse.org/legal/cpl-v10.html
10213% ;
10214% ; Contributors:
10215% ; IBM - Initial implementation
10216% ;
10217% ; @book{Mueller:2006,
10218% ;   author = "Erik T. Mueller",
10219% ;   year = "2006",
10220% ;   title = "Commonsense Reasoning",
10221% ;   address = "San Francisco",
10222% ;   publisher = "Morgan Kaufmann/Elsevier",
10223% ; }
10224% ;
10225% ectest/ec_reader_test_examples.e:5023
10226% 
10227% option timediff off
10228option(timediff, off).
10229
10230% 
10231% load foundations/Root.e
10232load('foundations/Root.e').
10233
10234% load foundations/EC.e
10235load('foundations/EC.e').
10236
10237% 
10238% ectest/ec_reader_test_examples.e:5029
10239% sort agent
10240sort(agent).
10241
10242% 
10243% fluent Awake(agent)
10244fluent(awake(agent)).
10245
10246% event WakeUp(agent)
10247event(wakeUp(agent)).
10248
10249% 
10250% ectest/ec_reader_test_examples.e:5034
10251% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
10252initiates(wakeUp(Agent), awake(Agent), Time).
10253
10254% 
10255% 
10256% agent James
10257t(agent, james).
10258
10259% !HoldsAt(Awake(James),0).
10260not(holds_at(awake(james), 0)).
10261
10262% 
10263% Delta:
10264directive(delta).
10265
10266 % Happens(WakeUp(James),0).
10267happens(wakeUp(james), 0).
10268
10269% 
10270% 
10271% ectest/ec_reader_test_examples.e:5040
10272% completion Delta Happens
10273completion(delta).
10274
10275completion(happens).
10276
10277% 
10278% range time 0 1
10279range(time, 0, 1).
10280
10281% range offset 1 1
10282range(offset, 1, 1).
10283
10284% 
10285% 
10286% ectest/ec_reader_test_examples.e:5046
10287% 
10288% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10289% ; FILE: examples/Mueller2006/Chapter13/Deduction1.e
10290% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10291% ;
10292% ; Copyright (c) 2005 IBM Corporation and others.
10293% ; All rights reserved. This program and the accompanying materials
10294% ; are made available under the terms of the Common Public License v1.0
10295% ; which accompanies this distribution, and is available at
10296% ; http://www.eclipse.org/legal/cpl-v10.html
10297% ;
10298% ; Contributors:
10299% ; IBM - Initial implementation
10300% ;
10301% ; @book{Mueller:2006,
10302% ;   author = "Erik T. Mueller",
10303% ;   year = "2006",
10304% ;   title = "Commonsense Reasoning",
10305% ;   address = "San Francisco",
10306% ;   publisher = "Morgan Kaufmann/Elsevier",
10307% ; }
10308% ;
10309% ectest/ec_reader_test_examples.e:5068
10310% 
10311% load foundations/Root.e
10312load('foundations/Root.e').
10313
10314% load foundations/EC.e
10315load('foundations/EC.e').
10316
10317% 
10318% sort agent
10319sort(agent).
10320
10321% 
10322% ectest/ec_reader_test_examples.e:5074
10323% fluent Awake(agent)
10324fluent(awake(agent)).
10325
10326% event WakeUp(agent)
10327event(wakeUp(agent)).
10328
10329% 
10330% ectest/ec_reader_test_examples.e:5077
10331% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
10332initiates(wakeUp(Agent), awake(Agent), Time).
10333
10334% 
10335% 
10336% agent James
10337t(agent, james).
10338
10339% !HoldsAt(Awake(James),0).
10340not(holds_at(awake(james), 0)).
10341
10342% 
10343% Delta:
10344directive(delta).
10345
10346 % Happens(WakeUp(James),0).
10347happens(wakeUp(james), 0).
10348
10349% 
10350% 
10351% ectest/ec_reader_test_examples.e:5083
10352% completion Delta Happens
10353completion(delta).
10354
10355completion(happens).
10356
10357% 
10358% range time 0 1
10359range(time, 0, 1).
10360
10361% range offset 1 1
10362range(offset, 1, 1).
10363
10364% 
10365% 
10366% ectest/ec_reader_test_examples.e:5089
10367% 
10368% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10369% ; FILE: examples/Mueller2006/Chapter13/Abduction.e
10370% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10371% ;
10372% ; Copyright (c) 2005 IBM Corporation and others.
10373% ; All rights reserved. This program and the accompanying materials
10374% ; are made available under the terms of the Common Public License v1.0
10375% ; which accompanies this distribution, and is available at
10376% ; http://www.eclipse.org/legal/cpl-v10.html
10377% ;
10378% ; Contributors:
10379% ; IBM - Initial implementation
10380% ;
10381% ; @book{Mueller:2006,
10382% ;   author = "Erik T. Mueller",
10383% ;   year = "2006",
10384% ;   title = "Commonsense Reasoning",
10385% ;   address = "San Francisco",
10386% ;   publisher = "Morgan Kaufmann/Elsevier",
10387% ; }
10388% ;
10389% ectest/ec_reader_test_examples.e:5111
10390% 
10391% load foundations/Root.e
10392load('foundations/Root.e').
10393
10394% load foundations/EC.e
10395load('foundations/EC.e').
10396
10397% 
10398% sort agent
10399sort(agent).
10400
10401% 
10402% ectest/ec_reader_test_examples.e:5117
10403% fluent Awake(agent)
10404fluent(awake(agent)).
10405
10406% event WakeUp(agent)
10407event(wakeUp(agent)).
10408
10409% 
10410% ectest/ec_reader_test_examples.e:5120
10411% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
10412initiates(wakeUp(Agent), awake(Agent), Time).
10413
10414% 
10415% 
10416% agent James
10417t(agent, james).
10418
10419% !HoldsAt(Awake(James),0).
10420not(holds_at(awake(james), 0)).
10421
10422% 
10423% HoldsAt(Awake(James),1).
10424holds_at(awake(james), 1).
10425
10426% 
10427% 
10428% ectest/ec_reader_test_examples.e:5126
10429% range time 0 1
10430range(time, 0, 1).
10431
10432% range offset 1 1
10433range(offset, 1, 1).
10434
10435% 
10436% 
10437% 
10438% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10439% ; FILE: examples/Mueller2006/Chapter4/AlarmClock.e
10440% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10441% ;
10442% ; Copyright (c) 2005 IBM Corporation and others.
10443% ; All rights reserved. This program and the accompanying materials
10444% ; are made available under the terms of the Common Public License v1.0
10445% ; which accompanies this distribution, and is available at
10446% ; http://www.eclipse.org/legal/cpl-v10.html
10447% ;
10448% ; Contributors:
10449% ; IBM - Initial implementation
10450% ;
10451% ; @book{Mueller:2006,
10452% ;   author = "Erik T. Mueller",
10453% ;   year = "2006",
10454% ;   title = "Commonsense Reasoning",
10455% ;   address = "San Francisco",
10456% ;   publisher = "Morgan Kaufmann/Elsevier",
10457% ; }
10458% ;
10459% ectest/ec_reader_test_examples.e:5152
10460% 
10461% load foundations/Root.e
10462load('foundations/Root.e').
10463
10464% load foundations/EC.e
10465load('foundations/EC.e').
10466
10467% 
10468% sort agent
10469sort(agent).
10470
10471% sort clock
10472sort(clock).
10473
10474% ectest/ec_reader_test_examples.e:5158
10475% 
10476% fluent Beeping(clock)
10477fluent(beeping(clock)).
10478
10479% fluent AlarmTime(clock,time)
10480fluent(alarmTime(clock, time)).
10481
10482% fluent AlarmOn(clock)
10483fluent(alarmOn(clock)).
10484
10485% 
10486% event SetAlarmTime(agent,clock,time)
10487event(setAlarmTime(agent, clock, time)).
10488
10489% ectest/ec_reader_test_examples.e:5164
10490% event StartBeeping(clock)
10491event(startBeeping(clock)).
10492
10493% event TurnOnAlarm(agent,clock)
10494event(turnOnAlarm(agent, clock)).
10495
10496% event TurnOffAlarm(agent,clock)
10497event(turnOffAlarm(agent, clock)).
10498
10499% 
10500% agent Nathan
10501t(agent, nathan).
10502
10503% clock Clock
10504t(clock, clock).
10505
10506% ectest/ec_reader_test_examples.e:5170
10507% 
10508% ; Sigma
10509% 
10510% ectest/ec_reader_test_examples.e:5173
10511% [agent,clock,time1,time2,time]% 
10512% HoldsAt(AlarmTime(clock,time1),time) &
10513% time1!=time2 ->
10514% Initiates(SetAlarmTime(agent,clock,time2),AlarmTime(clock,time2),time).
10515holds_at(alarmTime(Clock, Time1), Time), Time1\=Time2 ->
10516	initiates(setAlarmTime(Agent, Clock, Time2),
10517		  alarmTime(Clock, Time2),
10518		  Time).
10519
10520% 
10521% 
10522% ectest/ec_reader_test_examples.e:5178
10523% [agent,clock,time1,time2,time]% 
10524% HoldsAt(AlarmTime(clock,time1),time) &
10525% time1!=time2 ->
10526% Terminates(SetAlarmTime(agent,clock,time2),AlarmTime(clock,time1),time).
10527holds_at(alarmTime(Clock, Time1), Time), Time1\=Time2 ->
10528	terminates(setAlarmTime(Agent, Clock, Time2),
10529		   alarmTime(Clock, Time1),
10530		   Time).
10531
10532% 
10533% 
10534% ectest/ec_reader_test_examples.e:5183
10535% [agent,clock,time]% 
10536% Initiates(TurnOnAlarm(agent,clock),AlarmOn(clock),time).
10537initiates(turnOnAlarm(Agent, Clock), alarmOn(Clock), Time).
10538
10539% 
10540% 
10541% ectest/ec_reader_test_examples.e:5186
10542% [agent,clock,time]% 
10543% Terminates(TurnOffAlarm(agent,clock),AlarmOn(clock),time).
10544terminates(turnOffAlarm(Agent, Clock), alarmOn(Clock), Time).
10545
10546% 
10547% 
10548% ectest/ec_reader_test_examples.e:5189
10549% [clock,time]% 
10550% Initiates(StartBeeping(clock),Beeping(clock),time).
10551initiates(startBeeping(Clock), beeping(Clock), Time).
10552
10553% 
10554% 
10555% ectest/ec_reader_test_examples.e:5192
10556% [agent,clock,time]% 
10557% Terminates(TurnOffAlarm(agent,clock),Beeping(clock),time).
10558terminates(turnOffAlarm(Agent, Clock), beeping(Clock), Time).
10559
10560% 
10561% 
10562% ; Delta
10563% 
10564% ectest/ec_reader_test_examples.e:5197
10565% [clock,time]% 
10566% HoldsAt(AlarmTime(clock,time),time) &
10567% HoldsAt(AlarmOn(clock),time) ->
10568% Happens(StartBeeping(clock),time).
10569holds_at(alarmTime(Clock, Time), Time), holds_at(alarmOn(Clock), Time) ->
10570	happens(startBeeping(Clock), Time).
10571
10572% 
10573% 
10574% Happens(SetAlarmTime(Nathan,Clock,2),0).
10575happens(setAlarmTime(nathan, clock, 2), 0).
10576
10577% 
10578% ectest/ec_reader_test_examples.e:5203
10579% Happens(TurnOnAlarm(Nathan,Clock),1).
10580happens(turnOnAlarm(nathan, clock), 1).
10581
10582% 
10583% 
10584% ; Psi
10585% 
10586% ectest/ec_reader_test_examples.e:5207
10587% [clock,time1,time2,time]% 
10588% HoldsAt(AlarmTime(clock,time1),time) &
10589% HoldsAt(AlarmTime(clock,time2),time) ->
10590% time1=time2.
10591holds_at(alarmTime(Clock, Time1), Time), holds_at(alarmTime(Clock, Time2), Time) ->
10592	Time1=Time2.
10593
10594% 
10595% 
10596% ; Gamma
10597% ectest/ec_reader_test_examples.e:5213
10598% 
10599% !HoldsAt(AlarmOn(Clock),0).
10600not(holds_at(alarmOn(clock), 0)).
10601
10602% 
10603% !HoldsAt(Beeping(Clock),0).
10604not(holds_at(beeping(clock), 0)).
10605
10606% 
10607% HoldsAt(AlarmTime(Clock,3),0).
10608holds_at(alarmTime(clock, 3), 0).
10609
10610% 
10611% 
10612% completion Happens
10613completion(happens).
10614
10615% ectest/ec_reader_test_examples.e:5219
10616% 
10617% range time 0 3
10618range(time, 0, 3).
10619
10620% range offset 1 1
10621range(offset, 1, 1).
10622
10623% 
10624% ; End of file.
10625% 
10626% ectest/ec_reader_test_examples.e:5225
10627% 
10628% 
10629% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10630% ; FILE: examples/Mueller2006/Chapter4/BankAccountServiceFee.e
10631% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10632% ;
10633% ; Copyright (c) 2005 IBM Corporation and others.
10634% ; All rights reserved. This program and the accompanying materials
10635% ; are made available under the terms of the Common Public License v1.0
10636% ; which accompanies this distribution, and is available at
10637% ; http://www.eclipse.org/legal/cpl-v10.html
10638% ;
10639% ; Contributors:
10640% ; IBM - Initial implementation
10641% ;
10642% ; @book{Mueller:2006,
10643% ;   author = "Erik T. Mueller",
10644% ;   year = "2006",
10645% ;   title = "Commonsense Reasoning",
10646% ;   address = "San Francisco",
10647% ;   publisher = "Morgan Kaufmann/Elsevier",
10648% ; }
10649% ;
10650% ectest/ec_reader_test_examples.e:5248
10651% 
10652% option modeldiff on
10653option(modeldiff, on).
10654
10655% 
10656% load foundations/Root.e
10657load('foundations/Root.e').
10658
10659% load foundations/EC.e
10660load('foundations/EC.e').
10661
10662% 
10663% ectest/ec_reader_test_examples.e:5254
10664% sort account
10665sort(account).
10666
10667% sort value: integer
10668subsort(value, integer).
10669
10670% 
10671% account Account1, Account2
10672t(account, account1).
10673
10674t(account, account2).
10675
10676% 
10677% predicate EndOfMonth(time)
10678predicate(endOfMonth(time)).
10679
10680% ectest/ec_reader_test_examples.e:5260
10681% function ServiceFee(account): value
10682function(serviceFee(account), value).
10683
10684% function MinimumBalance(account): value
10685function(minimumBalance(account), value).
10686
10687% 
10688% fluent ServiceFeeCharged(account)
10689fluent(serviceFeeCharged(account)).
10690
10691% fluent Balance(account,value)
10692fluent(balance(account, value)).
10693
10694% 
10695% ectest/ec_reader_test_examples.e:5266
10696% event Transfer(account,account,value)
10697event(transfer(account, account, value)).
10698
10699% event MonthlyReset(account)
10700event(monthlyReset(account)).
10701
10702% event ChargeServiceFee(account)
10703event(chargeServiceFee(account)).
10704
10705% 
10706% ; Sigma
10707% 
10708% ectest/ec_reader_test_examples.e:5272
10709% [account1,account2,value1,value2,value3,value4,time]% 
10710% HoldsAt(Balance(account1,value1),time) &
10711% HoldsAt(Balance(account2,value2),time) &
10712% value3>0 &
10713% value1>=value3 &
10714% value4=(value2+value3) ->
10715% Initiates(Transfer(account1,account2,value3),Balance(account2,value4),time).
10716holds_at(balance(Account1, Value1), Time), holds_at(balance(Account2, Value2), Time), Value3>0, Value1>=Value3, Value4=Value2+Value3 ->
10717	initiates(transfer(Account1, Account2, Value3),
10718		  balance(Account2, Value4),
10719		  Time).
10720
10721% ectest/ec_reader_test_examples.e:5278
10722% 
10723% 
10724% ectest/ec_reader_test_examples.e:5280
10725% [account1,account2,value1,value2,value3,time]% 
10726% HoldsAt(Balance(account1,value1),time) &
10727% HoldsAt(Balance(account2,value2),time) &
10728% value3>0 &
10729% value1>=value3 ->
10730% Terminates(Transfer(account1,account2,value3),Balance(account2,value2),time).
10731holds_at(balance(Account1, Value1), Time), holds_at(balance(Account2, Value2), Time), Value3>0, Value1>=Value3 ->
10732	terminates(transfer(Account1, Account2, Value3),
10733		   balance(Account2, Value2),
10734		   Time).
10735
10736% 
10737% ectest/ec_reader_test_examples.e:5286
10738% 
10739% ectest/ec_reader_test_examples.e:5287
10740% [account1,account2,value1,value2,value3,value4,time]% 
10741% HoldsAt(Balance(account1,value1),time) &
10742% HoldsAt(Balance(account2,value2),time) &
10743% value3>0 &
10744% value1>=value3 &
10745% value4=(value1-value3) ->
10746% Initiates(Transfer(account1,account2,value3),Balance(account1,value4),time).
10747holds_at(balance(Account1, Value1), Time), holds_at(balance(Account2, Value2), Time), Value3>0, Value1>=Value3, Value4=Value1-Value3 ->
10748	initiates(transfer(Account1, Account2, Value3),
10749		  balance(Account1, Value4),
10750		  Time).
10751
10752% ectest/ec_reader_test_examples.e:5293
10753% 
10754% 
10755% ectest/ec_reader_test_examples.e:5295
10756% [account1,account2,value1,value2,value3,time]% 
10757% HoldsAt(Balance(account1,value1),time) &
10758% HoldsAt(Balance(account2,value2),time) &
10759% value3>0 &
10760% value1>=value3 ->
10761% Terminates(Transfer(account1,account2,value3),Balance(account1,value1),time).
10762holds_at(balance(Account1, Value1), Time), holds_at(balance(Account2, Value2), Time), Value3>0, Value1>=Value3 ->
10763	terminates(transfer(Account1, Account2, Value3),
10764		   balance(Account1, Value1),
10765		   Time).
10766
10767% 
10768% ectest/ec_reader_test_examples.e:5301
10769% 
10770% ectest/ec_reader_test_examples.e:5302
10771% [account,time]% 
10772% Initiates(ChargeServiceFee(account),ServiceFeeCharged(account),time).
10773initiates(chargeServiceFee(Account), serviceFeeCharged(Account), Time).
10774
10775% 
10776% 
10777% ectest/ec_reader_test_examples.e:5305
10778% [account,time]% 
10779% Terminates(MonthlyReset(account),ServiceFeeCharged(account),time).
10780terminates(monthlyReset(Account), serviceFeeCharged(Account), Time).
10781
10782% 
10783% 
10784% ectest/ec_reader_test_examples.e:5308
10785% [account,value1,value2,time]% 
10786% HoldsAt(Balance(account,value1),time) &
10787% value2 = (value1-ServiceFee(account)) ->
10788% Initiates(ChargeServiceFee(account),
10789%           Balance(account,value2),
10790%           time).
10791holds_at(balance(Account, Value1), Time), Value2=Value1-serviceFee(Account) ->
10792	initiates(chargeServiceFee(Account),
10793		  balance(Account, Value2),
10794		  Time).
10795
10796% 
10797% ectest/ec_reader_test_examples.e:5314
10798% 
10799% ectest/ec_reader_test_examples.e:5315
10800% [account,value,time]% 
10801% HoldsAt(Balance(account,value),time) ->
10802% Terminates(ChargeServiceFee(account),Balance(account,value),time).
10803holds_at(balance(Account, Value), Time) ->
10804	terminates(chargeServiceFee(Account),
10805		   balance(Account, Value),
10806		   Time).
10807
10808% 
10809% 
10810% ; Delta
10811% 
10812% ectest/ec_reader_test_examples.e:5321
10813% [account,value,time]% 
10814% HoldsAt(Balance(account,value),time) &
10815% value<MinimumBalance(account) &
10816% !HoldsAt(ServiceFeeCharged(account),time) ->
10817% Happens(ChargeServiceFee(account),time).
10818holds_at(balance(Account, Value), Time), Value<minimumBalance(Account), not(holds_at(serviceFeeCharged(Account), Time)) ->
10819	happens(chargeServiceFee(Account), Time).
10820
10821% 
10822% 
10823% ectest/ec_reader_test_examples.e:5327
10824% [account,time]% 
10825% EndOfMonth(time) ->
10826% Happens(MonthlyReset(account),time).
10827endOfMonth(Time) ->
10828	happens(monthlyReset(Account), Time).
10829
10830% 
10831% 
10832% Happens(Transfer(Account1,Account2,1),0).
10833happens(transfer(account1, account2, 1), 0).
10834
10835% 
10836% Happens(Transfer(Account1,Account2,1),0).
10837happens(transfer(account1, account2, 1), 0).
10838
10839% 
10840% ectest/ec_reader_test_examples.e:5333
10841% 
10842% ; Psi
10843% 
10844% ectest/ec_reader_test_examples.e:5336
10845% [account,value1,value2,time]% 
10846% HoldsAt(Balance(account,value1),time) &
10847% HoldsAt(Balance(account,value2),time) ->
10848% value1=value2.
10849holds_at(balance(Account, Value1), Time), holds_at(balance(Account, Value2), Time) ->
10850	Value1=Value2.
10851
10852% 
10853% 
10854% ; Gamma
10855% ectest/ec_reader_test_examples.e:5342
10856% 
10857% !HoldsAt(ServiceFeeCharged(Account1),0).
10858not(holds_at(serviceFeeCharged(account1), 0)).
10859
10860% 
10861% !HoldsAt(ServiceFeeCharged(Account2),0).
10862not(holds_at(serviceFeeCharged(account2), 0)).
10863
10864% 
10865% HoldsAt(Balance(Account1,3),0).
10866holds_at(balance(account1, 3), 0).
10867
10868% 
10869% HoldsAt(Balance(Account2,1),0).
10870holds_at(balance(account2, 1), 0).
10871
10872% 
10873% MinimumBalance(Account1)=3.
10874minimumBalance(account1)=3.
10875
10876% 
10877% ectest/ec_reader_test_examples.e:5348
10878% MinimumBalance(Account2)=1.
10879minimumBalance(account2)=1.
10880
10881% 
10882% ServiceFee(Account1)=1.
10883serviceFee(account1)=1.
10884
10885% 
10886% ServiceFee(Account2)=1.
10887serviceFee(account2)=1.
10888
10889% 
10890% ectest/ec_reader_test_examples.e:5351
10891% [time] % !EndOfMonth(time).
10892not(endOfMonth(Time)).
10893
10894% 
10895% 
10896% completion Happens
10897completion(happens).
10898
10899% 
10900% range time 0 3
10901range(time, 0, 3).
10902
10903% range value 1 3
10904range(value, 1, 3).
10905
10906% ectest/ec_reader_test_examples.e:5357
10907% range offset 1 1
10908range(offset, 1, 1).
10909
10910% 
10911% ; End of file.
10912% 
10913% 
10914% 
10915% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10916% ; FILE: examples/Mueller2006/Exercises/Counter.e
10917% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10918% ;
10919% ; Copyright (c) 2005 IBM Corporation and others.
10920% ; All rights reserved. This program and the accompanying materials
10921% ; are made available under the terms of the Common Public License v1.0
10922% ; which accompanies this distribution, and is available at
10923% ; http://www.eclipse.org/legal/cpl-v10.html
10924% ;
10925% ; Contributors:
10926% ; IBM - Initial implementation
10927% ;
10928% ; @article{DeneckerDupreBelleghem:1998,
10929% ;   author = "Marc Denecker and Daniele Theseider Dupr\'{e} and Kristof Van Belleghem",
10930% ;   year = "1998",
10931% ;   title = "An inductive definition approach to ramifications",
10932% ;   journal = "Link{\"{o}}ping Electronic Articles in Computer and Information Science",
10933% ;   volume = "3",
10934% ;   number = "007",
10935% ; }
10936% ;
10937% ; @book{Mueller:2006,
10938% ;   author = "Erik T. Mueller",
10939% ;   year = "2006",
10940% ;   title = "Commonsense Reasoning",
10941% ;   address = "San Francisco",
10942% ;   publisher = "Morgan Kaufmann/Elsevier",
10943% ; }
10944% ;
10945% ectest/ec_reader_test_examples.e:5393
10946% 
10947% load foundations/Root.e
10948load('foundations/Root.e').
10949
10950% load foundations/EC.e
10951load('foundations/EC.e').
10952
10953% 
10954% sort counter
10955sort(counter).
10956
10957% counter Counter1
10958t(counter, counter1).
10959
10960% ectest/ec_reader_test_examples.e:5399
10961% 
10962% event FalseToTrue(counter)
10963event(falseToTrue(counter)).
10964
10965% event TrueToFalse(counter)
10966event(trueToFalse(counter)).
10967
10968% 
10969% fluent Count(counter,integer)
10970fluent(count(counter, integer)).
10971
10972% fluent True(counter)
10973fluent(true(counter)).
10974
10975% ectest/ec_reader_test_examples.e:5405
10976% fluent InputLine(counter)
10977fluent(inputLine(counter)).
10978
10979% noninertial InputLine
10980noninertial(inputLine).
10981
10982% 
10983% Delta:
10984directive(delta).
10985
10986 
10987% ectest/ec_reader_test_examples.e:5408
10988% [counter,time]% 
10989% !HoldsAt(True(counter),time) &
10990% HoldsAt(InputLine(counter),time) ->
10991% Happens(FalseToTrue(counter),time).
10992not(holds_at(true(Counter), Time)), holds_at(inputLine(Counter), Time) ->
10993	happens(falseToTrue(Counter), Time).
10994
10995% 
10996% 
10997% Delta:
10998directive(delta).
10999
11000 
11001% ectest/ec_reader_test_examples.e:5413
11002% [counter,time]% 
11003% HoldsAt(True(counter),time) &
11004% !HoldsAt(InputLine(counter),time) ->
11005% Happens(TrueToFalse(counter),time).
11006holds_at(true(Counter), Time), not(holds_at(inputLine(Counter), Time)) ->
11007	happens(trueToFalse(Counter), Time).
11008
11009% 
11010% 
11011% ectest/ec_reader_test_examples.e:5418
11012% [counter,time] % Initiates(FalseToTrue(counter),True(counter),time).
11013initiates(falseToTrue(Counter), true(Counter), Time).
11014
11015% 
11016% 
11017% ectest/ec_reader_test_examples.e:5420
11018% [counter,time] % Terminates(TrueToFalse(counter),True(counter),time).
11019terminates(trueToFalse(Counter), true(Counter), Time).
11020
11021% 
11022% 
11023% ectest/ec_reader_test_examples.e:5422
11024% [counter,integer1,integer2,time]% 
11025% HoldsAt(Count(counter,integer1),time) &
11026% (integer2 = (integer1 + 1)) ->
11027% Initiates(FalseToTrue(counter),Count(counter,integer2),time).
11028holds_at(count(Counter, Integer1), Time), Integer2=Integer1+1 ->
11029	initiates(falseToTrue(Counter),
11030		  count(Counter, Integer2),
11031		  Time).
11032
11033% 
11034% 
11035% ectest/ec_reader_test_examples.e:5427
11036% [counter,integer,time]% 
11037% HoldsAt(Count(counter,integer),time) ->
11038% Terminates(FalseToTrue(counter),Count(counter,integer),time).
11039holds_at(count(Counter, Integer), Time) ->
11040	terminates(falseToTrue(Counter),
11041		   count(Counter, Integer),
11042		   Time).
11043
11044% 
11045% 
11046% ectest/ec_reader_test_examples.e:5431
11047% [counter,integer1,integer2,time]% 
11048% HoldsAt(Count(counter,integer1),time) &
11049% HoldsAt(Count(counter,integer2),time) ->
11050% integer1 = integer2.
11051holds_at(count(Counter, Integer1), Time), holds_at(count(Counter, Integer2), Time) ->
11052	Integer1=Integer2.
11053
11054% 
11055% 
11056% !HoldsAt(True(Counter1),0).
11057not(holds_at(true(counter1), 0)).
11058
11059% 
11060% ectest/ec_reader_test_examples.e:5437
11061% !HoldsAt(InputLine(Counter1),0).
11062not(holds_at(inputLine(counter1), 0)).
11063
11064% 
11065% HoldsAt(InputLine(Counter1),1).
11066holds_at(inputLine(counter1), 1).
11067
11068% 
11069% HoldsAt(InputLine(Counter1),2).
11070holds_at(inputLine(counter1), 2).
11071
11072% 
11073% HoldsAt(InputLine(Counter1),3).
11074holds_at(inputLine(counter1), 3).
11075
11076% 
11077% !HoldsAt(InputLine(Counter1),4).
11078not(holds_at(inputLine(counter1), 4)).
11079
11080% 
11081% !HoldsAt(InputLine(Counter1),5).
11082not(holds_at(inputLine(counter1), 5)).
11083
11084% 
11085% ectest/ec_reader_test_examples.e:5443
11086% !HoldsAt(InputLine(Counter1),6).
11087not(holds_at(inputLine(counter1), 6)).
11088
11089% 
11090% HoldsAt(InputLine(Counter1),7).
11091holds_at(inputLine(counter1), 7).
11092
11093% 
11094% HoldsAt(InputLine(Counter1),8).
11095holds_at(inputLine(counter1), 8).
11096
11097% 
11098% HoldsAt(InputLine(Counter1),9).
11099holds_at(inputLine(counter1), 9).
11100
11101% 
11102% 
11103% HoldsAt(Count(Counter1,0),0).
11104holds_at(count(counter1, 0), 0).
11105
11106% 
11107% ectest/ec_reader_test_examples.e:5449
11108% 
11109% completion Happens
11110completion(happens).
11111
11112% 
11113% range integer 0 6
11114range(integer, 0, 6).
11115
11116% range time 0 10
11117range(time, 0, 10).
11118
11119% range offset 1 1
11120range(offset, 1, 1).
11121
11122% ectest/ec_reader_test_examples.e:5455
11123% 
11124% ; End of file.
11125% 
11126% 
11127% 
11128% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11129% ; FILE: examples/Mueller2006/Exercises/TeacherTells.e
11130% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11131% ;
11132% ; Copyright (c) 2005 IBM Corporation and others.
11133% ; All rights reserved. This program and the accompanying materials
11134% ; are made available under the terms of the Common Public License v1.0
11135% ; which accompanies this distribution, and is available at
11136% ; http://www.eclipse.org/legal/cpl-v10.html
11137% ;
11138% ; Contributors:
11139% ; IBM - Initial implementation
11140% ;
11141% ; @book{Mueller:2006,
11142% ;   author = "Erik T. Mueller",
11143% ;   year = "2006",
11144% ;   title = "Commonsense Reasoning",
11145% ;   address = "San Francisco",
11146% ;   publisher = "Morgan Kaufmann/Elsevier",
11147% ; }
11148% ;
11149% ectest/ec_reader_test_examples.e:5481
11150% 
11151% option modeldiff on
11152option(modeldiff, on).
11153
11154% 
11155% load foundations/Root.e
11156load('foundations/Root.e').
11157
11158% load foundations/EC.e
11159load('foundations/EC.e').
11160
11161% 
11162% ectest/ec_reader_test_examples.e:5487
11163% sort agent
11164sort(agent).
11165
11166% sort room
11167sort(room).
11168
11169% sort fact
11170sort(fact).
11171
11172% 
11173% agent Teacher, Student
11174t(agent, teacher).
11175
11176t(agent, student).
11177
11178% room Kitchen, Classroom
11179t(room, kitchen).
11180
11181t(room, classroom).
11182
11183% ectest/ec_reader_test_examples.e:5493
11184% fact Fact1, Fact2
11185t(fact, fact1).
11186
11187t(fact, fact2).
11188
11189% 
11190% fluent InRoom(agent,room)
11191fluent(inRoom(agent, room)).
11192
11193% fluent ListeningTo(agent,agent)
11194fluent(listeningTo(agent, agent)).
11195
11196% fluent Know(agent,fact)
11197fluent(know(agent, fact)).
11198
11199% 
11200% ectest/ec_reader_test_examples.e:5499
11201% event Tell(agent,agent,fact)
11202event(tell(agent, agent, fact)).
11203
11204% 
11205% ; Sigma
11206% 
11207% ectest/ec_reader_test_examples.e:5503
11208% [agent1,agent2,fact,time]% 
11209% (
11210% ectest/ec_reader_test_examples.e:5504
11211% {room} HoldsAt(InRoom(agent1,room),time) &
11212%         HoldsAt(InRoom(agent2,room),time)) &
11213% HoldsAt(ListeningTo(agent2,agent1),time) ->
11214% Initiates(Tell(agent1,agent2,fact),Know(agent2,fact),time).
11215exists([Room],  ((holds_at(inRoom(Agent1, Room), Time), holds_at(inRoom(Agent2, Room), Time)), holds_at(listeningTo(Agent2, Agent1), Time)->initiates(tell(Agent1, Agent2, Fact), know(Agent2, Fact), Time))).
11216
11217% 
11218% 
11219% ; Delta
11220% ectest/ec_reader_test_examples.e:5510
11221% 
11222% Happens(Tell(Teacher,Student,Fact1),0).
11223happens(tell(teacher, student, fact1), 0).
11224
11225% 
11226% 
11227% ; Psi
11228% 
11229% ectest/ec_reader_test_examples.e:5515
11230% [agent,room1,room2,time]% 
11231% HoldsAt(InRoom(agent,room1),time) &
11232% HoldsAt(InRoom(agent,room2),time) ->
11233% room1 = room2.
11234holds_at(inRoom(Agent, Room1), Time), holds_at(inRoom(Agent, Room2), Time) ->
11235	Room1=Room2.
11236
11237% 
11238% 
11239% ; Gamma
11240% ectest/ec_reader_test_examples.e:5521
11241% 
11242% ectest/ec_reader_test_examples.e:5522
11243% [agent,fact] % !HoldsAt(Know(agent,fact),0).
11244not(holds_at(know(Agent, Fact), 0)).
11245
11246% 
11247% ectest/ec_reader_test_examples.e:5523
11248% [agent1,agent2] % HoldsAt(ListeningTo(agent1,agent2),0).
11249holds_at(listeningTo(Agent1, Agent2), 0).
11250
11251% 
11252% ectest/ec_reader_test_examples.e:5524
11253% [agent] % HoldsAt(InRoom(agent,Classroom),0).
11254holds_at(inRoom(Agent, classroom), 0).
11255
11256% 
11257% 
11258% completion Happens
11259completion(happens).
11260
11261% 
11262% range time 0 1
11263range(time, 0, 1).
11264
11265% range offset 1 1
11266range(offset, 1, 1).
11267
11268% ectest/ec_reader_test_examples.e:5530
11269% 
11270% ; End of file.
11271% 
11272% 
11273% 
11274% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11275% ; FILE: examples/Mueller2006/Exercises/MixingPaints.e
11276% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11277% ;
11278% ; Copyright (c) 2005 IBM Corporation and others.
11279% ; All rights reserved. This program and the accompanying materials
11280% ; are made available under the terms of the Common Public License v1.0
11281% ; which accompanies this distribution, and is available at
11282% ; http://www.eclipse.org/legal/cpl-v10.html
11283% ;
11284% ; Contributors:
11285% ; IBM - Initial implementation
11286% ;
11287% ; @book{Mueller:2006,
11288% ;   author = "Erik T. Mueller",
11289% ;   year = "2006",
11290% ;   title = "Commonsense Reasoning",
11291% ;   address = "San Francisco",
11292% ;   publisher = "Morgan Kaufmann/Elsevier",
11293% ; }
11294% ;
11295% ectest/ec_reader_test_examples.e:5556
11296% 
11297% load foundations/Root.e
11298load('foundations/Root.e').
11299
11300% load foundations/EC.e
11301load('foundations/EC.e').
11302
11303% 
11304% sort palette
11305sort(palette).
11306
11307% sort color
11308sort(color).
11309
11310% ectest/ec_reader_test_examples.e:5562
11311% 
11312% palette Palette1
11313t(palette, palette1).
11314
11315% color Red, Yellow, Blue, Green
11316t(color, red).
11317
11318t(color, yellow).
11319
11320t(color, blue).
11321
11322t(color, green).
11323
11324% 
11325% event PlaceOnPalette(palette,color)
11326event(placeOnPalette(palette, color)).
11327
11328% fluent OnPalette(palette,color)
11329fluent(onPalette(palette, color)).
11330
11331% ectest/ec_reader_test_examples.e:5568
11332% 
11333% ectest/ec_reader_test_examples.e:5569
11334% [palette,color,time]% 
11335% !Happens(PlaceOnPalette(palette,Yellow),time) |
11336% !Happens(PlaceOnPalette(palette,Blue),time) ->
11337% Initiates(PlaceOnPalette(palette,color),OnPalette(palette,color),time).
11338(   not(happens(placeOnPalette(Palette, yellow), Time))
11339;   (   (   not(happens(placeOnPalette(Palette, yellow), Time))
11340;   not(happens(placeOnPalette(Palette, blue), Time))
11341->  initiates(placeOnPalette(Palette, Color),
11342	      onPalette(Palette, Color),
11343	      Time)
11344).
11345
11346% 
11347% 
11348% ectest/ec_reader_test_examples.e:5574
11349% [palette,color1,color2,time]% 
11350% Happens(PlaceOnPalette(palette,Yellow),time) &
11351% color1 = Blue &
11352% color2 = Green ->
11353% Initiates(PlaceOnPalette(palette,color1),OnPalette(palette,color2),time).
11354happens(placeOnPalette(Palette, yellow), Time), Color1=blue, Color2=green ->
11355	initiates(placeOnPalette(Palette, Color1),
11356		  onPalette(Palette, Color2),
11357		  Time).
11358
11359% 
11360% 
11361% ectest/ec_reader_test_examples.e:5580
11362% [palette,color1,color2,time]% 
11363% !(Happens(PlaceOnPalette(palette,Yellow),time) &
11364%   Happens(PlaceOnPalette(palette,Blue),time)) &
11365% HoldsAt(OnPalette(palette,color1),time) &
11366% color1 != color2 ->
11367% Terminates(PlaceOnPalette(palette,color2),OnPalette(palette,color1),time).
11368not((happens(placeOnPalette(Palette, yellow), Time), happens(placeOnPalette(Palette, blue), Time))), holds_at(onPalette(Palette, Color1), Time), Color1\=Color2 ->
11369	terminates(placeOnPalette(Palette, Color2),
11370		   onPalette(Palette, Color1),
11371		   Time).
11372
11373% 
11374% ectest/ec_reader_test_examples.e:5586
11375% 
11376% ectest/ec_reader_test_examples.e:5587
11377% [palette,color1,color2,time]% 
11378% Happens(PlaceOnPalette(palette,Yellow),time) &
11379% HoldsAt(OnPalette(palette,color2),time) &
11380% color1 = Blue &
11381% color2 != Green ->
11382% Terminates(PlaceOnPalette(palette,color1),OnPalette(palette,color2),time).
11383happens(placeOnPalette(Palette, yellow), Time), holds_at(onPalette(Palette, Color2), Time), Color1=blue, Color2\=green ->
11384	terminates(placeOnPalette(Palette, Color1),
11385		   onPalette(Palette, Color2),
11386		   Time).
11387
11388% 
11389% ectest/ec_reader_test_examples.e:5593
11390% 
11391% ; state constraint
11392% 
11393% ectest/ec_reader_test_examples.e:5596
11394% [palette,color1,color2,time]% 
11395% HoldsAt(OnPalette(palette,color1),time) &
11396% HoldsAt(OnPalette(palette,color2),time) ->
11397% color1 = color2.
11398holds_at(onPalette(Palette, Color1), Time), holds_at(onPalette(Palette, Color2), Time) ->
11399	Color1=Color2.
11400
11401% 
11402% 
11403% ; (1) place green over red
11404% ectest/ec_reader_test_examples.e:5602
11405% HoldsAt(OnPalette(Palette1,Red),0).
11406holds_at(onPalette(palette1, red), 0).
11407
11408% 
11409% Delta:
11410directive(delta).
11411
11412 % Happens(PlaceOnPalette(Palette1,Green),0).
11413happens(placeOnPalette(palette1, green), 0).
11414
11415% 
11416% 
11417% ; (2) place yellow+blue over green
11418% Delta:
11419directive(delta).
11420
11421 % Happens(PlaceOnPalette(Palette1,Yellow),1).
11422happens(placeOnPalette(palette1, yellow), 1).
11423
11424% 
11425% Delta:
11426directive(delta).
11427
11428 % Happens(PlaceOnPalette(Palette1,Blue),1).
11429happens(placeOnPalette(palette1, blue), 1).
11430
11431% 
11432% ectest/ec_reader_test_examples.e:5608
11433% 
11434% ; (3) place yellow
11435% Delta:
11436directive(delta).
11437
11438 % Happens(PlaceOnPalette(Palette1,Yellow),2).
11439happens(placeOnPalette(palette1, yellow), 2).
11440
11441% 
11442% 
11443% ; (4) place blue
11444% Delta:
11445directive(delta).
11446
11447 % Happens(PlaceOnPalette(Palette1,Blue),3).
11448happens(placeOnPalette(palette1, blue), 3).
11449
11450% 
11451% ectest/ec_reader_test_examples.e:5614
11452% 
11453% ; (5) place green
11454% Delta:
11455directive(delta).
11456
11457 % Happens(PlaceOnPalette(Palette1,Yellow),4).
11458happens(placeOnPalette(palette1, yellow), 4).
11459
11460% 
11461% Delta:
11462directive(delta).
11463
11464 % Happens(PlaceOnPalette(Palette1,Blue),4).
11465happens(placeOnPalette(palette1, blue), 4).
11466
11467% 
11468% 
11469% completion Delta Happens
11470completion(delta).
11471
11472completion(happens).
11473
11474% ectest/ec_reader_test_examples.e:5620
11475% 
11476% range time 0 5
11477range(time, 0, 5).
11478
11479% range offset 1 1
11480range(offset, 1, 1).
11481
11482% 
11483% ; End of file.
11484% 
11485% ectest/ec_reader_test_examples.e:5626
11486% 
11487% 
11488% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11489% ; FILE: examples/Mueller2006/Exercises/SnoozeAlarm.e
11490% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11491% ;
11492% ; Copyright (c) 2005 IBM Corporation and others.
11493% ; All rights reserved. This program and the accompanying materials
11494% ; are made available under the terms of the Common Public License v1.0
11495% ; which accompanies this distribution, and is available at
11496% ; http://www.eclipse.org/legal/cpl-v10.html
11497% ;
11498% ; Contributors:
11499% ; IBM - Initial implementation
11500% ;
11501% ; Example: Alarm Clock with snooze alarm added
11502% ;
11503% ; @book{Mueller:2006,
11504% ;   author = "Erik T. Mueller",
11505% ;   year = "2006",
11506% ;   title = "Commonsense Reasoning",
11507% ;   address = "San Francisco",
11508% ;   publisher = "Morgan Kaufmann/Elsevier",
11509% ; }
11510% ;
11511% ectest/ec_reader_test_examples.e:5651
11512% 
11513% load foundations/Root.e
11514load('foundations/Root.e').
11515
11516% load foundations/EC.e
11517load('foundations/EC.e').
11518
11519% 
11520% sort agent
11521sort(agent).
11522
11523% sort clock
11524sort(clock).
11525
11526% ectest/ec_reader_test_examples.e:5657
11527% 
11528% fluent Beeping(clock)
11529fluent(beeping(clock)).
11530
11531% fluent AlarmTime(clock,time)
11532fluent(alarmTime(clock, time)).
11533
11534% fluent AlarmOn(clock)
11535fluent(alarmOn(clock)).
11536
11537% 
11538% event SetAlarmTime(agent,clock,time)
11539event(setAlarmTime(agent, clock, time)).
11540
11541% ectest/ec_reader_test_examples.e:5663
11542% event StartBeeping(clock)
11543event(startBeeping(clock)).
11544
11545% event TurnOnAlarm(agent,clock)
11546event(turnOnAlarm(agent, clock)).
11547
11548% event TurnOffAlarm(agent,clock)
11549event(turnOffAlarm(agent, clock)).
11550
11551% 
11552% event PressSnooze(agent,clock)
11553event(pressSnooze(agent, clock)).
11554
11555% 
11556% ectest/ec_reader_test_examples.e:5669
11557% agent Nathan
11558t(agent, nathan).
11559
11560% clock Clock
11561t(clock, clock).
11562
11563% 
11564% ; Sigma
11565% 
11566% ectest/ec_reader_test_examples.e:5674
11567% [agent,clock,time1,time2,time]% 
11568% HoldsAt(AlarmTime(clock,time1),time) &
11569% time1!=time2 ->
11570% Initiates(SetAlarmTime(agent,clock,time2),AlarmTime(clock,time2),time).
11571holds_at(alarmTime(Clock, Time1), Time), Time1\=Time2 ->
11572	initiates(setAlarmTime(Agent, Clock, Time2),
11573		  alarmTime(Clock, Time2),
11574		  Time).
11575
11576% 
11577% 
11578% ectest/ec_reader_test_examples.e:5679
11579% [agent,clock,time1,time2,time]% 
11580% HoldsAt(AlarmTime(clock,time1),time) &
11581% time1!=time2 ->
11582% Terminates(SetAlarmTime(agent,clock,time2),AlarmTime(clock,time1),time).
11583holds_at(alarmTime(Clock, Time1), Time), Time1\=Time2 ->
11584	terminates(setAlarmTime(Agent, Clock, Time2),
11585		   alarmTime(Clock, Time1),
11586		   Time).
11587
11588% 
11589% 
11590% ectest/ec_reader_test_examples.e:5684
11591% [agent,clock,time]% 
11592% Initiates(TurnOnAlarm(agent,clock),AlarmOn(clock),time).
11593initiates(turnOnAlarm(Agent, Clock), alarmOn(Clock), Time).
11594
11595% 
11596% 
11597% ectest/ec_reader_test_examples.e:5687
11598% [agent,clock,time]% 
11599% Terminates(TurnOffAlarm(agent,clock),AlarmOn(clock),time).
11600terminates(turnOffAlarm(Agent, Clock), alarmOn(Clock), Time).
11601
11602% 
11603% 
11604% ectest/ec_reader_test_examples.e:5690
11605% [clock,time]% 
11606% Initiates(StartBeeping(clock),Beeping(clock),time).
11607initiates(startBeeping(Clock), beeping(Clock), Time).
11608
11609% 
11610% 
11611% ectest/ec_reader_test_examples.e:5693
11612% [agent,clock,time]% 
11613% Terminates(TurnOffAlarm(agent,clock),Beeping(clock),time).
11614terminates(turnOffAlarm(Agent, Clock), beeping(Clock), Time).
11615
11616% 
11617% 
11618% ; added axioms:
11619% 
11620% ectest/ec_reader_test_examples.e:5698
11621% [agent,clock,time2,time]% 
11622% HoldsAt(Beeping(clock),time) &
11623% time2 = time+9 ->
11624% Initiates(PressSnooze(agent,clock),AlarmTime(clock,time2),time).
11625holds_at(beeping(Clock), Time), Time2=Time+9 ->
11626	initiates(pressSnooze(Agent, Clock),
11627		  alarmTime(Clock, Time2),
11628		  Time).
11629
11630% 
11631% 
11632% ectest/ec_reader_test_examples.e:5703
11633% [agent,clock,time1,time2,time]% 
11634% HoldsAt(Beeping(clock),time) &
11635% HoldsAt(AlarmTime(clock,time1),time) &
11636% time2 = time+9 &
11637% time1 != time2 ->
11638% Terminates(PressSnooze(agent,clock),AlarmTime(clock,time1),time).
11639holds_at(beeping(Clock), Time), holds_at(alarmTime(Clock, Time1), Time), Time2=Time+9, Time1\=Time2 ->
11640	terminates(pressSnooze(Agent, Clock),
11641		   alarmTime(Clock, Time1),
11642		   Time).
11643
11644% 
11645% ectest/ec_reader_test_examples.e:5709
11646% 
11647% ectest/ec_reader_test_examples.e:5710
11648% [agent,clock,time]% 
11649% Terminates(PressSnooze(agent,clock),Beeping(clock),time).
11650terminates(pressSnooze(Agent, Clock), beeping(Clock), Time).
11651
11652% 
11653% 
11654% ; Delta
11655% 
11656% ectest/ec_reader_test_examples.e:5715
11657% [clock,time]% 
11658% HoldsAt(AlarmTime(clock,time),time) &
11659% HoldsAt(AlarmOn(clock),time) ->
11660% Happens(StartBeeping(clock),time).
11661holds_at(alarmTime(Clock, Time), Time), holds_at(alarmOn(Clock), Time) ->
11662	happens(startBeeping(Clock), Time).
11663
11664% 
11665% 
11666% Happens(SetAlarmTime(Nathan,Clock,2),0).
11667happens(setAlarmTime(nathan, clock, 2), 0).
11668
11669% 
11670% ectest/ec_reader_test_examples.e:5721
11671% Happens(TurnOnAlarm(Nathan,Clock),1).
11672happens(turnOnAlarm(nathan, clock), 1).
11673
11674% 
11675% Happens(PressSnooze(Nathan,Clock),4).
11676happens(pressSnooze(nathan, clock), 4).
11677
11678% 
11679% 
11680% ; Psi
11681% 
11682% ectest/ec_reader_test_examples.e:5726
11683% [clock,time1,time2,time]% 
11684% HoldsAt(AlarmTime(clock,time1),time) &
11685% HoldsAt(AlarmTime(clock,time2),time) ->
11686% time1=time2.
11687holds_at(alarmTime(Clock, Time1), Time), holds_at(alarmTime(Clock, Time2), Time) ->
11688	Time1=Time2.
11689
11690% 
11691% 
11692% ; Gamma
11693% ectest/ec_reader_test_examples.e:5732
11694% 
11695% !HoldsAt(AlarmOn(Clock),0).
11696not(holds_at(alarmOn(clock), 0)).
11697
11698% 
11699% !HoldsAt(Beeping(Clock),0).
11700not(holds_at(beeping(clock), 0)).
11701
11702% 
11703% HoldsAt(AlarmTime(Clock,3),0).
11704holds_at(alarmTime(clock, 3), 0).
11705
11706% 
11707% 
11708% completion Happens
11709completion(happens).
11710
11711% ectest/ec_reader_test_examples.e:5738
11712% 
11713% range time 0 15
11714range(time, 0, 15).
11715
11716% range offset 1 1
11717range(offset, 1, 1).
11718
11719% 
11720% ; End of file.
11721% 
11722% ectest/ec_reader_test_examples.e:5744
11723% 
11724% 
11725% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11726% ; FILE: examples/Mueller2006/Exercises/TelephoneBugs.e
11727% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11728% ;
11729% ; Copyright (c) 2005 IBM Corporation and others.
11730% ; All rights reserved. This program and the accompanying materials
11731% ; are made available under the terms of the Common Public License v1.0
11732% ; which accompanies this distribution, and is available at
11733% ; http://www.eclipse.org/legal/cpl-v10.html
11734% ;
11735% ; Contributors:
11736% ; IBM - Initial implementation
11737% ;
11738% ; Example: Telephone
11739% ;
11740% ; @book{Mueller:2006,
11741% ;   author = "Erik T. Mueller",
11742% ;   year = "2006",
11743% ;   title = "Commonsense Reasoning",
11744% ;   address = "San Francisco",
11745% ;   publisher = "Morgan Kaufmann/Elsevier",
11746% ; }
11747% ;
11748% ectest/ec_reader_test_examples.e:5769
11749% 
11750% load foundations/Root.e
11751load('foundations/Root.e').
11752
11753% load foundations/EC.e
11754load('foundations/EC.e').
11755
11756% 
11757% sort agent
11758sort(agent).
11759
11760% sort phone
11761sort(phone).
11762
11763% ectest/ec_reader_test_examples.e:5775
11764% 
11765% agent Agent1, Agent2
11766t(agent, agent1).
11767
11768t(agent, agent2).
11769
11770% phone Phone1, Phone2
11771t(phone, phone1).
11772
11773t(phone, phone2).
11774
11775% 
11776% fluent Ringing(phone,phone)
11777fluent(ringing(phone, phone)).
11778
11779% fluent DialTone(phone)
11780fluent(dialTone(phone)).
11781
11782% ectest/ec_reader_test_examples.e:5781
11783% fluent BusySignal(phone)
11784fluent(busySignal(phone)).
11785
11786% fluent Idle(phone)
11787fluent(idle(phone)).
11788
11789% fluent Connected(phone,phone)
11790fluent(connected(phone, phone)).
11791
11792% fluent Disconnected(phone)
11793fluent(disconnected(phone)).
11794
11795% 
11796% event PickUp(agent,phone)
11797event(pickUp(agent, phone)).
11798
11799% ectest/ec_reader_test_examples.e:5787
11800% event SetDown(agent,phone)
11801event(setDown(agent, phone)).
11802
11803% event Dial(agent,phone,phone)
11804event(dial(agent, phone, phone)).
11805
11806% 
11807% ; Sigma
11808% 
11809% ectest/ec_reader_test_examples.e:5792
11810% [agent,phone,time]% 
11811% HoldsAt(Idle(phone),time) ->
11812% Initiates(PickUp(agent,phone),DialTone(phone),time).
11813holds_at(idle(Phone), Time) ->
11814	initiates(pickUp(Agent, Phone),
11815		  dialTone(Phone),
11816		  Time).
11817
11818% 
11819% 
11820% ectest/ec_reader_test_examples.e:5796
11821% [agent,phone,time]% 
11822% HoldsAt(Idle(phone),time) ->
11823% Terminates(PickUp(agent,phone),Idle(phone),time).
11824holds_at(idle(Phone), Time) ->
11825	terminates(pickUp(Agent, Phone),
11826		   idle(Phone),
11827		   Time).
11828
11829% 
11830% 
11831% ectest/ec_reader_test_examples.e:5800
11832% [agent,phone,time]% 
11833% HoldsAt(DialTone(phone),time) ->
11834% Initiates(SetDown(agent,phone),Idle(phone),time).
11835holds_at(dialTone(Phone), Time) ->
11836	initiates(setDown(Agent, Phone),
11837		  idle(Phone),
11838		  Time).
11839
11840% 
11841% 
11842% ectest/ec_reader_test_examples.e:5804
11843% [agent,phone,time]% 
11844% HoldsAt(DialTone(phone),time) ->
11845% Terminates(SetDown(agent,phone),DialTone(phone),time).
11846holds_at(dialTone(Phone), Time) ->
11847	terminates(setDown(Agent, Phone),
11848		   dialTone(Phone),
11849		   Time).
11850
11851% 
11852% 
11853% ectest/ec_reader_test_examples.e:5808
11854% [agent,phone1,phone2,time]% 
11855% HoldsAt(DialTone(phone1),time) &
11856% HoldsAt(Idle(phone2),time) ->
11857% Initiates(Dial(agent,phone1,phone2),Ringing(phone1,phone2),time).
11858holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
11859	initiates(dial(Agent, Phone1, Phone2),
11860		  ringing(Phone1, Phone2),
11861		  Time).
11862
11863% 
11864% 
11865% ectest/ec_reader_test_examples.e:5813
11866% [agent,phone1,phone2,time]% 
11867% HoldsAt(DialTone(phone1),time) &
11868% HoldsAt(Idle(phone2),time) ->
11869% Terminates(Dial(agent,phone1,phone2),DialTone(phone1),time).
11870holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
11871	terminates(dial(Agent, Phone1, Phone2),
11872		   dialTone(Phone1),
11873		   Time).
11874
11875% 
11876% 
11877% ectest/ec_reader_test_examples.e:5818
11878% [agent,phone1,phone2,time]% 
11879% HoldsAt(DialTone(phone1),time) &
11880% HoldsAt(Idle(phone2),time) ->
11881% Terminates(Dial(agent,phone1,phone2),Idle(phone2),time).
11882holds_at(dialTone(Phone1), Time), holds_at(idle(Phone2), Time) ->
11883	terminates(dial(Agent, Phone1, Phone2),
11884		   idle(Phone2),
11885		   Time).
11886
11887% 
11888% 
11889% ectest/ec_reader_test_examples.e:5823
11890% [agent,phone1,phone2,time]% 
11891% HoldsAt(DialTone(phone1),time) &
11892% !HoldsAt(Idle(phone2),time) ->
11893% Initiates(Dial(agent,phone1,phone2),BusySignal(phone1),time).
11894holds_at(dialTone(Phone1), Time), not(holds_at(idle(Phone2), Time)) ->
11895	initiates(dial(Agent, Phone1, Phone2),
11896		  busySignal(Phone1),
11897		  Time).
11898
11899% 
11900% 
11901% ectest/ec_reader_test_examples.e:5828
11902% [agent,phone1,phone2,time]% 
11903% HoldsAt(DialTone(phone1),time) &
11904% !HoldsAt(Idle(phone2),time) ->
11905% Terminates(Dial(agent,phone1,phone2),DialTone(phone1),time).
11906holds_at(dialTone(Phone1), Time), not(holds_at(idle(Phone2), Time)) ->
11907	terminates(dial(Agent, Phone1, Phone2),
11908		   dialTone(Phone1),
11909		   Time).
11910
11911% 
11912% 
11913% ectest/ec_reader_test_examples.e:5833
11914% [agent,phone,time]% 
11915% HoldsAt(BusySignal(phone),time) ->
11916% Initiates(SetDown(agent,phone),Idle(phone),time).
11917holds_at(busySignal(Phone), Time) ->
11918	initiates(setDown(Agent, Phone),
11919		  idle(Phone),
11920		  Time).
11921
11922% 
11923% 
11924% ectest/ec_reader_test_examples.e:5837
11925% [agent,phone,time]% 
11926% HoldsAt(BusySignal(phone),time) ->
11927% Terminates(SetDown(agent,phone),BusySignal(phone),time).
11928holds_at(busySignal(Phone), Time) ->
11929	terminates(setDown(Agent, Phone),
11930		   busySignal(Phone),
11931		   Time).
11932
11933% 
11934% 
11935% ectest/ec_reader_test_examples.e:5841
11936% [agent,phone1,phone2,time]% 
11937% HoldsAt(Ringing(phone1,phone2),time) ->
11938% Initiates(SetDown(agent,phone1),Idle(phone1),time).
11939holds_at(ringing(Phone1, Phone2), Time) ->
11940	initiates(setDown(Agent, Phone1),
11941		  idle(Phone1),
11942		  Time).
11943
11944% 
11945% 
11946% ectest/ec_reader_test_examples.e:5845
11947% [agent,phone1,phone2,time]% 
11948% HoldsAt(Ringing(phone1,phone2),time) ->
11949% Initiates(SetDown(agent,phone1),Idle(phone2),time).
11950holds_at(ringing(Phone1, Phone2), Time) ->
11951	initiates(setDown(Agent, Phone1),
11952		  idle(Phone2),
11953		  Time).
11954
11955% 
11956% 
11957% ectest/ec_reader_test_examples.e:5849
11958% [agent,phone1,phone2,time]% 
11959% HoldsAt(Ringing(phone1,phone2),time) ->
11960% Terminates(SetDown(agent,phone1),Ringing(phone1,phone2),time).
11961holds_at(ringing(Phone1, Phone2), Time) ->
11962	terminates(setDown(Agent, Phone1),
11963		   ringing(Phone1, Phone2),
11964		   Time).
11965
11966% 
11967% 
11968% ectest/ec_reader_test_examples.e:5853
11969% [agent,phone1,phone2,time]% 
11970% HoldsAt(Ringing(phone1,phone2),time) ->
11971% Initiates(PickUp(agent,phone2),Connected(phone1,phone2),time).
11972holds_at(ringing(Phone1, Phone2), Time) ->
11973	initiates(pickUp(Agent, Phone2),
11974		  connected(Phone1, Phone2),
11975		  Time).
11976
11977% 
11978% 
11979% ectest/ec_reader_test_examples.e:5857
11980% [agent,phone1,phone2,time]% 
11981% HoldsAt(Ringing(phone1,phone2),time) ->
11982% Terminates(PickUp(agent,phone2),Ringing(phone1,phone2),time).
11983holds_at(ringing(Phone1, Phone2), Time) ->
11984	terminates(pickUp(Agent, Phone2),
11985		   ringing(Phone1, Phone2),
11986		   Time).
11987
11988% 
11989% 
11990% ectest/ec_reader_test_examples.e:5861
11991% [agent,phone1,phone2,time]% 
11992% HoldsAt(Connected(phone1,phone2),time) ->
11993% Initiates(SetDown(agent,phone1),Idle(phone1),time).
11994holds_at(connected(Phone1, Phone2), Time) ->
11995	initiates(setDown(Agent, Phone1),
11996		  idle(Phone1),
11997		  Time).
11998
11999% 
12000% 
12001% ectest/ec_reader_test_examples.e:5865
12002% [agent,phone1,phone2,time]% 
12003% HoldsAt(Connected(phone1,phone2),time) ->
12004% Initiates(SetDown(agent,phone1),Disconnected(phone2),time).
12005holds_at(connected(Phone1, Phone2), Time) ->
12006	initiates(setDown(Agent, Phone1),
12007		  disconnected(Phone2),
12008		  Time).
12009
12010% 
12011% 
12012% ectest/ec_reader_test_examples.e:5869
12013% [agent,phone1,phone2,time]% 
12014% HoldsAt(Connected(phone1,phone2),time) ->
12015% Terminates(SetDown(agent,phone1),Connected(phone1,phone2),time).
12016holds_at(connected(Phone1, Phone2), Time) ->
12017	terminates(setDown(Agent, Phone1),
12018		   connected(Phone1, Phone2),
12019		   Time).
12020
12021% 
12022% 
12023% ectest/ec_reader_test_examples.e:5873
12024% [agent,phone1,phone2,time]% 
12025% HoldsAt(Connected(phone1,phone2),time) ->
12026% Initiates(SetDown(agent,phone2),Idle(phone2),time).
12027holds_at(connected(Phone1, Phone2), Time) ->
12028	initiates(setDown(Agent, Phone2),
12029		  idle(Phone2),
12030		  Time).
12031
12032% 
12033% 
12034% ectest/ec_reader_test_examples.e:5877
12035% [agent,phone1,phone2,time]% 
12036% HoldsAt(Connected(phone1,phone2),time) ->
12037% Initiates(SetDown(agent,phone2),Disconnected(phone1),time).
12038holds_at(connected(Phone1, Phone2), Time) ->
12039	initiates(setDown(Agent, Phone2),
12040		  disconnected(Phone1),
12041		  Time).
12042
12043% 
12044% 
12045% ectest/ec_reader_test_examples.e:5881
12046% [agent,phone1,phone2,time]% 
12047% HoldsAt(Connected(phone1,phone2),time) ->
12048% Terminates(SetDown(agent,phone2),Connected(phone1,phone2),time).
12049holds_at(connected(Phone1, Phone2), Time) ->
12050	terminates(setDown(Agent, Phone2),
12051		   connected(Phone1, Phone2),
12052		   Time).
12053
12054% 
12055% 
12056% ectest/ec_reader_test_examples.e:5885
12057% [agent,phone,time]% 
12058% HoldsAt(Disconnected(phone),time) ->
12059% Initiates(SetDown(agent,phone),Idle(phone),time).
12060holds_at(disconnected(Phone), Time) ->
12061	initiates(setDown(Agent, Phone),
12062		  idle(Phone),
12063		  Time).
12064
12065% 
12066% 
12067% ectest/ec_reader_test_examples.e:5889
12068% [agent,phone,time]% 
12069% HoldsAt(Disconnected(phone),time) ->
12070% Terminates(SetDown(agent,phone),Disconnected(phone),time).
12071holds_at(disconnected(Phone), Time) ->
12072	terminates(setDown(Agent, Phone),
12073		   disconnected(Phone),
12074		   Time).
12075
12076% 
12077% 
12078% ; Delta
12079% 
12080% ; (1) Two agents dial each other simultaneously without first
12081% ; picking up phone.
12082% ectest/ec_reader_test_examples.e:5897
12083% Happens(Dial(Agent1,Phone1,Phone2),0).
12084happens(dial(agent1, phone1, phone2), 0).
12085
12086% 
12087% Happens(Dial(Agent2,Phone2,Phone1),0).
12088happens(dial(agent2, phone2, phone1), 0).
12089
12090% 
12091% 
12092% ; (2) Two agents dial each other simultaneously.
12093% Happens(PickUp(Agent1,Phone1),1).
12094happens(pickUp(agent1, phone1), 1).
12095
12096% 
12097% Happens(PickUp(Agent2,Phone2),1).
12098happens(pickUp(agent2, phone2), 1).
12099
12100% 
12101% ectest/ec_reader_test_examples.e:5903
12102% Happens(Dial(Agent1,Phone1,Phone2),2).
12103happens(dial(agent1, phone1, phone2), 2).
12104
12105% 
12106% Happens(Dial(Agent2,Phone2,Phone1),2).
12107happens(dial(agent2, phone2, phone1), 2).
12108
12109% 
12110% Happens(SetDown(Agent1,Phone1),3).
12111happens(setDown(agent1, phone1), 3).
12112
12113% 
12114% Happens(SetDown(Agent2,Phone2),3).
12115happens(setDown(agent2, phone2), 3).
12116
12117% 
12118% 
12119% ; (3) One agent dials another agent just as the other
12120% ; agent picks up the phone.
12121% ectest/ec_reader_test_examples.e:5910
12122% Happens(PickUp(Agent1,Phone1),4).
12123happens(pickUp(agent1, phone1), 4).
12124
12125% 
12126% Happens(Dial(Agent1,Phone1,Phone2),5).
12127happens(dial(agent1, phone1, phone2), 5).
12128
12129% 
12130% Happens(PickUp(Agent2,Phone2),5).
12131happens(pickUp(agent2, phone2), 5).
12132
12133% 
12134% 
12135% ; Psi
12136% 
12137% ectest/ec_reader_test_examples.e:5916
12138% [phone,time]% 
12139% !HoldsAt(Ringing(phone,phone),time).
12140not(holds_at(ringing(Phone, Phone), Time)).
12141
12142% 
12143% 
12144% ectest/ec_reader_test_examples.e:5919
12145% [phone1,phone2,time]% 
12146% HoldsAt(Ringing(phone1,phone2),time) &
12147% phone1!=phone2 ->
12148% !HoldsAt(Ringing(phone2,phone1),time).
12149holds_at(ringing(Phone1, Phone2), Time), Phone1\=Phone2 ->
12150	not(holds_at(ringing(Phone2, Phone1), Time)).
12151
12152% 
12153% 
12154% ectest/ec_reader_test_examples.e:5924
12155% [phone,time]% 
12156% !HoldsAt(Connected(phone,phone),time).
12157not(holds_at(connected(Phone, Phone), Time)).
12158
12159% 
12160% 
12161% ectest/ec_reader_test_examples.e:5927
12162% [phone1,phone2,time]% 
12163% HoldsAt(Connected(phone1,phone2),time) &
12164% phone1!=phone2 ->
12165% !HoldsAt(Connected(phone2,phone1),time).
12166holds_at(connected(Phone1, Phone2), Time), Phone1\=Phone2 ->
12167	not(holds_at(connected(Phone2, Phone1), Time)).
12168
12169% 
12170% 
12171% mutex Idle, DialTone, BusySignal, Disconnected
12172mutex(idle).
12173
12174mutex(dialTone).
12175
12176mutex(busySignal).
12177
12178mutex(disconnected).
12179
12180% ectest/ec_reader_test_examples.e:5933
12181% 
12182% ectest/ec_reader_test_examples.e:5934
12183% [phone1,phone2,time]% 
12184% HoldsAt(Idle(phone1),time) ->
12185% !HoldsAt(Ringing(phone1,phone2),time) &
12186% !HoldsAt(Connected(phone1,phone2),time).
12187holds_at(idle(Phone1), Time) ->
12188	not(holds_at(ringing(Phone1, Phone2), Time)),
12189	not(holds_at(connected(Phone1, Phone2), Time)).
12190
12191% 
12192% 
12193% ; contradicts (3) above:
12194% ;[phone1,phone2,time]
12195% ;HoldsAt(DialTone(phone2),time) ->
12196% ;!HoldsAt(Ringing(phone1,phone2),time) &
12197% ;!HoldsAt(Connected(phone1,phone2),time).
12198% ectest/ec_reader_test_examples.e:5944
12199% 
12200% ; etc.
12201% 
12202% ; Gamma
12203% 
12204% ectest/ec_reader_test_examples.e:5949
12205% [phone] % HoldsAt(Idle(phone),0).
12206holds_at(idle(Phone), 0).
12207
12208% 
12209% 
12210% completion Happens
12211completion(happens).
12212
12213% 
12214% range time 0 6
12215range(time, 0, 6).
12216
12217% range offset 1 1
12218range(offset, 1, 1).
12219
12220% ectest/ec_reader_test_examples.e:5955
12221% 
12222% ; End of file.
12223% 
12224% 
12225% 
12226% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12227% ; FILE: examples/Mueller2006/Chapter11/HungryCat.e
12228% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12229% ;
12230% ; Copyright (c) 2005 IBM Corporation and others.
12231% ; All rights reserved. This program and the accompanying materials
12232% ; are made available under the terms of the Common Public License v1.0
12233% ; which accompanies this distribution, and is available at
12234% ; http://www.eclipse.org/legal/cpl-v10.html
12235% ;
12236% ; Contributors:
12237% ; IBM - Initial implementation
12238% ;
12239% ; @inproceedings{WinikoffEtAl:2002,
12240% ;   author = "Michael Winikoff and Lin Padgham and James Harland and John Thangarajah",
12241% ;   year = "2002",
12242% ;   title = "Declarative \& procedural goals in intelligent agent systems",
12243% ;   editor = "Dieter Fensel and Fausto Giunchiglia and Deborah McGuinness and Mary-Anne Williams",
12244% ;   booktitle = "\uppercase{P}roceedings of the \uppercase{E}ighth \uppercase{I}nternational \uppercase{C}onference on \uppercase{P}rinciples of \uppercase{K}nowledge \uppercase{R}epresentation and \uppercase{R}easoning",
12245% ;   pages = "470--481",
12246% ;   address = "San Francisco",
12247% ;   publisher = "Morgan Kaufmann",
12248% ; }
12249% ;
12250% ; @book{Mueller:2006,
12251% ;   author = "Erik T. Mueller",
12252% ;   year = "2006",
12253% ;   title = "Commonsense Reasoning",
12254% ;   address = "San Francisco",
12255% ;   publisher = "Morgan Kaufmann/Elsevier",
12256% ; }
12257% ;
12258% ectest/ec_reader_test_examples.e:5992
12259% 
12260% load foundations/Root.e
12261load('foundations/Root.e').
12262
12263% load foundations/EC.e
12264load('foundations/EC.e').
12265
12266% 
12267% sort object
12268sort(object).
12269
12270% sort agent: object
12271subsort(agent, object).
12272
12273% ectest/ec_reader_test_examples.e:5998
12274% sort food: object
12275subsort(food, object).
12276
12277% sort surface
12278sort(surface).
12279
12280% sort plan
12281sort(plan).
12282
12283% 
12284% reified sort belief
12285reified_sort(belief).
12286
12287% 
12288% ectest/ec_reader_test_examples.e:6004
12289% agent Cat
12290t(agent, cat).
12291
12292% surface Floor, Chair, Shelf, Table
12293t(surface, floor).
12294
12295t(surface, chair).
12296
12297t(surface, shelf).
12298
12299t(surface, table).
12300
12301% food Food1, Food2
12302t(food, food1).
12303
12304t(food, food2).
12305
12306% plan P1, P1a, P1b, P2, P2a
12307t(plan, p1).
12308
12309t(plan, p1a).
12310
12311t(plan, p1b).
12312
12313t(plan, p2).
12314
12315t(plan, p2a).
12316
12317% 
12318% predicate SelectedPlan(agent,belief,plan,time)
12319predicate(selectedPlan(agent, belief, plan, time)).
12320
12321% ectest/ec_reader_test_examples.e:6010
12322% predicate SoundPlan(agent,belief,plan,time)
12323predicate(soundPlan(agent, belief, plan, time)).
12324
12325% 
12326% fluent On(object,surface)
12327fluent(on(object, surface)).
12328
12329% fluent Goal(agent,belief)
12330fluent(goal(agent, belief)).
12331
12332% fluent CanJump(surface,surface)
12333fluent(canJump(surface, surface)).
12334
12335% fluent Plan(agent,belief,plan)
12336fluent(plan(agent, belief, plan)).
12337
12338% ectest/ec_reader_test_examples.e:6016
12339% fluent Satiated(agent)
12340fluent(satiated(agent)).
12341
12342% fluent Believe(agent,belief)
12343fluent(believe(agent, belief)).
12344
12345% 
12346% event AddPlan(agent,belief,plan)
12347event(addPlan(agent, belief, plan)).
12348
12349% event DropPlan(agent,belief,plan)
12350event(dropPlan(agent, belief, plan)).
12351
12352% event Jump(agent,surface,surface)
12353event(jump(agent, surface, surface)).
12354
12355% ectest/ec_reader_test_examples.e:6022
12356% event Move(surface,surface,surface)
12357event(move(surface, surface, surface)).
12358
12359% event Eat(agent,food)
12360event(eat(agent, food)).
12361
12362% event Wait(agent)
12363event(wait(agent)).
12364
12365% 
12366% belief BSatiated(agent)
12367t(belief, 'bSatiated(agent)').
12368
12369% belief BCanJump(surface,surface)
12370t(belief, 'bCanJump(surface').
12371
12372t(belief, 'surface)').
12373
12374% ectest/ec_reader_test_examples.e:6028
12375% belief BOn(object,surface)
12376t(belief, 'bOn(object').
12377
12378t(belief, 'surface)').
12379
12380% 
12381% ; Sigma
12382% 
12383% ; A5
12384% ectest/ec_reader_test_examples.e:6033
12385% [agent,belief,plan,time]% 
12386% Initiates(AddPlan(agent,belief,plan),Plan(agent,belief,plan),time).
12387initiates(addPlan(Agent, Belief, Plan), plan(Agent, Belief, Plan), Time).
12388
12389% 
12390% 
12391% ; A6
12392% ectest/ec_reader_test_examples.e:6037
12393% [agent,belief,plan,time]% 
12394% Terminates(DropPlan(agent,belief,plan),Plan(agent,belief,plan),time).
12395terminates(dropPlan(Agent, Belief, Plan), plan(Agent, Belief, Plan), Time).
12396
12397% 
12398% 
12399% ectest/ec_reader_test_examples.e:6040
12400% [agent,surface1,surface2,time]% 
12401% HoldsAt(On(agent,surface1),time) &
12402% HoldsAt(CanJump(surface1,surface2),time) ->
12403% Initiates(Jump(agent,surface1,surface2),On(agent,surface2),time).
12404holds_at(on(Agent, Surface1), Time), holds_at(canJump(Surface1, Surface2), Time) ->
12405	initiates(jump(Agent, Surface1, Surface2),
12406		  on(Agent, Surface2),
12407		  Time).
12408
12409% 
12410% 
12411% ectest/ec_reader_test_examples.e:6045
12412% [agent,surface1,surface2,time]% 
12413% HoldsAt(On(agent,surface1),time) &
12414% HoldsAt(CanJump(surface1,surface2),time) ->
12415% Terminates(Jump(agent,surface1,surface2),On(agent,surface1),time).
12416holds_at(on(Agent, Surface1), Time), holds_at(canJump(Surface1, Surface2), Time) ->
12417	terminates(jump(Agent, Surface1, Surface2),
12418		   on(Agent, Surface1),
12419		   Time).
12420
12421% 
12422% 
12423% ectest/ec_reader_test_examples.e:6050
12424% [surface1,surface2,surface3,time]% 
12425% Initiates(Move(surface1,surface2,surface3),CanJump(surface1,surface3),time).
12426initiates(move(Surface1, Surface2, Surface3), canJump(Surface1, Surface3), Time).
12427
12428% 
12429% 
12430% ectest/ec_reader_test_examples.e:6053
12431% [surface1,surface2,surface3,time]% 
12432% Terminates(Move(surface1,surface2,surface3),CanJump(surface1,surface2),time).
12433terminates(move(Surface1, Surface2, Surface3), canJump(Surface1, Surface2), Time).
12434
12435% 
12436% 
12437% ectest/ec_reader_test_examples.e:6056
12438% [agent,food,surface,time]% 
12439% HoldsAt(On(agent,surface),time) &
12440% HoldsAt(On(food,surface),time) ->
12441% Initiates(Eat(agent,food),Satiated(agent),time).
12442holds_at(on(Agent, Surface), Time), holds_at(on(Food, Surface), Time) ->
12443	initiates(eat(Agent, Food),
12444		  satiated(Agent),
12445		  Time).
12446
12447% 
12448% 
12449% ectest/ec_reader_test_examples.e:6061
12450% [agent,food,surface,time]% 
12451% HoldsAt(On(agent,surface),time) &
12452% HoldsAt(On(food,surface),time) ->
12453% Terminates(Eat(agent,food),On(food,surface),time).
12454holds_at(on(Agent, Surface), Time), holds_at(on(Food, Surface), Time) ->
12455	terminates(eat(Agent, Food),
12456		   on(Food, Surface),
12457		   Time).
12458
12459% 
12460% 
12461% ectest/ec_reader_test_examples.e:6066
12462% [agent,surface1,surface2,belief,time]% 
12463% HoldsAt(Believe(agent,BOn(agent,surface1)),time) &
12464% HoldsAt(Believe(agent,BCanJump(surface1,surface2)),time) &
12465% (belief = BOn(agent,surface2)) ->
12466% Initiates(Jump(agent,surface1,surface2),
12467%           Believe(agent,belief),
12468%           time).
12469holds_at(believe(Agent, bOn(Agent, Surface1)), Time), holds_at(believe(Agent, bCanJump(Surface1, Surface2)), Time), Belief=bOn(Agent, Surface2) ->
12470	initiates(jump(Agent, Surface1, Surface2),
12471		  believe(Agent, Belief),
12472		  Time).
12473
12474% ectest/ec_reader_test_examples.e:6072
12475% 
12476% 
12477% ectest/ec_reader_test_examples.e:6074
12478% [agent,surface1,surface2,belief,time]% 
12479% HoldsAt(Believe(agent,BOn(agent,surface1)),time) &
12480% HoldsAt(Believe(agent,BCanJump(surface1,surface2)),time) &
12481% (belief = BOn(agent,surface1)) ->
12482% Terminates(Jump(agent,surface1,surface2),
12483%            Believe(agent,belief),
12484%            time).
12485holds_at(believe(Agent, bOn(Agent, Surface1)), Time), holds_at(believe(Agent, bCanJump(Surface1, Surface2)), Time), Belief=bOn(Agent, Surface1) ->
12486	terminates(jump(Agent, Surface1, Surface2),
12487		   believe(Agent, Belief),
12488		   Time).
12489
12490% ectest/ec_reader_test_examples.e:6080
12491% 
12492% 
12493% ectest/ec_reader_test_examples.e:6082
12494% [agent,surface1,surface2,surface3,belief,time]% 
12495% (belief = BCanJump(surface1,surface3)) ->
12496% Initiates(Move(surface1,surface2,surface3),
12497%           Believe(agent,belief),
12498%           time).
12499Belief=bCanJump(Surface1, Surface3) ->
12500	initiates(move(Surface1, Surface2, Surface3),
12501		  believe(Agent, Belief),
12502		  Time).
12503
12504% 
12505% 
12506% ectest/ec_reader_test_examples.e:6088
12507% [agent,surface1,surface2,surface3,belief,time]% 
12508% (belief = BCanJump(surface1,surface2)) ->
12509% Terminates(Move(surface1,surface2,surface3),
12510%            Believe(agent,belief),
12511%            time).
12512Belief=bCanJump(Surface1, Surface2) ->
12513	terminates(move(Surface1, Surface2, Surface3),
12514		   believe(Agent, Belief),
12515		   Time).
12516
12517% 
12518% 
12519% ectest/ec_reader_test_examples.e:6094
12520% [agent,food,surface,belief,time]% 
12521% HoldsAt(Believe(agent,BOn(agent,surface)),time) &
12522% HoldsAt(Believe(agent,BOn(food,surface)),time) &
12523% (belief = BSatiated(agent)) ->
12524% Initiates(Eat(agent,food),Believe(agent,belief),time).
12525holds_at(believe(Agent, bOn(Agent, Surface)), Time), holds_at(believe(Agent, bOn(Food, Surface)), Time), Belief=bSatiated(Agent) ->
12526	initiates(eat(Agent, Food),
12527		  believe(Agent, Belief),
12528		  Time).
12529
12530% 
12531% 
12532% ectest/ec_reader_test_examples.e:6100
12533% [agent,food,surface,belief,time]% 
12534% HoldsAt(Believe(agent,BOn(agent,surface)),time) &
12535% HoldsAt(Believe(agent,BOn(food,surface)),time) &
12536% (belief = BOn(food,surface)) ->
12537% Terminates(Eat(agent,food),Believe(agent,belief),time).
12538holds_at(believe(Agent, bOn(Agent, Surface)), Time), holds_at(believe(Agent, bOn(Food, Surface)), Time), Belief=bOn(Food, Surface) ->
12539	terminates(eat(Agent, Food),
12540		   believe(Agent, Belief),
12541		   Time).
12542
12543% 
12544% 
12545% ; Delta
12546% ectest/ec_reader_test_examples.e:6107
12547% 
12548% ; A7
12549% ectest/ec_reader_test_examples.e:6109
12550% [agent,belief,plan,time]% 
12551% HoldsAt(Goal(agent,belief),time) &
12552% !HoldsAt(Believe(agent,belief),time) &
12553% SelectedPlan(agent,belief,plan,time) &
12554% (!{plan1} HoldsAt(Plan(agent,belief,plan1),time)) ->
12555% Happens(AddPlan(agent,belief,plan),time).
12556holds_at(goal(Agent, Belief), Time), not(holds_at(believe(Agent, Belief), Time)), selectedPlan(Agent, Belief, Plan, Time), not(exists([Plan1], holds_at(plan(Agent, Belief, Plan1), Time))) ->
12557	happens(addPlan(Agent, Belief, Plan), Time).
12558
12559% 
12560% ectest/ec_reader_test_examples.e:6115
12561% 
12562% ; A8
12563% ectest/ec_reader_test_examples.e:6117
12564% [agent,belief,time]% 
12565% HoldsAt(Plan(agent,belief,P1),time) &
12566% !HoldsAt(Believe(agent,belief),time) &
12567% SoundPlan(agent,belief,P1,time) ->
12568% Happens(Jump(Cat,Floor,Chair),time).
12569holds_at(plan(Agent, Belief, p1), Time), not(holds_at(believe(Agent, Belief), Time)), soundPlan(Agent, Belief, p1, Time) ->
12570	happens(jump(cat, floor, chair), Time).
12571
12572% 
12573% 
12574% ectest/ec_reader_test_examples.e:6123
12575% [agent,belief,time]% 
12576% HoldsAt(Plan(agent,belief,P1a),time) &
12577% !HoldsAt(Believe(agent,belief),time) &
12578% SoundPlan(agent,belief,P1a,time) ->
12579% Happens(Wait(Cat),time).
12580holds_at(plan(Agent, Belief, p1a), Time), not(holds_at(believe(Agent, Belief), Time)), soundPlan(Agent, Belief, p1a, Time) ->
12581	happens(wait(cat), Time).
12582
12583% 
12584% 
12585% ectest/ec_reader_test_examples.e:6129
12586% [agent,belief,time]% 
12587% HoldsAt(Plan(agent,belief,P2),time) &
12588% !HoldsAt(Believe(agent,belief),time) &
12589% SoundPlan(agent,belief,P2,time) ->
12590% Happens(Jump(Cat,Chair,Shelf),time).
12591holds_at(plan(Agent, Belief, p2), Time), not(holds_at(believe(Agent, Belief), Time)), soundPlan(Agent, Belief, p2, Time) ->
12592	happens(jump(cat, chair, shelf), Time).
12593
12594% 
12595% 
12596% ; A9
12597% ectest/ec_reader_test_examples.e:6136
12598% [agent,belief,plan,time]% 
12599% HoldsAt(Plan(agent,belief,plan),time) ->
12600% Happens(DropPlan(agent,belief,plan),time).
12601holds_at(plan(Agent, Belief, Plan), Time) ->
12602	happens(dropPlan(Agent, Belief, Plan), Time).
12603
12604% 
12605% 
12606% ; A10
12607% ectest/ec_reader_test_examples.e:6141
12608% [agent,belief,time]% 
12609% HoldsAt(Plan(agent,belief,P1),time) &
12610% !HoldsAt(Believe(agent,belief),time) &
12611% SoundPlan(agent,belief,P1,time) ->
12612% Happens(AddPlan(agent,belief,P1a),time).
12613holds_at(plan(Agent, Belief, p1), Time), not(holds_at(believe(Agent, Belief), Time)), soundPlan(Agent, Belief, p1, Time) ->
12614	happens(addPlan(Agent, Belief, p1a), Time).
12615
12616% 
12617% 
12618% ectest/ec_reader_test_examples.e:6147
12619% [agent,belief,time]% 
12620% HoldsAt(Plan(agent,belief,P1a),time) &
12621% !HoldsAt(Believe(agent,belief),time) &
12622% SoundPlan(agent,belief,P1a,time) ->
12623% Happens(AddPlan(agent,belief,P1b),time).
12624holds_at(plan(Agent, Belief, p1a), Time), not(holds_at(believe(Agent, Belief), Time)), soundPlan(Agent, Belief, p1a, Time) ->
12625	happens(addPlan(Agent, Belief, p1b), Time).
12626
12627% 
12628% 
12629% ectest/ec_reader_test_examples.e:6153
12630% [agent,belief,time]% 
12631% HoldsAt(Plan(agent,belief,P2),time) &
12632% !HoldsAt(Believe(agent,belief),time) &
12633% SoundPlan(agent,belief,P2,time) ->
12634% Happens(AddPlan(agent,belief,P2a),time).
12635holds_at(plan(Agent, Belief, p2), Time), not(holds_at(believe(Agent, Belief), Time)), soundPlan(Agent, Belief, p2, Time) ->
12636	happens(addPlan(Agent, Belief, p2a), Time).
12637
12638% 
12639% 
12640% ; reactive behavior
12641% ectest/ec_reader_test_examples.e:6160
12642% [agent,food,surface,time]% 
12643% !HoldsAt(Satiated(agent),time) &
12644% HoldsAt(On(agent,surface),time) &
12645% HoldsAt(On(food,surface),time) ->
12646% Happens(Eat(agent,food),time).
12647not(holds_at(satiated(Agent), Time)), holds_at(on(Agent, Surface), Time), holds_at(on(Food, Surface), Time) ->
12648	happens(eat(Agent, Food), Time).
12649
12650% 
12651% 
12652% ; narrative
12653% ectest/ec_reader_test_examples.e:6167
12654% 
12655% Happens(Move(Chair,Table,Shelf),2).
12656happens(move(chair, table, shelf), 2).
12657
12658% 
12659% 
12660% ; SelectedPlan - plan library
12661% 
12662% ;[agent,belief,plan,time]
12663% ;SelectedPlan(agent,belief,plan,time) <->
12664% ;(agent=Cat & belief=BSatiated(Cat) & plan=P1 & time=0) |
12665% ;(agent=Cat & belief=BSatiated(Cat) & plan=P2 & time=4).
12666% ectest/ec_reader_test_examples.e:6176
12667% 
12668% ectest/ec_reader_test_examples.e:6177
12669% [agent,belief,plan,time]% 
12670% SelectedPlan(agent,belief,plan,time) <->
12671% ({surface1,surface2,surface3,food}
12672%  HoldsAt(Believe(agent,BOn(agent,surface1)),time) &
12673%  HoldsAt(Believe(agent,BCanJump(surface1,surface2)),time) &
12674%  HoldsAt(Believe(agent,BCanJump(surface2,surface3)),time) &
12675%  HoldsAt(Believe(agent,BOn(food,surface3)),time) &
12676%  belief=BSatiated(agent) &
12677%  plan=P1 &
12678%  time=0) |
12679% ({surface1,surface2,surface3,food}
12680%  HoldsAt(Believe(agent,BOn(agent,surface1)),time) &
12681%  HoldsAt(Believe(agent,BCanJump(surface1,surface2)),time) &
12682%  HoldsAt(Believe(agent,BCanJump(surface2,surface3)),time) &
12683%  HoldsAt(Believe(agent,BOn(food,surface3)),time) &
12684%  belief=BSatiated(agent) &
12685%  plan=P2 &
12686%  time=4).
12687selectedPlan(Agent, Belief, Plan, Time) <->
12688	(   exists([Surface1, Surface2, Surface3, Food],
12689		   (holds_at(believe(Agent, bOn(Agent, Surface1)), Time), holds_at(believe(Agent, bCanJump(Surface1, Surface2)), Time), holds_at(believe(Agent, bCanJump(Surface2, Surface3)), Time), holds_at(believe(Agent, bOn(Food, Surface3)), Time), Belief=bSatiated(Agent), Plan=p1, Time=0))
12690	;   exists(
12691		   [ Surface18,
12692		     Surface29,
12693		     Surface310,
12694		     Food11
12695		   ],
12696		   (holds_at(believe(Agent, bOn(Agent, Surface18)), Time), holds_at(believe(Agent, bCanJump(Surface18, Surface29)), Time), holds_at(believe(Agent, bCanJump(Surface29, Surface310)), Time), holds_at(believe(Agent, bOn(Food11, Surface310)), Time), Belief=bSatiated(Agent), Plan=p2, Time=4))
12697	).
12698
12699% ectest/ec_reader_test_examples.e:6194
12700% 
12701% 
12702% 
12703% ; SoundPlan
12704% 
12705% ectest/ec_reader_test_examples.e:6199
12706% [agent,belief,plan,time]% 
12707% SoundPlan(agent,belief,plan,time) <->
12708% (plan=P1 ->
12709%  HoldsAt(Believe(agent,BCanJump(Floor,Chair)),time) &
12710%  HoldsAt(Believe(agent,BCanJump(Chair,Table)),time)) &
12711% ((plan=P1a | plan=P1b) ->
12712%   HoldsAt(Believe(agent,BCanJump(Chair,Table)),time)).
12713soundPlan(Agent, Belief, Plan, Time) <->
12714	( Plan=p1->holds_at(believe(Agent, bCanJump(floor, chair)), Time), holds_at(believe(Agent, bCanJump(chair, table)), Time)
12715	),
12716	( Plan=p1a;Plan=p1b->holds_at(believe(Agent, bCanJump(chair, table)), Time)
12717	).
12718
12719% ectest/ec_reader_test_examples.e:6205
12720% 
12721% 
12722% ; Gamma
12723% 
12724% ectest/ec_reader_test_examples.e:6209
12725% [agent,belief]% 
12726% HoldsAt(Goal(agent,belief),0) <->
12727% (agent=Cat & belief=BSatiated(Cat)).
12728holds_at(goal(Agent, Belief), 0) <->
12729	Agent=cat,
12730	Belief=bSatiated(cat).
12731
12732% 
12733% 
12734% ectest/ec_reader_test_examples.e:6213
12735% [agent,belief,plan] % !HoldsAt(Plan(agent,belief,plan),0).
12736not(holds_at(plan(Agent, Belief, Plan), 0)).
12737
12738% 
12739% 
12740% ectest/ec_reader_test_examples.e:6215
12741% [object,surface] % HoldsAt(On(object,surface),0) <->
12742% (object=Cat & surface=Floor) |
12743% (object=Food1 & surface=Table) |
12744% (object=Food2 & surface=Shelf).
12745holds_at(on(Object, Surface), 0) <->
12746	(   Object=cat,
12747	    Surface=floor
12748	;   Object=food1,
12749	    Surface=table
12750	;   Object=food2,
12751	    Surface=shelf
12752	).
12753
12754% 
12755% 
12756% ectest/ec_reader_test_examples.e:6220
12757% [surface1,surface2] % HoldsAt(CanJump(surface1,surface2),0) <->
12758% (surface1=Floor & surface2=Chair) |
12759% (surface1=Chair & surface2=Table) |
12760% (surface1=Shelf & surface2=Table).
12761holds_at(canJump(Surface1, Surface2), 0) <->
12762	(   Surface1=floor,
12763	    Surface2=chair
12764	;   Surface1=chair,
12765	    Surface2=table
12766	;   Surface1=shelf,
12767	    Surface2=table
12768	).
12769
12770% 
12771% 
12772% ectest/ec_reader_test_examples.e:6225
12773% [agent,object,surface]% 
12774% HoldsAt(Believe(agent,BOn(object,surface)),0) <->
12775% (agent=Cat & object=Cat & surface=Floor) |
12776% (agent=Cat & object=Food1 & surface=Table).
12777holds_at(believe(Agent, bOn(Object, Surface)), 0) <->
12778	(   Agent=cat,
12779	    Object=cat,
12780	    Surface=floor
12781	;   Agent=cat,
12782	    Object=food1,
12783	    Surface=table
12784	).
12785
12786% 
12787% 
12788% ectest/ec_reader_test_examples.e:6230
12789% [agent,surface1,surface2]% 
12790% HoldsAt(Believe(agent,BCanJump(surface1,surface2)),0) <->
12791% (agent=Cat & surface1=Floor & surface2=Chair) |
12792% (agent=Cat & surface1=Chair & surface2=Table) |
12793% (agent=Cat & surface1=Shelf & surface2=Table).
12794holds_at(believe(Agent, bCanJump(Surface1, Surface2)), 0) <->
12795	(   Agent=cat,
12796	    Surface1=floor,
12797	    Surface2=chair
12798	;   Agent=cat,
12799	    Surface1=chair,
12800	    Surface2=table
12801	;   Agent=cat,
12802	    Surface1=shelf,
12803	    Surface2=table
12804	).
12805
12806% 
12807% 
12808% ectest/ec_reader_test_examples.e:6236
12809% !HoldsAt(Believe(Cat,BSatiated(Cat)),0).
12810not(holds_at(believe(cat, bSatiated(cat)), 0)).
12811
12812% 
12813% 
12814% ; ADDED:
12815% !HoldsAt(Satiated(Cat),0).
12816not(holds_at(satiated(cat), 0)).
12817
12818% 
12819% 
12820% completion Happens
12821completion(happens).
12822
12823% ectest/ec_reader_test_examples.e:6242
12824% 
12825% range time 0 7
12826range(time, 0, 7).
12827
12828% range offset 1 1
12829range(offset, 1, 1).
12830
12831% 
12832% ; End of file.
12833% 
12834% ectest/ec_reader_test_examples.e:6248
12835% 
12836% 
12837% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12838% ; FILE: examples/Mueller2006/Chapter11/Lottery.e
12839% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12840% ;
12841% ; Copyright (c) 2005 IBM Corporation and others.
12842% ; All rights reserved. This program and the accompanying materials
12843% ; are made available under the terms of the Common Public License v1.0
12844% ; which accompanies this distribution, and is available at
12845% ; http://www.eclipse.org/legal/cpl-v10.html
12846% ;
12847% ; Contributors:
12848% ; IBM - Initial implementation
12849% ;
12850% ; @book{OrtonyCloreCollins:1988,
12851% ;   author = "Andrew Ortony and Gerald L. Clore and Allan M. Collins",
12852% ;   year = "1988",
12853% ;   title = "The Cognitive Structure of Emotions",
12854% ;   address = "Cambridge",
12855% ;   publisher = "Cambridge University Press",
12856% ; }
12857% ;
12858% ; @book{Mueller:2006,
12859% ;   author = "Erik T. Mueller",
12860% ;   year = "2006",
12861% ;   title = "Commonsense Reasoning",
12862% ;   address = "San Francisco",
12863% ;   publisher = "Morgan Kaufmann/Elsevier",
12864% ; }
12865% ;
12866% ectest/ec_reader_test_examples.e:6279
12867% 
12868% option modeldiff on
12869option(modeldiff, on).
12870
12871% 
12872% load foundations/Root.e
12873load('foundations/Root.e').
12874
12875% load foundations/EC.e
12876load('foundations/EC.e').
12877
12878% 
12879% ectest/ec_reader_test_examples.e:6285
12880% sort agent
12881sort(agent).
12882
12883% sort aboutevent
12884sort(aboutevent).
12885
12886% sort desirability: integer
12887subsort(desirability, integer).
12888
12889% 
12890% agent Kate, Lisa
12891t(agent, kate).
12892
12893t(agent, lisa).
12894
12895% aboutevent WinLotteryKate, WinLotteryLisa
12896t(aboutevent, winLotteryKate).
12897
12898t(aboutevent, winLotteryLisa).
12899
12900% ectest/ec_reader_test_examples.e:6291
12901% 
12902% fluent Joy(agent,aboutevent)
12903fluent(joy(agent, aboutevent)).
12904
12905% fluent Desirability(agent,agent,aboutevent,desirability)
12906fluent(desirability(agent, agent, aboutevent, desirability)).
12907
12908% fluent Believe(agent,aboutevent)
12909fluent(believe(agent, aboutevent)).
12910
12911% fluent Like(agent,agent)
12912fluent(like(agent, agent)).
12913
12914% fluent HappyFor(agent,agent,aboutevent)
12915fluent(happyFor(agent, agent, aboutevent)).
12916
12917% ectest/ec_reader_test_examples.e:6297
12918% 
12919% event WinLottery(agent)
12920event(winLottery(agent)).
12921
12922% event AddJoy(agent,aboutevent)
12923event(addJoy(agent, aboutevent)).
12924
12925% event AddHappyFor(agent,agent,aboutevent)
12926event(addHappyFor(agent, agent, aboutevent)).
12927
12928% 
12929% ; Sigma
12930% ectest/ec_reader_test_examples.e:6303
12931% 
12932% ectest/ec_reader_test_examples.e:6304
12933% [agent,aboutevent,time]% 
12934% Initiates(AddJoy(agent,aboutevent),Joy(agent,aboutevent),time).
12935initiates(addJoy(Agent, Aboutevent), joy(Agent, Aboutevent), Time).
12936
12937% 
12938% 
12939% ectest/ec_reader_test_examples.e:6307
12940% [agent1,agent2,aboutevent,time]% 
12941% Initiates(AddHappyFor(agent1,agent2,aboutevent),
12942%           HappyFor(agent1,agent2,aboutevent),
12943%           time).
12944initiates(addHappyFor(Agent1, Agent2, Aboutevent), happyFor(Agent1, Agent2, Aboutevent), Time).
12945
12946% 
12947% 
12948% ectest/ec_reader_test_examples.e:6312
12949% [agent1,agent2,aboutevent,time]% 
12950% (agent1=Kate & aboutevent=WinLotteryKate) |
12951% (agent1=Lisa & aboutevent=WinLotteryLisa) ->
12952% Initiates(WinLottery(agent1),Believe(agent2,aboutevent),time).
12953(   Agent1=kate,
12954    Aboutevent=winLotteryKate
12955;   (   (   Agent1=kate,
12956    Aboutevent=winLotteryKate
12957;   Agent1=lisa,
12958    Aboutevent=winLotteryLisa
12959->  initiates(winLottery(Agent1),
12960	      believe(Agent2, Aboutevent),
12961	      Time)
12962).
12963
12964% 
12965% 
12966% ; Delta
12967% ectest/ec_reader_test_examples.e:6318
12968% 
12969% ectest/ec_reader_test_examples.e:6319
12970% [agent,aboutevent,desirability,time]% 
12971% !HoldsAt(Joy(agent,aboutevent),time) &
12972% HoldsAt(Desirability(agent,agent,aboutevent,desirability),time) &
12973% desirability=1 &
12974% HoldsAt(Believe(agent,aboutevent),time) ->
12975% Happens(AddJoy(agent,aboutevent),time).
12976not(holds_at(joy(Agent, Aboutevent), Time)), holds_at(desirability(Agent, Agent, Aboutevent, Desirability), Time), Desirability=1, holds_at(believe(Agent, Aboutevent), Time) ->
12977	happens(addJoy(Agent, Aboutevent), Time).
12978
12979% 
12980% ectest/ec_reader_test_examples.e:6325
12981% 
12982% ectest/ec_reader_test_examples.e:6326
12983% [agent1,agent2,aboutevent,desirability1,desirability2,time]% 
12984% !HoldsAt(HappyFor(agent1,agent2,aboutevent),time) &
12985% HoldsAt(Desirability(agent1,agent2,aboutevent,desirability1),time) &
12986% desirability1=1 &
12987% HoldsAt(Desirability(agent1,agent1,aboutevent,desirability2),time) &
12988% desirability2=1 &
12989% HoldsAt(Like(agent1,agent2),time) &
12990% HoldsAt(Believe(agent1,aboutevent),time) &
12991% agent1 != agent2 ->
12992% Happens(AddHappyFor(agent1,agent2,aboutevent),time).
12993not(holds_at(happyFor(Agent1, Agent2, Aboutevent), Time)), holds_at(desirability(Agent1, Agent2, Aboutevent, Desirability1), Time), Desirability1=1, holds_at(desirability(Agent1, Agent1, Aboutevent, Desirability2), Time), Desirability2=1, holds_at(like(Agent1, Agent2), Time), holds_at(believe(Agent1, Aboutevent), Time), Agent1\=Agent2 ->
12994	happens(addHappyFor(Agent1, Agent2, Aboutevent),
12995		Time).
12996
12997% ectest/ec_reader_test_examples.e:6335
12998% 
12999% 
13000% Happens(WinLottery(Kate),0).
13001happens(winLottery(kate), 0).
13002
13003% 
13004% 
13005% ; Psi
13006% 
13007% ectest/ec_reader_test_examples.e:6341
13008% [agent1,agent2,aboutevent,desirability1,desirability2,time]% 
13009% HoldsAt(Desirability(agent1,agent2,aboutevent,desirability1),time) &
13010% HoldsAt(Desirability(agent1,agent2,aboutevent,desirability2),time) ->
13011% desirability1 = desirability2.
13012holds_at(desirability(Agent1, Agent2, Aboutevent, Desirability1), Time), holds_at(desirability(Agent1, Agent2, Aboutevent, Desirability2), Time) ->
13013	Desirability1=Desirability2.
13014
13015% 
13016% 
13017% ; Gamma
13018% ectest/ec_reader_test_examples.e:6347
13019% 
13020% ectest/ec_reader_test_examples.e:6348
13021% [agent,aboutevent] % !HoldsAt(Joy(agent,aboutevent),0).
13022not(holds_at(joy(Agent, Aboutevent), 0)).
13023
13024% 
13025% ectest/ec_reader_test_examples.e:6349
13026% [agent1,agent2,aboutevent] % !HoldsAt(HappyFor(agent1,agent2,aboutevent),0).
13027not(holds_at(happyFor(Agent1, Agent2, Aboutevent), 0)).
13028
13029% 
13030% ectest/ec_reader_test_examples.e:6350
13031% [aboutevent] % !HoldsAt(Believe(Kate,aboutevent),0).
13032not(holds_at(believe(kate, Aboutevent), 0)).
13033
13034% 
13035% ectest/ec_reader_test_examples.e:6351
13036% [aboutevent] % !HoldsAt(Believe(Lisa,aboutevent),0).
13037not(holds_at(believe(lisa, Aboutevent), 0)).
13038
13039% 
13040% ectest/ec_reader_test_examples.e:6352
13041% [agent1,agent2,time] % HoldsAt(Like(agent1,agent2),time).
13042holds_at(like(Agent1, Agent2), Time).
13043
13044% 
13045% 
13046% ectest/ec_reader_test_examples.e:6354
13047% [time] % HoldsAt(Desirability(Lisa,Kate,WinLotteryKate,1),time).
13048holds_at(desirability(lisa, kate, winLotteryKate, 1), Time).
13049
13050% 
13051% ectest/ec_reader_test_examples.e:6355
13052% [time] % HoldsAt(Desirability(Kate,Kate,WinLotteryKate,1),time).
13053holds_at(desirability(kate, kate, winLotteryKate, 1), Time).
13054
13055% 
13056% ectest/ec_reader_test_examples.e:6356
13057% [time] % HoldsAt(Desirability(Lisa,Lisa,WinLotteryKate,1),time).
13058holds_at(desirability(lisa, lisa, winLotteryKate, 1), Time).
13059
13060% 
13061% ectest/ec_reader_test_examples.e:6357
13062% [time] % HoldsAt(Desirability(Kate,Kate,WinLotteryLisa,0),time).
13063holds_at(desirability(kate, kate, winLotteryLisa, 0), Time).
13064
13065% 
13066% ectest/ec_reader_test_examples.e:6358
13067% [time] % HoldsAt(Desirability(Kate,Lisa,WinLotteryLisa,0),time).
13068holds_at(desirability(kate, lisa, winLotteryLisa, 0), Time).
13069
13070% 
13071% ectest/ec_reader_test_examples.e:6359
13072% [time] % HoldsAt(Desirability(Kate,Kate,WinLotteryLisa,0),time).
13073holds_at(desirability(kate, kate, winLotteryLisa, 0), Time).
13074
13075% 
13076% ectest/ec_reader_test_examples.e:6360
13077% [time] % HoldsAt(Desirability(Kate,Lisa,WinLotteryKate,0),time).
13078holds_at(desirability(kate, lisa, winLotteryKate, 0), Time).
13079
13080% 
13081% ectest/ec_reader_test_examples.e:6361
13082% [time] % HoldsAt(Desirability(Lisa,Lisa,WinLotteryLisa,0),time).
13083holds_at(desirability(lisa, lisa, winLotteryLisa, 0), Time).
13084
13085% 
13086% ectest/ec_reader_test_examples.e:6362
13087% [time] % HoldsAt(Desirability(Lisa,Kate,WinLotteryLisa,1),time).
13088holds_at(desirability(lisa, kate, winLotteryLisa, 1), Time).
13089
13090% 
13091% 
13092% completion Happens
13093completion(happens).
13094
13095% 
13096% range time 0 3
13097range(time, 0, 3).
13098
13099% range desirability -1 1
13100range(desirability, -1, 1).
13101
13102% ectest/ec_reader_test_examples.e:6368
13103% range offset 1 1
13104range(offset, 1, 1).
13105
13106% 
13107% ; End of file.
13108% 
13109% 
13110% 
13111% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13112% ; FILE: examples/Manual/Example1a.e
13113% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13114% ;
13115% ; Copyright (c) 2005 IBM Corporation and others.
13116% ; All rights reserved. This program and the accompanying materials
13117% ; are made available under the terms of the Common Public License v1.0
13118% ; which accompanies this distribution, and is available at
13119% ; http://www.eclipse.org/legal/cpl-v10.html
13120% ;
13121% ; Contributors:
13122% ; IBM - Initial implementation
13123% ;
13124% ; deduction
13125% ectest/ec_reader_test_examples.e:6388
13126% 
13127% option timediff off
13128option(timediff, off).
13129
13130% 
13131% load foundations/Root.e
13132load('foundations/Root.e').
13133
13134% load foundations/EC.e
13135load('foundations/EC.e').
13136
13137% 
13138% ectest/ec_reader_test_examples.e:6394
13139% sort agent
13140sort(agent).
13141
13142% 
13143% fluent Awake(agent)
13144fluent(awake(agent)).
13145
13146% event WakeUp(agent)
13147event(wakeUp(agent)).
13148
13149% 
13150% ectest/ec_reader_test_examples.e:6399
13151% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
13152initiates(wakeUp(Agent), awake(Agent), Time).
13153
13154% 
13155% 
13156% agent James
13157t(agent, james).
13158
13159% !HoldsAt(Awake(James),0).
13160not(holds_at(awake(james), 0)).
13161
13162% 
13163% Delta:
13164directive(delta).
13165
13166 % Happens(WakeUp(James),0).
13167happens(wakeUp(james), 0).
13168
13169% 
13170% 
13171% ectest/ec_reader_test_examples.e:6405
13172% completion Delta Happens
13173completion(delta).
13174
13175completion(happens).
13176
13177% 
13178% range time 0 1
13179range(time, 0, 1).
13180
13181% range offset 1 1
13182range(offset, 1, 1).
13183
13184% 
13185% 
13186% ectest/ec_reader_test_examples.e:6411
13187% 
13188% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13189% ; FILE: examples/Manual/Example1.e
13190% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13191% ;
13192% ; Copyright (c) 2005 IBM Corporation and others.
13193% ; All rights reserved. This program and the accompanying materials
13194% ; are made available under the terms of the Common Public License v1.0
13195% ; which accompanies this distribution, and is available at
13196% ; http://www.eclipse.org/legal/cpl-v10.html
13197% ;
13198% ; Contributors:
13199% ; IBM - Initial implementation
13200% ;
13201% ; deduction
13202% ectest/ec_reader_test_examples.e:6426
13203% 
13204% load foundations/Root.e
13205load('foundations/Root.e').
13206
13207% load foundations/EC.e
13208load('foundations/EC.e').
13209
13210% 
13211% sort agent
13212sort(agent).
13213
13214% 
13215% ectest/ec_reader_test_examples.e:6432
13216% fluent Awake(agent)
13217fluent(awake(agent)).
13218
13219% event WakeUp(agent)
13220event(wakeUp(agent)).
13221
13222% 
13223% ectest/ec_reader_test_examples.e:6435
13224% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
13225initiates(wakeUp(Agent), awake(Agent), Time).
13226
13227% 
13228% 
13229% agent James
13230t(agent, james).
13231
13232% !HoldsAt(Awake(James),0).
13233not(holds_at(awake(james), 0)).
13234
13235% 
13236% Delta:
13237directive(delta).
13238
13239 % Happens(WakeUp(James),0).
13240happens(wakeUp(james), 0).
13241
13242% 
13243% 
13244% ectest/ec_reader_test_examples.e:6441
13245% completion Delta Happens
13246completion(delta).
13247
13248completion(happens).
13249
13250% 
13251% range time 0 1
13252range(time, 0, 1).
13253
13254% range offset 1 1
13255range(offset, 1, 1).
13256
13257% 
13258% 
13259% ectest/ec_reader_test_examples.e:6447
13260% 
13261% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13262% ; FILE: examples/Manual/Example4.e
13263% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13264% ;
13265% ; Copyright (c) 2005 IBM Corporation and others.
13266% ; All rights reserved. This program and the accompanying materials
13267% ; are made available under the terms of the Common Public License v1.0
13268% ; which accompanies this distribution, and is available at
13269% ; http://www.eclipse.org/legal/cpl-v10.html
13270% ;
13271% ; Contributors:
13272% ; IBM - Initial implementation
13273% ;
13274% ectest/ec_reader_test_examples.e:6461
13275% load foundations/Root.e
13276load('foundations/Root.e').
13277
13278% load foundations/EC.e
13279load('foundations/EC.e').
13280
13281% 
13282% sort agent
13283sort(agent).
13284
13285% 
13286% fluent Awake(agent)
13287fluent(awake(agent)).
13288
13289% ectest/ec_reader_test_examples.e:6467
13290% event WakeUp(agent)
13291event(wakeUp(agent)).
13292
13293% 
13294% ectest/ec_reader_test_examples.e:6469
13295% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
13296initiates(wakeUp(Agent), awake(Agent), Time).
13297
13298% 
13299% ectest/ec_reader_test_examples.e:6470
13300% [agent,time] % Happens(WakeUp(agent),time) -> !HoldsAt(Awake(agent),time).
13301happens(wakeUp(Agent), Time) ->
13302	not(holds_at(awake(Agent), Time)).
13303
13304% 
13305% 
13306% agent James, Jessie
13307t(agent, james).
13308
13309t(agent, jessie).
13310
13311% !HoldsAt(Awake(James),0).
13312not(holds_at(awake(james), 0)).
13313
13314% 
13315% !HoldsAt(Awake(Jessie),0).
13316not(holds_at(awake(jessie), 0)).
13317
13318% 
13319% HoldsAt(Awake(James),1).
13320holds_at(awake(james), 1).
13321
13322% 
13323% ectest/ec_reader_test_examples.e:6476
13324% 
13325% range time 0 1
13326range(time, 0, 1).
13327
13328% range offset 1 1
13329range(offset, 1, 1).
13330
13331% 
13332% 
13333% 
13334% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13335% ; FILE: examples/Manual/Example3.e
13336% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13337% ;
13338% ; Copyright (c) 2005 IBM Corporation and others.
13339% ; All rights reserved. This program and the accompanying materials
13340% ; are made available under the terms of the Common Public License v1.0
13341% ; which accompanies this distribution, and is available at
13342% ; http://www.eclipse.org/legal/cpl-v10.html
13343% ;
13344% ; Contributors:
13345% ; IBM - Initial implementation
13346% ;
13347% ectest/ec_reader_test_examples.e:6495
13348% load foundations/Root.e
13349load('foundations/Root.e').
13350
13351% load foundations/EC.e
13352load('foundations/EC.e').
13353
13354% 
13355% sort agent
13356sort(agent).
13357
13358% 
13359% fluent Awake(agent)
13360fluent(awake(agent)).
13361
13362% ectest/ec_reader_test_examples.e:6501
13363% event WakeUp(agent)
13364event(wakeUp(agent)).
13365
13366% 
13367% ectest/ec_reader_test_examples.e:6503
13368% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
13369initiates(wakeUp(Agent), awake(Agent), Time).
13370
13371% 
13372% 
13373% agent James, Jessie
13374t(agent, james).
13375
13376t(agent, jessie).
13377
13378% !HoldsAt(Awake(James),0).
13379not(holds_at(awake(james), 0)).
13380
13381% 
13382% HoldsAt(Awake(James),1).
13383holds_at(awake(james), 1).
13384
13385% 
13386% 
13387% ectest/ec_reader_test_examples.e:6509
13388% range time 0 1
13389range(time, 0, 1).
13390
13391% range offset 1 1
13392range(offset, 1, 1).
13393
13394% 
13395% 
13396% 
13397% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13398% ; FILE: examples/Manual/Example2.e
13399% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13400% ;
13401% ; Copyright (c) 2005 IBM Corporation and others.
13402% ; All rights reserved. This program and the accompanying materials
13403% ; are made available under the terms of the Common Public License v1.0
13404% ; which accompanies this distribution, and is available at
13405% ; http://www.eclipse.org/legal/cpl-v10.html
13406% ;
13407% ; Contributors:
13408% ; IBM - Initial implementation
13409% ;
13410% ectest/ec_reader_test_examples.e:6527
13411% load foundations/Root.e
13412load('foundations/Root.e').
13413
13414% load foundations/EC.e
13415load('foundations/EC.e').
13416
13417% 
13418% sort agent
13419sort(agent).
13420
13421% 
13422% fluent Awake(agent)
13423fluent(awake(agent)).
13424
13425% ectest/ec_reader_test_examples.e:6533
13426% event WakeUp(agent)
13427event(wakeUp(agent)).
13428
13429% 
13430% ectest/ec_reader_test_examples.e:6535
13431% [agent,time] % Initiates(WakeUp(agent),Awake(agent),time).
13432initiates(wakeUp(Agent), awake(Agent), Time).
13433
13434% 
13435% 
13436% agent James
13437t(agent, james).
13438
13439% !HoldsAt(Awake(James),0).
13440not(holds_at(awake(james), 0)).
13441
13442% 
13443% HoldsAt(Awake(James),1).
13444holds_at(awake(james), 1).
13445
13446% 
13447% 
13448% ectest/ec_reader_test_examples.e:6541
13449% range time 0 1
13450range(time, 0, 1).
13451
13452% range offset 1 1
13453range(offset, 1, 1).
13454
13455% 
13456% 
13457% 
13458% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13459% ; FILE: examples/Mueller2004b/RunningAndDriving2.e
13460% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13461% ;
13462% ; Copyright (c) 2005 IBM Corporation and others.
13463% ; All rights reserved. This program and the accompanying materials
13464% ; are made available under the terms of the Common Public License v1.0
13465% ; which accompanies this distribution, and is available at
13466% ; http://www.eclipse.org/legal/cpl-v10.html
13467% ;
13468% ; Contributors:
13469% ; IBM - Initial implementation
13470% ;
13471% ; @inproceedings{Mueller:2004b,
13472% ;   author = "Erik T. Mueller",
13473% ;   year = "2004",
13474% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
13475% ;   editor = "Valerie Barr and Zdravko Markov",
13476% ;   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",
13477% ;   pages = "147--152",
13478% ;   address = "Menlo Park, CA",
13479% ;   publisher = "AAAI Press",
13480% ; }
13481% ;
13482% ectest/ec_reader_test_examples.e:6570
13483% 
13484% load foundations/Root.e
13485load('foundations/Root.e').
13486
13487% load foundations/EC.e
13488load('foundations/EC.e').
13489
13490% 
13491% sort agent
13492sort(agent).
13493
13494% 
13495% ectest/ec_reader_test_examples.e:6576
13496% fluent Tired(agent)
13497fluent(tired(agent)).
13498
13499% 
13500% event Move(agent)
13501event(move(agent)).
13502
13503% event Run(agent)
13504event(run(agent)).
13505
13506% event Drive(agent)
13507event(drive(agent)).
13508
13509% 
13510% ectest/ec_reader_test_examples.e:6582
13511% [agent,time]% 
13512% Happens(Move(agent),time) ->
13513% Happens(Run(agent),time) | Happens(Drive(agent),time).
13514(   ( happens(move(Agent), Time)->happens(run(Agent), Time)
13515    )
13516;   happens(drive(Agent), Time)
13517).
13518
13519% 
13520% 
13521% xor Run, Drive
13522xor([run, drive]).
13523
13524% 
13525% ectest/ec_reader_test_examples.e:6588
13526% [agent,time] % Initiates(Run(agent),Tired(agent),time).
13527initiates(run(Agent), tired(Agent), Time).
13528
13529% 
13530% 
13531% agent James
13532t(agent, james).
13533
13534% 
13535% !HoldsAt(Tired(James),0).
13536not(holds_at(tired(james), 0)).
13537
13538% 
13539% Happens(Move(James),0).
13540happens(move(james), 0).
13541
13542% 
13543% ectest/ec_reader_test_examples.e:6594
13544% 
13545% range time 0 1
13546range(time, 0, 1).
13547
13548% range offset 1 1
13549range(offset, 1, 1).
13550
13551% 
13552% ; End of file.
13553% 
13554% ectest/ec_reader_test_examples.e:6600
13555% 
13556% 
13557% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13558% ; FILE: examples/Mueller2004b/OffOn.e
13559% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13560% ;
13561% ; Copyright (c) 2005 IBM Corporation and others.
13562% ; All rights reserved. This program and the accompanying materials
13563% ; are made available under the terms of the Common Public License v1.0
13564% ; which accompanies this distribution, and is available at
13565% ; http://www.eclipse.org/legal/cpl-v10.html
13566% ;
13567% ; Contributors:
13568% ; IBM - Initial implementation
13569% ;
13570% ; @inproceedings{Mueller:2004b,
13571% ;   author = "Erik T. Mueller",
13572% ;   year = "2004",
13573% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
13574% ;   editor = "Valerie Barr and Zdravko Markov",
13575% ;   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",
13576% ;   pages = "147--152",
13577% ;   address = "Menlo Park, CA",
13578% ;   publisher = "AAAI Press",
13579% ; }
13580% ;
13581% ectest/ec_reader_test_examples.e:6626
13582% 
13583% load foundations/Root.e
13584load('foundations/Root.e').
13585
13586% load foundations/EC.e
13587load('foundations/EC.e').
13588
13589% 
13590% sort agent
13591sort(agent).
13592
13593% sort switch
13594sort(switch).
13595
13596% ectest/ec_reader_test_examples.e:6632
13597% 
13598% fluent On(switch)
13599fluent(on(switch)).
13600
13601% fluent Off(switch)
13602fluent(off(switch)).
13603
13604% event TurnOn(agent,switch)
13605event(turnOn(agent, switch)).
13606
13607% event TurnOff(agent,switch)
13608event(turnOff(agent, switch)).
13609
13610% 
13611% ectest/ec_reader_test_examples.e:6638
13612% noninertial Off
13613noninertial(off).
13614
13615% 
13616% ectest/ec_reader_test_examples.e:6640
13617% [switch,time] % HoldsAt(Off(switch),time) <-> !HoldsAt(On(switch),time).
13618holds_at(off(Switch), Time) <->
13619	not(holds_at(on(Switch), Time)).
13620
13621% 
13622% 
13623% ectest/ec_reader_test_examples.e:6642
13624% [agent,switch,time] % Initiates(TurnOn(agent,switch),On(switch),time).
13625initiates(turnOn(Agent, Switch), on(Switch), Time).
13626
13627% 
13628% ectest/ec_reader_test_examples.e:6643
13629% [agent,switch,time] % Terminates(TurnOff(agent,switch),On(switch),time).
13630terminates(turnOff(Agent, Switch), on(Switch), Time).
13631
13632% 
13633% 
13634% agent James
13635t(agent, james).
13636
13637% switch Switch1
13638t(switch, switch1).
13639
13640% 
13641% !HoldsAt(On(Switch1),0).
13642not(holds_at(on(switch1), 0)).
13643
13644% 
13645% ectest/ec_reader_test_examples.e:6649
13646% Happens(TurnOn(James,Switch1),0).
13647happens(turnOn(james, switch1), 0).
13648
13649% 
13650% 
13651% range time 0 1
13652range(time, 0, 1).
13653
13654% range offset 1 1
13655range(offset, 1, 1).
13656
13657% 
13658% ; End of file.
13659% ectest/ec_reader_test_examples.e:6655
13660% 
13661% 
13662% 
13663% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13664% ; FILE: examples/Mueller2004b/TV2.e
13665% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13666% ;
13667% ; Copyright (c) 2005 IBM Corporation and others.
13668% ; All rights reserved. This program and the accompanying materials
13669% ; are made available under the terms of the Common Public License v1.0
13670% ; which accompanies this distribution, and is available at
13671% ; http://www.eclipse.org/legal/cpl-v10.html
13672% ;
13673% ; Contributors:
13674% ; IBM - Initial implementation
13675% ;
13676% ; @inproceedings{Mueller:2004b,
13677% ;   author = "Erik T. Mueller",
13678% ;   year = "2004",
13679% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
13680% ;   editor = "Valerie Barr and Zdravko Markov",
13681% ;   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",
13682% ;   pages = "147--152",
13683% ;   address = "Menlo Park, CA",
13684% ;   publisher = "AAAI Press",
13685% ; }
13686% ;
13687% ectest/ec_reader_test_examples.e:6682
13688% 
13689% load foundations/Root.e
13690load('foundations/Root.e').
13691
13692% load foundations/EC.e
13693load('foundations/EC.e').
13694
13695% 
13696% sort agent
13697sort(agent).
13698
13699% sort switch
13700sort(switch).
13701
13702% ectest/ec_reader_test_examples.e:6688
13703% sort tv
13704sort(tv).
13705
13706% 
13707% function TVOf(switch): tv
13708function(tVOf(switch), tv).
13709
13710% fluent SwitchOn(switch)
13711fluent(switchOn(switch)).
13712
13713% fluent TVOn(tv)
13714fluent(tVOn(tv)).
13715
13716% fluent PluggedIn(tv)
13717fluent(pluggedIn(tv)).
13718
13719% ectest/ec_reader_test_examples.e:6694
13720% event TurnOn(agent,switch)
13721event(turnOn(agent, switch)).
13722
13723% event TurnOff(agent,switch)
13724event(turnOff(agent, switch)).
13725
13726% 
13727% ectest/ec_reader_test_examples.e:6697
13728% [agent,switch,time] % Initiates(TurnOn(agent,switch),SwitchOn(switch),time).
13729initiates(turnOn(Agent, Switch), switchOn(Switch), Time).
13730
13731% 
13732% 
13733% ectest/ec_reader_test_examples.e:6699
13734% [agent,switch,tv,time]% 
13735% TVOf(switch)=tv & HoldsAt(PluggedIn(tv),time) ->
13736% Initiates(TurnOn(agent,switch),TVOn(tv),time).
13737tVOf(Switch)=Tv, holds_at(pluggedIn(Tv), Time) ->
13738	initiates(turnOn(Agent, Switch), tVOn(Tv), Time).
13739
13740% 
13741% 
13742% agent James
13743t(agent, james).
13744
13745% switch Switch1
13746t(switch, switch1).
13747
13748% ectest/ec_reader_test_examples.e:6705
13749% tv TV1
13750t(tv, tv1).
13751
13752% 
13753% TVOf(Switch1)=TV1.
13754tVOf(switch1)=tv1.
13755
13756% 
13757% !HoldsAt(PluggedIn(TV1),0).
13758not(holds_at(pluggedIn(tv1), 0)).
13759
13760% 
13761% !HoldsAt(SwitchOn(Switch1),0).
13762not(holds_at(switchOn(switch1), 0)).
13763
13764% 
13765% !HoldsAt(TVOn(TV1),0).
13766not(holds_at(tVOn(tv1), 0)).
13767
13768% 
13769% ectest/ec_reader_test_examples.e:6711
13770% Happens(TurnOn(James,Switch1),0).
13771happens(turnOn(james, switch1), 0).
13772
13773% 
13774% 
13775% range time 0 1
13776range(time, 0, 1).
13777
13778% range offset 1 1
13779range(offset, 1, 1).
13780
13781% 
13782% ; End of file.
13783% ectest/ec_reader_test_examples.e:6717
13784% 
13785% 
13786% 
13787% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13788% ; FILE: examples/Mueller2004b/Approve.e
13789% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13790% ;
13791% ; Copyright (c) 2005 IBM Corporation and others.
13792% ; All rights reserved. This program and the accompanying materials
13793% ; are made available under the terms of the Common Public License v1.0
13794% ; which accompanies this distribution, and is available at
13795% ; http://www.eclipse.org/legal/cpl-v10.html
13796% ;
13797% ; Contributors:
13798% ; IBM - Initial implementation
13799% ;
13800% ; example of concurrent events with cumulative or canceling effects
13801% ;
13802% ; @inproceedings{Mueller:2004b,
13803% ;   author = "Erik T. Mueller",
13804% ;   year = "2004",
13805% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
13806% ;   editor = "Valerie Barr and Zdravko Markov",
13807% ;   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",
13808% ;   pages = "147--152",
13809% ;   address = "Menlo Park, CA",
13810% ;   publisher = "AAAI Press",
13811% ; }
13812% ;
13813% ectest/ec_reader_test_examples.e:6746
13814% 
13815% load foundations/Root.e
13816load('foundations/Root.e').
13817
13818% load foundations/EC.e
13819load('foundations/EC.e').
13820
13821% 
13822% sort agent
13823sort(agent).
13824
13825% 
13826% ectest/ec_reader_test_examples.e:6752
13827% event ApproveOf(agent,agent)
13828event(approveOf(agent, agent)).
13829
13830% event DisapproveOf(agent,agent)
13831event(disapproveOf(agent, agent)).
13832
13833% fluent Happy(agent)
13834fluent(happy(agent)).
13835
13836% fluent Confused(agent)
13837fluent(confused(agent)).
13838
13839% 
13840% ectest/ec_reader_test_examples.e:6757
13841% [agent1,agent2,time]% 
13842% !Happens(DisapproveOf(agent1,agent2),time) ->
13843% Initiates(ApproveOf(agent1,agent2),Happy(agent2),time).
13844not(happens(disapproveOf(Agent1, Agent2), Time)) ->
13845	initiates(approveOf(Agent1, Agent2),
13846		  happy(Agent2),
13847		  Time).
13848
13849% 
13850% 
13851% ectest/ec_reader_test_examples.e:6761
13852% [agent1,agent2,time]% 
13853% !Happens(ApproveOf(agent1,agent2),time) ->
13854% Terminates(DisapproveOf(agent1,agent2),Happy(agent2),time).
13855not(happens(approveOf(Agent1, Agent2), Time)) ->
13856	terminates(disapproveOf(Agent1, Agent2),
13857		   happy(Agent2),
13858		   Time).
13859
13860% 
13861% 
13862% ectest/ec_reader_test_examples.e:6765
13863% [agent1,agent2,time]% 
13864% Happens(DisapproveOf(agent1,agent2),time) ->
13865% Initiates(ApproveOf(agent1,agent2),Confused(agent2),time).
13866happens(disapproveOf(Agent1, Agent2), Time) ->
13867	initiates(approveOf(Agent1, Agent2),
13868		  confused(Agent2),
13869		  Time).
13870
13871% 
13872% 
13873% agent James, Peter
13874t(agent, james).
13875
13876t(agent, peter).
13877
13878% 
13879% ectest/ec_reader_test_examples.e:6771
13880% [agent] % !HoldsAt(Happy(agent),0) & !HoldsAt(Confused(agent),0).
13881not(holds_at(happy(Agent), 0)),
13882not(holds_at(confused(Agent), 0)).
13883
13884% 
13885% 
13886% Happens(ApproveOf(Peter,James),0).
13887happens(approveOf(peter, james), 0).
13888
13889% 
13890% Happens(DisapproveOf(Peter,James),0).
13891happens(disapproveOf(peter, james), 0).
13892
13893% 
13894% 
13895% completion Happens
13896completion(happens).
13897
13898% ectest/ec_reader_test_examples.e:6777
13899% 
13900% range time 0 1
13901range(time, 0, 1).
13902
13903% range offset 1 1
13904range(offset, 1, 1).
13905
13906% 
13907% ; End of file.
13908% 
13909% ectest/ec_reader_test_examples.e:6783
13910% 
13911% 
13912% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13913% ; FILE: examples/Mueller2004b/Leaf.e
13914% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13915% ;
13916% ; Copyright (c) 2005 IBM Corporation and others.
13917% ; All rights reserved. This program and the accompanying materials
13918% ; are made available under the terms of the Common Public License v1.0
13919% ; which accompanies this distribution, and is available at
13920% ; http://www.eclipse.org/legal/cpl-v10.html
13921% ;
13922% ; Contributors:
13923% ; IBM - Initial implementation
13924% ;
13925% ; @inproceedings{Mueller:2004b,
13926% ;   author = "Erik T. Mueller",
13927% ;   year = "2004",
13928% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
13929% ;   editor = "Valerie Barr and Zdravko Markov",
13930% ;   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",
13931% ;   pages = "147--152",
13932% ;   address = "Menlo Park, CA",
13933% ;   publisher = "AAAI Press",
13934% ; }
13935% ;
13936% ectest/ec_reader_test_examples.e:6809
13937% 
13938% option trajectory on
13939option(trajectory, on).
13940
13941% 
13942% load foundations/Root.e
13943load('foundations/Root.e').
13944
13945% load foundations/EC.e
13946load('foundations/EC.e').
13947
13948% 
13949% ectest/ec_reader_test_examples.e:6815
13950% sort object
13951sort(object).
13952
13953% sort height: integer
13954subsort(height, integer).
13955
13956% 
13957% fluent Height(object,height)
13958fluent(height(object, height)).
13959
13960% fluent Falling(object)
13961fluent(falling(object)).
13962
13963% event StartFalling(object)
13964event(startFalling(object)).
13965
13966% ectest/ec_reader_test_examples.e:6821
13967% event HitsGround(object)
13968event(hitsGround(object)).
13969
13970% 
13971% ectest/ec_reader_test_examples.e:6823
13972% [object,height1,height2,time]% 
13973% HoldsAt(Height(object,height1),time) &
13974% HoldsAt(Height(object,height2),time) ->
13975% height1=height2.
13976holds_at(height(Object, Height1), Time), holds_at(height(Object, Height2), Time) ->
13977	Height1=Height2.
13978
13979% 
13980% 
13981% ectest/ec_reader_test_examples.e:6828
13982% [object,time]% 
13983% Initiates(StartFalling(object),Falling(object),time).
13984initiates(startFalling(Object), falling(Object), Time).
13985
13986% 
13987% 
13988% ectest/ec_reader_test_examples.e:6831
13989% [object,height,time]% 
13990% Releases(StartFalling(object),Height(object,height),time).
13991releases(startFalling(Object), height(Object, Height), Time).
13992
13993% 
13994% 
13995% ectest/ec_reader_test_examples.e:6834
13996% [object,height1,height2,offset,time]% 
13997% HoldsAt(Height(object,height1),time) &
13998% height2=height1-offset ->
13999% Trajectory(Falling(object),time,Height(object,height2),offset).
14000holds_at(height(Object, Height1), Time), Height2=Height1-Offset ->
14001	trajectory(falling(Object),
14002		   Time,
14003		   height(Object, Height2),
14004		   Offset).
14005
14006% 
14007% 
14008% ectest/ec_reader_test_examples.e:6839
14009% [object,time]% 
14010% HoldsAt(Falling(object),time) &
14011% HoldsAt(Height(object,0),time) ->
14012% Happens(HitsGround(object),time).
14013holds_at(falling(Object), Time), holds_at(height(Object, 0), Time) ->
14014	happens(hitsGround(Object), Time).
14015
14016% 
14017% 
14018% ;[object,height1,height2,time]
14019% ;HoldsAt(Height(object,height1),time) &
14020% ;height1 != height2 ->
14021% ;Terminates(HitsGround(object),Height(object,height2),time).
14022% ectest/ec_reader_test_examples.e:6848
14023% 
14024% ectest/ec_reader_test_examples.e:6849
14025% [object,height,time]% 
14026% HoldsAt(Height(object,height),time) ->
14027% Initiates(HitsGround(object),Height(object,height),time).
14028holds_at(height(Object, Height), Time) ->
14029	initiates(hitsGround(Object),
14030		  height(Object, Height),
14031		  Time).
14032
14033% 
14034% 
14035% ectest/ec_reader_test_examples.e:6853
14036% [object,time]% 
14037% Terminates(HitsGround(object),Falling(object),time).
14038terminates(hitsGround(Object), falling(Object), Time).
14039
14040% 
14041% 
14042% object Leaf
14043t(object, leaf).
14044
14045% 
14046% !HoldsAt(Falling(Leaf),0).
14047not(holds_at(falling(leaf), 0)).
14048
14049% 
14050% ectest/ec_reader_test_examples.e:6859
14051% HoldsAt(Height(Leaf,4),0).
14052holds_at(height(leaf, 4), 0).
14053
14054% 
14055% Happens(StartFalling(Leaf),2).
14056happens(startFalling(leaf), 2).
14057
14058% 
14059% 
14060% completion Happens
14061completion(happens).
14062
14063% 
14064% range time 0 7
14065range(time, 0, 7).
14066
14067% ectest/ec_reader_test_examples.e:6865
14068% range offset 1 4
14069range(offset, 1, 4).
14070
14071% range height 0 4
14072range(height, 0, 4).
14073
14074% 
14075% ; End of file.
14076% 
14077% 
14078% ectest/ec_reader_test_examples.e:6871
14079% 
14080% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14081% ; FILE: examples/Mueller2004b/RunningAndDriving1.e
14082% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14083% ;
14084% ; Copyright (c) 2005 IBM Corporation and others.
14085% ; All rights reserved. This program and the accompanying materials
14086% ; are made available under the terms of the Common Public License v1.0
14087% ; which accompanies this distribution, and is available at
14088% ; http://www.eclipse.org/legal/cpl-v10.html
14089% ;
14090% ; Contributors:
14091% ; IBM - Initial implementation
14092% ;
14093% ; @inproceedings{Mueller:2004b,
14094% ;   author = "Erik T. Mueller",
14095% ;   year = "2004",
14096% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
14097% ;   editor = "Valerie Barr and Zdravko Markov",
14098% ;   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",
14099% ;   pages = "147--152",
14100% ;   address = "Menlo Park, CA",
14101% ;   publisher = "AAAI Press",
14102% ; }
14103% ;
14104% ectest/ec_reader_test_examples.e:6896
14105% 
14106% load foundations/Root.e
14107load('foundations/Root.e').
14108
14109% load foundations/EC.e
14110load('foundations/EC.e').
14111
14112% 
14113% sort agent
14114sort(agent).
14115
14116% 
14117% ectest/ec_reader_test_examples.e:6902
14118% fluent Tired(agent)
14119fluent(tired(agent)).
14120
14121% 
14122% event Move(agent)
14123event(move(agent)).
14124
14125% event Run(agent)
14126event(run(agent)).
14127
14128% event Drive(agent)
14129event(drive(agent)).
14130
14131% 
14132% ectest/ec_reader_test_examples.e:6908
14133% [agent,time]% 
14134% Happens(Move(agent),time) ->
14135% Happens(Run(agent),time) | Happens(Drive(agent),time).
14136(   ( happens(move(Agent), Time)->happens(run(Agent), Time)
14137    )
14138;   happens(drive(Agent), Time)
14139).
14140
14141% 
14142% 
14143% xor Run, Drive
14144xor([run, drive]).
14145
14146% 
14147% ectest/ec_reader_test_examples.e:6914
14148% [agent,time] % Initiates(Run(agent),Tired(agent),time).
14149initiates(run(Agent), tired(Agent), Time).
14150
14151% 
14152% 
14153% agent James
14154t(agent, james).
14155
14156% 
14157% !HoldsAt(Tired(James),0).
14158not(holds_at(tired(james), 0)).
14159
14160% 
14161% Happens(Move(James),0).
14162happens(move(james), 0).
14163
14164% 
14165% ectest/ec_reader_test_examples.e:6920
14166% HoldsAt(Tired(James),1).
14167holds_at(tired(james), 1).
14168
14169% 
14170% 
14171% range time 0 1
14172range(time, 0, 1).
14173
14174% range offset 1 1
14175range(offset, 1, 1).
14176
14177% 
14178% ; End of file.
14179% ectest/ec_reader_test_examples.e:6926
14180% 
14181% 
14182% 
14183% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14184% ; FILE: examples/Mueller2004b/TV1.e
14185% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14186% ;
14187% ; Copyright (c) 2005 IBM Corporation and others.
14188% ; All rights reserved. This program and the accompanying materials
14189% ; are made available under the terms of the Common Public License v1.0
14190% ; which accompanies this distribution, and is available at
14191% ; http://www.eclipse.org/legal/cpl-v10.html
14192% ;
14193% ; Contributors:
14194% ; IBM - Initial implementation
14195% ;
14196% ; @inproceedings{Mueller:2004b,
14197% ;   author = "Erik T. Mueller",
14198% ;   year = "2004",
14199% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
14200% ;   editor = "Valerie Barr and Zdravko Markov",
14201% ;   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",
14202% ;   pages = "147--152",
14203% ;   address = "Menlo Park, CA",
14204% ;   publisher = "AAAI Press",
14205% ; }
14206% ;
14207% ectest/ec_reader_test_examples.e:6953
14208% 
14209% load foundations/Root.e
14210load('foundations/Root.e').
14211
14212% load foundations/EC.e
14213load('foundations/EC.e').
14214
14215% 
14216% sort agent
14217sort(agent).
14218
14219% sort switch
14220sort(switch).
14221
14222% ectest/ec_reader_test_examples.e:6959
14223% sort tv
14224sort(tv).
14225
14226% 
14227% function TVOf(switch): tv
14228function(tVOf(switch), tv).
14229
14230% fluent SwitchOn(switch)
14231fluent(switchOn(switch)).
14232
14233% fluent TVOn(tv)
14234fluent(tVOn(tv)).
14235
14236% fluent PluggedIn(tv)
14237fluent(pluggedIn(tv)).
14238
14239% ectest/ec_reader_test_examples.e:6965
14240% event TurnOn(agent,switch)
14241event(turnOn(agent, switch)).
14242
14243% event TurnOff(agent,switch)
14244event(turnOff(agent, switch)).
14245
14246% 
14247% ectest/ec_reader_test_examples.e:6968
14248% [agent,switch,time] % Initiates(TurnOn(agent,switch),SwitchOn(switch),time).
14249initiates(turnOn(Agent, Switch), switchOn(Switch), Time).
14250
14251% 
14252% 
14253% ectest/ec_reader_test_examples.e:6970
14254% [agent,switch,tv,time]% 
14255% TVOf(switch)=tv & HoldsAt(PluggedIn(tv),time) ->
14256% Initiates(TurnOn(agent,switch),TVOn(tv),time).
14257tVOf(Switch)=Tv, holds_at(pluggedIn(Tv), Time) ->
14258	initiates(turnOn(Agent, Switch), tVOn(Tv), Time).
14259
14260% 
14261% 
14262% agent James
14263t(agent, james).
14264
14265% switch Switch1
14266t(switch, switch1).
14267
14268% ectest/ec_reader_test_examples.e:6976
14269% tv TV1
14270t(tv, tv1).
14271
14272% 
14273% TVOf(Switch1)=TV1.
14274tVOf(switch1)=tv1.
14275
14276% 
14277% HoldsAt(PluggedIn(TV1),0).
14278holds_at(pluggedIn(tv1), 0).
14279
14280% 
14281% !HoldsAt(SwitchOn(Switch1),0).
14282not(holds_at(switchOn(switch1), 0)).
14283
14284% 
14285% !HoldsAt(TVOn(TV1),0).
14286not(holds_at(tVOn(tv1), 0)).
14287
14288% 
14289% ectest/ec_reader_test_examples.e:6982
14290% Happens(TurnOn(James,Switch1),0).
14291happens(turnOn(james, switch1), 0).
14292
14293% 
14294% 
14295% range time 0 1
14296range(time, 0, 1).
14297
14298% range offset 1 1
14299range(offset, 1, 1).
14300
14301% 
14302% ; End of file.
14303% ectest/ec_reader_test_examples.e:6988
14304% 
14305% 
14306% 
14307% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14308% ; FILE: examples/Mueller2004b/RouletteWheel.e
14309% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14310% ;
14311% ; Copyright (c) 2005 IBM Corporation and others.
14312% ; All rights reserved. This program and the accompanying materials
14313% ; are made available under the terms of the Common Public License v1.0
14314% ; which accompanies this distribution, and is available at
14315% ; http://www.eclipse.org/legal/cpl-v10.html
14316% ;
14317% ; Contributors:
14318% ; IBM - Initial implementation
14319% ;
14320% ; @inproceedings{Mueller:2004b,
14321% ;   author = "Erik T. Mueller",
14322% ;   year = "2004",
14323% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
14324% ;   editor = "Valerie Barr and Zdravko Markov",
14325% ;   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",
14326% ;   pages = "147--152",
14327% ;   address = "Menlo Park, CA",
14328% ;   publisher = "AAAI Press",
14329% ; }
14330% ;
14331% ectest/ec_reader_test_examples.e:7015
14332% 
14333% load foundations/Root.e
14334load('foundations/Root.e').
14335
14336% load foundations/EC.e
14337load('foundations/EC.e').
14338
14339% 
14340% sort wheel
14341sort(wheel).
14342
14343% sort value: integer
14344subsort(value, integer).
14345
14346% ectest/ec_reader_test_examples.e:7021
14347% 
14348% fluent WheelValueDeterminingFluent(wheel,value)
14349fluent(wheelValueDeterminingFluent(wheel, value)).
14350
14351% fluent WheelValue(wheel,value)
14352fluent(wheelValue(wheel, value)).
14353
14354% noninertial WheelValueDeterminingFluent
14355noninertial(wheelValueDeterminingFluent).
14356
14357% event Spin(wheel)
14358event(spin(wheel)).
14359
14360% 
14361% ectest/ec_reader_test_examples.e:7027
14362% [wheel,value1,value2,time]% 
14363% HoldsAt(WheelValue(wheel,value1),time) &
14364% HoldsAt(WheelValue(wheel,value2),time) ->
14365% value1=value2.
14366holds_at(wheelValue(Wheel, Value1), Time), holds_at(wheelValue(Wheel, Value2), Time) ->
14367	Value1=Value2.
14368
14369% 
14370% 
14371% ectest/ec_reader_test_examples.e:7032
14372% [wheel,value1,value2,time]% 
14373% HoldsAt(WheelValueDeterminingFluent(wheel,value1),time) &
14374% HoldsAt(WheelValueDeterminingFluent(wheel,value2),time) ->
14375% value1=value2.
14376holds_at(wheelValueDeterminingFluent(Wheel, Value1), Time), holds_at(wheelValueDeterminingFluent(Wheel, Value2), Time) ->
14377	Value1=Value2.
14378
14379% 
14380% 
14381% ectest/ec_reader_test_examples.e:7037
14382% [wheel,value,time]% 
14383% HoldsAt(WheelValueDeterminingFluent(wheel,value),time) ->
14384% Initiates(Spin(wheel),WheelValue(wheel,value),time).
14385holds_at(wheelValueDeterminingFluent(Wheel, Value), Time) ->
14386	initiates(spin(Wheel),
14387		  wheelValue(Wheel, Value),
14388		  Time).
14389
14390% 
14391% 
14392% ectest/ec_reader_test_examples.e:7041
14393% [wheel,value1,value2,time]% 
14394% HoldsAt(WheelValue(wheel,value1),time) &
14395% HoldsAt(WheelValueDeterminingFluent(wheel,value2),time) &
14396% value1!=value2 ->
14397% Terminates(Spin(wheel),WheelValue(wheel,value1),time).
14398holds_at(wheelValue(Wheel, Value1), Time), holds_at(wheelValueDeterminingFluent(Wheel, Value2), Time), Value1\=Value2 ->
14399	terminates(spin(Wheel),
14400		   wheelValue(Wheel, Value1),
14401		   Time).
14402
14403% 
14404% 
14405% ectest/ec_reader_test_examples.e:7047
14406% [wheel,time]% 
14407% ectest/ec_reader_test_examples.e:7048
14408% {value} % HoldsAt(WheelValueDeterminingFluent(wheel,value),time).
14409exists([Value], holds_at(wheelValueDeterminingFluent(Wheel, Value), Time)).
14410
14411% 
14412% 
14413% wheel Wheel
14414t(wheel, wheel).
14415
14416% 
14417% HoldsAt(WheelValue(Wheel,7),0).
14418holds_at(wheelValue(wheel, 7), 0).
14419
14420% 
14421% Happens(Spin(Wheel),0).
14422happens(spin(wheel), 0).
14423
14424% 
14425% ectest/ec_reader_test_examples.e:7054
14426% HoldsAt(WheelValueDeterminingFluent(Wheel,7),1).
14427holds_at(wheelValueDeterminingFluent(wheel, 7), 1).
14428
14429% 
14430% 
14431% completion Happens
14432completion(happens).
14433
14434% 
14435% range value 7 10
14436range(value, 7, 10).
14437
14438% range time 0 1
14439range(time, 0, 1).
14440
14441% ectest/ec_reader_test_examples.e:7060
14442% range offset 1 1
14443range(offset, 1, 1).
14444
14445% 
14446% ; End of file.
14447% 
14448% 
14449% 
14450% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14451% ; FILE: examples/Mueller2004b/PickUp.e
14452% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14453% ;
14454% ; Copyright (c) 2005 IBM Corporation and others.
14455% ; All rights reserved. This program and the accompanying materials
14456% ; are made available under the terms of the Common Public License v1.0
14457% ; which accompanies this distribution, and is available at
14458% ; http://www.eclipse.org/legal/cpl-v10.html
14459% ;
14460% ; Contributors:
14461% ; IBM - Initial implementation
14462% ;
14463% ; @inproceedings{Mueller:2004b,
14464% ;   author = "Erik T. Mueller",
14465% ;   year = "2004",
14466% ;   title = "A tool for satisfiability-based commonsense reasoning in the event calculus",
14467% ;   editor = "Valerie Barr and Zdravko Markov",
14468% ;   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",
14469% ;   pages = "147--152",
14470% ;   address = "Menlo Park, CA",
14471% ;   publisher = "AAAI Press",
14472% ; }
14473% ;
14474% ectest/ec_reader_test_examples.e:7090
14475% 
14476% load foundations/Root.e
14477load('foundations/Root.e').
14478
14479% load foundations/EC.e
14480load('foundations/EC.e').
14481
14482% 
14483% sort object
14484sort(object).
14485
14486% sort agent: object
14487subsort(agent, object).
14488
14489% ectest/ec_reader_test_examples.e:7096
14490% sort physobj: object
14491subsort(physobj, object).
14492
14493% sort location
14494sort(location).
14495
14496% 
14497% fluent At(object,location)
14498fluent(at(object, location)).
14499
14500% fluent Holding(agent,physobj)
14501fluent(holding(agent, physobj)).
14502
14503% event PickUp(agent,physobj)
14504event(pickUp(agent, physobj)).
14505
14506% ectest/ec_reader_test_examples.e:7102
14507% event SetDown(agent,physobj)
14508event(setDown(agent, physobj)).
14509
14510% event Move(agent,location,location)
14511event(move(agent, location, location)).
14512
14513% 
14514% ; state constraints
14515% 
14516% ectest/ec_reader_test_examples.e:7107
14517% [agent,location,physobj,time]% 
14518% HoldsAt(At(agent,location),time) &
14519% HoldsAt(Holding(agent,physobj),time) ->
14520% HoldsAt(At(physobj,location),time).
14521holds_at(at(Agent, Location), Time), holds_at(holding(Agent, Physobj), Time) ->
14522	holds_at(at(Physobj, Location), Time).
14523
14524% 
14525% 
14526% ectest/ec_reader_test_examples.e:7112
14527% [object,location1,location2,time]% 
14528% HoldsAt(At(object,location1),time) &
14529% HoldsAt(At(object,location2),time) ->
14530% location1=location2.
14531holds_at(at(Object, Location1), Time), holds_at(at(Object, Location2), Time) ->
14532	Location1=Location2.
14533
14534% 
14535% 
14536% ; effect axioms
14537% ectest/ec_reader_test_examples.e:7118
14538% 
14539% ectest/ec_reader_test_examples.e:7119
14540% [agent,location1,location2,time]% 
14541% Initiates(Move(agent,location1,location2),At(agent,location2),time).
14542initiates(move(Agent, Location1, Location2), at(Agent, Location2), Time).
14543
14544% 
14545% 
14546% ectest/ec_reader_test_examples.e:7122
14547% [agent,location1,location2,time]% 
14548% Terminates(Move(agent,location1,location2),At(agent,location1),time).
14549terminates(move(Agent, Location1, Location2), at(Agent, Location1), Time).
14550
14551% 
14552% 
14553% ectest/ec_reader_test_examples.e:7125
14554% [agent,physobj,time]% 
14555% Initiates(PickUp(agent,physobj),Holding(agent,physobj),time).
14556initiates(pickUp(Agent, Physobj), holding(Agent, Physobj), Time).
14557
14558% 
14559% 
14560% ectest/ec_reader_test_examples.e:7128
14561% [agent,physobj,time]% 
14562% Terminates(SetDown(agent,physobj),Holding(agent,physobj),time).
14563terminates(setDown(Agent, Physobj), holding(Agent, Physobj), Time).
14564
14565% 
14566% 
14567% ; preconditions
14568% 
14569% ectest/ec_reader_test_examples.e:7133
14570% [agent,location1,location2,time]% 
14571% Happens(Move(agent,location1,location2),time) ->
14572% HoldsAt(At(agent,location1),time).
14573happens(move(Agent, Location1, Location2), Time) ->
14574	holds_at(at(Agent, Location1), Time).
14575
14576% 
14577% 
14578% ectest/ec_reader_test_examples.e:7137
14579% [agent,physobj,time]% 
14580% Happens(PickUp(agent,physobj),time) ->
14581% ectest/ec_reader_test_examples.e:7139
14582% {location}%  HoldsAt(At(agent,location),time) &
14583%            HoldsAt(At(physobj,location),time).
14584exists([Location],  (happens(pickUp(Agent, Physobj), Time)->holds_at(at(Agent, Location), Time), holds_at(at(Physobj, Location), Time))).
14585
14586% 
14587% 
14588% ; releases
14589% 
14590% ectest/ec_reader_test_examples.e:7144
14591% [agent,physobj,location,time]% 
14592% Releases(PickUp(agent,physobj),At(physobj,location),time).
14593releases(pickUp(Agent, Physobj), at(Physobj, Location), Time).
14594
14595% 
14596% 
14597% ectest/ec_reader_test_examples.e:7147
14598% [agent,physobj,location,time]% 
14599% HoldsAt(At(agent,location),time) ->
14600% Initiates(SetDown(agent,physobj),At(physobj,location),time).
14601holds_at(at(Agent, Location), Time) ->
14602	initiates(setDown(Agent, Physobj),
14603		  at(Physobj, Location),
14604		  Time).
14605
14606% 
14607% 
14608% ;[agent,physobj,location1,location2,time]
14609% ;HoldsAt(At(agent,location1),time) &
14610% ;location1 != location2 ->
14611% ;Terminates(SetDown(agent,physobj),At(physobj,location2),time).
14612% ectest/ec_reader_test_examples.e:7155
14613% 
14614% agent James
14615t(agent, james).
14616
14617% physobj Coin
14618t(physobj, coin).
14619
14620% location L1, L2, L3, L4
14621t(location, l1).
14622
14623t(location, l2).
14624
14625t(location, l3).
14626
14627t(location, l4).
14628
14629% 
14630% !HoldsAt(Holding(James,Coin),0).
14631not(holds_at(holding(james, coin), 0)).
14632
14633% 
14634% ectest/ec_reader_test_examples.e:7161
14635% HoldsAt(At(Coin,L4),0).
14636holds_at(at(coin, l4), 0).
14637
14638% 
14639% HoldsAt(At(James,L1),0).
14640holds_at(at(james, l1), 0).
14641
14642% 
14643% Happens(Move(James,L1,L2),0).
14644happens(move(james, l1, l2), 0).
14645
14646% 
14647% Happens(Move(James,L2,L3),1).
14648happens(move(james, l2, l3), 1).
14649
14650% 
14651% Happens(Move(James,L3,L4),2).
14652happens(move(james, l3, l4), 2).
14653
14654% 
14655% Happens(PickUp(James,Coin),3).
14656happens(pickUp(james, coin), 3).
14657
14658% 
14659% ectest/ec_reader_test_examples.e:7167
14660% Happens(Move(James,L4,L3),4).
14661happens(move(james, l4, l3), 4).
14662
14663% 
14664% Happens(Move(James,L3,L2),5).
14665happens(move(james, l3, l2), 5).
14666
14667% 
14668% Happens(SetDown(James,Coin),6).
14669happens(setDown(james, coin), 6).
14670
14671% 
14672% Happens(Move(James,L2,L3),7).
14673happens(move(james, l2, l3), 7).
14674
14675% 
14676% Happens(Move(James,L3,L4),8).
14677happens(move(james, l3, l4), 8).
14678
14679% 
14680% 
14681% ectest/ec_reader_test_examples.e:7173
14682% completion Happens
14683completion(happens).
14684
14685% 
14686% range time 0 9
14687range(time, 0, 9).
14688
14689% range offset 1 1
14690range(offset, 1, 1).
14691
14692% 
14693% ; End of file.
14694% ectest/ec_reader_test_examples.e:7179
14695% 
14696% 
14697% 
14698% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14699% ; FILE: examples/FrankEtAl2003/Story1.e
14700% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14701% ;
14702% ; Copyright (c) 2005 IBM Corporation and others.
14703% ; All rights reserved. This program and the accompanying materials
14704% ; are made available under the terms of the Common Public License v1.0
14705% ; which accompanies this distribution, and is available at
14706% ; http://www.eclipse.org/legal/cpl-v10.html
14707% ;
14708% ; Contributors:
14709% ; IBM - Initial implementation
14710% ;
14711% ; @article{FrankEtAl:2003,
14712% ;   author = "Stefan L. Frank and Mathieu Koppen and Leo G. M. Noordman and Wietske Vonk",
14713% ;   year = "2003",
14714% ;   title = "Modeling knowledge-based inferences in story comprehension",
14715% ;   journal = "Cognitive Science",
14716% ;   volume = "27",
14717% ;   pages = "875--910",
14718% ; }
14719% ;
14720% ectest/ec_reader_test_examples.e:7204
14721% 
14722% option modeldiff on
14723option(modeldiff, on).
14724
14725% 
14726% load foundations/Root.e
14727load('foundations/Root.e').
14728
14729% load foundations/EC.e
14730load('foundations/EC.e').
14731
14732% 
14733% ectest/ec_reader_test_examples.e:7210
14734% sort agent
14735sort(agent).
14736
14737% 
14738% load examples/FrankEtAl2003/FrankEtAl.e
14739load('examples/FrankEtAl2003/FrankEtAl.e').
14740
14741% 
14742% agent Bob, Jilly
14743t(agent, bob).
14744
14745t(agent, jilly).
14746
14747% 
14748% ectest/ec_reader_test_examples.e:7216
14749% !HoldsAt(Raining(),0).
14750not(holds_at(raining(), 0)).
14751
14752% 
14753% !HoldsAt(SunShining(),0).
14754not(holds_at(sunShining(), 0)).
14755
14756% 
14757% 
14758% (HoldsAt(PlaySoccer(Bob),1) & HoldsAt(PlaySoccer(Jilly),1)) |
14759% (HoldsAt(PlayHideAndSeek(Bob),1) & HoldsAt(PlayHideAndSeek(Jilly),1)) |
14760% (HoldsAt(PlayComputerGame(Bob),1) & HoldsAt(PlayComputerGame(Jilly),1)).
14761(   holds_at(playSoccer(bob), 1),
14762    holds_at(playSoccer(jilly), 1)
14763;   holds_at(playHideAndSeek(bob), 1),
14764    holds_at(playHideAndSeek(jilly), 1)
14765;   holds_at(playComputerGame(bob), 1),
14766    holds_at(playComputerGame(jilly), 1)
14767).
14768
14769% 
14770% ectest/ec_reader_test_examples.e:7222
14771% 
14772% HoldsAt(Win(Bob),1) | HoldsAt(Win(Jilly),1).
14773(   holds_at(win(bob), 1)
14774;   holds_at(win(jilly), 1)
14775).
14776
14777% 
14778% 
14779% range time 0 1
14780range(time, 0, 1).
14781
14782% range offset 0 0
14783range(offset, 0, 0).
14784
14785% 
14786% ; End of file.
14787% ectest/ec_reader_test_examples.e:7229
14788% 
14789% 
14790% 
14791% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14792% ; FILE: examples/FrankEtAl2003/FrankEtAl.e
14793% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14794% ;
14795% ; Copyright (c) 2005 IBM Corporation and others.
14796% ; All rights reserved. This program and the accompanying materials
14797% ; are made available under the terms of the Common Public License v1.0
14798% ; which accompanies this distribution, and is available at
14799% ; http://www.eclipse.org/legal/cpl-v10.html
14800% ;
14801% ; Contributors:
14802% ; IBM - Initial implementation
14803% ;
14804% ; @article{FrankEtAl:2003,
14805% ;   author = "Stefan L. Frank and Mathieu Koppen and Leo G. M. Noordman and Wietske Vonk",
14806% ;   year = "2003",
14807% ;   title = "Modeling knowledge-based inferences in story comprehension",
14808% ;   journal = "Cognitive Science",
14809% ;   volume = "27",
14810% ;   pages = "875--910",
14811% ; }
14812% ;
14813% ectest/ec_reader_test_examples.e:7254
14814% 
14815% fluent SunShining()
14816fluent(sunShining()).
14817
14818% fluent Raining()
14819fluent(raining()).
14820
14821% fluent Outside(agent)
14822fluent(outside(agent)).
14823
14824% fluent PlaySoccer(agent)
14825fluent(playSoccer(agent)).
14826
14827% fluent PlayHideAndSeek(agent)
14828fluent(playHideAndSeek(agent)).
14829
14830% ectest/ec_reader_test_examples.e:7260
14831% fluent PlayComputerGame(agent)
14832fluent(playComputerGame(agent)).
14833
14834% fluent PlayWithDog(agent)
14835fluent(playWithDog(agent)).
14836
14837% fluent Win(agent)
14838fluent(win(agent)).
14839
14840% 
14841% noninertial Outside, PlaySoccer, PlayHideAndSeek, PlayComputerGame
14842noninertial([outside, playSoccer, playHideAndSeek, playComputerGame]).
14843
14844% noninertial PlayWithDog, Win
14845noninertial([playWithDog, win]).
14846
14847% ectest/ec_reader_test_examples.e:7266
14848% 
14849% xor PlaySoccer, PlayHideAndSeek, PlayComputerGame, PlayWithDog
14850xor([playSoccer, playHideAndSeek, playComputerGame, playWithDog]).
14851
14852% 
14853% ectest/ec_reader_test_examples.e:7269
14854% [agent,time]% 
14855% HoldsAt(PlaySoccer(agent),time) ->
14856% HoldsAt(Outside(agent),time).
14857holds_at(playSoccer(Agent), Time) ->
14858	holds_at(outside(Agent), Time).
14859
14860% 
14861% 
14862% ectest/ec_reader_test_examples.e:7273
14863% [agent,time]% 
14864% HoldsAt(PlaySoccer(agent),time) ->
14865% ({agent1} agent1!=agent & HoldsAt(PlaySoccer(agent1),time)).
14866holds_at(playSoccer(Agent), Time) ->
14867	exists([Agent1],
14868	       (Agent1\=Agent, holds_at(playSoccer(Agent1), Time))).
14869
14870% 
14871% 
14872% ectest/ec_reader_test_examples.e:7277
14873% [agent,time]% 
14874% HoldsAt(PlayHideAndSeek(agent),time) ->
14875% ({agent1} agent1!=agent & HoldsAt(PlayHideAndSeek(agent1),time)).
14876holds_at(playHideAndSeek(Agent), Time) ->
14877	exists([Agent1],
14878	       (Agent1\=Agent, holds_at(playHideAndSeek(Agent1), Time))).
14879
14880% 
14881% 
14882% ectest/ec_reader_test_examples.e:7281
14883% [agent,time]% 
14884% HoldsAt(PlayComputerGame(agent),time) ->
14885% !HoldsAt(Outside(agent),time).
14886holds_at(playComputerGame(Agent), Time) ->
14887	not(holds_at(outside(Agent), Time)).
14888
14889% 
14890% 
14891% ectest/ec_reader_test_examples.e:7285
14892% [agent,time]% 
14893% HoldsAt(Win(agent),time) ->
14894% (HoldsAt(PlaySoccer(agent),time) |
14895%  HoldsAt(PlayHideAndSeek(agent),time) |
14896%  (HoldsAt(PlayComputerGame(agent),time) &
14897%   ({agent1} agent1!=agent & HoldsAt(PlayComputerGame(agent1),time)))).
14898holds_at(win(Agent), Time) ->
14899	(   holds_at(playSoccer(Agent), Time)
14900	;   holds_at(playHideAndSeek(Agent), Time)
14901	;   holds_at(playComputerGame(Agent), Time),
14902	    exists([Agent1],
14903		   (Agent1\=Agent, holds_at(playComputerGame(Agent1), Time)))
14904	).
14905
14906% 
14907% ectest/ec_reader_test_examples.e:7291
14908% 
14909% ectest/ec_reader_test_examples.e:7292
14910% [agent,time]% 
14911% HoldsAt(PlaySoccer(agent),time) &
14912% HoldsAt(Win(agent),time) ->
14913% !HoldsAt(PlaySoccer(agent),time+1).
14914holds_at(playSoccer(Agent), Time), holds_at(win(Agent), Time) ->
14915	not(holds_at(playSoccer(Agent), Time+1)).
14916
14917% 
14918% 
14919% ectest/ec_reader_test_examples.e:7297
14920% [agent,time]% 
14921% HoldsAt(PlayHideAndSeek(agent),time) &
14922% HoldsAt(Win(agent),time) ->
14923% !HoldsAt(PlayHideAndSeek(agent),time+1).
14924holds_at(playHideAndSeek(Agent), Time), holds_at(win(Agent), Time) ->
14925	not(holds_at(playHideAndSeek(Agent), Time+1)).
14926
14927% 
14928% 
14929% ectest/ec_reader_test_examples.e:7302
14930% [agent,time]% 
14931% HoldsAt(PlayComputerGame(agent),time) &
14932% HoldsAt(Win(agent),time) ->
14933% !HoldsAt(PlayComputerGame(agent),time+1).
14934holds_at(playComputerGame(Agent), Time), holds_at(win(Agent), Time) ->
14935	not(holds_at(playComputerGame(Agent), Time+1)).
14936
14937% 
14938% 
14939% ectest/ec_reader_test_examples.e:7307
14940% [agent,time]% 
14941% HoldsAt(Win(agent),time) ->
14942% HoldsAt(PlaySoccer(agent),time-1) |
14943% HoldsAt(PlayHideAndSeek(agent),time-1) |
14944% HoldsAt(PlayComputerGame(agent),time-1).
14945(   ( holds_at(win(Agent), Time)->holds_at(playSoccer(Agent), Time-1)
14946    )
14947;   holds_at(playHideAndSeek(Agent), Time-1)
14948;   holds_at(playComputerGame(Agent), Time-1)
14949).
14950
14951% 
14952% 
14953% ectest/ec_reader_test_examples.e:7313
14954% [agent,time]% 
14955% HoldsAt(PlaySoccer(agent),time) ->
14956% !HoldsAt(Raining(),time).
14957holds_at(playSoccer(Agent), Time) ->
14958	not(holds_at(raining(), Time)).
14959
14960% 
14961% 
14962% ectest/ec_reader_test_examples.e:7317
14963% [agent,time]% 
14964% HoldsAt(Win(agent),time) ->
14965% !({agent1} agent1!=agent & HoldsAt(Win(agent1),time)).
14966holds_at(win(Agent), Time) ->
14967	not(exists([Agent1],
14968		   (Agent1\=Agent, holds_at(win(Agent1), Time)))).
14969
14970% 
14971% 
14972% ectest/ec_reader_test_examples.e:7321
14973% [agent1,agent2,time]% 
14974% HoldsAt(PlayHideAndSeek(agent1),time) &
14975% HoldsAt(PlayHideAndSeek(agent2),time) ->
14976% ((HoldsAt(Outside(agent1),time) & HoldsAt(Outside(agent2),time)) |
14977%  (!HoldsAt(Outside(agent1),time) & !HoldsAt(Outside(agent2),time))).
14978holds_at(playHideAndSeek(Agent1), Time), holds_at(playHideAndSeek(Agent2), Time) ->
14979	(   holds_at(outside(Agent1), Time),
14980	    holds_at(outside(Agent2), Time)
14981	;   not(holds_at(outside(Agent1), Time)),
14982	    not(holds_at(outside(Agent2), Time))
14983	).
14984
14985% 
14986% 
14987% ; End of file.
14988% ectest/ec_reader_test_examples.e:7328
14989% 
14990% 
14991% 
14992% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14993% ; FILE: examples/GiunchigliaEtAl2004/MonkeyPrediction.e
14994% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14995% ;
14996% ; Copyright (c) 2005 IBM Corporation and others.
14997% ; All rights reserved. This program and the accompanying materials
14998% ; are made available under the terms of the Common Public License v1.0
14999% ; which accompanies this distribution, and is available at
15000% ; http://www.eclipse.org/legal/cpl-v10.html
15001% ;
15002% ; Contributors:
15003% ; IBM - Initial implementation
15004% ;
15005% ; @article{Giunchiglia:2004,
15006% ;   author = "Enrico Giunchiglia and Joohyung Lee and Vladimir Lifschitz and Norman C. McCain and Hudson Turner",
15007% ;   year = "2004",
15008% ;   title = "Nonmonotonic causal theories",
15009% ;   journal = "Artificial Intelligence",
15010% ;   volume = "153",
15011% ;   pages = "49--104",
15012% ; }
15013% ;
15014% ectest/ec_reader_test_examples.e:7353
15015% 
15016% ; deduction
15017% 
15018% load foundations/Root.e
15019load('foundations/Root.e').
15020
15021% load foundations/EC.e
15022load('foundations/EC.e').
15023
15024% load examples/GiunchigliaEtAl2004/MonkeyBananas.e
15025load('examples/GiunchigliaEtAl2004/MonkeyBananas.e').
15026
15027% ectest/ec_reader_test_examples.e:7359
15028% 
15029% HoldsAt(At(Monkey,L1),0).
15030holds_at(at(monkey, l1), 0).
15031
15032% 
15033% HoldsAt(At(Bananas,L2),0).
15034holds_at(at(bananas, l2), 0).
15035
15036% 
15037% HoldsAt(At(Box,L3),0).
15038holds_at(at(box, l3), 0).
15039
15040% 
15041% Happens(Walk(L3),0).
15042happens(walk(l3), 0).
15043
15044% 
15045% Happens(PushBox(L2),1).
15046happens(pushBox(l2), 1).
15047
15048% 
15049% ectest/ec_reader_test_examples.e:7365
15050% 
15051% completion Happens
15052completion(happens).
15053
15054% 
15055% range time 0 2
15056range(time, 0, 2).
15057
15058% range offset 0 0
15059range(offset, 0, 0).
15060
15061% 
15062% ; End of file.
15063% ectest/ec_reader_test_examples.e:7372
15064% 
15065% 
15066% 
15067% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15068% ; FILE: examples/GiunchigliaEtAl2004/MonkeyPlanning.e
15069% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15070% ;
15071% ; Copyright (c) 2005 IBM Corporation and others.
15072% ; All rights reserved. This program and the accompanying materials
15073% ; are made available under the terms of the Common Public License v1.0
15074% ; which accompanies this distribution, and is available at
15075% ; http://www.eclipse.org/legal/cpl-v10.html
15076% ;
15077% ; Contributors:
15078% ; IBM - Initial implementation
15079% ;
15080% ; @article{Giunchiglia:2004,
15081% ;   author = "Enrico Giunchiglia and Joohyung Lee and Vladimir Lifschitz and Norman C. McCain and Hudson Turner",
15082% ;   year = "2004",
15083% ;   title = "Nonmonotonic causal theories",
15084% ;   journal = "Artificial Intelligence",
15085% ;   volume = "153",
15086% ;   pages = "49--104",
15087% ; }
15088% ;
15089% ectest/ec_reader_test_examples.e:7397
15090% 
15091% ; planning
15092% 
15093% load foundations/Root.e
15094load('foundations/Root.e').
15095
15096% load foundations/EC.e
15097load('foundations/EC.e').
15098
15099% load examples/GiunchigliaEtAl2004/MonkeyBananas.e
15100load('examples/GiunchigliaEtAl2004/MonkeyBananas.e').
15101
15102% ectest/ec_reader_test_examples.e:7403
15103% 
15104% HoldsAt(At(Monkey,L1),0).
15105holds_at(at(monkey, l1), 0).
15106
15107% 
15108% HoldsAt(At(Bananas,L2),0).
15109holds_at(at(bananas, l2), 0).
15110
15111% 
15112% HoldsAt(At(Box,L3),0).
15113holds_at(at(box, l3), 0).
15114
15115% 
15116% HoldsAt(HasBananas(),4).
15117holds_at(hasBananas(), 4).
15118
15119% 
15120% 
15121% ; PLAN Happens(Walk(L3),0).
15122% ; PLAN Happens(PushBox(L2),1).
15123% ; PLAN Happens(ClimbOn(),2).
15124% ; PLAN Happens(GraspBananas(),3).
15125% ectest/ec_reader_test_examples.e:7413
15126% 
15127% ; one event at a time
15128% ectest/ec_reader_test_examples.e:7415
15129% [event1,event2,time] % Happens(event1,time) & Happens(event2,time) ->
15130% event1=event2.
15131happens(Event1, Time), happens(Event2, Time) ->
15132	Event1=Event2.
15133
15134% 
15135% 
15136% range time 0 4
15137range(time, 0, 4).
15138
15139% range offset 0 0
15140range(offset, 0, 0).
15141
15142% 
15143% ; End of file.
15144% ectest/ec_reader_test_examples.e:7422
15145% 
15146% 
15147% 
15148% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15149% ; FILE: examples/GiunchigliaEtAl2004/MonkeyPostdiction.e
15150% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15151% ;
15152% ; Copyright (c) 2005 IBM Corporation and others.
15153% ; All rights reserved. This program and the accompanying materials
15154% ; are made available under the terms of the Common Public License v1.0
15155% ; which accompanies this distribution, and is available at
15156% ; http://www.eclipse.org/legal/cpl-v10.html
15157% ;
15158% ; Contributors:
15159% ; IBM - Initial implementation
15160% ;
15161% ; @article{Giunchiglia:2004,
15162% ;   author = "Enrico Giunchiglia and Joohyung Lee and Vladimir Lifschitz and Norman C. McCain and Hudson Turner",
15163% ;   year = "2004",
15164% ;   title = "Nonmonotonic causal theories",
15165% ;   journal = "Artificial Intelligence",
15166% ;   volume = "153",
15167% ;   pages = "49--104",
15168% ; }
15169% ;
15170% ectest/ec_reader_test_examples.e:7447
15171% 
15172% ; postdiction
15173% 
15174% load foundations/Root.e
15175load('foundations/Root.e').
15176
15177% load foundations/EC.e
15178load('foundations/EC.e').
15179
15180% load examples/GiunchigliaEtAl2004/MonkeyBananas.e
15181load('examples/GiunchigliaEtAl2004/MonkeyBananas.e').
15182
15183% ectest/ec_reader_test_examples.e:7453
15184% 
15185% HoldsAt(At(Monkey,L1),0).
15186holds_at(at(monkey, l1), 0).
15187
15188% 
15189% HoldsAt(At(Bananas,L2),0).
15190holds_at(at(bananas, l2), 0).
15191
15192% 
15193% Happens(Walk(L3),0).
15194happens(walk(l3), 0).
15195
15196% 
15197% Happens(PushBox(L2),1).
15198happens(pushBox(l2), 1).
15199
15200% 
15201% 
15202% ectest/ec_reader_test_examples.e:7459
15203% completion Happens
15204completion(happens).
15205
15206% 
15207% range time 0 2
15208range(time, 0, 2).
15209
15210% range offset 0 0
15211range(offset, 0, 0).
15212
15213% 
15214% ; End of file.
15215% ectest/ec_reader_test_examples.e:7465
15216% 
15217% 
15218% 
15219% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15220% ; FILE: examples/GiunchigliaEtAl2004/MonkeyBananas.e
15221% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15222% ;
15223% ; Copyright (c) 2005 IBM Corporation and others.
15224% ; All rights reserved. This program and the accompanying materials
15225% ; are made available under the terms of the Common Public License v1.0
15226% ; which accompanies this distribution, and is available at
15227% ; http://www.eclipse.org/legal/cpl-v10.html
15228% ;
15229% ; Contributors:
15230% ; IBM - Initial implementation
15231% ;
15232% ; @article{Giunchiglia:2004,
15233% ;   author = "Enrico Giunchiglia and Joohyung Lee and Vladimir Lifschitz and Norman C. McCain and Hudson Turner",
15234% ;   year = "2004",
15235% ;   title = "Nonmonotonic causal theories",
15236% ;   journal = "Artificial Intelligence",
15237% ;   volume = "153",
15238% ;   pages = "49--104",
15239% ; }
15240% ;
15241% ectest/ec_reader_test_examples.e:7490
15242% 
15243% sort object
15244sort(object).
15245
15246% sort location
15247sort(location).
15248
15249% 
15250% object Monkey, Bananas, Box
15251t(object, monkey).
15252
15253t(object, bananas).
15254
15255t(object, box).
15256
15257% location L1, L2, L3
15258t(location, l1).
15259
15260t(location, l2).
15261
15262t(location, l3).
15263
15264% ectest/ec_reader_test_examples.e:7496
15265% 
15266% fluent At(object,location)
15267fluent(at(object, location)).
15268
15269% fluent OnBox()
15270fluent(onBox()).
15271
15272% fluent HasBananas()
15273fluent(hasBananas()).
15274
15275% 
15276% event Walk(location)
15277event(walk(location)).
15278
15279% ectest/ec_reader_test_examples.e:7502
15280% event PushBox(location)
15281event(pushBox(location)).
15282
15283% event ClimbOn()
15284event(climbOn()).
15285
15286% event ClimbOff()
15287event(climbOff()).
15288
15289% event GraspBananas()
15290event(graspBananas()).
15291
15292% 
15293% ectest/ec_reader_test_examples.e:7507
15294% [object,location1,location2,time]% 
15295% HoldsAt(At(object,location1),time) &
15296% HoldsAt(At(object,location2),time) ->
15297% location1=location2.
15298holds_at(at(Object, Location1), Time), holds_at(at(Object, Location2), Time) ->
15299	Location1=Location2.
15300
15301% 
15302% 
15303% ectest/ec_reader_test_examples.e:7512
15304% [object,location,time]% 
15305% object=% Monkey ->
15306% Initiates(Walk(location),At(object,location),time).
15307Object=monkey ->
15308	initiates(walk(Location),
15309		  at(Object, Location),
15310		  Time).
15311
15312% 
15313% 
15314% ectest/ec_reader_test_examples.e:7516
15315% [object,location1,location2,time]% 
15316% object=% Monkey &
15317% HoldsAt(At(object,location1),time) ->
15318% Terminates(Walk(location2),At(object,location1),time).
15319Object=monkey, holds_at(at(Object, Location1), Time) ->
15320	terminates(walk(Location2),
15321		   at(Object, Location1),
15322		   Time).
15323
15324% 
15325% 
15326% ectest/ec_reader_test_examples.e:7521
15327% [location,time]% 
15328% Happens(Walk(location),time) ->
15329% !HoldsAt(At(Monkey,location),time) &
15330% !HoldsAt(OnBox(),time).
15331happens(walk(Location), Time) ->
15332	not(holds_at(at(monkey, Location), Time)),
15333	not(holds_at(onBox(), Time)).
15334
15335% 
15336% 
15337% ectest/ec_reader_test_examples.e:7526
15338% [location,time]% 
15339% HoldsAt(HasBananas(),time) &
15340% HoldsAt(At(Monkey,location),time) ->
15341% HoldsAt(At(Bananas,location),time).
15342holds_at(hasBananas(), Time), holds_at(at(monkey, Location), Time) ->
15343	holds_at(at(bananas, Location), Time).
15344
15345% 
15346% 
15347% ectest/ec_reader_test_examples.e:7531
15348% [object,location,time]% 
15349% object=% Box | object=Monkey ->
15350% Initiates(PushBox(location),At(object,location),time).
15351(   Object=box
15352;   (   (   Object=box
15353;   Object=monkey
15354->  initiates(pushBox(Location),
15355	      at(Object, Location),
15356	      Time)
15357).
15358
15359% 
15360% 
15361% ectest/ec_reader_test_examples.e:7535
15362% [object,location1,location2,time]% 
15363% (object=Box | object=Monkey) &
15364% HoldsAt(At(object,location1),time) ->
15365% Terminates(PushBox(location2),At(object,location1),time).
15366(Object=box;Object=monkey), holds_at(at(Object, Location1), Time) ->
15367	terminates(pushBox(Location2),
15368		   at(Object, Location1),
15369		   Time).
15370
15371% 
15372% 
15373% ectest/ec_reader_test_examples.e:7540
15374% [location,time]% 
15375% Happens(PushBox(location),time) ->
15376% ({location1}
15377%   HoldsAt(At(Box,location1),time) &
15378%   HoldsAt(At(Monkey,location1),time)) &
15379% !HoldsAt(At(Monkey,location),time) &
15380% !HoldsAt(OnBox(),time).
15381happens(pushBox(Location), Time) ->
15382	exists([Location1],
15383	       (holds_at(at(box, Location1), Time), holds_at(at(monkey, Location1), Time))),
15384	not(holds_at(at(monkey, Location), Time)),
15385	not(holds_at(onBox(), Time)).
15386
15387% ectest/ec_reader_test_examples.e:7546
15388% 
15389% 
15390% ectest/ec_reader_test_examples.e:7548
15391% [time] % Initiates(ClimbOn(),OnBox(),time).
15392initiates(climbOn(), onBox(), Time).
15393
15394% 
15395% 
15396% ectest/ec_reader_test_examples.e:7550
15397% [time]% 
15398% Happens(ClimbOn(),time) ->
15399% !HoldsAt(OnBox(),time).
15400happens(climbOn(), Time) ->
15401	not(holds_at(onBox(), Time)).
15402
15403% 
15404% 
15405% ectest/ec_reader_test_examples.e:7554
15406% [time] % Terminates(ClimbOff(),OnBox(),time).
15407terminates(climbOff(), onBox(), Time).
15408
15409% 
15410% 
15411% ectest/ec_reader_test_examples.e:7556
15412% [time]% 
15413% Happens(ClimbOff(),time) ->
15414% HoldsAt(OnBox(),time).
15415happens(climbOff(), Time) ->
15416	holds_at(onBox(), Time).
15417
15418% 
15419% 
15420% ectest/ec_reader_test_examples.e:7560
15421% [time] % Initiates(GraspBananas(),HasBananas(),time).
15422initiates(graspBananas(), hasBananas(), Time).
15423
15424% 
15425% 
15426% ectest/ec_reader_test_examples.e:7562
15427% [object,location,time]% 
15428% object=% Bananas ->
15429% Releases(GraspBananas(),At(object,location),time).
15430Object=bananas ->
15431	releases(graspBananas(), at(Object, Location), Time).
15432
15433% 
15434% 
15435% ectest/ec_reader_test_examples.e:7566
15436% [time]% 
15437% Happens(GraspBananas(),time) ->
15438% ({location1}
15439%   HoldsAt(At(Bananas,location1),time) &
15440%   HoldsAt(At(Monkey,location1),time)) &
15441% HoldsAt(OnBox(),time).
15442happens(graspBananas(), Time) ->
15443	exists([Location1],
15444	       (holds_at(at(bananas, Location1), Time), holds_at(at(monkey, Location1), Time))),
15445	holds_at(onBox(), Time).
15446
15447% 
15448% ectest/ec_reader_test_examples.e:7572
15449% 
15450% ectest/ec_reader_test_examples.e:7573
15451% [time]% 
15452% HoldsAt(OnBox(),time) ->
15453% ectest/ec_reader_test_examples.e:7575
15454% {location1}%  HoldsAt(At(Box,location1),time) &
15455%             HoldsAt(At(Monkey,location1),time).
15456exists([Location1],  (holds_at(onBox(), Time)->holds_at(at(box, Location1), Time), holds_at(at(monkey, Location1), Time))).
15457
15458% 
15459% 
15460% ; End of file.
15461% 
15462% 
15463% ectest/ec_reader_test_examples.e:7581
15464% 
15465% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15466% ; FILE: examples/Antoniou1997/Student.e
15467% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15468% ;
15469% ; Copyright (c) 2005 IBM Corporation and others.
15470% ; All rights reserved. This program and the accompanying materials
15471% ; are made available under the terms of the Common Public License v1.0
15472% ; which accompanies this distribution, and is available at
15473% ; http://www.eclipse.org/legal/cpl-v10.html
15474% ;
15475% ; Contributors:
15476% ; IBM - Initial implementation
15477% ;
15478% ; conflicting defaults: method (D)
15479% ; \fullciteA[p. 157]{Antoniou:1997}
15480% ;
15481% ; @book{Antoniou:1997,
15482% ;   author = "Grigoris Antoniou",
15483% ;   year = "1997",
15484% ;   title = "Nonmonotonic Reasoning",
15485% ;   address = "Cambridge, MA",
15486% ;   publisher = "MIT Press",
15487% ; }
15488% ;
15489% ectest/ec_reader_test_examples.e:7606
15490% 
15491% load foundations/Root.e
15492load('foundations/Root.e').
15493
15494% load foundations/EC.e
15495load('foundations/EC.e').
15496
15497% 
15498% sort x
15499sort(x).
15500
15501% 
15502% ectest/ec_reader_test_examples.e:7612
15503% predicate Adult(x)
15504predicate(adult(x)).
15505
15506% predicate Student(x)
15507predicate(student(x)).
15508
15509% predicate Employed(x)
15510predicate(employed(x)).
15511
15512% predicate Ab1(x)
15513predicate(ab1(x)).
15514
15515% predicate Ab2(x)
15516predicate(ab2(x)).
15517
15518% 
15519% ectest/ec_reader_test_examples.e:7618
15520% x Mary
15521t(x, mary).
15522
15523% 
15524% Student(Mary).
15525student(mary).
15526
15527% 
15528% 
15529% ectest/ec_reader_test_examples.e:7622
15530% [x] % Adult(x) & !Ab1(x) -> Employed(x).
15531adult(X), not(ab1(X)) ->
15532	employed(X).
15533
15534% 
15535% ectest/ec_reader_test_examples.e:7623
15536% [x] % Student(x) & !Ab2(x) -> !Employed(x).
15537student(X), not(ab2(X)) ->
15538	not(employed(X)).
15539
15540% 
15541% ectest/ec_reader_test_examples.e:7624
15542% [x] % Student(x) -> Adult(x).
15543student(X) ->
15544	adult(X).
15545
15546% 
15547% Theta:
15548directive(theta).
15549
15550 
15551% ectest/ec_reader_test_examples.e:7625
15552% [x] % Student(x) -> Ab1(x).
15553student(X) ->
15554	ab1(X).
15555
15556% 
15557% 
15558% range time 0 0
15559range(time, 0, 0).
15560
15561% range offset 1 1
15562range(offset, 1, 1).
15563
15564% 
15565% completion Theta Ab1
15566completion(theta).
15567
15568completion(ab1).
15569
15570% ectest/ec_reader_test_examples.e:7631
15571% completion Theta Ab2
15572completion(theta).
15573
15574completion(ab2).
15575
15576% 
15577% ; End of file.
15578% 
15579% 
15580% 
15581% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15582% ; FILE: examples/Antoniou1997/Dropout.e
15583% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15584% ;
15585% ; Copyright (c) 2005 IBM Corporation and others.
15586% ; All rights reserved. This program and the accompanying materials
15587% ; are made available under the terms of the Common Public License v1.0
15588% ; which accompanies this distribution, and is available at
15589% ; http://www.eclipse.org/legal/cpl-v10.html
15590% ;
15591% ; Contributors:
15592% ; IBM - Initial implementation
15593% ;
15594% ; dealing with conflicting defaults by adding conditions
15595% ; to one of the conflicting rules
15596% ; \fullciteA[p. 56]{Antoniou:1997}
15597% ;
15598% ; @book{Antoniou:1997,
15599% ;   author = "Grigoris Antoniou",
15600% ;   year = "1997",
15601% ;   title = "Nonmonotonic Reasoning",
15602% ;   address = "Cambridge, MA",
15603% ;   publisher = "MIT Press",
15604% ; }
15605% ;
15606% ectest/ec_reader_test_examples.e:7662
15607% 
15608% load foundations/Root.e
15609load('foundations/Root.e').
15610
15611% load foundations/EC.e
15612load('foundations/EC.e').
15613
15614% 
15615% sort x
15616sort(x).
15617
15618% 
15619% ectest/ec_reader_test_examples.e:7668
15620% predicate Dropout(x)
15621predicate(dropout(x)).
15622
15623% predicate Adult(x)
15624predicate(adult(x)).
15625
15626% predicate Employed(x)
15627predicate(employed(x)).
15628
15629% predicate Ab1(x)
15630predicate(ab1(x)).
15631
15632% predicate Ab2(x)
15633predicate(ab2(x)).
15634
15635% 
15636% ectest/ec_reader_test_examples.e:7674
15637% x Bill
15638t(x, bill).
15639
15640% 
15641% Dropout(Bill).
15642dropout(bill).
15643
15644% 
15645% 
15646% ectest/ec_reader_test_examples.e:7678
15647% [x] % Dropout(x) & !Ab1(x) -> Adult(x).
15648dropout(X), not(ab1(X)) ->
15649	adult(X).
15650
15651% 
15652% ectest/ec_reader_test_examples.e:7679
15653% [x] % Adult(x) & !Dropout(x) & !Ab2(x) -> Employed(x).
15654adult(X), not(dropout(X)), not(ab2(X)) ->
15655	employed(X).
15656
15657% 
15658% 
15659% range time 0 0
15660range(time, 0, 0).
15661
15662% range offset 1 1
15663range(offset, 1, 1).
15664
15665% 
15666% completion Theta Ab1
15667completion(theta).
15668
15669completion(ab1).
15670
15671% ectest/ec_reader_test_examples.e:7685
15672% completion Theta Ab2
15673completion(theta).
15674
15675completion(ab2).
15676
15677% 
15678% ; End of file.
15679% 
15680% 
15681% 
15682% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15683% ; FILE: examples/Shanahan1999/Happy.e
15684% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15685% ;
15686% ; Copyright (c) 2005 IBM Corporation and others.
15687% ; All rights reserved. This program and the accompanying materials
15688% ; are made available under the terms of the Common Public License v1.0
15689% ; which accompanies this distribution, and is available at
15690% ; http://www.eclipse.org/legal/cpl-v10.html
15691% ;
15692% ; Contributors:
15693% ; IBM - Initial implementation
15694% ;
15695% ; @incollection{Shanahan:1999,
15696% ;   author = "Shanahan, Murray",
15697% ;   year = "1999",
15698% ;   title = "The Event Calculus explained",
15699% ;   editor = "Michael J. Wooldridge and Manuela M. Veloso",
15700% ;   booktitle = "Artificial Intelligence Today: Recent Trends and Developments",
15701% ;   series = "Lecture Notes in Computer Science",
15702% ;   volume = "1600",
15703% ;   pages = "409--430",
15704% ;   address = "Berlin",
15705% ;   publisher = "Springer",
15706% ; }
15707% ;
15708% ; deduction
15709% ;
15710% ; modifications from Shanahan's formulation:
15711% ; InitiallyN -> !HoldsAt
15712% ; InitiallyP -> HoldsAt
15713% ; timestamps
15714% ;
15715% ectest/ec_reader_test_examples.e:7724
15716% 
15717% load foundations/Root.e
15718load('foundations/Root.e').
15719
15720% load foundations/EC.e
15721load('foundations/EC.e').
15722
15723% 
15724% sort person
15725sort(person).
15726
15727% event Feed(person)
15728event(feed(person)).
15729
15730% ectest/ec_reader_test_examples.e:7730
15731% event Clothe(person)
15732event(clothe(person)).
15733
15734% fluent Happy(person)
15735fluent(happy(person)).
15736
15737% fluent Hungry(person)
15738fluent(hungry(person)).
15739
15740% fluent Cold(person)
15741fluent(cold(person)).
15742
15743% noninertial Happy
15744noninertial(happy).
15745
15746% 
15747% ectest/ec_reader_test_examples.e:7736
15748% [person,time]% 
15749% HoldsAt(Happy(person),time) <->
15750% !HoldsAt(Hungry(person),time) &
15751% !HoldsAt(Cold(person),time).
15752holds_at(happy(Person), Time) <->
15753	not(holds_at(hungry(Person), Time)),
15754	not(holds_at(cold(Person), Time)).
15755
15756% 
15757% 
15758% ectest/ec_reader_test_examples.e:7741
15759% [person,time]% 
15760% Terminates(Feed(person),Hungry(person),time).
15761terminates(feed(Person), hungry(Person), Time).
15762
15763% 
15764% 
15765% ectest/ec_reader_test_examples.e:7744
15766% [person,time]% 
15767% Terminates(Clothe(person),Cold(person),time).
15768terminates(clothe(Person), cold(Person), Time).
15769
15770% 
15771% 
15772% person Fred
15773t(person, fred).
15774
15775% 
15776% HoldsAt(Hungry(Fred),0).
15777holds_at(hungry(fred), 0).
15778
15779% 
15780% ectest/ec_reader_test_examples.e:7750
15781% !HoldsAt(Cold(Fred),0).
15782not(holds_at(cold(fred), 0)).
15783
15784% 
15785% Happens(Feed(Fred),1).
15786happens(feed(fred), 1).
15787
15788% 
15789% 
15790% completion Happens
15791completion(happens).
15792
15793% 
15794% range time 0 2
15795range(time, 0, 2).
15796
15797% ectest/ec_reader_test_examples.e:7756
15798% range offset 1 1
15799range(offset, 1, 1).
15800
15801% 
15802% ; End of file.
15803% 
15804% 
15805% 
15806% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15807% ; FILE: examples/Shanahan1999/ThielscherCircuit.e
15808% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15809% ;
15810% ; Copyright (c) 2005 IBM Corporation and others.
15811% ; All rights reserved. This program and the accompanying materials
15812% ; are made available under the terms of the Common Public License v1.0
15813% ; which accompanies this distribution, and is available at
15814% ; http://www.eclipse.org/legal/cpl-v10.html
15815% ;
15816% ; Contributors:
15817% ; IBM - Initial implementation
15818% ;
15819% ; @article{Thielscher:1997,
15820% ;   author = "Michael Thielscher",
15821% ;   year = "1997",
15822% ;   title = "Ramification and causality",
15823% ;   journal = "Artificial Intelligence",
15824% ;   volume = "89",
15825% ;   pages = "317--364",
15826% ; }
15827% ;
15828% ; @incollection{Shanahan:1999,
15829% ;   author = "Shanahan, Murray",
15830% ;   year = "1999",
15831% ;   title = "The Event Calculus explained",
15832% ;   editor = "Michael J. Wooldridge and Manuela M. Veloso",
15833% ;   booktitle = "Artificial Intelligence Today: Recent Trends and Developments",
15834% ;   series = "Lecture Notes in Computer Science",
15835% ;   volume = "1600",
15836% ;   pages = "409--430",
15837% ;   address = "Berlin",
15838% ;   publisher = "Springer",
15839% ; }
15840% ;
15841% ; deduction
15842% ;
15843% ; modifications from Shanahan's formulation:
15844% ; timestamps
15845% ;
15846% ectest/ec_reader_test_examples.e:7802
15847% 
15848% load foundations/Root.e
15849load('foundations/Root.e').
15850
15851% load foundations/EC.e
15852load('foundations/EC.e').
15853
15854% load foundations/ECCausal.e
15855load('foundations/ECCausal.e').
15856
15857% 
15858% event LightOn()
15859event(lightOn()).
15860
15861% ectest/ec_reader_test_examples.e:7808
15862% event Close1()
15863event(close1()).
15864
15865% event Open2()
15866event(open2()).
15867
15868% event CloseRelay()
15869event(closeRelay()).
15870
15871% 
15872% fluent Light()
15873fluent(light()).
15874
15875% fluent Switch1()
15876fluent(switch1()).
15877
15878% ectest/ec_reader_test_examples.e:7814
15879% fluent Switch2()
15880fluent(switch2()).
15881
15882% fluent Switch3()
15883fluent(switch3()).
15884
15885% fluent Relay()
15886fluent(relay()).
15887
15888% 
15889% ectest/ec_reader_test_examples.e:7818
15890% [time]% 
15891% Stopped(Light(),time) &
15892% Initiated(Switch1(),time) &
15893% Initiated(Switch2(),time) ->
15894% Happens(LightOn(),time).
15895stopped(light(), Time), initiated(switch1(), Time), initiated(switch2(), Time) ->
15896	happens(lightOn(), Time).
15897
15898% 
15899% 
15900% ectest/ec_reader_test_examples.e:7824
15901% [time]% 
15902% Started(Switch2(),time) &
15903% Initiated(Relay(),time) ->
15904% Happens(Open2(),time).
15905started(switch2(), Time), initiated(relay(), Time) ->
15906	happens(open2(), Time).
15907
15908% 
15909% 
15910% ectest/ec_reader_test_examples.e:7829
15911% [time]% 
15912% Stopped(Relay(),time) &
15913% Initiated(Switch1(),time) &
15914% Initiated(Switch3(),time) ->
15915% Happens(CloseRelay(),time).
15916stopped(relay(), Time), initiated(switch1(), Time), initiated(switch3(), Time) ->
15917	happens(closeRelay(), Time).
15918
15919% 
15920% 
15921% ectest/ec_reader_test_examples.e:7835
15922% [time] % Initiates(LightOn(),Light(),time).
15923initiates(lightOn(), light(), Time).
15924
15925% 
15926% 
15927% ectest/ec_reader_test_examples.e:7837
15928% [time] % Terminates(Open2(),Switch2(),time).
15929terminates(open2(), switch2(), Time).
15930
15931% 
15932% 
15933% ectest/ec_reader_test_examples.e:7839
15934% [time] % Initiates(CloseRelay(),Relay(),time).
15935initiates(closeRelay(), relay(), Time).
15936
15937% 
15938% 
15939% ectest/ec_reader_test_examples.e:7841
15940% [time] % Initiates(Close1(),Switch1(),time).
15941initiates(close1(), switch1(), Time).
15942
15943% 
15944% 
15945% !HoldsAt(Switch1(),0).
15946not(holds_at(switch1(), 0)).
15947
15948% 
15949% HoldsAt(Switch2(),0).
15950holds_at(switch2(), 0).
15951
15952% 
15953% HoldsAt(Switch3(),0).
15954holds_at(switch3(), 0).
15955
15956% 
15957% !HoldsAt(Relay(),0).
15958not(holds_at(relay(), 0)).
15959
15960% 
15961% ectest/ec_reader_test_examples.e:7847
15962% !HoldsAt(Light(),0).
15963not(holds_at(light(), 0)).
15964
15965% 
15966% 
15967% Happens(Close1(),0).
15968happens(close1(), 0).
15969
15970% 
15971% 
15972% completion Happens
15973completion(happens).
15974
15975% 
15976% ectest/ec_reader_test_examples.e:7853
15977% range time 0 1
15978range(time, 0, 1).
15979
15980% range offset 1 1
15981range(offset, 1, 1).
15982
15983% 
15984% ; End of file.
15985% 
15986% 
15987% ectest/ec_reader_test_examples.e:7859
15988% 
15989% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15990% ; FILE: examples/Shanahan1999/CoinToss.e
15991% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15992% ;
15993% ; Copyright (c) 2005 IBM Corporation and others.
15994% ; All rights reserved. This program and the accompanying materials
15995% ; are made available under the terms of the Common Public License v1.0
15996% ; which accompanies this distribution, and is available at
15997% ; http://www.eclipse.org/legal/cpl-v10.html
15998% ;
15999% ; Contributors:
16000% ; IBM - Initial implementation
16001% ;
16002% ; @article{Kartha:1994,
16003% ;   author = "G. Neelakantan Kartha",
16004% ;   year = "1994",
16005% ;   title = "Two counterexamples related to \uppercase{B}aker's approach to the frame problem",
16006% ;   journal = "Artificial Intelligence",
16007% ;   volume = "69",
16008% ;   number = "1--2",
16009% ;   pages = "379--391",
16010% ; }
16011% ;
16012% ; @incollection{Shanahan:1999,
16013% ;   author = "Shanahan, Murray",
16014% ;   year = "1999",
16015% ;   title = "The Event Calculus explained",
16016% ;   editor = "Michael J. Wooldridge and Manuela M. Veloso",
16017% ;   booktitle = "Artificial Intelligence Today: Recent Trends and Developments",
16018% ;   series = "Lecture Notes in Computer Science",
16019% ;   volume = "1600",
16020% ;   pages = "409--430",
16021% ;   address = "Berlin",
16022% ;   publisher = "Springer",
16023% ; }
16024% ;
16025% ; model finding
16026% ;
16027% ; modifications from Shanahan's formulation:
16028% ; InitiallyP -> HoldsAt
16029% ; pruning of models irrelevant to example
16030% ; timestamps
16031% ;
16032% ectest/ec_reader_test_examples.e:7903
16033% 
16034% load foundations/Root.e
16035load('foundations/Root.e').
16036
16037% load foundations/EC.e
16038load('foundations/EC.e').
16039
16040% 
16041% event Toss()
16042event(toss()).
16043
16044% fluent ItsHeads()
16045fluent(itsHeads()).
16046
16047% ectest/ec_reader_test_examples.e:7909
16048% fluent Heads()
16049fluent(heads()).
16050
16051% noninertial ItsHeads
16052noninertial(itsHeads).
16053
16054% 
16055% ectest/ec_reader_test_examples.e:7912
16056% [time] % HoldsAt(ItsHeads(),time) -> Initiates(Toss(),Heads(),time).
16057holds_at(itsHeads(), Time) ->
16058	initiates(toss(), heads(), Time).
16059
16060% 
16061% ectest/ec_reader_test_examples.e:7913
16062% [time] % !HoldsAt(ItsHeads(),time) -> Terminates(Toss(),Heads(),time).
16063not(holds_at(itsHeads(), Time)) ->
16064	terminates(toss(), heads(), Time).
16065
16066% 
16067% 
16068% HoldsAt(Heads(),0).
16069holds_at(heads(), 0).
16070
16071% 
16072% Happens(Toss(),1).
16073happens(toss(), 1).
16074
16075% 
16076% Happens(Toss(),2).
16077happens(toss(), 2).
16078
16079% 
16080% Happens(Toss(),3).
16081happens(toss(), 3).
16082
16083% 
16084% ectest/ec_reader_test_examples.e:7919
16085% 
16086% ; prune models irrelevant to example:
16087% HoldsAt(ItsHeads(),0).
16088holds_at(itsHeads(), 0).
16089
16090% 
16091% HoldsAt(ItsHeads(),4).
16092holds_at(itsHeads(), 4).
16093
16094% 
16095% 
16096% completion Happens
16097completion(happens).
16098
16099% ectest/ec_reader_test_examples.e:7925
16100% 
16101% range time 0 4
16102range(time, 0, 4).
16103
16104% range offset 1 1
16105range(offset, 1, 1).
16106
16107% 
16108% ; End of file.
16109% 
16110% ectest/ec_reader_test_examples.e:7931
16111% 
16112% 
16113% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16114% ; FILE: examples/Shanahan1999/ChessBoard.e
16115% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16116% ;
16117% ; Copyright (c) 2005 IBM Corporation and others.
16118% ; All rights reserved. This program and the accompanying materials
16119% ; are made available under the terms of the Common Public License v1.0
16120% ; which accompanies this distribution, and is available at
16121% ; http://www.eclipse.org/legal/cpl-v10.html
16122% ;
16123% ; Contributors:
16124% ; IBM - Initial implementation
16125% ;
16126% ; due to Raymond Reiter
16127% ;
16128% ; @inproceedings{KarthaLifschitz:1994,
16129% ;   author = "G. Neelakantan Kartha and Vladimir Lifschitz",
16130% ;   year = "1994",
16131% ;   title = "Actions with indirect effects (preliminary report)",
16132% ;   editor = "Jon Doyle and Erik Sandewall and Pietro Torasso",
16133% ;   booktitle = "\uppercase{P}roceedings of the \uppercase{F}ourth \uppercase{I}nternational \uppercase{C}onference on \uppercase{P}rinciples of \uppercase{K}nowledge \uppercase{R}epresentation and \uppercase{R}easoning",
16134% ;   pages = "341--350",
16135% ;   address = "San Francisco",
16136% ;   publisher = "Morgan Kaufmann",
16137% ; }
16138% ;
16139% ; @incollection{Shanahan:1999,
16140% ;   author = "Shanahan, Murray",
16141% ;   year = "1999",
16142% ;   title = "The Event Calculus explained",
16143% ;   editor = "Michael J. Wooldridge and Manuela M. Veloso",
16144% ;   booktitle = "Artificial Intelligence Today: Recent Trends and Developments",
16145% ;   series = "Lecture Notes in Computer Science",
16146% ;   volume = "1600",
16147% ;   pages = "409--430",
16148% ;   address = "Berlin",
16149% ;   publisher = "Springer",
16150% ; }
16151% ;
16152% ; model finding
16153% ;
16154% ; modifications from Shanahan's formulation:
16155% ; InitiallyN -> !HoldsAt
16156% ; pruning of models irrelevant to example
16157% ; timestamps
16158% ;
16159% ectest/ec_reader_test_examples.e:7979
16160% 
16161% load foundations/Root.e
16162load('foundations/Root.e').
16163
16164% load foundations/EC.e
16165load('foundations/EC.e').
16166
16167% 
16168% event Throw()
16169event(throw()).
16170
16171% fluent ItsBlack()
16172fluent(itsBlack()).
16173
16174% ectest/ec_reader_test_examples.e:7985
16175% fluent ItsWhite()
16176fluent(itsWhite()).
16177
16178% fluent OnBlack()
16179fluent(onBlack()).
16180
16181% fluent OnWhite()
16182fluent(onWhite()).
16183
16184% noninertial ItsBlack, ItsWhite
16185noninertial([itsBlack, itsWhite]).
16186
16187% 
16188% ectest/ec_reader_test_examples.e:7990
16189% [time]% 
16190% HoldsAt(ItsWhite(),time) ->
16191% Initiates(Throw(),OnWhite(),time).
16192holds_at(itsWhite(), Time) ->
16193	initiates(throw(), onWhite(), Time).
16194
16195% 
16196% 
16197% ectest/ec_reader_test_examples.e:7994
16198% [time]% 
16199% HoldsAt(ItsBlack(),time) ->
16200% Initiates(Throw(),OnBlack(),time).
16201holds_at(itsBlack(), Time) ->
16202	initiates(throw(), onBlack(), Time).
16203
16204% 
16205% 
16206% ectest/ec_reader_test_examples.e:7998
16207% [time] % HoldsAt(ItsWhite(),time) | HoldsAt(ItsBlack(),time).
16208(   holds_at(itsWhite(), Time)
16209;   holds_at(itsBlack(), Time)
16210).
16211
16212% 
16213% 
16214% !HoldsAt(OnWhite(),0).
16215not(holds_at(onWhite(), 0)).
16216
16217% 
16218% !HoldsAt(OnBlack(),0).
16219not(holds_at(onBlack(), 0)).
16220
16221% 
16222% Happens(Throw(),1).
16223happens(throw(), 1).
16224
16225% 
16226% 
16227% ; prune models irrelevant to example:
16228% ectest/ec_reader_test_examples.e:8005
16229% HoldsAt(ItsWhite(),0).
16230holds_at(itsWhite(), 0).
16231
16232% 
16233% HoldsAt(ItsBlack(),0).
16234holds_at(itsBlack(), 0).
16235
16236% 
16237% HoldsAt(ItsWhite(),2).
16238holds_at(itsWhite(), 2).
16239
16240% 
16241% HoldsAt(ItsBlack(),2).
16242holds_at(itsBlack(), 2).
16243
16244% 
16245% 
16246% completion Happens
16247completion(happens).
16248
16249% ectest/ec_reader_test_examples.e:8011
16250% 
16251% range time 0 2
16252range(time, 0, 2).
16253
16254% range offset 1 1
16255range(offset, 1, 1).
16256
16257% 
16258% ; End of file.
16259% 
16260% ectest/ec_reader_test_examples.e:8017
16261% 
16262% 
16263% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16264% ; FILE: examples/Shanahan1999/RussianTurkey.e
16265% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16266% ;
16267% ; Copyright (c) 2005 IBM Corporation and others.
16268% ; All rights reserved. This program and the accompanying materials
16269% ; are made available under the terms of the Common Public License v1.0
16270% ; which accompanies this distribution, and is available at
16271% ; http://www.eclipse.org/legal/cpl-v10.html
16272% ;
16273% ; Contributors:
16274% ; IBM - Initial implementation
16275% ;
16276% ; @book{Sandewall:1994,
16277% ;   author = "Sandewall, Erik",
16278% ;   year = "1994",
16279% ;   title = "Features and Fluents: The Representation of Knowledge about Dynamical Systems",
16280% ;   volume = "I",
16281% ;   address = "Oxford",
16282% ;   publisher = "Oxford University Press",
16283% ; }
16284% ;
16285% ; @incollection{Shanahan:1999,
16286% ;   author = "Shanahan, Murray",
16287% ;   year = "1999",
16288% ;   title = "The Event Calculus explained",
16289% ;   editor = "Michael J. Wooldridge and Manuela M. Veloso",
16290% ;   booktitle = "Artificial Intelligence Today: Recent Trends and Developments",
16291% ;   series = "Lecture Notes in Computer Science",
16292% ;   volume = "1600",
16293% ;   pages = "409--430",
16294% ;   address = "Berlin",
16295% ;   publisher = "Springer",
16296% ; }
16297% ;
16298% ; model finding
16299% ;
16300% ; modifications from Shanahan's formulation:
16301% ; InitiallyP -> HoldsAt
16302% ; added [time] Terminates(Shoot(),Loaded(),time).
16303% ; added !HoldsAt(Loaded(),0) to prune models
16304% ; timestamps
16305% ;
16306% ectest/ec_reader_test_examples.e:8062
16307% 
16308% load foundations/Root.e
16309load('foundations/Root.e').
16310
16311% load foundations/EC.e
16312load('foundations/EC.e').
16313
16314% 
16315% event Load()
16316event(load()).
16317
16318% event Shoot()
16319event(shoot()).
16320
16321% ectest/ec_reader_test_examples.e:8068
16322% event Spin()
16323event(spin()).
16324
16325% fluent Loaded()
16326fluent(loaded()).
16327
16328% fluent Alive()
16329fluent(alive()).
16330
16331% 
16332% ectest/ec_reader_test_examples.e:8072
16333% [time] % Initiates(Load(),Loaded(),time).
16334initiates(load(), loaded(), Time).
16335
16336% 
16337% ectest/ec_reader_test_examples.e:8073
16338% [time] % HoldsAt(Loaded(),time) -> Terminates(Shoot(),Alive(),time).
16339holds_at(loaded(), Time) ->
16340	terminates(shoot(), alive(), Time).
16341
16342% 
16343% ectest/ec_reader_test_examples.e:8074
16344% [time] % Releases(Spin(),Loaded(),time).
16345releases(spin(), loaded(), Time).
16346
16347% 
16348% ectest/ec_reader_test_examples.e:8075
16349% [time] % Terminates(Shoot(),Loaded(),time).
16350terminates(shoot(), loaded(), Time).
16351
16352% 
16353% 
16354% HoldsAt(Alive(),0).
16355holds_at(alive(), 0).
16356
16357% 
16358% !HoldsAt(Loaded(),0).
16359not(holds_at(loaded(), 0)).
16360
16361% 
16362% Happens(Load(),1).
16363happens(load(), 1).
16364
16365% 
16366% Happens(Spin(),2).
16367happens(spin(), 2).
16368
16369% 
16370% ectest/ec_reader_test_examples.e:8081
16371% Happens(Shoot(),3).
16372happens(shoot(), 3).
16373
16374% 
16375% 
16376% completion Happens
16377completion(happens).
16378
16379% 
16380% range time 0 4
16381range(time, 0, 4).
16382
16383% range offset 1 1
16384range(offset, 1, 1).
16385
16386% ectest/ec_reader_test_examples.e:8087
16387% 
16388% ; End of file.
16389% 
16390% 
16391% 
16392% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16393% ; FILE: examples/AkmanEtAl2004/ZooTest4.2.e
16394% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16395% ;
16396% ; Copyright (c) 2005 IBM Corporation and others.
16397% ; All rights reserved. This program and the accompanying materials
16398% ; are made available under the terms of the Common Public License v1.0
16399% ; which accompanies this distribution, and is available at
16400% ; http://www.eclipse.org/legal/cpl-v10.html
16401% ;
16402% ; Contributors:
16403% ; IBM - Initial implementation
16404% ;
16405% ; @article{Akman:2004,
16406% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
16407% ;   year = "2004",
16408% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
16409% ;   journal = "Artificial Intelligence",
16410% ;   volume = "153",
16411% ;   pages = "105--140",
16412% ; }
16413% ;
16414% ectest/ec_reader_test_examples.e:8114
16415% 
16416% option encoding 3
16417option(encoding, 3).
16418
16419% 
16420% load foundations/Root.e
16421load('foundations/Root.e').
16422
16423% load foundations/EC.e
16424load('foundations/EC.e').
16425
16426% load examples/AkmanEtAl2004/ZooWorld.e
16427load('examples/AkmanEtAl2004/ZooWorld.e').
16428
16429% ectest/ec_reader_test_examples.e:8120
16430% 
16431% human Homer
16432t(human, homer).
16433
16434% elephant Jumbo
16435t(elephant, jumbo).
16436
16437% 
16438% Species(Homer)=HumanSpecies.
16439species(homer)=humanSpecies.
16440
16441% 
16442% Adult(Homer).
16443adult(homer).
16444
16445% 
16446% ectest/ec_reader_test_examples.e:8126
16447% Species(Jumbo)=ElephantSpecies.
16448species(jumbo)=elephantSpecies.
16449
16450% 
16451% Adult(Jumbo).
16452adult(jumbo).
16453
16454% 
16455% 
16456% !HoldsAt(Opened(GateAO),0).
16457not(holds_at(opened(gateAO), 0)).
16458
16459% 
16460% ectest/ec_reader_test_examples.e:8130
16461% {position} % HoldsAt(Pos(Homer,position),0) & Outside=Loc(position).
16462exists([Position],  (holds_at(pos(homer, Position), 0), outside=loc(Position))).
16463
16464% 
16465% ectest/ec_reader_test_examples.e:8131
16466% {position} % HoldsAt(Pos(Jumbo,position),0) & CageA=Loc(position).
16467exists([Position],  (holds_at(pos(jumbo, Position), 0), cageA=loc(Position))).
16468
16469% 
16470% 
16471% ectest/ec_reader_test_examples.e:8133
16472% {position} % HoldsAt(Pos(Homer,position),5) & CageA=Loc(position).
16473exists([Position],  (holds_at(pos(homer, Position), 5), cageA=loc(Position))).
16474
16475% 
16476% ectest/ec_reader_test_examples.e:8134
16477% {position} % HoldsAt(Pos(Jumbo,position),5) & Outside=Loc(position).
16478exists([Position],  (holds_at(pos(jumbo, Position), 5), outside=loc(Position))).
16479
16480% 
16481% 
16482% ectest/ec_reader_test_examples.e:8136
16483% [animal,time] % !HoldsAt(Mounted(Homer,animal),time).
16484not(holds_at(mounted(homer, Animal), Time)).
16485
16486% 
16487% 
16488% ectest/ec_reader_test_examples.e:8138
16489% [human] % HoldsAt(PosDeterminingFluent(human,1),5).
16490holds_at(posDeterminingFluent(Human, 1), 5).
16491
16492% 
16493% ectest/ec_reader_test_examples.e:8139
16494% [event,animal] % !HoldsAt(DoneBy(event,animal),5).
16495not(holds_at(doneBy(Event, Animal), 5)).
16496
16497% 
16498% 
16499% ;HoldsAt(Pos(Homer,7),0).
16500% ;HoldsAt(Pos(Jumbo,4),0).
16501% ;Happens(Move(Jumbo,3),0).
16502% ;Happens(Open(Homer,GateAO),0).
16503% ;Happens(Move(Homer,4),1).
16504% ;Happens(Move(Jumbo,1),1).
16505% ;Happens(Move(Jumbo,3),2).
16506% ;Happens(Mount(Homer,Jumbo),2).
16507% ;Happens(Move(Jumbo,4),3).
16508% ;!Happens(Move(Homer,2),3).
16509% ;Happens(Move(Jumbo,7),4).
16510% ;!Happens(Mount(Homer,Jumbo),3).
16511% ;!Happens(Mount(Homer,Jumbo),4).
16512% ;[position] !Happens(Move(Homer,position),4).
16513% ectest/ec_reader_test_examples.e:8155
16514% 
16515% range time 0 5
16516range(time, 0, 5).
16517
16518% range position 1 8
16519range(position, 1, 8).
16520
16521% range offset 0 0
16522range(offset, 0, 0).
16523
16524% 
16525% completion Happens
16526completion(happens).
16527
16528% ectest/ec_reader_test_examples.e:8161
16529% 
16530% ; End of file.
16531% 
16532% 
16533% 
16534% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16535% ; FILE: examples/AkmanEtAl2004/ZooTest5.1.e
16536% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16537% ;
16538% ; Copyright (c) 2005 IBM Corporation and others.
16539% ; All rights reserved. This program and the accompanying materials
16540% ; are made available under the terms of the Common Public License v1.0
16541% ; which accompanies this distribution, and is available at
16542% ; http://www.eclipse.org/legal/cpl-v10.html
16543% ;
16544% ; Contributors:
16545% ; IBM - Initial implementation
16546% ;
16547% ; @article{Akman:2004,
16548% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
16549% ;   year = "2004",
16550% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
16551% ;   journal = "Artificial Intelligence",
16552% ;   volume = "153",
16553% ;   pages = "105--140",
16554% ; }
16555% ;
16556% ectest/ec_reader_test_examples.e:8188
16557% 
16558% option encoding 3
16559option(encoding, 3).
16560
16561% 
16562% load foundations/Root.e
16563load('foundations/Root.e').
16564
16565% load foundations/EC.e
16566load('foundations/EC.e').
16567
16568% load examples/AkmanEtAl2004/ZooWorld.e
16569load('examples/AkmanEtAl2004/ZooWorld.e').
16570
16571% ectest/ec_reader_test_examples.e:8194
16572% 
16573% human Homer
16574t(human, homer).
16575
16576% elephant Jumbo
16577t(elephant, jumbo).
16578
16579% horse Silver
16580t(horse, silver).
16581
16582% 
16583% Species(Homer)=HumanSpecies.
16584species(homer)=humanSpecies.
16585
16586% 
16587% ectest/ec_reader_test_examples.e:8200
16588% Adult(Homer).
16589adult(homer).
16590
16591% 
16592% Species(Jumbo)=ElephantSpecies.
16593species(jumbo)=elephantSpecies.
16594
16595% 
16596% Adult(Jumbo).
16597adult(jumbo).
16598
16599% 
16600% Species(Silver)=HorseSpecies.
16601species(silver)=horseSpecies.
16602
16603% 
16604% Adult(Silver).
16605adult(silver).
16606
16607% 
16608% 
16609% ectest/ec_reader_test_examples.e:8206
16610% {position}% 
16611% !HoldsAt(Pos(Homer,position),0) &
16612% HoldsAt(Pos(Jumbo,position),0) &
16613% HoldsAt(Pos(Homer,position),1) &
16614% !HoldsAt(Pos(Jumbo,position),1).
16615exists([Position],  (not(holds_at(pos(homer, Position), 0)), holds_at(pos(jumbo, Position), 0), holds_at(pos(homer, Position), 1), not(holds_at(pos(jumbo, Position), 1)))).
16616
16617% 
16618% HoldsAt(Mounted(Homer,Silver),0).
16619holds_at(mounted(homer, silver), 0).
16620
16621% 
16622% ectest/ec_reader_test_examples.e:8212
16623% 
16624% option manualrelease on
16625option(manualrelease, on).
16626
16627% ectest/ec_reader_test_examples.e:8214
16628% [human, animal] % !ReleasedAt(Mounted(human, animal),0).
16629not(releasedAt(mounted(Human, Animal), 0)).
16630
16631% 
16632% ectest/ec_reader_test_examples.e:8215
16633% [gate] % !ReleasedAt(Opened(gate),0).
16634not(releasedAt(opened(Gate), 0)).
16635
16636% 
16637% ectest/ec_reader_test_examples.e:8216
16638% [position] % ReleasedAt(Pos(Homer,position),0).
16639releasedAt(pos(homer, Position), 0).
16640
16641% 
16642% ectest/ec_reader_test_examples.e:8217
16643% [position] % !ReleasedAt(Pos(Jumbo,position),0).
16644not(releasedAt(pos(jumbo, Position), 0)).
16645
16646% 
16647% ectest/ec_reader_test_examples.e:8218
16648% [position] % !ReleasedAt(Pos(Silver,position),0).
16649not(releasedAt(pos(silver, Position), 0)).
16650
16651% 
16652% 
16653% ectest/ec_reader_test_examples.e:8220
16654% [human] % HoldsAt(PosDeterminingFluent(human,1),1).
16655holds_at(posDeterminingFluent(Human, 1), 1).
16656
16657% 
16658% ectest/ec_reader_test_examples.e:8221
16659% [event,animal] % !HoldsAt(DoneBy(event,animal),1).
16660not(holds_at(doneBy(Event, Animal), 1)).
16661
16662% 
16663% 
16664% ;HoldsAt(Opened(GateAO),0).
16665% ;HoldsAt(Pos(Homer,3),0).
16666% ;HoldsAt(Pos(Jumbo,2),0).
16667% ;HoldsAt(Pos(Silver,3),0).
16668% ;Happens(Move(Jumbo,4),0).
16669% ;Happens(ThrowOff(Silver,Homer),0).
16670% ;HoldsAt(PosDeterminingFluent(Homer,2),0).
16671% ectest/ec_reader_test_examples.e:8230
16672% 
16673% range time 0 1
16674range(time, 0, 1).
16675
16676% range position 1 8
16677range(position, 1, 8).
16678
16679% range offset 0 0
16680range(offset, 0, 0).
16681
16682% 
16683% ; End of file.
16684% ectest/ec_reader_test_examples.e:8236
16685% 
16686% 
16687% 
16688% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16689% ; FILE: examples/AkmanEtAl2004/ZooTest3.e
16690% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16691% ;
16692% ; Copyright (c) 2005 IBM Corporation and others.
16693% ; All rights reserved. This program and the accompanying materials
16694% ; are made available under the terms of the Common Public License v1.0
16695% ; which accompanies this distribution, and is available at
16696% ; http://www.eclipse.org/legal/cpl-v10.html
16697% ;
16698% ; Contributors:
16699% ; IBM - Initial implementation
16700% ;
16701% ; @article{Akman:2004,
16702% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
16703% ;   year = "2004",
16704% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
16705% ;   journal = "Artificial Intelligence",
16706% ;   volume = "153",
16707% ;   pages = "105--140",
16708% ; }
16709% ;
16710% ectest/ec_reader_test_examples.e:8261
16711% 
16712% option encoding 3
16713option(encoding, 3).
16714
16715% 
16716% load foundations/Root.e
16717load('foundations/Root.e').
16718
16719% load foundations/EC.e
16720load('foundations/EC.e').
16721
16722% load examples/AkmanEtAl2004/ZooWorld.e
16723load('examples/AkmanEtAl2004/ZooWorld.e').
16724
16725% ectest/ec_reader_test_examples.e:8267
16726% 
16727% human Homer
16728t(human, homer).
16729
16730% dog Snoopy
16731t(dog, snoopy).
16732
16733% 
16734% Species(Homer)=HumanSpecies.
16735species(homer)=humanSpecies.
16736
16737% 
16738% Adult(Homer).
16739adult(homer).
16740
16741% 
16742% ectest/ec_reader_test_examples.e:8273
16743% Species(Snoopy)=DogSpecies.
16744species(snoopy)=dogSpecies.
16745
16746% 
16747% Adult(Snoopy).
16748adult(snoopy).
16749
16750% 
16751% 
16752% !HoldsAt(Opened(GateAO),0).
16753not(holds_at(opened(gateAO), 0)).
16754
16755% 
16756% ectest/ec_reader_test_examples.e:8277
16757% {position} % HoldsAt(Pos(Homer,position),0) & Outside=Loc(position).
16758exists([Position],  (holds_at(pos(homer, Position), 0), outside=loc(Position))).
16759
16760% 
16761% ectest/ec_reader_test_examples.e:8278
16762% {position} % HoldsAt(Pos(Snoopy,position),0) & CageA=Loc(position).
16763exists([Position],  (holds_at(pos(snoopy, Position), 0), cageA=loc(Position))).
16764
16765% 
16766% 
16767% ectest/ec_reader_test_examples.e:8280
16768% {position} % HoldsAt(Pos(Homer,position),2) & CageA=Loc(position).
16769exists([Position],  (holds_at(pos(homer, Position), 2), cageA=loc(Position))).
16770
16771% 
16772% ectest/ec_reader_test_examples.e:8281
16773% {position} % HoldsAt(Pos(Snoopy,position),2) & Outside=Loc(position).
16774exists([Position],  (holds_at(pos(snoopy, Position), 2), outside=loc(Position))).
16775
16776% 
16777% 
16778% ectest/ec_reader_test_examples.e:8283
16779% [human] % HoldsAt(PosDeterminingFluent(human,1),2).
16780holds_at(posDeterminingFluent(Human, 1), 2).
16781
16782% 
16783% ectest/ec_reader_test_examples.e:8284
16784% [event,animal] % !HoldsAt(DoneBy(event,animal),2).
16785not(holds_at(doneBy(Event, Animal), 2)).
16786
16787% 
16788% 
16789% range time 0 2
16790range(time, 0, 2).
16791
16792% range position 1 8
16793range(position, 1, 8).
16794
16795% range offset 0 0
16796range(offset, 0, 0).
16797
16798% 
16799% ; End of file.
16800% ectest/ec_reader_test_examples.e:8291
16801% 
16802% 
16803% 
16804% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16805% ; FILE: examples/AkmanEtAl2004/ZooWorld.e
16806% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16807% ;
16808% ; Copyright (c) 2005 IBM Corporation and others.
16809% ; All rights reserved. This program and the accompanying materials
16810% ; are made available under the terms of the Common Public License v1.0
16811% ; which accompanies this distribution, and is available at
16812% ; http://www.eclipse.org/legal/cpl-v10.html
16813% ;
16814% ; Contributors:
16815% ; IBM - Initial implementation
16816% ;
16817% ; @article{Akman:2004,
16818% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
16819% ;   year = "2004",
16820% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
16821% ;   journal = "Artificial Intelligence",
16822% ;   volume = "153",
16823% ;   pages = "105--140",
16824% ; }
16825% ;
16826% ectest/ec_reader_test_examples.e:8316
16827% 
16828% sort position: integer
16829subsort(position, integer).
16830
16831% sort location
16832sort(location).
16833
16834% sort cage: location
16835subsort(cage, location).
16836
16837% sort gate
16838sort(gate).
16839
16840% sort animal
16841sort(animal).
16842
16843% ectest/ec_reader_test_examples.e:8322
16844% sort elephant: animal
16845subsort(elephant, animal).
16846
16847% sort horse: animal
16848subsort(horse, animal).
16849
16850% sort dog: animal
16851subsort(dog, animal).
16852
16853% sort human: animal
16854subsort(human, animal).
16855
16856% sort species
16857sort(species).
16858
16859% 
16860% ectest/ec_reader_test_examples.e:8328
16861% function Loc(position): location
16862function(loc(position), location).
16863
16864% function Side1(gate): position
16865function(side1(gate), position).
16866
16867% function Side2(gate): position
16868function(side2(gate), position).
16869
16870% function Species(animal): species
16871function(species(animal), species).
16872
16873% 
16874% predicate Accessible(position,position,time)
16875predicate(accessible(position, position, time)).
16876
16877% ectest/ec_reader_test_examples.e:8334
16878% predicate Adult(animal)
16879predicate(adult(animal)).
16880
16881% predicate Large(animal)
16882predicate(large(animal)).
16883
16884% predicate LargeSpecies(species)
16885predicate(largeSpecies(species)).
16886
16887% predicate Neighbor(position,position)
16888predicate(neighbor(position, position)).
16889
16890% predicate Sides(position,position,gate)
16891predicate(sides(position, position, gate)).
16892
16893% 
16894% ectest/ec_reader_test_examples.e:8340
16895% event Close(human,gate)
16896event(close(human, gate)).
16897
16898% event GetOff(human,animal)
16899event(getOff(human, animal)).
16900
16901% event Mount(human,animal)
16902event(mount(human, animal)).
16903
16904% event Move(animal,position)
16905event(move(animal, position)).
16906
16907% event Open(human,gate)
16908event(open(human, gate)).
16909
16910% event ThrowOff(animal,human)
16911event(throwOff(animal, human)).
16912
16913% ectest/ec_reader_test_examples.e:8346
16914% 
16915% fluent AbnormalEncroachment(human)
16916fluent(abnormalEncroachment(human)).
16917
16918% noninertial AbnormalEncroachment
16919noninertial(abnormalEncroachment).
16920
16921% fluent DoneBy(event,animal)
16922fluent(doneBy(event, animal)).
16923
16924% noninertial DoneBy
16925noninertial(doneBy).
16926
16927% fluent Mounted(human,animal)
16928fluent(mounted(human, animal)).
16929
16930% ectest/ec_reader_test_examples.e:8352
16931% fluent MountFails(human)
16932fluent(mountFails(human)).
16933
16934% noninertial MountFails
16935noninertial(mountFails).
16936
16937% fluent Moves(animal)
16938fluent(moves(animal)).
16939
16940% noninertial Moves
16941noninertial(moves).
16942
16943% fluent Opened(gate)
16944fluent(opened(gate)).
16945
16946% fluent Pos(animal,position)
16947fluent(pos(animal, position)).
16948
16949% ectest/ec_reader_test_examples.e:8358
16950% fluent PosDeterminingFluent(human,position)
16951fluent(posDeterminingFluent(human, position)).
16952
16953% noninertial PosDeterminingFluent
16954noninertial(posDeterminingFluent).
16955
16956% fluent ThrowOffFails(animal,human)
16957fluent(throwOffFails(animal, human)).
16958
16959% noninertial ThrowOffFails
16960noninertial(throwOffFails).
16961
16962% 
16963% species HumanSpecies, ElephantSpecies, HorseSpecies, DogSpecies
16964t(species, humanSpecies).
16965
16966t(species, elephantSpecies).
16967
16968t(species, horseSpecies).
16969
16970t(species, dogSpecies).
16971
16972% ectest/ec_reader_test_examples.e:8364
16973% location Outside
16974t(location, outside).
16975
16976% 
16977% LargeSpecies(HumanSpecies).
16978largeSpecies(humanSpecies).
16979
16980% 
16981% LargeSpecies(ElephantSpecies).
16982largeSpecies(elephantSpecies).
16983
16984% 
16985% LargeSpecies(HorseSpecies).
16986largeSpecies(horseSpecies).
16987
16988% 
16989% !LargeSpecies(DogSpecies).
16990not(largeSpecies(dogSpecies)).
16991
16992% 
16993% ectest/ec_reader_test_examples.e:8370
16994% 
16995% ectest/ec_reader_test_examples.e:8371
16996% [event,animal,time]% 
16997% HoldsAt(DoneBy(event,animal),time) <->
16998% (Happens(event,time) &
16999%  (({gate} event=Close(animal,gate)) |
17000%   ({animal1} event=GetOff(animal,animal1))|
17001%   ({animal1} event=Mount(animal,animal1))|
17002%   ({position} event=Move(animal,position))|
17003%   ({gate} event=Open(animal,gate)) |
17004%   ({human1} event=ThrowOff(animal,human1)))).
17005holds_at(doneBy(Event, Animal), Time) <->
17006	happens(Event, Time),
17007	(   exists([Gate], Event=close(Animal, Gate))
17008	;   exists([Animal1],
17009		   Event=getOff(Animal, Animal1))
17010	;   exists([Animal15],
17011		   Event=mount(Animal, Animal15))
17012	;   exists([Position],
17013		   Event=move(Animal, Position))
17014	;   exists([Gate7], Event=open(Animal, Gate7))
17015	;   exists([Human1],
17016		   Event=throwOff(Animal, Human1))
17017	).
17018
17019% ectest/ec_reader_test_examples.e:8379
17020% 
17021% 
17022% ectest/ec_reader_test_examples.e:8381
17023% [event1,event2,animal,time]% 
17024% HoldsAt(DoneBy(event1,animal),time) &
17025% HoldsAt(DoneBy(event2,animal),time) ->
17026% event1=event2.
17027holds_at(doneBy(Event1, Animal), Time), holds_at(doneBy(Event2, Animal), Time) ->
17028	Event1=Event2.
17029
17030% 
17031% 
17032% ectest/ec_reader_test_examples.e:8386
17033% [animal] % Large(animal) <-> (Adult(animal) & LargeSpecies(Species(animal))).
17034large(Animal) <->
17035	adult(Animal),
17036	largeSpecies(species(Animal)).
17037
17038% 
17039% 
17040% ectest/ec_reader_test_examples.e:8388
17041% [position] 
17042% ectest/ec_reader_test_examples.e:8388
17043% {position1} % position1!=% position & Neighbor(position,position1).
17044exists([Position1],  (Position1\=Position, neighbor(Position, Position1))).
17045
17046% 
17047% 
17048% ectest/ec_reader_test_examples.e:8390
17049% [position] % !Neighbor(position,position).
17050not(neighbor(Position, Position)).
17051
17052% 
17053% 
17054% ectest/ec_reader_test_examples.e:8392
17055% [position1,position2]% 
17056% Neighbor(position1,position2) ->
17057% Neighbor(position2,position1).
17058neighbor(Position1, Position2) ->
17059	neighbor(Position2, Position1).
17060
17061% 
17062% 
17063% ectest/ec_reader_test_examples.e:8396
17064% [cage] % cage!=% Outside.
17065Cage\=outside.
17066
17067% 
17068% 
17069% ectest/ec_reader_test_examples.e:8398
17070% [position1,position2,gate]% 
17071% Sides(position1,position2,gate) <->
17072% ((Side1(gate)=position1 &
17073%   Side2(gate)=position2) |
17074%  (Side2(gate)=position1 &
17075%   Side1(gate)=position2)).
17076sides(Position1, Position2, Gate) <->
17077	(   side1(Gate)=Position1,
17078	    side2(Gate)=Position2
17079	;   side2(Gate)=Position1,
17080	    side1(Gate)=Position2
17081	).
17082
17083% 
17084% ectest/ec_reader_test_examples.e:8404
17085% 
17086% ectest/ec_reader_test_examples.e:8405
17087% [gate] % Loc(Side1(gate))!=Loc(Side2(gate)).
17088loc(side1(Gate))\=loc(side2(Gate)).
17089
17090% 
17091% 
17092% ectest/ec_reader_test_examples.e:8407
17093% [position1,position2,gate1,gate2]% 
17094% Sides(position1,position2,gate1) &
17095% Sides(position1,position2,gate2) ->
17096% gate1=gate2.
17097sides(Position1, Position2, Gate1), sides(Position1, Position2, Gate2) ->
17098	Gate1=Gate2.
17099
17100% 
17101% 
17102% ectest/ec_reader_test_examples.e:8412
17103% [position1,position2,gate]% 
17104% Sides(position1,position2,gate) ->
17105% Neighbor(position1,position2).
17106sides(Position1, Position2, Gate) ->
17107	neighbor(Position1, Position2).
17108
17109% 
17110% 
17111% ectest/ec_reader_test_examples.e:8416
17112% [position1,position2]% 
17113% Loc(position1) != Loc(position2) &
17114% Neighbor(position1,position2) ->
17115% ectest/ec_reader_test_examples.e:8419
17116% {gate}%  Sides(position1,position2,gate).
17117exists([Gate],  (loc(Position1)\=loc(Position2), neighbor(Position1, Position2)->sides(Position1, Position2, Gate))).
17118
17119% 
17120% 
17121% ectest/ec_reader_test_examples.e:8421
17122% [animal,position1,position2,time]% 
17123% HoldsAt(Pos(animal,position1),time) &
17124% HoldsAt(Pos(animal,position2),time) ->
17125% position1=position2.
17126holds_at(pos(Animal, Position1), Time), holds_at(pos(Animal, Position2), Time) ->
17127	Position1=Position2.
17128
17129% 
17130% 
17131% ectest/ec_reader_test_examples.e:8426
17132% [animal,time]% 
17133% ectest/ec_reader_test_examples.e:8427
17134% {position} % HoldsAt(Pos(animal,position),time).
17135exists([Position], holds_at(pos(Animal, Position), Time)).
17136
17137% 
17138% 
17139% ectest/ec_reader_test_examples.e:8429
17140% [animal1,animal2,position,time]% 
17141% (animal1!=animal2 &
17142%  Large(animal1) &
17143%  Large(animal2) &
17144%  HoldsAt(Pos(animal1,position),time) &
17145%  HoldsAt(Pos(animal2,position),time)) ->
17146% (({human} human=animal1 & HoldsAt(Mounted(human,animal2),time)) |
17147%  ({human} human=animal2 & HoldsAt(Mounted(human,animal1),time))).
17148Animal1\=Animal2, large(Animal1), large(Animal2), holds_at(pos(Animal1, Position), Time), holds_at(pos(Animal2, Position), Time) ->
17149	(   exists([Human],
17150		   (Human=Animal1, holds_at(mounted(Human, Animal2), Time)))
17151	;   exists([Human5],
17152		   (Human5=Animal2, holds_at(mounted(Human5, Animal1), Time)))
17153	).
17154
17155% ectest/ec_reader_test_examples.e:8436
17156% 
17157% 
17158% ectest/ec_reader_test_examples.e:8438
17159% [human,position1,position2,time]% 
17160% HoldsAt(PosDeterminingFluent(human,position1),time) &
17161% HoldsAt(PosDeterminingFluent(human,position2),time) ->
17162% position1=position2.
17163holds_at(posDeterminingFluent(Human, Position1), Time), holds_at(posDeterminingFluent(Human, Position2), Time) ->
17164	Position1=Position2.
17165
17166% 
17167% 
17168% ectest/ec_reader_test_examples.e:8443
17169% [animal,position,time]% 
17170% Initiates(Move(animal,position),Pos(animal,position),time).
17171initiates(move(Animal, Position), pos(Animal, Position), Time).
17172
17173% 
17174% 
17175% ectest/ec_reader_test_examples.e:8446
17176% [animal,position1,position2,time]% 
17177% HoldsAt(Pos(animal,position1),time) ->
17178% Terminates(Move(animal,position2),Pos(animal,position1),time).
17179holds_at(pos(Animal, Position1), Time) ->
17180	terminates(move(Animal, Position2),
17181		   pos(Animal, Position1),
17182		   Time).
17183
17184% 
17185% 
17186% ectest/ec_reader_test_examples.e:8450
17187% [animal,position,time]% 
17188% Happens(Move(animal,position),time) ->
17189% !HoldsAt(Pos(animal,position),time).
17190happens(move(Animal, Position), Time) ->
17191	not(holds_at(pos(Animal, Position), Time)).
17192
17193% 
17194% 
17195% ectest/ec_reader_test_examples.e:8454
17196% [human,position,time]% 
17197% Happens(Move(human,position),time) ->
17198% !{animal} HoldsAt(Mounted(human,animal),time).
17199happens(move(Human, Position), Time) ->
17200	not(exists([Animal],
17201		   holds_at(mounted(Human, Animal), Time))).
17202
17203% 
17204% 
17205% ectest/ec_reader_test_examples.e:8458
17206% [human,gate,time]% 
17207% Initiates(Open(human,gate),Opened(gate),time).
17208initiates(open(Human, Gate), opened(Gate), Time).
17209
17210% 
17211% 
17212% ectest/ec_reader_test_examples.e:8461
17213% [human,gate,time]% 
17214% Happens(Open(human,gate),time) ->
17215% !HoldsAt(Opened(gate),time) &
17216% (!{animal} HoldsAt(Mounted(human,animal),time)) &
17217% ({position}
17218%  (Side1(gate)=position | Side2(gate)=position) &
17219%  HoldsAt(Pos(human,position),time)).
17220happens(open(Human, Gate), Time) ->
17221	not(holds_at(opened(Gate), Time)),
17222	not(exists([Animal],
17223		   holds_at(mounted(Human, Animal), Time))),
17224	exists([Position],
17225	       ((side1(Gate)=Position;side2(Gate)=Position), holds_at(pos(Human, Position), Time))).
17226
17227% ectest/ec_reader_test_examples.e:8467
17228% 
17229% 
17230% ectest/ec_reader_test_examples.e:8469
17231% [human,gate,time]% 
17232% Terminates(Close(human,gate),Opened(gate),time).
17233terminates(close(Human, Gate), opened(Gate), Time).
17234
17235% 
17236% 
17237% ectest/ec_reader_test_examples.e:8472
17238% [human,gate,time]% 
17239% Happens(Close(human,gate),time) ->
17240% HoldsAt(Opened(gate),time) &
17241% (!{animal} HoldsAt(Mounted(human,animal),time)) &
17242% ectest/ec_reader_test_examples.e:8476
17243% {position}% 
17244% (Side1(gate)=position | Side2(gate)=position) &
17245% HoldsAt(Pos(human,position),time).
17246exists([Position],  (happens(close(Human, Gate), Time)->holds_at(opened(Gate), Time), not(exists([Animal], holds_at(mounted(Human, Animal), Time))), (side1(Gate)=Position;side2(Gate)=Position), holds_at(pos(Human, Position), Time))).
17247
17248% 
17249% 
17250% ectest/ec_reader_test_examples.e:8480
17251% [human,animal,position,time]% 
17252% HoldsAt(Mounted(human,animal),time) &
17253% HoldsAt(Pos(animal,position),time) ->
17254% HoldsAt(Pos(human,position),time).
17255holds_at(mounted(Human, Animal), Time), holds_at(pos(Animal, Position), Time) ->
17256	holds_at(pos(Human, Position), Time).
17257
17258% 
17259% 
17260% ectest/ec_reader_test_examples.e:8485
17261% [animal,time]% 
17262% HoldsAt(Moves(animal),time) <->
17263% ({position}
17264%  HoldsAt(Pos(animal,position),time) &
17265%  !HoldsAt(Pos(animal,position),time+1)).
17266holds_at(moves(Animal), Time) <->
17267	exists([Position],
17268	       (holds_at(pos(Animal, Position), Time), not(holds_at(pos(Animal, Position), Time+1)))).
17269
17270% 
17271% 
17272% ectest/ec_reader_test_examples.e:8491
17273% [human,time]% 
17274% HoldsAt(MountFails(human),time) <->
17275% ({animal}
17276%   Happens(Mount(human,animal),time) &
17277%   HoldsAt(Moves(animal),time)).
17278holds_at(mountFails(Human), Time) <->
17279	exists([Animal],
17280	       (happens(mount(Human, Animal), Time), holds_at(moves(Animal), Time))).
17281
17282% 
17283% 
17284% ectest/ec_reader_test_examples.e:8497
17285% [human,animal,position,time]% 
17286% !HoldsAt(Moves(animal),time) ->
17287% Releases(Mount(human,animal),Pos(human,position),time).
17288not(holds_at(moves(Animal), Time)) ->
17289	releases(mount(Human, Animal),
17290		 pos(Human, Position),
17291		 Time).
17292
17293% 
17294% 
17295% ectest/ec_reader_test_examples.e:8501
17296% [human,animal,time]% 
17297% !HoldsAt(Moves(animal),time) ->
17298% Initiates(Mount(human,animal),Mounted(human,animal),time).
17299not(holds_at(moves(Animal), Time)) ->
17300	initiates(mount(Human, Animal),
17301		  mounted(Human, Animal),
17302		  Time).
17303
17304% 
17305% 
17306% ectest/ec_reader_test_examples.e:8505
17307% [human,animal,position,time]% 
17308% HoldsAt(Pos(animal,position),time) &
17309% HoldsAt(Moves(animal),time) ->
17310% Initiates(Mount(human,animal),Pos(human,position),time).
17311holds_at(pos(Animal, Position), Time), holds_at(moves(Animal), Time) ->
17312	initiates(mount(Human, Animal),
17313		  pos(Human, Position),
17314		  Time).
17315
17316% 
17317% 
17318% ectest/ec_reader_test_examples.e:8510
17319% [human,animal,position,time]% 
17320% HoldsAt(Pos(human,position),time) &
17321% HoldsAt(Moves(animal),time) ->
17322% Terminates(Mount(human,animal),Pos(human,position),time).
17323holds_at(pos(Human, Position), Time), holds_at(moves(Animal), Time) ->
17324	terminates(mount(Human, Animal),
17325		   pos(Human, Position),
17326		   Time).
17327
17328% 
17329% 
17330% ectest/ec_reader_test_examples.e:8515
17331% [human,animal,time]% 
17332% Happens(Mount(human,animal),time) ->
17333% Large(animal).
17334happens(mount(Human, Animal), Time) ->
17335	large(Animal).
17336
17337% 
17338% 
17339% ectest/ec_reader_test_examples.e:8519
17340% [human,animal,time]% 
17341% HoldsAt(Mounted(human,animal),time) ->
17342% Large(animal).
17343holds_at(mounted(Human, Animal), Time) ->
17344	large(Animal).
17345
17346% 
17347% 
17348% ectest/ec_reader_test_examples.e:8523
17349% [human1,human2,time]% 
17350% Happens(Mount(human1,human2),time) ->
17351% !Large(human1).
17352happens(mount(Human1, Human2), Time) ->
17353	not(large(Human1)).
17354
17355% 
17356% 
17357% ectest/ec_reader_test_examples.e:8527
17358% [human1,human2,time]% 
17359% HoldsAt(Mounted(human1,human2),time) ->
17360% !Large(human1).
17361holds_at(mounted(Human1, Human2), Time) ->
17362	not(large(Human1)).
17363
17364% 
17365% 
17366% ectest/ec_reader_test_examples.e:8531
17367% [human,animal,time]% 
17368% Happens(Mount(human,animal),time) ->
17369% !{human1} human1!=human & HoldsAt(Mounted(human1,animal),time).
17370happens(mount(Human, Animal), Time) ->
17371	not(exists([Human1],
17372		   (Human1\=Human, holds_at(mounted(Human1, Animal), Time)))).
17373
17374% 
17375% 
17376% ectest/ec_reader_test_examples.e:8535
17377% [human1,human2,animal,time]% 
17378% HoldsAt(Mounted(human1,animal),time) &
17379% HoldsAt(Mounted(human2,animal),time) ->
17380% human1=human2.
17381holds_at(mounted(Human1, Animal), Time), holds_at(mounted(Human2, Animal), Time) ->
17382	Human1=Human2.
17383
17384% 
17385% 
17386% ectest/ec_reader_test_examples.e:8540
17387% [human,animal,time]% 
17388% Happens(Mount(human,animal),time) ->
17389% !{human1} human1!=human & HoldsAt(Mounted(human1,human),time).
17390happens(mount(Human, Animal), Time) ->
17391	not(exists([Human1],
17392		   (Human1\=Human, holds_at(mounted(Human1, Human), Time)))).
17393
17394% 
17395% 
17396% ectest/ec_reader_test_examples.e:8544
17397% [human1,human2,time]% 
17398% Happens(Mount(human1,human2),time) ->
17399% ectest/ec_reader_test_examples.e:8546
17400% {animal}%  HoldsAt(Mounted(human2,animal),time).
17401exists([Animal],  (happens(mount(Human1, Human2), Time)->holds_at(mounted(Human2, Animal), Time))).
17402
17403% 
17404% 
17405% ectest/ec_reader_test_examples.e:8548
17406% [human1,human2,time]% 
17407% HoldsAt(Mounted(human1,human2),time) ->
17408% !{animal} HoldsAt(Mounted(human2,animal),time).
17409holds_at(mounted(Human1, Human2), Time) ->
17410	not(exists([Animal],
17411		   holds_at(mounted(Human2, Animal), Time))).
17412
17413% 
17414% 
17415% ectest/ec_reader_test_examples.e:8552
17416% [human,animal,time]% 
17417% Happens(Mount(human,animal),time) ->
17418% !{animal1} HoldsAt(Mounted(human,animal1),time).
17419happens(mount(Human, Animal), Time) ->
17420	not(exists([Animal1],
17421		   holds_at(mounted(Human, Animal1), Time))).
17422
17423% 
17424% 
17425% ectest/ec_reader_test_examples.e:8556
17426% [human,animal,time]% 
17427% !HoldsAt(Moves(animal),time) ->
17428% Terminates(GetOff(human,animal),Mounted(human,animal),time).
17429not(holds_at(moves(Animal), Time)) ->
17430	terminates(getOff(Human, Animal),
17431		   mounted(Human, Animal),
17432		   Time).
17433
17434% 
17435% 
17436% ectest/ec_reader_test_examples.e:8560
17437% [human,animal,position,time]% 
17438% !HoldsAt(Moves(animal),time) &
17439% HoldsAt(PosDeterminingFluent(human,position),time) ->
17440% Initiates(GetOff(human,animal),Pos(human,position),time).
17441not(holds_at(moves(Animal), Time)), holds_at(posDeterminingFluent(Human, Position), Time) ->
17442	initiates(getOff(Human, Animal),
17443		  pos(Human, Position),
17444		  Time).
17445
17446% 
17447% 
17448% ectest/ec_reader_test_examples.e:8565
17449% [human,animal,position,time]% 
17450% !HoldsAt(Moves(animal),time) &
17451% HoldsAt(Pos(human,position),time) ->
17452% Terminates(GetOff(human,animal),Pos(human,position),time).
17453not(holds_at(moves(Animal), Time)), holds_at(pos(Human, Position), Time) ->
17454	terminates(getOff(Human, Animal),
17455		   pos(Human, Position),
17456		   Time).
17457
17458% 
17459% 
17460% ectest/ec_reader_test_examples.e:8570
17461% [human,animal,position1,position2,time]% 
17462% !HoldsAt(Moves(animal),time) &
17463% HoldsAt(Pos(human,position1),time) &
17464% position1!=position2 ->
17465% Terminates(GetOff(human,animal),Pos(human,position2),time).
17466not(holds_at(moves(Animal), Time)), holds_at(pos(Human, Position1), Time), Position1\=Position2 ->
17467	terminates(getOff(Human, Animal),
17468		   pos(Human, Position2),
17469		   Time).
17470
17471% 
17472% 
17473% ectest/ec_reader_test_examples.e:8576
17474% [human,animal,time]% 
17475% Happens(GetOff(human,animal),time) ->
17476% HoldsAt(Mounted(human,animal),time).
17477happens(getOff(Human, Animal), Time) ->
17478	holds_at(mounted(Human, Animal), Time).
17479
17480% 
17481% 
17482% ectest/ec_reader_test_examples.e:8580
17483% [animal1,human,time]% 
17484% HoldsAt(ThrowOffFails(animal1,human),time) <->
17485% ({position,animal2}
17486%  animal2!=human &
17487%  HoldsAt(PosDeterminingFluent(human,position),time) &
17488%  Large(animal2) &
17489%  HoldsAt(Pos(animal2,position),time+1)).
17490holds_at(throwOffFails(Animal1, Human), Time) <->
17491	exists([Position, Animal2],
17492	       (Animal2\=Human, holds_at(posDeterminingFluent(Human, Position), Time), large(Animal2), holds_at(pos(Animal2, Position), Time+1))).
17493
17494% ectest/ec_reader_test_examples.e:8586
17495% 
17496% 
17497% ectest/ec_reader_test_examples.e:8588
17498% [animal,human,position,time]% 
17499% HoldsAt(PosDeterminingFluent(human,position),time) &
17500% !HoldsAt(ThrowOffFails(animal,human),time) ->
17501% Initiates(ThrowOff(animal,human),Pos(human,position),time).
17502holds_at(posDeterminingFluent(Human, Position), Time), not(holds_at(throwOffFails(Animal, Human), Time)) ->
17503	initiates(throwOff(Animal, Human),
17504		  pos(Human, Position),
17505		  Time).
17506
17507% 
17508% 
17509% ectest/ec_reader_test_examples.e:8593
17510% [animal,human,position,time]% 
17511% HoldsAt(Pos(human,position),time) &
17512% !HoldsAt(ThrowOffFails(animal,human),time) ->
17513% Terminates(ThrowOff(animal,human),Pos(human,position),time).
17514holds_at(pos(Human, Position), Time), not(holds_at(throwOffFails(Animal, Human), Time)) ->
17515	terminates(throwOff(Animal, Human),
17516		   pos(Human, Position),
17517		   Time).
17518
17519% 
17520% 
17521% ectest/ec_reader_test_examples.e:8598
17522% [animal,human,position1,position2,time]% 
17523% !HoldsAt(ThrowOffFails(animal,human),time) &
17524% HoldsAt(Pos(human,position1),time) &
17525% !HoldsAt(PosDeterminingFluent(human,position2),time) &
17526% position1!=position2 ->
17527% Terminates(ThrowOff(animal,human),Pos(human,position2),time).
17528not(holds_at(throwOffFails(Animal, Human), Time)), holds_at(pos(Human, Position1), Time), not(holds_at(posDeterminingFluent(Human, Position2), Time)), Position1\=Position2 ->
17529	terminates(throwOff(Animal, Human),
17530		   pos(Human, Position2),
17531		   Time).
17532
17533% 
17534% ectest/ec_reader_test_examples.e:8604
17535% 
17536% ectest/ec_reader_test_examples.e:8605
17537% [human,time]% 
17538% (!{animal} Happens(ThrowOff(animal,human),time) |
17539%            Happens(GetOff(human,animal),time)) ->
17540% HoldsAt(PosDeterminingFluent(human,1),time).
17541not(exists([Animal], happens(throwOff(Animal, Human), Time)));happens(getOff(Human, animal), Time) ->
17542	holds_at(posDeterminingFluent(Human, 1), Time).
17543
17544% 
17545% 
17546% ectest/ec_reader_test_examples.e:8610
17547% [human,position,animal1,animal2,time]% 
17548% HoldsAt(PosDeterminingFluent(human,position),time) &
17549% HoldsAt(ThrowOffFails(animal1,human),time) &
17550% HoldsAt(Pos(animal2,position),time) ->
17551% Initiates(ThrowOff(animal1,human),Mounted(human,animal2),time).
17552holds_at(posDeterminingFluent(Human, Position), Time), holds_at(throwOffFails(Animal1, Human), Time), holds_at(pos(Animal2, Position), Time) ->
17553	initiates(throwOff(Animal1, Human),
17554		  mounted(Human, Animal2),
17555		  Time).
17556
17557% 
17558% 
17559% ectest/ec_reader_test_examples.e:8616
17560% [human,animal,time]% 
17561% !HoldsAt(ThrowOffFails(animal,human),time) ->
17562% Terminates(ThrowOff(animal,human),Mounted(human,animal),time).
17563not(holds_at(throwOffFails(Animal, Human), Time)) ->
17564	terminates(throwOff(Animal, Human),
17565		   mounted(Human, Animal),
17566		   Time).
17567
17568% 
17569% 
17570% ectest/ec_reader_test_examples.e:8620
17571% [animal,human,time]% 
17572% Happens(ThrowOff(animal,human),time) ->
17573% HoldsAt(Mounted(human,animal),time).
17574happens(throwOff(Animal, Human), Time) ->
17575	holds_at(mounted(Human, Animal), Time).
17576
17577% 
17578% 
17579% ectest/ec_reader_test_examples.e:8624
17580% [animal,human,time]% 
17581% Happens(ThrowOff(animal,human),time) ->
17582% !Happens(GetOff(human,animal),time).
17583happens(throwOff(Animal, Human), Time) ->
17584	not(happens(getOff(Human, Animal), Time)).
17585
17586% 
17587% 
17588% ectest/ec_reader_test_examples.e:8628
17589% [animal,human,time]% 
17590% Happens(GetOff(human,animal),time) ->
17591% !Happens(ThrowOff(animal,human),time).
17592happens(getOff(Human, Animal), Time) ->
17593	not(happens(throwOff(Animal, Human), Time)).
17594
17595% 
17596% 
17597% ectest/ec_reader_test_examples.e:8632
17598% [position1,position2,time]% 
17599% Accessible(position1,position2,time) <->
17600% (Neighbor(position1,position2) &
17601%  !{gate} Sides(position1,position2,gate) &
17602%          !HoldsAt(Opened(gate),time)).
17603accessible(Position1, Position2, Time) <->
17604	thereExists((neighbor(Position1, Position2), not([gate])),
17605		    (sides(Position1, Position2, gate), not(holds_at(opened(gate), Time)))).
17606
17607% 
17608% 
17609% ectest/ec_reader_test_examples.e:8638
17610% [animal,position1,position2,time]% 
17611% (position1!=position2 &
17612%  HoldsAt(Pos(animal,position1),time) &
17613%  HoldsAt(Pos(animal,position2),time+1)) ->
17614% Accessible(position1,position2,time).
17615Position1\=Position2, holds_at(pos(Animal, Position1), Time), holds_at(pos(Animal, Position2), Time+1) ->
17616	accessible(Position1, Position2, Time).
17617
17618% 
17619% 
17620% ectest/ec_reader_test_examples.e:8644
17621% [human,time]% 
17622% HoldsAt(AbnormalEncroachment(human),time) <->
17623% (HoldsAt(MountFails(human),time) |
17624%  ({position,animal1,animal2}
17625%    HoldsAt(PosDeterminingFluent(human,position),time) &
17626%    !HoldsAt(ThrowOffFails(animal2,human),time) &
17627%    Happens(ThrowOff(animal2,human),time) &
17628%    animal1!=human &
17629%    Large(animal1) &
17630%    HoldsAt(Pos(animal1,position),time) &
17631%    !HoldsAt(Pos(animal1,position),time+1))).
17632holds_at(abnormalEncroachment(Human), Time) <->
17633	(   holds_at(mountFails(Human), Time)
17634	;   exists([Position, Animal1, Animal2],
17635		   (holds_at(posDeterminingFluent(Human, Position), Time), not(holds_at(throwOffFails(Animal2, Human), Time)), happens(throwOff(Animal2, Human), Time), Animal1\=Human, large(Animal1), holds_at(pos(Animal1, Position), Time), not(holds_at(pos(Animal1, Position), Time+1))))
17636	).
17637
17638% ectest/ec_reader_test_examples.e:8654
17639% 
17640% 
17641% ectest/ec_reader_test_examples.e:8656
17642% [animal1,animal2,position,time]% 
17643% HoldsAt(Pos(animal1,position),time) &
17644% !HoldsAt(Pos(animal1,position),time+1) &
17645% !HoldsAt(Pos(animal2,position),time) &
17646% HoldsAt(Pos(animal2,position),time+1) ->
17647% (!Large(animal1) |
17648%  !Large(animal2) |
17649%  ({human} human=animal2 & HoldsAt(AbnormalEncroachment(human),time))).
17650holds_at(pos(Animal1, Position), Time), not(holds_at(pos(Animal1, Position), Time+1)), not(holds_at(pos(Animal2, Position), Time)), holds_at(pos(Animal2, Position), Time+1) ->
17651	(   not(large(Animal1))
17652	;   not(large(Animal2))
17653	;   exists([Human],
17654		   (Human=Animal2, holds_at(abnormalEncroachment(Human), Time)))
17655	).
17656
17657% ectest/ec_reader_test_examples.e:8663
17658% 
17659% 
17660% ectest/ec_reader_test_examples.e:8665
17661% [animal1,animal2,position1,position2,time]% 
17662% animal1!=% animal2 &
17663% Large(animal1) & Large(animal2) &
17664% HoldsAt(Pos(animal1,position1),time) &
17665% HoldsAt(Pos(animal1,position2),time+1) &
17666% HoldsAt(Pos(animal2,position1),time) &
17667% HoldsAt(Pos(animal2,position2),time+1) ->
17668% !{gate} Sides(position1,position2,gate).
17669Animal1\=Animal2, large(Animal1), large(Animal2), holds_at(pos(Animal1, Position1), Time), holds_at(pos(Animal1, Position2), Time+1), holds_at(pos(Animal2, Position1), Time), holds_at(pos(Animal2, Position2), Time+1) ->
17670	not(exists([Gate],
17671		   sides(Position1, Position2, Gate))).
17672
17673% ectest/ec_reader_test_examples.e:8672
17674% 
17675% 
17676% ectest/ec_reader_test_examples.e:8674
17677% [animal1,animal2,position1,position2,time]% 
17678% animal1!=% animal2 &
17679% Large(animal1) & Large(animal2) &
17680% HoldsAt(Pos(animal1,position1),time) &
17681% HoldsAt(Pos(animal1,position2),time+1) &
17682% HoldsAt(Pos(animal2,position2),time) &
17683% HoldsAt(Pos(animal2,position1),time+1) ->
17684% !{gate} Sides(position1,position2,gate).
17685Animal1\=Animal2, large(Animal1), large(Animal2), holds_at(pos(Animal1, Position1), Time), holds_at(pos(Animal1, Position2), Time+1), holds_at(pos(Animal2, Position2), Time), holds_at(pos(Animal2, Position1), Time+1) ->
17686	not(exists([Gate],
17687		   sides(Position1, Position2, Gate))).
17688
17689% ectest/ec_reader_test_examples.e:8681
17690% 
17691% 
17692% ectest/ec_reader_test_examples.e:8683
17693% [gate,position1,position2,time]% 
17694% HoldsAt(Opened(gate),time) &
17695% !HoldsAt(Opened(gate),time+1) &
17696% Sides(position1,position2,gate) ->
17697% !{animal}
17698% HoldsAt(Pos(animal,position1),time) &
17699% HoldsAt(Pos(animal,position2),time+1).
17700holds_at(opened(Gate), Time), not(holds_at(opened(Gate), Time+1)), sides(Position1, Position2, Gate) ->
17701	not(exists([Animal],
17702		   (holds_at(pos(Animal, Position1), Time), holds_at(pos(Animal, Position2), Time+1)))).
17703
17704% ectest/ec_reader_test_examples.e:8689
17705% 
17706% 
17707% gate GateAO
17708t(gate, gateAO).
17709
17710% cage CageA
17711t(cage, cageA).
17712
17713% 
17714% Loc(1)=CageA.
17715loc(1)=cageA.
17716
17717% 
17718% ectest/ec_reader_test_examples.e:8695
17719% Loc(2)=CageA.
17720loc(2)=cageA.
17721
17722% 
17723% Loc(3)=CageA.
17724loc(3)=cageA.
17725
17726% 
17727% Loc(4)=CageA.
17728loc(4)=cageA.
17729
17730% 
17731% Loc(5)=Outside.
17732loc(5)=outside.
17733
17734% 
17735% Loc(6)=Outside.
17736loc(6)=outside.
17737
17738% 
17739% Loc(7)=Outside.
17740loc(7)=outside.
17741
17742% 
17743% ectest/ec_reader_test_examples.e:8701
17744% Loc(8)=Outside.
17745loc(8)=outside.
17746
17747% 
17748% 
17749% ectest/ec_reader_test_examples.e:8703
17750% [position1,position2]% 
17751% Neighbor(position1,position2) <->
17752% ((position1=1 & position2=2) |
17753%  (position1=1 & position2=3) |
17754%  (position1=1 & position2=4) |
17755%  (position1=2 & position2=3) |
17756%  (position1=2 & position2=4) |
17757%  (position1=3 & position2=4) |
17758%  (position1=5 & position2=6) |
17759%  (position1=5 & position2=7) |
17760%  (position1=5 & position2=8) |
17761%  (position1=6 & position2=7) |
17762%  (position1=6 & position2=8) |
17763%  (position1=7 & position2=8) |
17764%  (position2=1 & position1=2) |
17765%  (position2=1 & position1=3) |
17766%  (position2=1 & position1=4) |
17767%  (position2=2 & position1=3) |
17768%  (position2=2 & position1=4) |
17769%  (position2=3 & position1=4) |
17770%  (position2=5 & position1=6) |
17771%  (position2=5 & position1=7) |
17772%  (position2=5 & position1=8) |
17773%  (position2=6 & position1=7) |
17774%  (position2=6 & position1=8) |
17775%  (position2=7 & position1=8) |
17776%  (position1=4 & position2=7) |
17777%  (position2=4 & position1=7)).
17778neighbor(Position1, Position2) <->
17779	(   Position1=1,
17780	    Position2=2
17781	;   Position1=1,
17782	    Position2=3
17783	;   Position1=1,
17784	    Position2=4
17785	;   Position1=2,
17786	    Position2=3
17787	;   Position1=2,
17788	    Position2=4
17789	;   Position1=3,
17790	    Position2=4
17791	;   Position1=5,
17792	    Position2=6
17793	;   Position1=5,
17794	    Position2=7
17795	;   Position1=5,
17796	    Position2=8
17797	;   Position1=6,
17798	    Position2=7
17799	;   Position1=6,
17800	    Position2=8
17801	;   Position1=7,
17802	    Position2=8
17803	;   Position2=1,
17804	    Position1=2
17805	;   Position2=1,
17806	    Position1=3
17807	;   Position2=1,
17808	    Position1=4
17809	;   Position2=2,
17810	    Position1=3
17811	;   Position2=2,
17812	    Position1=4
17813	;   Position2=3,
17814	    Position1=4
17815	;   Position2=5,
17816	    Position1=6
17817	;   Position2=5,
17818	    Position1=7
17819	;   Position2=5,
17820	    Position1=8
17821	;   Position2=6,
17822	    Position1=7
17823	;   Position2=6,
17824	    Position1=8
17825	;   Position2=7,
17826	    Position1=8
17827	;   Position1=4,
17828	    Position2=7
17829	;   Position2=4,
17830	    Position1=7
17831	).
17832
17833% ectest/ec_reader_test_examples.e:8730
17834% 
17835% 
17836% Side1(GateAO)=4.
17837side1(gateAO)=4.
17838
17839% 
17840% Side2(GateAO)=7.
17841side2(gateAO)=7.
17842
17843% 
17844% 
17845% ; End of file.
17846% ectest/ec_reader_test_examples.e:8736
17847% 
17848% 
17849% 
17850% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17851% ; FILE: examples/AkmanEtAl2004/ZooTest4.1.e
17852% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17853% ;
17854% ; Copyright (c) 2005 IBM Corporation and others.
17855% ; All rights reserved. This program and the accompanying materials
17856% ; are made available under the terms of the Common Public License v1.0
17857% ; which accompanies this distribution, and is available at
17858% ; http://www.eclipse.org/legal/cpl-v10.html
17859% ;
17860% ; Contributors:
17861% ; IBM - Initial implementation
17862% ;
17863% ; @article{Akman:2004,
17864% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
17865% ;   year = "2004",
17866% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
17867% ;   journal = "Artificial Intelligence",
17868% ;   volume = "153",
17869% ;   pages = "105--140",
17870% ; }
17871% ;
17872% ectest/ec_reader_test_examples.e:8761
17873% 
17874% option encoding 3
17875option(encoding, 3).
17876
17877% 
17878% load foundations/Root.e
17879load('foundations/Root.e').
17880
17881% load foundations/EC.e
17882load('foundations/EC.e').
17883
17884% load examples/AkmanEtAl2004/ZooWorld.e
17885load('examples/AkmanEtAl2004/ZooWorld.e').
17886
17887% ectest/ec_reader_test_examples.e:8767
17888% 
17889% human Homer
17890t(human, homer).
17891
17892% elephant Jumbo
17893t(elephant, jumbo).
17894
17895% 
17896% Species(Homer)=HumanSpecies.
17897species(homer)=humanSpecies.
17898
17899% 
17900% Adult(Homer).
17901adult(homer).
17902
17903% 
17904% ectest/ec_reader_test_examples.e:8773
17905% Species(Jumbo)=ElephantSpecies.
17906species(jumbo)=elephantSpecies.
17907
17908% 
17909% Adult(Jumbo).
17910adult(jumbo).
17911
17912% 
17913% 
17914% !HoldsAt(Opened(GateAO),0).
17915not(holds_at(opened(gateAO), 0)).
17916
17917% 
17918% ectest/ec_reader_test_examples.e:8777
17919% {position} % HoldsAt(Pos(Homer,position),0) & Outside=Loc(position).
17920exists([Position],  (holds_at(pos(homer, Position), 0), outside=loc(Position))).
17921
17922% 
17923% ectest/ec_reader_test_examples.e:8778
17924% {position} % HoldsAt(Pos(Jumbo,position),0) & CageA=Loc(position).
17925exists([Position],  (holds_at(pos(jumbo, Position), 0), cageA=loc(Position))).
17926
17927% 
17928% 
17929% ectest/ec_reader_test_examples.e:8780
17930% {position} % HoldsAt(Pos(Homer,position),4) & CageA=Loc(position).
17931exists([Position],  (holds_at(pos(homer, Position), 4), cageA=loc(Position))).
17932
17933% 
17934% ectest/ec_reader_test_examples.e:8781
17935% {position} % HoldsAt(Pos(Jumbo,position),4) & Outside=Loc(position).
17936exists([Position],  (holds_at(pos(jumbo, Position), 4), outside=loc(Position))).
17937
17938% 
17939% 
17940% ectest/ec_reader_test_examples.e:8783
17941% [human] % HoldsAt(PosDeterminingFluent(human,1),4).
17942holds_at(posDeterminingFluent(Human, 1), 4).
17943
17944% 
17945% ectest/ec_reader_test_examples.e:8784
17946% [event,animal] % !HoldsAt(DoneBy(event,animal),4).
17947not(holds_at(doneBy(Event, Animal), 4)).
17948
17949% 
17950% 
17951% ; ccalc.2.0b.8.3 single model
17952% ;HoldsAt(Pos(Homer,7),0).
17953% ;HoldsAt(Pos(Jumbo,2),0).
17954% ;Happens(Move(Jumbo,4),0).
17955% ;Happens(Open(Homer,GateAO),0).
17956% ;Happens(Mount(Homer,Jumbo),1).
17957% ;Happens(ThrowOff(Jumbo,Homer),2).
17958% ;HoldsAt(PosDeterminingFluent(Homer,1),2).
17959% ;Happens(Move(Jumbo,7),3).
17960% ;Happens(Mount(Homer,Jumbo),3).
17961% ectest/ec_reader_test_examples.e:8796
17962% 
17963% range time 0 4
17964range(time, 0, 4).
17965
17966% range position 1 8
17967range(position, 1, 8).
17968
17969% range offset 0 0
17970range(offset, 0, 0).
17971
17972% 
17973% ; End of file.
17974% ectest/ec_reader_test_examples.e:8802
17975% 
17976% 
17977% 
17978% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17979% ; FILE: examples/AkmanEtAl2004/ZooTest2.e
17980% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17981% ;
17982% ; Copyright (c) 2005 IBM Corporation and others.
17983% ; All rights reserved. This program and the accompanying materials
17984% ; are made available under the terms of the Common Public License v1.0
17985% ; which accompanies this distribution, and is available at
17986% ; http://www.eclipse.org/legal/cpl-v10.html
17987% ;
17988% ; Contributors:
17989% ; IBM - Initial implementation
17990% ;
17991% ; @article{Akman:2004,
17992% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
17993% ;   year = "2004",
17994% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
17995% ;   journal = "Artificial Intelligence",
17996% ;   volume = "153",
17997% ;   pages = "105--140",
17998% ; }
17999% ;
18000% ectest/ec_reader_test_examples.e:8827
18001% 
18002% option encoding 3
18003option(encoding, 3).
18004
18005% 
18006% load foundations/Root.e
18007load('foundations/Root.e').
18008
18009% load foundations/EC.e
18010load('foundations/EC.e').
18011
18012% load examples/AkmanEtAl2004/ZooWorld.e
18013load('examples/AkmanEtAl2004/ZooWorld.e').
18014
18015% ectest/ec_reader_test_examples.e:8833
18016% 
18017% human Homer
18018t(human, homer).
18019
18020% 
18021% Species(Homer)=HumanSpecies.
18022species(homer)=humanSpecies.
18023
18024% 
18025% Adult(Homer).
18026adult(homer).
18027
18028% 
18029% 
18030% ectest/ec_reader_test_examples.e:8839
18031% !HoldsAt(Opened(GateAO),0).
18032not(holds_at(opened(gateAO), 0)).
18033
18034% 
18035% ectest/ec_reader_test_examples.e:8840
18036% {position} % HoldsAt(Pos(Homer,position),0) & Outside=Loc(position).
18037exists([Position],  (holds_at(pos(homer, Position), 0), outside=loc(Position))).
18038
18039% 
18040% ectest/ec_reader_test_examples.e:8841
18041% {position} % HoldsAt(Pos(Homer,position),2) & CageA=Loc(position).
18042exists([Position],  (holds_at(pos(homer, Position), 2), cageA=loc(Position))).
18043
18044% 
18045% 
18046% ectest/ec_reader_test_examples.e:8843
18047% [human] % HoldsAt(PosDeterminingFluent(human,1),2).
18048holds_at(posDeterminingFluent(Human, 1), 2).
18049
18050% 
18051% ectest/ec_reader_test_examples.e:8844
18052% [event,animal] % !HoldsAt(DoneBy(event,animal),2).
18053not(holds_at(doneBy(Event, Animal), 2)).
18054
18055% 
18056% 
18057% range time 0 2
18058range(time, 0, 2).
18059
18060% range position 1 8
18061range(position, 1, 8).
18062
18063% range offset 0 0
18064range(offset, 0, 0).
18065
18066% 
18067% ; End of file.
18068% ectest/ec_reader_test_examples.e:8851
18069% 
18070% 
18071% 
18072% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18073% ; FILE: examples/AkmanEtAl2004/ZooTest6.e
18074% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18075% ;
18076% ; Copyright (c) 2005 IBM Corporation and others.
18077% ; All rights reserved. This program and the accompanying materials
18078% ; are made available under the terms of the Common Public License v1.0
18079% ; which accompanies this distribution, and is available at
18080% ; http://www.eclipse.org/legal/cpl-v10.html
18081% ;
18082% ; Contributors:
18083% ; IBM - Initial implementation
18084% ;
18085% ; @article{Akman:2004,
18086% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
18087% ;   year = "2004",
18088% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
18089% ;   journal = "Artificial Intelligence",
18090% ;   volume = "153",
18091% ;   pages = "105--140",
18092% ; }
18093% ;
18094% ectest/ec_reader_test_examples.e:8876
18095% 
18096% option encoding 3
18097option(encoding, 3).
18098
18099% 
18100% load foundations/Root.e
18101load('foundations/Root.e').
18102
18103% load foundations/EC.e
18104load('foundations/EC.e').
18105
18106% load examples/AkmanEtAl2004/ZooWorld.e
18107load('examples/AkmanEtAl2004/ZooWorld.e').
18108
18109% ectest/ec_reader_test_examples.e:8882
18110% 
18111% human Homer
18112t(human, homer).
18113
18114% elephant Jumbo
18115t(elephant, jumbo).
18116
18117% 
18118% Species(Homer)=HumanSpecies.
18119species(homer)=humanSpecies.
18120
18121% 
18122% Adult(Homer).
18123adult(homer).
18124
18125% 
18126% ectest/ec_reader_test_examples.e:8888
18127% Species(Jumbo)=ElephantSpecies.
18128species(jumbo)=elephantSpecies.
18129
18130% 
18131% Adult(Jumbo).
18132adult(jumbo).
18133
18134% 
18135% 
18136% HoldsAt(Mounted(Homer,Jumbo),0).
18137holds_at(mounted(homer, jumbo), 0).
18138
18139% 
18140% HoldsAt(Pos(Jumbo,1),0).
18141holds_at(pos(jumbo, 1), 0).
18142
18143% 
18144% Happens(ThrowOff(Jumbo,Homer),0).
18145happens(throwOff(jumbo, homer), 0).
18146
18147% 
18148% ectest/ec_reader_test_examples.e:8894
18149% 
18150% option manualrelease on
18151option(manualrelease, on).
18152
18153% ectest/ec_reader_test_examples.e:8896
18154% [human, animal] % !ReleasedAt(Mounted(human, animal),0).
18155not(releasedAt(mounted(Human, Animal), 0)).
18156
18157% 
18158% ectest/ec_reader_test_examples.e:8897
18159% [gate] % !ReleasedAt(Opened(gate),0).
18160not(releasedAt(opened(Gate), 0)).
18161
18162% 
18163% ectest/ec_reader_test_examples.e:8898
18164% [position] % ReleasedAt(Pos(Homer,position),0).
18165releasedAt(pos(homer, Position), 0).
18166
18167% 
18168% ectest/ec_reader_test_examples.e:8899
18169% [position] % !ReleasedAt(Pos(Jumbo,position),0).
18170not(releasedAt(pos(jumbo, Position), 0)).
18171
18172% 
18173% 
18174% ectest/ec_reader_test_examples.e:8901
18175% [human] % HoldsAt(PosDeterminingFluent(human,1),1).
18176holds_at(posDeterminingFluent(Human, 1), 1).
18177
18178% 
18179% ectest/ec_reader_test_examples.e:8902
18180% [event,animal] % !HoldsAt(DoneBy(event,animal),1).
18181not(holds_at(doneBy(Event, Animal), 1)).
18182
18183% 
18184% 
18185% range time 0 1
18186range(time, 0, 1).
18187
18188% range position 1 8
18189range(position, 1, 8).
18190
18191% range offset 0 0
18192range(offset, 0, 0).
18193
18194% 
18195% ; End of file.
18196% ectest/ec_reader_test_examples.e:8909
18197% 
18198% 
18199% 
18200% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18201% ; FILE: examples/AkmanEtAl2004/ZooTest1.e
18202% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18203% ;
18204% ; Copyright (c) 2005 IBM Corporation and others.
18205% ; All rights reserved. This program and the accompanying materials
18206% ; are made available under the terms of the Common Public License v1.0
18207% ; which accompanies this distribution, and is available at
18208% ; http://www.eclipse.org/legal/cpl-v10.html
18209% ;
18210% ; Contributors: 
18211% ; IBM - Initial implementation
18212% ;
18213% ; @article{Akman:2004,
18214% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
18215% ;   year = "2004",
18216% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
18217% ;   journal = "Artificial Intelligence",
18218% ;   volume = "153",
18219% ;   pages = "105--140",
18220% ; }
18221% ;
18222% ectest/ec_reader_test_examples.e:8934
18223% 
18224% option encoding 3
18225option(encoding, 3).
18226
18227% 
18228% load foundations/Root.e
18229load('foundations/Root.e').
18230
18231% load foundations/EC.e
18232load('foundations/EC.e').
18233
18234% load examples/AkmanEtAl2004/ZooWorld.e
18235load('examples/AkmanEtAl2004/ZooWorld.e').
18236
18237% ectest/ec_reader_test_examples.e:8940
18238% 
18239% human Homer
18240t(human, homer).
18241
18242% elephant Jumbo
18243t(elephant, jumbo).
18244
18245% 
18246% Species(Homer)=HumanSpecies.
18247species(homer)=humanSpecies.
18248
18249% 
18250% Adult(Homer).
18251adult(homer).
18252
18253% 
18254% ectest/ec_reader_test_examples.e:8946
18255% Species(Jumbo)=ElephantSpecies.
18256species(jumbo)=elephantSpecies.
18257
18258% 
18259% Adult(Jumbo).
18260adult(jumbo).
18261
18262% 
18263% 
18264% !HoldsAt(Opened(GateAO),0).
18265not(holds_at(opened(gateAO), 0)).
18266
18267% 
18268% HoldsAt(Pos(Homer,6),0).
18269holds_at(pos(homer, 6), 0).
18270
18271% 
18272% ectest/ec_reader_test_examples.e:8951
18273% [time] % HoldsAt(Pos(Jumbo,1),time).
18274holds_at(pos(jumbo, 1), Time).
18275
18276% 
18277% 
18278% ; goal
18279% HoldsAt(Mounted(Homer,Jumbo),4).
18280holds_at(mounted(homer, jumbo), 4).
18281
18282% 
18283% 
18284% ;ABDUCE
18285% ;Happens(Move(Homer,7),0).
18286% ;Happens(Open(Homer,GateAO),1).
18287% ;Happens(Move(Homer,4),2).
18288% ;Happens(Mount(Homer,Jumbo),3).
18289% ectest/ec_reader_test_examples.e:8961
18290% 
18291% ectest/ec_reader_test_examples.e:8962
18292% [human] % HoldsAt(PosDeterminingFluent(human,1),4).
18293holds_at(posDeterminingFluent(Human, 1), 4).
18294
18295% 
18296% ectest/ec_reader_test_examples.e:8963
18297% [event,animal] % !HoldsAt(DoneBy(event,animal),4).
18298not(holds_at(doneBy(Event, Animal), 4)).
18299
18300% 
18301% 
18302% range time 0 4
18303range(time, 0, 4).
18304
18305% range position 1 8
18306range(position, 1, 8).
18307
18308% range offset 0 0
18309range(offset, 0, 0).
18310
18311% 
18312% ectest/ec_reader_test_examples.e:8969
18313% option timediff off
18314option(timediff, off).
18315
18316% option modeldiff on
18317option(modeldiff, on).
18318
18319% 
18320% ; End of file.
18321% 
18322% 
18323% ectest/ec_reader_test_examples.e:8975
18324% 
18325% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18326% ; FILE: examples/AkmanEtAl2004/ZooTest5.2.e
18327% ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18328% ;
18329% ; Copyright (c) 2005 IBM Corporation and others.
18330% ; All rights reserved. This program and the accompanying materials
18331% ; are made available under the terms of the Common Public License v1.0
18332% ; which accompanies this distribution, and is available at
18333% ; http://www.eclipse.org/legal/cpl-v10.html
18334% ;
18335% ; Contributors:
18336% ; IBM - Initial implementation
18337% ;
18338% ; @article{Akman:2004,
18339% ;   author = "Varol Akman and Selim T. Erdogan and Joohyung Lee and Vladimir Lifschitz and Hudson Turner",
18340% ;   year = "2004",
18341% ;   title = "Representing the zoo world and the traffic world in the language of the causal calculator",
18342% ;   journal = "Artificial Intelligence",
18343% ;   volume = "153",
18344% ;   pages = "105--140",
18345% ; }
18346% ;
18347% ectest/ec_reader_test_examples.e:8998
18348% 
18349% option encoding 3
18350option(encoding, 3).
18351
18352% 
18353% load foundations/Root.e
18354load('foundations/Root.e').
18355
18356% load foundations/EC.e
18357load('foundations/EC.e').
18358
18359% load examples/AkmanEtAl2004/ZooWorld.e
18360load('examples/AkmanEtAl2004/ZooWorld.e').
18361
18362% ectest/ec_reader_test_examples.e:9004
18363% 
18364% human Homer
18365t(human, homer).
18366
18367% elephant Jumbo
18368t(elephant, jumbo).
18369
18370% horse Silver
18371t(horse, silver).
18372
18373% 
18374% Species(Homer)=HumanSpecies.
18375species(homer)=humanSpecies.
18376
18377% 
18378% ectest/ec_reader_test_examples.e:9010
18379% Adult(Homer).
18380adult(homer).
18381
18382% 
18383% Species(Jumbo)=ElephantSpecies.
18384species(jumbo)=elephantSpecies.
18385
18386% 
18387% Adult(Jumbo).
18388adult(jumbo).
18389
18390% 
18391% Species(Silver)=HorseSpecies.
18392species(silver)=horseSpecies.
18393
18394% 
18395% Adult(Silver).
18396adult(silver).
18397
18398% 
18399% 
18400% ectest/ec_reader_test_examples.e:9016
18401% {position}% 
18402% !HoldsAt(Pos(Homer,position),0) &
18403% HoldsAt(Pos(Jumbo,position),0) &
18404% HoldsAt(Pos(Homer,position),1) &
18405% !HoldsAt(Pos(Jumbo,position),1).
18406exists([Position],  (not(holds_at(pos(homer, Position), 0)), holds_at(pos(jumbo, Position), 0), holds_at(pos(homer, Position), 1), not(holds_at(pos(jumbo, Position), 1)))).
18407
18408% 
18409% ectest/ec_reader_test_examples.e:9021
18410% [animal,time] % !Happens(ThrowOff(animal,Homer),time).
18411not(happens(throwOff(Animal, homer), Time)).
18412
18413% 
18414% 
18415% ectest/ec_reader_test_examples.e:9023
18416% [human] % HoldsAt(PosDeterminingFluent(human,1),1).
18417holds_at(posDeterminingFluent(Human, 1), 1).
18418
18419% 
18420% ectest/ec_reader_test_examples.e:9024
18421% [event,animal] % !HoldsAt(DoneBy(event,animal),1).
18422not(holds_at(doneBy(Event, Animal), 1)).
18423
18424% 
18425% 
18426% ;HoldsAt(Opened(GateAO),0).
18427% ;HoldsAt(Pos(Homer,3),0).
18428% ;HoldsAt(Pos(Jumbo,2),0).
18429% ;HoldsAt(Pos(Silver,7),0).
18430% ;Happens(Move(Jumbo,4),0).
18431% ;Happens(Move(Silver,8),0).
18432% ;Happens(Mount(Homer,Jumbo),0).
18433% ectest/ec_reader_test_examples.e:9033
18434% 
18435% range time 0 1
18436range(time, 0, 1).
18437
18438% range position 1 8
18439range(position, 1, 8).
18440
18441% range offset 0 0
18442range(offset, 0, 0).
18443
18444% 
18445% ; End of file.
18446% ectest/ec_reader_test_examples.e:9039
18447% translate: ending  File: ectest/ec_reader_test_examples.e.pro