2:- use_module(library(logicmoo_common)).    3:- use_module(library(lps_corner)).    4:- expects_dialect(lps).    5
    6
    7/* Fluents regarding units */
    8fluent(person(_, _)).
    9fluent(position(_, _, _, _)).
   10fluent(health(_, _)).
   11fluent(hunger(_, _)).
   12fluent(holds_wood(_,_)).
   13fluent(holds_food(_, _, _, _, _)).
   14fluent(has_shelter(_,_)).
   15fluent(shelter(_,_,_,_)).
   16fluent(turns(_,_)).
   17fluent(dead(_)).
   18
   19/* Inanimate object fluents */
   20fluent(tree(_,_)).
   21fluent(wood(_,_)).
   22fluent(animal(_, _, _, _, _)).
   23fluent(food(_, _, _, _, _)).
   24
   25/* Cycles */
   26fluent(cycles(_)).
   27
   28/* Start game event */
   29event(start_game(_)).
   30
   31
   32
   33initial_state([
   34	
   35	/* The people in the game */
   36	person(amanda, cautious),
   37	
   38	person(katherine, normal),
   39	
   40	person(peter, normal),
   41	
   42	person(tom, normal),
   43
   44	person(alex, violent),
   45
   46	
   47	/* Defining the information for Amanda */
   48	position(amanda, north, 3, 3),
   49	holds_wood(amanda, 0),
   50	holds_food(amanda, 0, 0, 0, 0),
   51	health(amanda, 50),
   52	hunger(amanda, 20), 
   53	has_shelter(amanda, true),
   54	shelter(amanda, 100, 4, 5),
   55	turns(amanda, 0),
   56	
   57	/* Defining the information for Katherine */
   58	position(katherine, east, 4, 18),
   59	holds_wood(katherine, 0),
   60	holds_food(katherine, 0, 0, 0, 0),
   61	health(katherine, 50),
   62	hunger(katherine, 20),
   63	has_shelter(katherine, true),
   64	shelter(katherine, 100, 8, 19),
   65	turns(katherine, 0),
   66
   67	/* Defining the information for Peter */
   68	position(peter, north, 17, 3),
   69	holds_wood(peter, 0),
   70	holds_food(peter, 0, 0, 0, 0),
   71	health(peter, 50),
   72	hunger(peter, 20),
   73	has_shelter(peter, true),
   74	shelter(peter, 100, 13, 4),
   75	turns(peter, 0),
   76
   77	/* Defining the information for Tom */
   78	position(tom, west, 19, 18),
   79	holds_wood(tom, 0),
   80	holds_food(tom, 0, 0, 0, 0),
   81	health(tom, 50),
   82	hunger(tom, 20),
   83	has_shelter(tom, true),
   84	shelter(tom, 100, 14, 20),
   85	turns(tom, 0),
   86
   87	/* Defining the information for Alex */
   88	position(alex, north, 10, 9),
   89	holds_wood(alex, 0),
   90	holds_food(alex, 10, 0, 0, 2),
   91	health(alex, 50),
   92	hunger(alex, 20),
   93	has_shelter(alex, false),
   94	turns(alex, 0),
   95
   96	/* Defining locations for animals */
   97	animal(rabbit, 5, west, 5, 7),
   98	animal(rabbit, 5, east, 12, 8),
   99	animal(rabbit, 5, west, 4, 9),
  100	animal(rabbit, 5, south, 1, 10),
  101	animal(rabbit, 5, west, 6, 13),
  102	animal(rabbit, 5, north, 14, 16),
  103	animal(rabbit, 5, north, 9, 16),
  104
  105	animal(chicken, 10, north, 7, 6),
  106	animal(chicken, 10, east, 16, 6),
  107	animal(chicken, 10, east, 8, 8),
  108	animal(chicken, 10, west, 2, 13),
  109	animal(chicken, 10, east, 3, 15),
  110	animal(chicken, 10, south, 12, 15),
  111	animal(chicken, 10, south, 13, 18),
  112
  113	animal(cow, 15, north, 9, 3),
  114	animal(cow, 15, north, 18, 8),
  115	animal(cow, 15, south, 17, 13),
  116	animal(cow, 15, west, 6, 16),
  117
  118	/* Defining locations for food */
  119	food(2, 1, 0, 3, 8),
  120	food(2, 1, 1, 15, 9),
  121	food(2, 1, 2, 20, 9),
  122	food(2, 1, 0, 8, 14),
  123
  124	/* Defining locations for trees */
  125	tree(1, 1),
  126	tree(4, 1),
  127	tree(11, 1),
  128	tree(18, 1),
  129	tree(2, 2),
  130	tree(13, 2),
  131	tree(6, 3),
  132	tree(19, 4),
  133	tree(1, 5),
  134	tree(11, 6),
  135	tree(13, 7),
  136	tree(12, 10),
  137	tree(8, 11),
  138	tree(11, 12),
  139	tree(14, 12),
  140	tree(19, 14),
  141	tree(1, 15),
  142	tree(3, 17),
  143	tree(1, 19),
  144	tree(6, 19),
  145	tree(4, 20),
  146	tree(8, 20),
  147	tree(17, 20),
  148	tree(20, 20),
  149
  150	/* Defining locations for food */
  151	wood(7, 1),
  152	wood(4, 11),
  153	wood(18, 11),
  154	wood(10, 14),
  155
  156	/* Cycles start at zero */
  157	cycles(0)
  158]).
  159
  160
  161/**************************************** l_timeless' for universal use ****************************************/
  162
  163/* Defining weapon information for Amanda */
  164
  165l_timeless(has(amanda, weapon(spear)), []).
  166l_timeless(power(weapon(spear), 6), []).
  167l_timeless(range(weapon(spear), 1, 3),[]).
  168
  169/* Defining weapon information for Katherine */
  170
  171l_timeless(has(katherine, weapon(bow)),[]).
  172l_timeless(power(weapon(bow), 6),[]).
  173l_timeless(range(weapon(bow), 1, 6),[]).
  174
  175/* Defining weapon information for Peter */
  176
  177l_timeless(has(peter, weapon(bombs)),[]).
  178l_timeless(power(weapon(bombs), 8),[]).
  179l_timeless(range(weapon(bombs), 6, 6),[]).
  180
  181/* Defining weapon information for Tom */
  182
  183l_timeless(has(tom, weapon(whip)),[]).
  184l_timeless(power(weapon(whip), 4),[]).
  185l_timeless(range(weapon(whip), 1, 3),[]).
  186
  187/* Defining weapon information for Alex */
  188
  189l_timeless(has(alex, weapon(sword)),[]).
  190l_timeless(power(weapon(sword), 8),[]).
  191l_timeless(range(weapon(sword), 1, 1),[]).
  192
  193
  194/* Comparators */
  195
  196l_timeless(less_than(X, Y), [X < Y]).
  197l_timeless(less_or_equal(X, Y), [X =< Y]).
  198l_timeless(greater_or_equal(X, Y), [X >= Y]).
  199l_timeless(greater_than(X, Y), [X > Y]).
  200l_timeless(equal(X, Y), [X == Y]).
  201l_timeless(not_equal(X, Y), [X \= Y]).
  202
  203/* Mathematical usuage */
  204
  205l_timeless(decrement(X, X1), [X1 is X - 1]).
  206l_timeless(increment(X, X1), [X1 is X + 1]).
  207l_timeless(decrease(X, X1, N), [X1 is X - N]).
  208l_timeless(increase(X, X1, N), [X1 is X + N]).
  209l_timeless(calculate(N, A, B, C), [N is A * 1 + B * 3 + C * 5]).
  210l_timeless(modu(X, X1), [X is mod(X1, 8)]).
  211
  212/* Defining the opposite compass direction */
  213
  214l_timeless(opposite(north, south), []).
  215l_timeless(opposite(east, west), []).
  216l_timeless(opposite(south, north), []).
  217l_timeless(opposite(west, east), []).
  218
  219/**************************************** l_int's for universal use ****************************************/
  220
  221
  222/* Different cases to determine whether a unit is next to a specified object depending on the unit's direction */
  223
  224l_int(
  225	holds(next_to(Unit, Type), T),
  226	[
  227		holds(position(Unit, south, X, Y), T),
  228		increment(Y, Y1),
  229		holds(item(Type, X, Y1), T)
  230	]
  231
  232).
  233
  234
  235l_int(
  236	holds(next_to(Unit, Type), T),
  237	[
  238		holds(position(Unit, north, X, Y), T),
  239		decrement(Y, Y1),
  240		holds(item(Type, X, Y1), T)
  241	]
  242
  243).
  244
  245l_int(
  246	holds(next_to(Unit, Type), T),
  247	[
  248		holds(position(Unit, east, X, Y), T),
  249		increment(X, X1),
  250		holds(item(Type, X1, Y), T)
  251	]
  252
  253).
  254
  255l_int(
  256	holds(next_to(Unit, Type), T),
  257	[
  258		holds(position(Unit, west, X, Y), T),
  259		decrement(X, X1),
  260		holds(item(Type, X1, Y), T)
  261	]
  262
  263).
  264
  265
  266
  267/* Different cases for if a unit is in sight of a specified item depending on depending on the unit's direction */
  268
  269l_int(
  270	holds(in_sight(Unit, Type), T),
  271	[
  272		holds(position(Unit, east, X, Y), T),
  273		holds(item(Type, A, Y), T),
  274		greater_than(A, X),
  275		increase(X, X1, 6),
  276		less_or_equal(A, X1)
  277	]
  278
  279).
  280
  281l_int(
  282	holds(in_sight(Unit, Type), T),
  283	[
  284		holds(position(Unit, north, X, Y), T),
  285		holds(item(Type, X, A), T),
  286		less_than(A, Y),
  287		decrease(Y, Y1, 6),
  288		greater_or_equal(A, Y1)
  289	]
  290
  291).
  292
  293l_int(
  294	holds(in_sight(Unit, Type), T),
  295	[
  296		holds(position(Unit, south, X, Y), T),
  297		holds(item(Type, X, A), T),
  298		greater_than(A, Y),
  299		increase(Y, Y1, 6),
  300		less_or_equal(A, Y1)
  301	]
  302
  303).
  304
  305
  306l_int(
  307	holds(in_sight(Unit, Type), T),
  308	[
  309		holds(position(Unit, west, X, Y), T),
  310		holds(item(Type, A, Y), T),
  311		less_than(A, X),
  312		decrease(X, X1, 6),
  313		greater_or_equal(A, X1)
  314	]
  315
  316).
  317
  318/* Defining the different items, used to determine if an item is of a certain type */
  319
  320l_int(
  321	holds(item(tree, X, Y), T),
  322	[
  323		holds(tree(X,Y), T)
  324	]
  325
  326).
  327
  328l_int(
  329	holds(item(tree, X, Y), T),
  330	[
  331		holds(wood(X,Y), T)
  332	]
  333
  334).
  335
  336l_int(
  337	holds(item(animal, X, Y), T),
  338	[
  339		holds(animal(Type, N, D, X, Y), T)
  340	]
  341).
  342
  343l_int(
  344	holds(item(animal, X, Y), T),
  345	[
  346		holds(food(A, B, C, X, Y), T)
  347	]
  348
  349).
  350
  351l_int(
  352	holds(item(food, X, Y), T),
  353	[
  354		holds(food(A, B, C, X, Y), T)
  355	]
  356
  357).
  358
  359l_int(
  360	holds(item(person, X, Y), T),
  361	[
  362		holds(position(P, D, X, Y), T)
  363	]
  364).
  365
  366l_int(
  367	holds(item(wood, X, Y), T),
  368	[
  369		holds(wood(X, Y), T)
  370	]
  371).
  372
  373/* Different cases determining if something is in view, depending on the unit's position */
  374
  375l_int(
  376	holds(in_view(Unit, east, Type), T),
  377	[
  378		holds(position(Unit, D, X, Y), T),
  379		holds(item(Type, A, Y), T),
  380		greater_than(A, X),
  381		increase(X, X1, 6),
  382		less_or_equal(A, X1)
  383	]
  384
  385).
  386
  387l_int(
  388	holds(in_view(Unit, north, Type), T),
  389	[
  390		holds(position(Unit, D, X, Y), T),
  391		holds(item(Type, X, A), T),
  392		less_than(A, Y),
  393		decrease(Y, Y1, 6),
  394		greater_or_equal(A, Y1)
  395	]
  396
  397).
  398
  399l_int(
  400	holds(in_view(Unit, south, Type), T),
  401	[
  402		holds(position(Unit, D, X, Y), T),
  403		holds(item(Type, X, A), T),
  404		greater_than(A, Y),
  405		increase(Y, Y1, 6),
  406		less_or_equal(A, Y1)
  407	]
  408
  409).
  410
  411
  412l_int(
  413	holds(in_view(Unit, west, Type), T),
  414	[
  415		holds(position(Unit, D, X, Y), T),
  416		holds(item(Type, A, Y), T),
  417		less_than(A, X),
  418		decrease(X, X1, 6),
  419		greater_or_equal(A, X1)
  420	]
  421
  422).
  423
  424/* Different cases determining if something is in range, depending on the unit's position */
  425
  426l_int(
  427	holds(in_range(Unit, Unit1, north, A), T1),
  428	[
  429		holds(position(Unit, D, X, Y), T1),
  430		holds(position(Unit1, D1, X, Y1), T1),
  431		not_equal(Unit, Unit1),
  432		range(weapon(A), L, U),
  433		decrease(Y, Y2, Y1),
  434		greater_or_equal(Y2, L),
  435		less_or_equal(Y2, U)
  436	]
  437).
  438
  439l_int(
  440	holds(in_range(Unit, Unit1, east, A), T1),
  441	[
  442		holds(position(Unit, D, X, Y), T1),
  443		holds(position(Unit1, D1, X1, Y), T1),
  444		not_equal(Unit, Unit1),
  445		range(weapon(A), L, U),
  446		decrease(X1, X2, X),
  447		greater_or_equal(X2, L),
  448		less_or_equal(X2, U)
  449	]
  450).
  451
  452l_int(
  453	holds(in_range(Unit, Unit1, south, A), T1),
  454	[
  455		holds(position(Unit, D, X, Y), T1),
  456		holds(position(Unit1, D1, X, Y1), T1),
  457		not_equal(Unit, Unit1),
  458		range(weapon(A), L, U),
  459		decrease(Y1, Y2, Y),
  460		greater_or_equal(Y2, L),
  461		less_or_equal(Y2, U)
  462
  463	]
  464).
  465
  466l_int(
  467	holds(in_range(Unit, Unit1, west, A), T1),
  468	[
  469		holds(position(Unit, D, X, Y), T1),
  470		holds(position(Unit1, D1, X1, Y), T1),
  471		not_equal(Unit, Unit1),
  472		range(weapon(A), L, U),
  473		decrease(X, X2, X1),
  474		greater_or_equal(X2, L),
  475		less_or_equal(X2, U)
  476	]
  477).
  478
  479
  480l_int(
  481	holds(in_range(Unit, animal, north, A), T1),
  482	[
  483		holds(position(Unit, D, X, Y), T1),
  484		holds(animal(Type, H, D1, X, Y1), T1),
  485		range(weapon(A), L, U),
  486		decrease(Y, Y2, Y1),
  487		greater_or_equal(Y2, L),
  488		less_or_equal(Y2, U)
  489	]
  490).
  491
  492l_int(
  493	holds(in_range(Unit, animal, east, A), T1),
  494	[
  495		holds(position(Unit, D, X, Y), T1),
  496		holds(animal(Type, H, D1, X1, Y), T1),
  497		range(weapon(A), L, U),
  498		decrease(X1, X2, X),
  499		greater_or_equal(X2, L),
  500		less_or_equal(X2, U)
  501	]
  502).
  503
  504l_int(
  505	holds(in_range(Unit, animal, south, A), T1),
  506	[
  507		holds(position(Unit, D, X, Y), T1),
  508		holds(animal(Type, H, D1, X, Y1), T1),
  509		range(weapon(A), L, U),
  510		decrease(Y1, Y2, Y),
  511		greater_or_equal(Y2, L),
  512		less_or_equal(Y2, U)
  513
  514	]
  515).
  516
  517l_int(
  518	holds(in_range(Unit, animal, west, A), T1),
  519	[
  520		holds(position(Unit, D, X, Y), T1),
  521		holds(animal(Type, H, D1, X1, Y), T1),
  522		range(weapon(A), L, U),
  523		decrease(X, X2, X1),
  524		greater_or_equal(X2, L),
  525		less_or_equal(X2, U)
  526	]
  527).
  528
  529
  530/********************************************* Preconditions *********************************************/
  531
  532/* Preconditions to ensure a unit cannot do to actions at once */
  533
  534d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(turn(Unit, N1, D1, X1, Y1), T1, T2)]).
  535
  536d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(walk(Unit, D1, X1, Y1), T1, T2)]).
  537
  538d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(successful_shelter(Unit, N1, X1, Y1), T1, T2)]).
  539
  540d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(break_tree(Unit, X1, Y1), T1, T2)]).
  541
  542d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(collect_wood(Unit, W, X1, Y1), T1, T2)]).
  543
  544d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(change_animal(Unit, N1, D1, X1, Y1, N2, A), T1, T2)]).
  545
  546d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(collect_food(Unit, A, B, C, K, L, M, X1, Y1), T1, T2)]).
  547
  548d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2)]).
  549
  550d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(hit_from(Unit, Unit1, H, D1), T1, T2)]).
  551
  552d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2)]).
  553
  554d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2)]).
  555
  556d_pre([happens(turn(Unit, N, D, X, Y), T1, T2), happens(eat(Unit, V, F, N1, A, B, C), T1, T2)]).
  557
  558
  559
  560d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(walk(Unit, D1, X1, Y1), T1, T2)]).
  561
  562d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(successful_shelter(Unit, N1, X1, Y1), T1, T2)]).
  563
  564d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(break_tree(Unit, X1, Y1), T1, T2)]).
  565
  566d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(collect_wood(Unit, W, X1, Y1), T1, T2)]).
  567
  568d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(change_animal(Unit, N1, D1, X1, Y1, N2, A), T1, T2)]).
  569
  570d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(collect_food(Unit, A, B, C, K, L, M, X1, Y1), T1, T2)]).
  571
  572d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2)]).
  573
  574d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(hit_from(Unit, Unit1, H, D1), T1, T2)]).
  575
  576d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2)]).
  577
  578d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2)]).
  579
  580d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(eat(Unit, V, F, N1, A, B, C), T1, T2)]).
  581
  582
  583
  584d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(successful_shelter(Unit, N1, X1, Y1), T1, T2)]).
  585
  586d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(break_tree(Unit, X1, Y1), T1, T2)]).
  587
  588d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(collect_wood(Unit, W, X1, Y1), T1, T2)]).
  589
  590d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(change_animal(Unit, N1, D1, X1, Y1, N2, A), T1, T2)]).
  591
  592d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(collect_food(Unit, A, B, C, K, L, M, X1, Y1), T1, T2)]).
  593
  594d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2)]).
  595
  596d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(hit_from(Unit, Unit1, H, D1), T1, T2)]).
  597
  598d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2)]).
  599
  600d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2)]).
  601
  602d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(eat(Unit, V, F, N1, A, B, C), T1, T2)]).
  603
  604
  605
  606d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(break_tree(Unit, X1, Y1), T1, T2)]).
  607
  608d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(collect_wood(Unit, W, X1, Y1), T1, T2)]).
  609
  610d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(change_animal(Unit, N1, D1, X1, Y1, N2, A), T1, T2)]).
  611
  612d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(collect_food(Unit, A, B, C, K, L, M, X1, Y1), T1, T2)]).
  613
  614d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2)]).
  615
  616d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(hit_from(Unit, Unit1, H, D1), T1, T2)]).
  617
  618d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2)]).
  619
  620d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2)]).
  621
  622d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(eat(Unit, V, F, N1, A, B, C), T1, T2)]).
  623
  624
  625
  626d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(collect_wood(Unit, W1, X1, Y1), T1, T2)]).
  627
  628d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(change_animal(Unit, N1, D1, X1, Y1, N2, A), T1, T2)]).
  629
  630d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(collect_food(Unit, A, B, C, K, L, M, X1, Y1), T1, T2)]).
  631
  632d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2)]).
  633
  634d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(hit_from(Unit, Unit1, H, D1), T1, T2)]).
  635
  636d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2)]).
  637
  638d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2)]).
  639
  640d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(eat(Unit, V, F, N1, A, B, C), T1, T2)]).
  641
  642
  643
  644d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(change_animal(Unit, N2, D1, X1, Y1, N3, A1), T1, T2)]).
  645
  646d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(collect_food(Unit, A1, B, C, K, L, M, X1, Y1), T1, T2)]).
  647
  648d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2)]).
  649
  650d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(hit_from(Unit, Unit1, H, D1), T1, T2)]).
  651
  652d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2)]).
  653
  654d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2)]).
  655
  656d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(eat(Unit, V, F, N2, A1, B, C), T1, T2)]).
  657
  658
  659
  660d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), happens(collect_food(Unit, A1, B1, C1, K1, L1, M1, X1, Y1), T1, T2)]).
  661
  662d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2)]).
  663
  664d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), happens(hit_from(Unit, Unit1, H, D1), T1, T2)]).
  665
  666d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2)]).
  667
  668d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2)]).
  669
  670d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), happens(eat(Unit, V, F, N1, A1, B1, C1), T1, T2)]).
  671
  672
  673
  674d_pre([happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), happens(hit_shelter(Unit, Unit2, H2, D2, X2, Y2), T1, T2)]).
  675
  676d_pre([happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), happens(hit_from(Unit, Unit2, H1, D1), T1, T2)]).
  677
  678d_pre([happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit2, H2, D2), T1, T2)]).
  679
  680d_pre([happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit2, H2, D2, X2, Y2), T1, T2)]).
  681
  682d_pre([happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), happens(eat(Unit, V, F, N1, A1, B1, C1), T1, T2)]).
  683
  684
  685
  686d_pre([happens(hit_from(Unit, Unit1, H, D), T1, T2), happens(hit_from(Unit, Unit2, H2, D2), T1, T2)]).
  687
  688d_pre([happens(hit_from(Unit, Unit1, H, D), T1, T2), happens(turn_hit(Unit, D1, X1, Y1, Unit2, H2, D2), T1, T2)]).
  689
  690d_pre([happens(hit_from(Unit, Unit1, H, D), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit2, H2, D2, X2, Y2), T1, T2)]).
  691
  692d_pre([happens(hit_from(Unit, Unit1, H, D), T1, T2), happens(eat(Unit, V, F, N1, A1, B1, C1), T1, T2)]).
  693
  694
  695
  696d_pre([happens(turn_hit(Unit, D, X, Y, Unit1, H1, D1), T1, T2), happens(turn_hit(Unit, D2, X2, Y2, Unit3, H3, D3), T1, T2)]).
  697
  698d_pre([happens(turn_hit(Unit, D, X, Y, Unit1, H1, D1), T1, T2), happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit2, H2, D2, X2, Y2), T1, T2)]).
  699
  700d_pre([happens(turn_hit(Unit, D, X, Y, Unit1, H1, D1), T1, T2), happens(eat(Unit, V, F, N1, A1, B1, C1), T1, T2)]).
  701
  702
  703
  704d_pre([happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H1, D1, X1, Y1), T1, T2), happens(turn_hit_shelter(Unit, D2, X2, Y2, Unit3, H3, D3, X3, Y3), T1, T2)]).
  705
  706d_pre([happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H1, D1, X1, Y1), T1, T2), happens(eat(Unit, V, F, N1, A1, B1, C1), T1, T2)]).
  707
  708
  709
  710d_pre([happens(eat(Unit, V, F, N, A, B, C), T1, T2), happens(eat(Unit, V1, F1, N1, A1, B1, C1), T1, T2)]).
  711
  712/* Preconditions to ensure a two different units performing an action that would clash */
  713
  714d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(walk(Unit1, D1, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  715
  716d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(successful_shelter(Unit1, N1, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  717
  718d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(turn_hit(Unit1, D1, X, Y, Unit2, H2, D2), T1, T2), not_equal(Unit, Unit1)]).
  719
  720d_pre([happens(walk(Unit, D, X, Y), T1, T2), happens(turn_hit_shelter(Unit1, D1, X, Y, Unit2, H, D2, X2, Y2), T1, T2), not_equal(Unit, Unit1)]).
  721
  722
  723
  724d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(successful_shelter(Unit1, N, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  725
  726d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(turn_hit(Unit1, D1, X, Y, Unit2, H, D2), T1, T2), not_equal(Unit, Unit1)]).
  727
  728d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), happens(turn_hit_shelter(Unit1, D1, X, Y, Unit2, H, D2, X2, Y2), T1, T2), not_equal(Unit, Unit1)]).
  729
  730
  731
  732d_pre([happens(break_tree(Unit, X, Y), T1, T2), happens(break_tree(Unit1, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  733
  734
  735
  736d_pre([happens(collect_wood(Unit, W, X, Y), T1, T2), happens(collect_wood(Unit1, W1, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  737
  738
  739
  740d_pre([happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2), happens(change_animal(Unit1, N2, D2, X, Y, N3, A1), T1, T2), not_equal(Unit, Unit1)]).
  741
  742
  743
  744d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), happens(collect_food(Unit1, A1, B1, C1, K1, L1, M1, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  745
  746
  747
  748d_pre([happens(hit_shelter(Unit, Unit2, H, D, X, Y), T1, T2), happens(hit_shelter(Unit1, Unit3, H1, D1, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  749
  750d_pre([happens(hit_shelter(Unit, Unit2, H, D, X, Y), T1, T2), happens(turn_hit_shelter(Unit1, D1, X1, Y1, Unit3, H1, D1, X, Y), T1, T2), not_equal(Unit, Unit1)]).
  751
  752
  753
  754d_pre([happens(hit_from(Unit, Unit2, H, D), T1, T2), happens(hit_from(Unit1, Unit2, H1, D1), T1, T2), not_equal(Unit, Unit1)]).
  755
  756d_pre([happens(hit_from(Unit, Unit2, H, D), T1, T2), happens(turn_hit(Unit1, D1, X1, Y1, Unit2, H2, D2), T1, T2), not_equal(Unit, Unit1)]).
  757
  758
  759
  760d_pre([happens(turn_hit(Unit, D, X, Y, Unit2, H2, D2), T1, T2), happens(turn_hit(Unit1, D1, X1, Y1, Unit2, H3, D3), T1, T2), not_equal(Unit, Unit1)]).
  761
  762d_pre([happens(turn_hit(Unit, D, X, Y, Unit2, H2, D2), T1, T2), happens(turn_hit(Unit1, D1, X, Y, Unit3, H3, D3), T1, T2), not_equal(Unit, Unit1)]).
  763
  764
  765
  766d_pre([happens(turn_hit_shelter(Unit, D, X, Y, Unit2, H2, D2, X2, Y2), T1, T2), happens(turn_hit_shelter(Unit1, D1, X1, Y1, Unit3, H3, D3, X2, Y2), T1, T2), not_equal(Unit, Unit1)]).
  767
  768d_pre([happens(turn_hit_shelter(Unit, D, X, Y, Unit2, H2, D2, X2, Y2), T1, T2), happens(turn_hit_shelter(Unit1, D1, X, Y, Unit3, H3, D3, X3, Y3), T1, T2), not_equal(Unit, Unit1)]).
  769
  770/* Preconditions to stop clash between foreground and background actions or two clashing background items */
  771
  772
  773d_pre([happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), happens(lower_health(Unit1, N), T1, T2)]).
  774
  775d_pre([happens(hit_from(Unit, Unit1, H, D), T1, T2), happens(lower_health(Unit1, N), T1, T2)]).
  776
  777d_pre([happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), happens(burn(Unit1, N), T1, T2)]).
  778
  779d_pre([happens(hit_from(Unit, Unit1, H, D), T1, T2), happens(burn(Unit1, N), T1, T2)]).
  780
  781d_pre([happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), happens(heal(Unit1, N), T1, T2)]).
  782
  783d_pre([happens(heal(Unit1, N), T1, T2), happens(hit_from(Unit, Unit1, H, D), T1, T2)]).
  784
  785d_pre([happens(lower_health(Unit, N), T1, T2), happens(burn(Unit, N1), T1, T2)]).
  786
  787d_pre([happens(lower_health(Unit, N), T1, T2), happens(heal(Unit, N1), T1, T2)]).
  788
  789d_pre([happens(burn(Unit, N), T1, T2), happens(heal(Unit, N1), T1, T2)]).
  790
  791d_pre([happens(eat(Unit, V, F, N, A, B, C), T1, T2), happens(reduce_hunger(Unit, H), T1, T2)]).
  792
  793/* Preconditions to ensure the unit does not move into an already occupied space */
  794
  795d_pre([happens(walk(Unit, D, X, Y), T1, T2), holds(position(Unit1, Direction, X, Y), T2)]).
  796
  797d_pre([happens(walk(Unit, D, X, Y), T1, T2), holds(animal(Type, N, Direction, X, Y), T2)]).
  798
  799d_pre([happens(walk(Unit, D, X, Y), T1, T2), holds(shelter(Unit1, H, X, Y), T2), not_equal(Unit, Unit1)]).
  800
  801d_pre([happens(walk(Unit, D, X, Y), T1, T2), holds(tree(X, Y), T2)]).
  802
  803d_pre([happens(walk(Unit, D, X, Y), T1, T2), holds(wood(X, Y), T2)]).
  804
  805d_pre([happens(walk(Unit, D, X, Y), T1, T2), holds(food(A, B, C, X, Y), T2)]).
  806
  807d_pre([happens(walk(Unit, D, X, Y), T1, T2), greater_than(X, 20)]).
  808
  809d_pre([happens(walk(Unit, D, X, Y), T1, T2), greater_than(Y, 20)]).
  810
  811d_pre([happens(walk(Unit, D, X, Y), T1, T2), less_than(X, 1)]).
  812
  813d_pre([happens(walk(Unit, D, X, Y), T1, T2), less_than(Y, 1)]).
  814
  815
  816
  817d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), holds(position(Unit1, Direction, X, Y), T2)]).
  818
  819d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), holds(animal(Type, N1, Direction, X, Y), T2)]).
  820
  821d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), holds(shelter(Unit1, H, X, Y), T2), not_equal(Unit, Unit1)]).
  822
  823d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), holds(tree(X, Y), T2)]).
  824
  825d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), holds(wood(X, Y), T2)]).
  826
  827d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), holds(food(A, B, C, X, Y), T2)]).
  828
  829d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), greater_than(X, 20)]).
  830
  831d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), greater_than(Y, 20)]).
  832
  833d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), less_than(X, 1)]).
  834
  835d_pre([happens(successful_shelter(Unit, N, X, Y), T1, T2), less_than(Y, 1)]).
  836
  837/* Preconditions to ensure the unit cannot perform any action when they are dead */
  838
  839d_pre([happens(turn(Unit, N1, D1, X1, Y1), T1, T2), holds(dead(Unit), T2)]).
  840
  841d_pre([happens(walk(Unit, D1, X1, Y1), T1, T2), holds(dead(Unit), T2)]).
  842
  843d_pre([happens(successful_shelter(Unit, N1, X1, Y1), T1, T2), holds(dead(Unit), T2)]).
  844
  845d_pre([happens(break_tree(Unit, X1, Y1), T1, T2), holds(dead(Unit), T2)]).
  846
  847d_pre([happens(collect_wood(Unit, W, X1, Y1), T1, T2), holds(dead(Unit), T2)]).
  848
  849d_pre([happens(change_animal(Unit, N1, D1, X1, Y1, N2, A), T1, T2), holds(dead(Unit), T2)]).
  850
  851d_pre([happens(collect_food(Unit, A, B, C, K, L, M, X1, Y1), T1, T2), holds(dead(Unit), T2)]).
  852
  853d_pre([happens(hit_shelter(Unit, Unit1, H, D1, X1, Y1), T1, T2), holds(dead(Unit), T2)]).
  854
  855d_pre([happens(hit_from(Unit, Unit1, H, D1), T1, T2), holds(dead(Unit), T2)]).
  856
  857d_pre([happens(turn_hit(Unit, D1, X1, Y1, Unit1, H, D2), T1, T2), holds(dead(Unit), T2)]).
  858
  859d_pre([happens(turn_hit_shelter(Unit, D1, X1, Y1, Unit1, H, D2, X2, Y2), T1, T2), holds(dead(Unit), T2)]).
  860
  861d_pre([happens(eat(Unit, V, F, N1, A, B, C), T1, T2), holds(dead(Unit), T2)]).
  862
  863/********************************************* l_events' for universal use *********************************************/
  864
  865
  866action(find(_, _)).
  867
  868action(turn(_, _, _, _, _)).
  869
  870action(walk_towards(_, _)).
  871
  872action(walk(_, _, _, _)).
  873
  874/* Defining how to find an item of specified type */
  875
  876l_events(
  877	happens(find(Unit, Type), T1, T2),
  878	[
  879		holds(in_sight(Unit, Type), T1)
  880	]
  881).
  882
  883/* Recursive case */
  884
  885l_events(
  886	happens(find(Unit, Type), T1, T3),
  887	[
  888		holds(position(Unit, north, X, Y), T1),
  889		holds(turns(Unit, N), T1),
  890		less_than(N, 4),
  891		happens(turn(Unit, N, west, X, Y), T1, T2),
  892		happens(find(Unit, Type), T2, T3)
  893	]
  894).
  895
  896l_events(
  897	happens(find(Unit, Type), T1, T3),
  898	[
  899		holds(position(Unit, west, X, Y), T1),
  900		holds(turns(Unit, N), T1),
  901		less_than(N, 4),
  902		happens(turn(Unit, N, south, X, Y), T1, T2),
  903		happens(find(Unit, Type), T2, T3)
  904	]
  905).
  906
  907l_events(
  908	happens(find(Unit, Type), T1, T3),
  909	[
  910		holds(position(Unit, south, X, Y), T1),
  911		holds(turns(Unit, N), T1),
  912		less_than(N, 4),
  913		happens(turn(Unit, N, east, X, Y), T1, T2),
  914		happens(find(Unit, Type), T2, T3)
  915	]
  916).
  917
  918l_events(
  919	happens(find(Unit, Type), T1, T3),
  920	[
  921		holds(position(Unit, east, X, Y), T1),
  922		holds(turns(Unit, N), T1),
  923		less_than(N, 4),
  924		happens(turn(Unit, N, north, X, Y), T1, T2),
  925		happens(find(Unit, Type), T2, T3)
  926	]
  927).
  928
  929/* Recursive case when too many turns are made */
  930
  931l_events(
  932	happens(find(Unit, Type), T1, T3),
  933	[
  934		holds(position(Unit, north, X, Y), T1),
  935		holds(turns(Unit, N), T1),
  936		greater_or_equal(N, 4),
  937		decrement(Y, Y2),
  938		greater_than(Y2, 1),
  939		happens(walk(Unit, north, X, Y2), T1, T2),
  940		happens(find(Unit, Type), T2, T3)
  941
  942	]
  943).
  944
  945l_events(
  946	happens(find(Unit, Type), T1, T3),
  947	[
  948		holds(position(Unit, east, X, Y), T1),
  949		holds(turns(Unit, N), T1),
  950		greater_or_equal(N, 4),
  951		increment(X, X2),
  952		less_or_equal(X2, 20),
  953		happens(walk(Unit, east, X2, Y), T1, T2),
  954		happens(find(Unit, Type), T2, T3)
  955
  956	]
  957).
  958
  959l_events(
  960	happens(find(Unit, Type), T1, T3),
  961	[
  962		holds(position(Unit, south, X, Y), T1),
  963		holds(turns(Unit, N), T1),
  964		greater_or_equal(N, 4),
  965		increment(Y, Y2),
  966		less_or_equal(Y2, 20),
  967		happens(walk(Unit, south, X, Y2), T1, T2),
  968		happens(find(Unit, Type), T2, T3)
  969
  970	]
  971).
  972
  973l_events(
  974	happens(find(Unit, Type), T1, T3),
  975	[
  976		holds(position(Unit, west, X, Y), T1),
  977		holds(turns(Unit, N), T1),
  978		greater_or_equal(N, 4),
  979		decrement(X, X2),
  980		greater_or_equal(X2, 1),
  981		happens(walk(Unit, west, X2, Y), T1, T2),
  982		happens(find(Unit, Type), T2, T3)
  983
  984	]
  985).
  986
  987/* Defining how to walk towards an item of specified type */
  988
  989/* Base Case */
  990
  991l_events(
  992	happens(walk_towards(Unit, Type), T1, T2),
  993	[
  994		holds(next_to(Unit, Type), T1)
  995	]
  996
  997).
  998
  999/* Recursive case */
 1000
 1001l_events(
 1002	happens(walk_towards(Unit, Type), T1, T3),
 1003	[
 1004		holds(position(Unit, north, X, Y), T1),
 1005		holds(in_sight(Unit, Type), T1),
 1006		holds(item(Type, X, A), T1),
 1007		decrease(Y, Y1, A),
 1008		greater_than(Y1, 1),
 1009		decrement(Y, Y2),
 1010		greater_or_equal(Y2, 1),
 1011		happens(walk(Unit, north, X, Y2), T1, T2),
 1012		happens(walk_towards(Unit, Type), T2, T3)
 1013
 1014	]
 1015
 1016).
 1017
 1018l_events(
 1019	happens(walk_towards(Unit, Type), T1, T3),
 1020	[
 1021		holds(position(Unit, east, X, Y), T1),
 1022		holds(in_sight(Unit, Type), T1),
 1023		holds(item(Type, A, Y), T1),
 1024		decrease(A, X1, X),
 1025		greater_than(X1, 1),
 1026		increment(X, X2),
 1027		less_or_equal(X2, 20),
 1028		happens(walk(Unit, east, X2, Y), T1, T2),
 1029		happens(walk_towards(Unit, Type), T2, T3)
 1030	]
 1031
 1032).
 1033
 1034l_events(
 1035	happens(walk_towards(Unit, Type), T1, T3),
 1036	[
 1037		holds(position(Unit, south, X, Y), T1),
 1038		holds(in_sight(Unit, Type), T1),
 1039		holds(item(Type, X, A), T1),
 1040		decrease(A, Y1, Y),
 1041		greater_than(Y1, 1),
 1042		increment(Y, Y2),
 1043		less_or_equal(Y2, 20),
 1044		happens(walk(Unit, south, X, Y2), T1, T2),
 1045		happens(walk_towards(Unit, Type), T2, T3)
 1046	]
 1047
 1048).
 1049
 1050l_events(
 1051	happens(walk_towards(Unit, Type), T1, T3),
 1052	[
 1053		holds(position(Unit, west, X, Y), T1),
 1054		holds(in_sight(Unit, Type), T1),
 1055		holds(item(Type, A, Y), T1),
 1056		decrease(X, X1, A),
 1057		greater_than(X1, 1),
 1058		decrement(X, X2),
 1059		greater_or_equal(X2, 1),
 1060		happens(walk(Unit, west, X2, Y), T1, T2),
 1061		happens(walk_towards(Unit, Type), T2, T3)
 1062	]
 1063
 1064).
 1065
 1066/* Post conditions to update the state */
 1067
 1068terminated(happens(turn(Unit, N, D, X, Y), T1, T2), position(Unit, Direction, X, Y), []).
 1069
 1070initiated(happens(turn(Unit, N, D, X, Y), T1, T2), position(Unit, D, X, Y), []).
 1071
 1072initiated(happens(turn(Unit, N, D, X, Y), T1, T2), turns(Unit, N1), [increment(N, N1)]).
 1073terminated(happens(turn(Unit, N, D, X, Y), T1, T2), turns(Unit, N), []).
 1074
 1075initiated(happens(turn(Unit, N, D, X, Y), T1, T2), cycles(T), [modu(T, T1)]).
 1076terminated(happens(turn(Unit, N, D, X, Y), T1, T2), cycles(T), []).
 1077
 1078
 1079terminated(happens(walk(Unit, D, X, Y), T1, T2), position(Unit, D1, X1, Y1), []).
 1080
 1081initiated(happens(walk(Unit, D, X, Y), T1, T2), position(Unit, D, X, Y), []).
 1082
 1083terminated(happens(walk(Unit, D, X, Y), T1, T2), turns(Unit, N), []).
 1084initiated(happens(walk(Unit, D, X, Y), T1, T2), turns(Unit, 0), []).
 1085
 1086terminated(happens(walk(Unit, D, X, Y), T1, T2), cycles(T), []).
 1087initiated(happens(walk(Unit, D, X, Y), T1, T2), cycles(T), [modu(T, T1)]).
 1088
 1089/*********************************** Logic to make a shelter ***********************************/
 1090
 1091action(make_shelter(_)).
 1092
 1093action(build_shelter(_, _)).
 1094
 1095action(get_wood(_)).
 1096
 1097action(successful_shelter(_, _, _, _)).
 1098
 1099/* Reactive rules to make a shelter */
 1100reactive_rule(
 1101	[
 1102		happens(start_game(Unit), T1, T2),
 1103		holds(person(Unit, cautious), T2),
 1104		holds(has_shelter(Unit, false), T2)
 1105	],
 1106	[
 1107		happens(make_shelter(Unit), T3, T4),
 1108		tc(T2 =< T3)
 1109	],
 1110	95
 1111).
 1112
 1113reactive_rule(
 1114	[
 1115		happens(start_game(Unit), T1, T2),
 1116		holds(person(Unit, normal), T2),
 1117		holds(has_shelter(Unit, false), T2)
 1118	],
 1119	[
 1120		happens(make_shelter(Unit), T3, T4),
 1121		tc(T2 =< T3)
 1122	],
 1123	95
 1124).
 1125
 1126/* Base case when unit has enough wood */
 1127
 1128l_events(
 1129	happens(make_shelter(Unit), T1, T2),
 1130	[
 1131		holds(holds_wood(Unit, N), T1),
 1132		greater_or_equal(N, 25),
 1133		happens(build_shelter(Unit, N), T1, T2)
 1134	]
 1135).
 1136
 1137/* Recursive case when unit doesn't have enough wood */
 1138
 1139l_events(
 1140	happens(make_shelter(Unit), T1, T3),
 1141	[
 1142		holds(holds_wood(Unit, N), T1),
 1143		less_than(N, 25),
 1144		happens(get_wood(Unit), T1, T2),
 1145		happens(make_shelter(Unit), T2, T3)
 1146	]
 1147).
 1148
 1149/* Case when unit has enough wood */
 1150/* Different cases to build a shelter depending on unit's direction */
 1151
 1152l_events(
 1153	happens(build_shelter(Unit, N), T1, T2),
 1154	[
 1155		holds(position(Unit, north, X, Y), T1),
 1156		decrement(Y, Y1),
 1157		happens(successful_shelter(Unit, N, X, Y1), T1, T2)
 1158	]
 1159
 1160).
 1161
 1162l_events(
 1163	happens(build_shelter(Unit, N), T1, T2),
 1164	[
 1165		holds(position(Unit, east, X, Y), T1),
 1166		increment(X, X1),
 1167		happens(successful_shelter(Unit, N, X1, Y), T1, T2)
 1168	]
 1169
 1170).
 1171
 1172l_events(
 1173	happens(build_shelter(Unit, N), T1, T2),
 1174	[
 1175		holds(position(Unit, south, X, Y), T1),
 1176		increment(Y, Y1),
 1177		happens(successful_shelter(Unit, N, X, Y1), T1, T2)
 1178	]
 1179
 1180).
 1181
 1182l_events(
 1183	happens(build_shelter(Unit, N), T1, T2),
 1184	[
 1185		holds(position(Unit, west, X, Y), T1),
 1186		decrement(X, X1),
 1187		happens(successful_shelter(Unit, N, X1, Y), T1, T2)
 1188	]
 1189
 1190).		
 1191
 1192/* Case when unit doesn't have enough wood */
 1193
 1194action(break_tree(_, _, _)).
 1195action(collect_wood(_, _, _, _)).
 1196action(hit_tree(_)).
 1197
 1198/* Case where unit can see wood */
 1199
 1200l_events(
 1201	happens(get_wood(Unit), T1, T3),
 1202	[
 1203		holds(in_sight(Unit, wood), T1),
 1204		happens(walk_towards(Unit, wood), T1, T2),
 1205		happens(pick_wood(Unit), T2, T3)
 1206	]
 1207).
 1208
 1209/* Alternative case for unit to find trees */
 1210
 1211l_events(
 1212	happens(get_wood(Unit), T1, T5),
 1213	[
 1214		holds(position(Unit, Direction, X, Y), T1),
 1215		happens(find(Unit, tree), T1, T2),
 1216		happens(walk_towards(Unit, tree), T2, T3),
 1217		happens(hit_tree(Unit), T3, T4),
 1218		happens(pick_wood(Unit), T4, T5)
 1219	]
 1220
 1221).
 1222
 1223
 1224/* Cases when tree is already wood */
 1225
 1226l_events(
 1227	happens(hit_tree(Unit), T1, T2),
 1228	[
 1229		holds(position(Unit, north, X, Y), T1),
 1230		decrement(Y, Y1),
 1231		holds(wood(X, Y1), T1)
 1232	]
 1233
 1234).
 1235
 1236l_events(
 1237	happens(hit_tree(Unit), T1, T2),
 1238	[
 1239		holds(position(Unit, east, X, Y), T1),
 1240		increment(X, X1),
 1241		holds(wood(X1, Y), T1)
 1242	]
 1243
 1244).
 1245
 1246l_events(
 1247	happens(hit_tree(Unit), T1, T2),
 1248	[
 1249		holds(position(Unit, south, X, Y), T1),
 1250		increment(Y, Y1),
 1251		holds(wood(X, Y1), T1)
 1252	]
 1253
 1254).
 1255
 1256l_events(
 1257	happens(hit_tree(Unit), T1, T2),
 1258	[
 1259		holds(position(Unit, west, X, Y), T1),
 1260		decrement(X, X1),
 1261		holds(wood(X1, Y), T1)
 1262	]
 1263
 1264).
 1265
 1266
 1267/* Different cases to hit a tree depending on unit's direction */
 1268
 1269l_events(
 1270	happens(hit_tree(Unit), T1, T2),
 1271	[
 1272		holds(position(Unit, north, X, Y), T1),
 1273		decrement(Y, Y1),
 1274		holds(tree(X, Y1), T1),
 1275		happens(break_tree(Unit, X, Y1), T1, T2)
 1276	]
 1277
 1278).
 1279
 1280l_events(
 1281	happens(hit_tree(Unit), T1, T2),
 1282	[
 1283		holds(position(Unit, east, X, Y), T1),
 1284		increment(X, X1),
 1285		holds(tree(X1, Y), T1),
 1286		happens(break_tree(Unit, X1, Y), T1, T2)
 1287	]
 1288
 1289).
 1290
 1291l_events(
 1292	happens(hit_tree(Unit), T1, T2),
 1293	[
 1294		holds(position(Unit, south, X, Y), T1),
 1295		increment(Y, Y1),
 1296		holds(tree(X, Y1), T1),
 1297		happens(break_tree(Unit, X, Y1), T1, T2)
 1298	]
 1299
 1300).
 1301
 1302l_events(
 1303	happens(hit_tree(Unit), T1, T2),
 1304	[
 1305		holds(position(Unit, west, X, Y), T1),
 1306		decrement(X, X1),
 1307		holds(tree(X1, Y), T1),
 1308		happens(break_tree(Unit, X1, Y), T1, T2)
 1309	]
 1310
 1311).
 1312
 1313/* Different cases to pick wood depending on unit's direction */
 1314
 1315action(pick_wood(_)).
 1316
 1317l_events(
 1318	happens(pick_wood(Unit), T1, T2),
 1319	[
 1320		holds(position(Unit, north, X, Y), T1),
 1321		holds(holds_wood(Unit, N), T1),
 1322		decrement(Y, Y1),
 1323		holds(wood(X, Y1), T1),
 1324		happens(collect_wood(Unit, N, X, Y1), T1, T2)
 1325	]
 1326
 1327).
 1328
 1329l_events(
 1330	happens(pick_wood(Unit), T1, T2),
 1331	[
 1332		holds(position(Unit, east, X, Y), T1),
 1333		holds(holds_wood(Unit, N), T1),
 1334		increment(X, X1),
 1335		holds(wood(X1, Y), T3),
 1336		happens(collect_wood(Unit, N, X1, Y), T1, T2)
 1337	]
 1338
 1339).
 1340
 1341l_events(
 1342	happens(pick_wood(Unit), T1, T2),
 1343	[
 1344		holds(position(Unit, south, X, Y), T1),
 1345		holds(holds_wood(Unit, N), T1),
 1346		increment(Y, Y1),
 1347		holds(wood(X, Y1), T3),
 1348		happens(collect_wood(Unit, N, X, Y1), T1, T2)
 1349	]
 1350
 1351).
 1352
 1353l_events(
 1354	happens(pick_wood(Unit), T1, T2),
 1355	[
 1356		holds(position(Unit, west, X, Y), T1),
 1357		holds(holds_wood(Unit, N), T1),
 1358		decrement(X, X1),
 1359		holds(wood(X1, Y), T3),
 1360		happens(collect_wood(Unit, N, X1, Y), T1, T2)
 1361	]
 1362
 1363).
 1364
 1365
 1366/* Post conditions to update the state */
 1367
 1368/* To make a shelter */
 1369
 1370initiated(happens(successful_shelter(Unit, N, X, Y), T1, T2), holds_wood(Unit, N1), [decrease(N, N1, 25)]).
 1371terminated(happens(successful_shelter(Unit, N, X, Y), T1, T2), holds_wood(Unit, N), []).
 1372
 1373initiated(happens(successful_shelter(Unit, N, X, Y), T1, T2), has_shelter(Unit, true), []).
 1374terminated(happens(successful_shelter(Unit, N, X, Y), T1, T2), has_shelter(Unit, false), []).
 1375
 1376initiated(happens(successful_shelter(Unit, N, X, Y), T1, T2), shelter(Unit, 100, X, Y), []).
 1377
 1378initiated(happens(successful_shelter(Unit, N, X, Y), T1, T2), cycles(T), [modu(T, T1)]).
 1379terminated(happens(successful_shelter(Unit, N, X, Y), T1, T2), cycles(T), []).
 1380
 1381terminated(happens(successful_shelter(Unit, N, X, Y), T1, T2), turns(Unit, N1), []).
 1382initiated(happens(successful_shelter(Unit, N, X, Y), T1, T2), turns(Unit, 0), []).
 1383
 1384/* When a tree is broken */
 1385
 1386terminated(happens(break_tree(Unit, X, Y), T1, T2), tree(X, Y), []).
 1387initiated(happens(break_tree(Unit, X, Y), T1, T2), wood(X, Y), []).
 1388
 1389terminated(happens(break_tree(Unit, X, Y), T1, T2), turns(Unit, N), []).
 1390initiated(happens(break_tree(Unit, X, Y), T1, T2), turns(Unit, 0), []).
 1391
 1392initiated(happens(break_tree(Unit, X, Y), T1, T2), cycles(T), [modu(T, T1)]).
 1393terminated(happens(break_tree(Unit, X, Y), T1, T2), cycles(T), []).
 1394
 1395terminated(happens(break_tree(Unit, X, Y), T1, T2), turns(Unit, N), []).
 1396initiated(happens(break_tree(Unit, X, Y), T1, T2), turns(Unit, 0), []).
 1397
 1398
 1399/* When a unit collects wood */
 1400
 1401terminated(happens(collect_wood(Unit, N, X, Y), T1, T2), wood(X, Y), []).
 1402terminated(happens(collect_wood(Unit, N, X, Y), T1, T2), holds_wood(Unit, N), []).
 1403initiated(happens(collect_wood(Unit, N, X, Y), T1, T2), holds_wood(Unit, N1), [increase(N, N1, 5)]).
 1404
 1405initiated(happens(collect_wood(Unit, N, X, Y), T1, T2), cycles(T), [modu(T, T1)]).
 1406terminated(happens(collect_wood(Unit, N, X, Y), T1, T2), cycles(T), []).
 1407
 1408terminated(happens(collect_wood(Unit, N, X, Y), T1, T2), turns(Unit, N1), []).
 1409initiated(happens(collect_wood(Unit, N, X, Y), T1, T2), turns(Unit, 0), []).
 1410
 1411
 1412/**************************************** Logic to get food ****************************************/
 1413
 1414action(get_food(_)).
 1415
 1416action(hit_animal(_)).
 1417
 1418action(pick_food(_)).
 1419
 1420action(pick_up_food(_, _)).
 1421
 1422action(collect_food(_, _, _, _, _, _, _, _, _)).
 1423
 1424action(kill_animal(_)).
 1425
 1426
 1427/* Reactive rule to get food */
 1428
 1429reactive_rule(
 1430	[
 1431		happens(start_game(Unit), T1, T2)
 1432	],
 1433	[
 1434		happens(need_food(Unit), T3, T4),
 1435		tc(T2 =< T3)
 1436	],
 1437	94
 1438).
 1439
 1440/* Case for cautious unit needing food */
 1441
 1442/* Base case for cautious units */
 1443
 1444l_events(
 1445	happens(need_food(Unit), T1, T2),
 1446	[
 1447		holds(person(Unit, cautious), T1),
 1448		holds(holds_food(Unit, N, A, B, C), T1),
 1449		greater_or_equal(N, 15)
 1450	]
 1451).
 1452
 1453/* Recursive case for cautious units */
 1454
 1455l_events(
 1456	happens(need_food(Unit), T1, T3),
 1457	[
 1458		holds(person(Unit, cautious), T1),
 1459		holds(holds_food(Unit, N, A, B, C), T1),
 1460		less_than(N, 15),
 1461		happens(get_food(Unit), T1, T2),
 1462		happens(need_food(Unit), T2, T3)
 1463	]
 1464
 1465).
 1466
 1467/* Base case for normal units */
 1468
 1469l_events(
 1470	happens(need_food(Unit), T1, T2),
 1471	[
 1472		holds(person(Unit, normal), T1),
 1473		holds(holds_food(Unit, N, A, B, C), T1),
 1474		greater_or_equal(N, 10)
 1475	]
 1476).
 1477
 1478/* Recursive case for normal units */
 1479
 1480l_events(
 1481	happens(need_food(Unit), T1, T3),
 1482	[
 1483		holds(person(Unit, normal), T1),
 1484		holds(holds_food(Unit, N, A, B, C), T1),
 1485		less_than(N, 10),
 1486		happens(get_food(Unit), T1, T2),
 1487		happens(need_food(Unit), T2, T3)
 1488	]
 1489
 1490).
 1491
 1492/* Base case for violent units */
 1493
 1494l_events(
 1495	happens(need_food(Unit), T1, T2),
 1496	[
 1497		holds(person(Unit, violent), T1),
 1498		holds(holds_food(Unit, N, A, B, C), T1),
 1499		greater_or_equal(N, 5)
 1500	]
 1501).
 1502
 1503/* Recursive case for violent units */
 1504
 1505l_events(
 1506	happens(need_food(Unit), T1, T3),
 1507	[
 1508		holds(person(Unit, violent), T1),
 1509		holds(holds_food(Unit, N, A, B, C), T1),
 1510		less_than(N, 5),
 1511		happens(get_food(Unit), T1, T2),
 1512		happens(need_food(Unit), T2, T3)
 1513	]
 1514
 1515).
 1516
 1517/* Case if food is in in_sight */
 1518
 1519l_events(
 1520	happens(get_food(Unit), T1, T2),
 1521	[
 1522		holds(in_sight(Unit, food), T1),
 1523		happens(pick_food(Unit), T1, T2)
 1524	]
 1525).
 1526
 1527/* Case if food is not in sight, find and hit animal, then recurse */
 1528
 1529l_events(
 1530	happens(get_food(Unit), T1, T5),
 1531	[
 1532		happens(find(Unit, animal), T1, T2),
 1533		happens(kill_animal(Unit), T2, T3),
 1534		happens(hit_animal(Unit), T3, T4),
 1535		happens(get_food(Unit), T4, T5)
 1536	]
 1537).
 1538
 1539/* Base case when food is in range */
 1540
 1541l_events(
 1542	happens(kill_animal(Unit), T1, T2),
 1543	[
 1544		holds(position(Unit, D, X, Y), T1),
 1545		holds(in_sight(Unit, food), T1)
 1546	]
 1547).
 1548
 1549/* Base case when animal is in range */
 1550
 1551l_events(
 1552	happens(kill_animal(Unit), T1, T2),
 1553	[
 1554		holds(position(Unit, D, X, Y), T1),
 1555		has(Unit, weapon(A)),
 1556		holds(in_range(Unit, animal, D, A), T1)
 1557	]
 1558).
 1559
 1560
 1561/* Recursive case when animal is too far away from enemy */
 1562
 1563l_events(
 1564	happens(kill_animal(Unit), T1, T3),
 1565	[
 1566		holds(position(Unit, north, X, Y), T1),
 1567		holds(animal(Type, H, D1, X, Y1), T1),
 1568		has(Unit, weapon(A)),
 1569		range(weapon(A), L, U),
 1570		decrease(Y, Y2, Y1),
 1571		greater_than(Y2, U),
 1572		decrement(Y, NewY),
 1573		happens(walk(Unit, north, X, NewY), T1, T2),
 1574		happens(kill_animal(Unit), T2, T3)
 1575	]
 1576).
 1577
 1578l_events(
 1579	happens(kill_animal(Unit), T1, T3),
 1580	[
 1581		holds(position(Unit, east, X, Y), T1),
 1582		holds(animal(Type, H, D1, X1, Y), T1),
 1583		has(Unit, weapon(A)),
 1584		range(weapon(A), L, U),
 1585		decrease(X1, X2, X),
 1586		greater_than(X2, U),
 1587		increment(X, NewX),
 1588		happens(walk(Unit, east, NewX, Y), T1, T2),
 1589		happens(kill_animal(Unit), T2, T3)
 1590	]
 1591).
 1592
 1593l_events(
 1594	happens(kill_animal(Unit), T1, T3),
 1595	[
 1596		holds(position(Unit, south, X, Y), T1),
 1597		holds(animal(Type, H, D1, X, Y1), T1),
 1598		has(Unit, weapon(A)),
 1599		range(weapon(A), L, U),
 1600		decrease(Y1, Y2, Y),
 1601		greater_than(Y2, U),
 1602		increment(Y, NewY),
 1603		happens(walk(Unit, south, X, NewY), T1, T2),
 1604		happens(kill_animal(Unit), T2, T3)
 1605
 1606	]
 1607).
 1608
 1609l_events(
 1610	happens(kill_animal(Unit), T1, T3),
 1611	[
 1612		holds(position(Unit, west, X, Y), T1),
 1613		holds(animal(Type, H, D1, X1, Y), T1),
 1614		has(Unit, weapon(A)),
 1615		range(weapon(A), L, U),
 1616		decrease(X, X2, X1),
 1617		greater_than(X2, U),
 1618		decrement(X, NewX),
 1619		happens(walk(Unit, west, NewX, Y), T1, T2),
 1620		happens(kill_animal(Unit), T2, T3)
 1621	]
 1622).
 1623
 1624
 1625/* Recursive case when animal is too close to the enemy unit */
 1626
 1627l_events(
 1628	happens(kill_animal(Unit), T1, T3),
 1629	[
 1630		holds(position(Unit, north, X, Y), T1),
 1631		holds(animal(Type, H, D1, X, Y1), T1),
 1632		has(Unit, weapon(A)),
 1633		range(weapon(A), L, U),
 1634		decrease(Y, Y2, Y1),
 1635		less_than(Y2, L),
 1636		increment(Y, NewY),
 1637		happens(walk(Unit, north, X, NewY), T1, T2),
 1638		happens(kill_animal(Unit), T2, T3)
 1639	]
 1640).
 1641
 1642l_events(
 1643	happens(kill_animal(Unit), T1, T3),
 1644	[
 1645		holds(position(Unit, east, X, Y), T1),
 1646		holds(animal(Type, H, D1, X1, Y), T1),
 1647		has(Unit, weapon(A)),
 1648		range(weapon(A), L, U),
 1649		decrease(X1, X2, X),
 1650		less_than(X2, L),
 1651		decrement(X, NewX),
 1652		happens(walk(Unit, east, NewX, Y), T1, T2),
 1653		happens(kill_animal(Unit), T2, T3)
 1654	]
 1655).
 1656
 1657l_events(
 1658	happens(kill_animal(Unit), T1, T3),
 1659	[
 1660		holds(position(Unit, south, X, Y), T1),
 1661		holds(animal(Type, H, D1, X, Y1), T1),
 1662		has(Unit, weapon(A)),
 1663		range(weapon(A), L, U),
 1664		decrease(Y1, Y2, Y),
 1665		less_than(Y2, L),
 1666		decrement(Y, NewY),
 1667		happens(walk(Unit, south, X, NewY), T1, T2),
 1668		happens(kill_animal(Unit), T2, T3)
 1669
 1670	]
 1671).
 1672
 1673l_events(
 1674	happens(kill_animal(Unit), T1, T3),
 1675	[
 1676		holds(position(Unit, west, X, Y), T1),
 1677		holds(animal(Type, H, D1, X1, Y), T1),
 1678		has(Unit, weapon(A)),
 1679		range(weapon(A), L, U),
 1680		decrease(X, X2, X1),
 1681		less_than(X2, L),
 1682		increment(X, NewX),
 1683		happens(walk(Unit, west, NewX, Y), T1, T2),
 1684		happens(kill_animal(Unit), T2, T3)
 1685	]
 1686).
 1687
 1688/* Base case when food is in range */
 1689
 1690l_events(
 1691	happens(hit_animal(Unit), T1, T2),
 1692	[
 1693		holds(position(Unit, D, X, Y), T1),
 1694		holds(in_sight(Unit, food), T1)
 1695	]
 1696).
 1697
 1698/* Different cases to hit an animal depending on direction of unit */
 1699
 1700l_events(
 1701	happens(hit_animal(Unit), T1, T2),
 1702	[
 1703		holds(position(Unit, north, X, Y), T1),
 1704		holds(animal(Type, H, D1, X, Y1), T1),
 1705		has(Unit, weapon(A)),
 1706		range(weapon(A), L, U),
 1707		decrease(Y, Y2, Y1),
 1708		greater_or_equal(Y2, L),
 1709		less_or_equal(Y2, U),
 1710		happens(reduce_health(Unit, animal(Type, H, D1, X, Y1)), T1, T2)
 1711	]
 1712
 1713).
 1714
 1715l_events(
 1716	happens(hit_animal(Unit), T1, T2),
 1717	[
 1718		holds(position(Unit, east, X, Y), T1),
 1719		holds(animal(Type, H, D1, X1, Y), T1),
 1720		has(Unit, weapon(A)),
 1721		range(weapon(A), L, U),
 1722		decrease(X1, X2, X),
 1723		greater_or_equal(X2, L),
 1724		less_or_equal(X2, U),
 1725		happens(reduce_health(Unit, animal(Type, H, D1, X1, Y)), T1, T2)
 1726	]
 1727
 1728).
 1729
 1730l_events(
 1731	happens(hit_animal(Unit), T1, T2),
 1732	[
 1733		holds(position(Unit, south, X, Y), T1),
 1734		holds(animal(Type, H, D1, X, Y1), T1),
 1735		has(Unit, weapon(A)),
 1736		range(weapon(A), L, U),
 1737		decrease(Y1, Y2, Y),
 1738		greater_or_equal(Y2, L),
 1739		less_or_equal(Y2, U),
 1740		happens(reduce_health(Unit, animal(Type, H, D1, X, Y1)), T1, T2)
 1741	]
 1742
 1743).
 1744
 1745l_events(
 1746	happens(hit_animal(Unit), T1, T2),
 1747	[
 1748		holds(position(Unit, west, X, Y), T1),
 1749		holds(animal(Type, H, D1, X1, Y), T1),
 1750		has(Unit, weapon(A)),
 1751		range(weapon(A), L, U),
 1752		decrease(X, X2, X1),
 1753		greater_or_equal(X2, L),
 1754		less_or_equal(X2, U),
 1755		happens(reduce_health(Unit, animal(Type, H, D1, X1, Y)), T1, T2)
 1756	]
 1757
 1758).
 1759
 1760/* Reducing the health of the animal */
 1761
 1762action(reduce_health(_, _)).
 1763action(check_animal(_, _, _, _, _, _, _)).
 1764action(change_animal(_, _, _, _, _, _, _)).
 1765
 1766
 1767/* Chicken case */
 1768
 1769l_events(
 1770	happens(reduce_health(Unit, animal(Type, N, D, X, Y)), T1, T2),
 1771	[
 1772		holds(person(Unit, Kind), T1),
 1773		has(Unit, weapon(A)),
 1774		power(weapon(A), P),
 1775		decrease(N, N1, P),
 1776		happens(check_animal(Unit, N, D, X, Y, N1, Type), T1, T2) 
 1777	]
 1778
 1779).
 1780
 1781/* Case where N1 is less than zero, then animal is dead */
 1782
 1783l_events(
 1784	happens(check_animal(Unit, N, D, X, Y, N1, A), T1, T2),
 1785	[
 1786		less_than(N1, 0),
 1787		happens(change_animal(Unit, N, D, X, Y, 0, A), T1, T2)
 1788	]
 1789
 1790).
 1791
 1792/* Case where N1 is greater than zero, then animal's health is reduced */
 1793
 1794l_events(
 1795	happens(check_animal(Unit, N, D, X, Y, N1, A), T1, T2),
 1796	[
 1797		greater_or_equal(N1, 0),
 1798		happens(change_animal(Unit, N, D, X, Y, N1, A), T1, T2)
 1799	]
 1800
 1801).
 1802
 1803/* Case for when there is food in sight */
 1804
 1805l_events(
 1806	happens(pick_food(Unit), T1, T3),
 1807	[
 1808		happens(walk_towards(Unit, food), T1, T2),
 1809		happens(pick_up_food(Unit), T2, T3)
 1810	]
 1811).
 1812
 1813/* Different cases for unit to pick up food depending on the unit's direction */
 1814
 1815l_events(
 1816	happens(pick_up_food(Unit), T1, T2),
 1817	[
 1818		holds(position(Unit, north, X, Y), T1),
 1819		holds(holds_food(Unit, N, A, B, C), T1),
 1820		decrement(Y, Y1),
 1821		holds(food(K, L, M, X, Y1), T1),
 1822		happens(collect_food(Unit, A, B, C, K, L, M, X, Y1), T1, T2)
 1823	]
 1824
 1825).
 1826
 1827l_events(
 1828	happens(pick_up_food(Unit), T1, T2),
 1829	[
 1830		holds(position(Unit, east, X, Y), T1),
 1831		holds(holds_food(Unit, N, A, B, C), T1),
 1832		increment(X, X1),
 1833		holds(food(K, L, M, X1, Y), T1),
 1834		happens(collect_food(Unit, A, B, C, K, L, M, X1, Y), T1, T2)
 1835	]
 1836
 1837).
 1838
 1839l_events(
 1840	happens(pick_up_food(Unit), T1, T2),
 1841	[
 1842		holds(position(Unit, south, X, Y), T1),
 1843		holds(holds_food(Unit, N, A, B, C), T1),
 1844		increment(Y, Y1),
 1845		holds(food(K, L, M, X, Y1), T1),
 1846		happens(collect_food(Unit, A, B, C, K, L, M, X, Y1), T1, T2)
 1847	]
 1848
 1849).
 1850
 1851l_events(
 1852	happens(pick_up_food(Unit), T1, T2),
 1853	[
 1854		holds(position(Unit, west, X, Y), T1),
 1855		holds(holds_food(Unit, N, A, B, C), T1),
 1856		decrement(X, X1),
 1857		holds(food(K, L, M, X1, Y), T1),
 1858		happens(collect_food(Unit, A, B, C, K, L, M, X1, Y), T1, T2)
 1859	]
 1860
 1861).
 1862
 1863/* Post conditions to update the state */
 1864
 1865initiated(happens(change_animal(Unit, N, D, X, Y, N1, Type), T1, T2), animal(Type, N1, D, X, Y), [greater_than(N1, 0)]).
 1866terminated(happens(change_animal(Unit, N, D, X, Y, N1, Type), T1, T2), animal(Type, N, D, X, Y), [greater_than(N1, 0)]).
 1867
 1868initiated(happens(change_animal(Unit, N, D, X, Y, 0, rabbit), T1, T2), food(2, 1, 0, X, Y), []).
 1869terminated(happens(change_animal(Unit, N, D, X, Y, 0, rabbit), T1, T2), animal(rabbit, N1, D, X, Y), []).
 1870
 1871initiated(happens(change_animal(Unit, N, D, X, Y, 0, chicken), T1, T2), food(2, 1, 1, X, Y), []).
 1872terminated(happens(change_animal(Unit, N, D, X, Y, 0, chicken), T1, T2), animal(chicken, N1, D, X, Y), []).
 1873
 1874initiated(happens(change_animal(Unit, N, D, X, Y, 0, cow), T1, T2), food(2, 1, 2, X, Y), []).
 1875terminated(happens(change_animal(Unit, N, D, X, Y, 0, cow), T1, T2), animal(cow, N1, D, X, Y), []).
 1876
 1877initiated(happens(change_animal(Unit, N, D, X, Y, N1, Type), T1, T2), cycles(T), [modu(T, T1)]).
 1878terminated(happens(change_animal(Unit, N, D, X, Y, N1, Type), T1, T2), cycles(T), []).
 1879
 1880terminated(happens(change_animal(Unit, N, D, X, Y, N1, Type), T1, T2), turns(Unit, N2), []).
 1881initiated(happens(change_animal(Unit, N, D, X, Y, N1, Type), T1, T2), turns(Unit, 0), []).
 1882
 1883terminated(happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), food(K, L, M, X, Y), []).
 1884terminated(happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), holds_food(Unit, N, A, B, C), []).
 1885
 1886initiated(happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), holds_food(Unit, N1, A1, B1, C1), 
 1887		[increase(A, A1, K), increase(B, B1, L), increase(C, C1, M), calculate(N1, A1, B1, C1)]).
 1888
 1889initiated(happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), cycles(T), [modu(T, T1)]).
 1890terminated(happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), cycles(T), []).
 1891
 1892terminated(happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), turns(Unit, N), []).
 1893initiated(happens(collect_food(Unit, A, B, C, K, L, M, X, Y), T1, T2), turns(Unit, 0), []).
 1894
 1895
 1896/**************************************** Logic when attacked or to attack ****************************************/
 1897
 1898action(attack(_)).
 1899
 1900action(hit_from(_, _, _, _)).
 1901
 1902action(walk_backward(_, _, _, _)).
 1903
 1904action(hit(_, _, _, _, _)).
 1905
 1906action(hit_shelter(_, _, _, _, _, _)).
 1907
 1908action(move_away(_, _)).
 1909
 1910action(turn_and_hit(_, _, _, _, _, _, _, _)).
 1911
 1912action(turn_hit_shelter(_, _, _, _, _, _, _, _, _)).
 1913
 1914action(turn_hit(_, _, _, _, _, _, _)).
 1915
 1916action(walk_away(_)).
 1917
 1918action(look(_, _)).
 1919
 1920/* Reactive rules */
 1921
 1922reactive_rule(
 1923	[
 1924		holds(person(Unit, cautious), T1),
 1925		holds(in_sight(Unit, person), T1)
 1926	],
 1927	[
 1928		happens(walk_away(Unit), T2, T3)
 1929	],
 1930	97
 1931).
 1932
 1933reactive_rule(
 1934	[
 1935		happens(hit_from(Unit, Unit1, H, D), T1, T2),
 1936		holds(person(Unit1, cautious), T2),
 1937		holds(in_view(Unit1, D, person), T2)
 1938	],
 1939	[
 1940		happens(move_away(Unit1, D), T3, T4)
 1941	],
 1942	98
 1943).
 1944
 1945reactive_rule(
 1946	[
 1947		happens(turn_hit(Unit, D, X, Y, Unit, H, D1), T1, T2),
 1948		holds(person(Unit1, cautious), T2),
 1949		holds(in_view(Unit1, D, person), T2)
 1950	],
 1951	[
 1952		happens(move_away(Unit1, D), T3, T4)
 1953	],
 1954	98
 1955).
 1956
 1957reactive_rule(
 1958	[
 1959		happens(hit_from(Unit, Unit1, H, D), T1, T2),
 1960		holds(person(Unit1, normal), T2),
 1961		holds(in_view(Unit1, D, person), T2)
 1962	],
 1963	[
 1964		happens(turn_and_attack(Unit1, D, Unit), T3, T4)
 1965	],
 1966	98
 1967).
 1968
 1969reactive_rule(
 1970	[
 1971		happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2),
 1972		holds(person(Unit1, normal), T2),
 1973		holds(in_view(Unit1, D, person), T2)
 1974	],
 1975	[
 1976		happens(turn_and_attack(Unit1, D, Unit), T3, T4)
 1977	],
 1978	98
 1979).
 1980
 1981reactive_rule(
 1982	[
 1983		holds(person(Unit, violent), T1),
 1984		holds(in_sight(Unit, person), T1)
 1985	],
 1986	[
 1987		happens(attack(Unit), T2, T3)
 1988	],
 1989	93
 1990
 1991).
 1992
 1993reactive_rule(
 1994	[
 1995		holds(person(Unit, violent), T1),
 1996		holds(not(in_sight(Unit, person)), T1)
 1997	],
 1998	[
 1999		happens(look(Unit, person), T2, T3)
 2000	],
 2001	92
 2002
 2003).
 2004
 2005reactive_rule(
 2006	[
 2007		happens(hit_from(Unit, Unit1, H, D), T1, T2),
 2008		holds(person(Unit1, violent), T2),
 2009		holds(in_view(Unit1, D, person), T2)
 2010	],
 2011	[
 2012		happens(turn_and_attack(Unit1, D, Unit), T3, T4)
 2013	],
 2014	98
 2015).
 2016
 2017reactive_rule(
 2018	[
 2019		happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2),
 2020		holds(person(Unit1, violent), T2),
 2021		holds(in_view(Unit1, D, person), T2)
 2022	],
 2023	[
 2024		happens(turn_and_attack(Unit1, D, Unit), T3, T4)
 2025	],
 2026	98
 2027).
 2028
 2029/* Base case if in range of unit, to attack them */
 2030
 2031l_events(
 2032	happens(attack(Unit), T1, T2),
 2033	[
 2034		holds(position(Unit, D, X, Y), T1),
 2035		has(Unit, weapon(A)),
 2036		holds(in_range(Unit, Unit1, D, A), T1),
 2037		power(weapon(A), P),
 2038		holds(health(Unit1, H), T1),
 2039		opposite(D, D1),
 2040		happens(hit(Unit, Unit1, H, D1, P), T1, T2)
 2041	]
 2042).
 2043
 2044/* Case when unit is in shelter */
 2045
 2046l_events(
 2047	happens(hit(Unit, Unit1, H, D1, P), T1, T2),
 2048	[
 2049		holds(in_shelter(Unit1), T1),
 2050		holds(shelter(Unit1, H1, X, Y), T1),
 2051		decrease(H1, H2, P),
 2052		greater_than(H2, 0),
 2053		happens(hit_shelter(Unit, Unit1, H2, D1, X, Y), T1, T2)
 2054	]
 2055).
 2056
 2057l_events(
 2058	happens(hit(Unit, Unit1, H, D1, P), T1, T2),
 2059	[
 2060		holds(in_shelter(Unit1), T1),
 2061		holds(shelter(Unit1, H1, X, Y), T1),
 2062		decrease(H1, H2, P),
 2063		less_or_equal(H2, 0),
 2064		happens(hit_shelter(Unit, Unit1, 0, D1, X, Y), T1, T2)
 2065	]
 2066).
 2067
 2068/* Case when unit is not inside a shelter */
 2069
 2070l_events(
 2071	happens(hit(Unit, Unit1, H, D1, P), T1, T2),
 2072	[
 2073		holds(not(in_shelter(Unit1)), T1),
 2074		decrease(H, H1, P),
 2075		greater_than(H1, 0),
 2076		happens(hit_from(Unit, Unit1, H1, D1), T1, T2)
 2077	]
 2078).
 2079
 2080l_events(
 2081	happens(hit(Unit, Unit1, H, D1, P), T1, T2),
 2082	[
 2083		holds(not(in_shelter(Unit1)), T1),
 2084		decrease(H, H1, P),
 2085		less_or_equal(H1, 0),
 2086		happens(hit_from(Unit, Unit1, 0, D1), T1, T2)
 2087	]
 2088).
 2089
 2090
 2091/* Recursive case when unit is too far away from enemy */
 2092
 2093l_events(
 2094	happens(attack(Unit), T1, T3),
 2095	[
 2096		holds(position(Unit, north, X, Y), T1),
 2097		holds(position(Unit1, D1, X, Y1), T1),
 2098		not_equal(Unit, Unit1),
 2099		has(Unit, weapon(A)),
 2100		range(weapon(A), L, U),
 2101		decrease(Y, Y2, Y1),
 2102		greater_than(Y2, U),
 2103		decrement(Y, NewY),
 2104		happens(walk(Unit, north, X, NewY), T1, T2),
 2105		happens(attack(Unit), T2, T3)
 2106	]
 2107).
 2108
 2109l_events(
 2110	happens(attack(Unit), T1, T3),
 2111	[
 2112		holds(position(Unit, east, X, Y), T1),
 2113		holds(position(Unit1, D1, X1, Y), T1),
 2114		not_equal(Unit, Unit1),
 2115		has(Unit, weapon(A)),
 2116		range(weapon(A), L, U),
 2117		decrease(X1, X2, X),
 2118		greater_than(X2, U),
 2119		increment(X, NewX),
 2120		happens(walk(Unit, east, NewX, Y), T1, T2),
 2121		happens(attack(Unit), T2, T3)
 2122	]
 2123).
 2124
 2125l_events(
 2126	happens(attack(Unit), T1, T3),
 2127	[
 2128		holds(position(Unit, south, X, Y), T1),
 2129		holds(position(Unit1, D1, X, Y1), T1),
 2130		not_equal(Unit, Unit1),
 2131		has(Unit, weapon(A)),
 2132		range(weapon(A), L, U),
 2133		decrease(Y1, Y2, Y),
 2134		greater_than(Y2, U),
 2135		increment(Y, NewY),
 2136		happens(walk(Unit, south, X, NewY), T1, T2),
 2137		happens(attack(Unit), T2, T3)
 2138
 2139	]
 2140).
 2141
 2142l_events(
 2143	happens(attack(Unit), T1, T3),
 2144	[
 2145		holds(position(Unit, west, X, Y), T1),
 2146		holds(position(Unit1, D1, X1, Y), T1),
 2147		not_equal(Unit, Unit1),
 2148		has(Unit, weapon(A)),
 2149		range(weapon(A), L, U),
 2150		decrease(X, X2, X1),
 2151		greater_than(X2, U),
 2152		decrement(X, NewX),
 2153		happens(walk(Unit, west, NewX, Y), T1, T2),
 2154		happens(attack(Unit), T2, T3)
 2155	]
 2156).
 2157
 2158
 2159/* Recursive case when unit is too close to the enemy unit */
 2160
 2161l_events(
 2162	happens(attack(Unit), T1, T3),
 2163	[
 2164		holds(position(Unit, north, X, Y), T1),
 2165		holds(position(Unit1, D1, X, Y1), T1),
 2166		not_equal(Unit, Unit1),
 2167		has(Unit, weapon(A)),
 2168		range(weapon(A), L, U),
 2169		decrease(Y, Y2, Y1),
 2170		less_than(Y2, L),
 2171		increment(Y, NewY),
 2172		happens(walk(Unit, north, X, NewY), T1, T2),
 2173		happens(attack(Unit), T2, T3)
 2174	]
 2175).
 2176
 2177l_events(
 2178	happens(attack(Unit), T1, T3),
 2179	[
 2180		holds(position(Unit, east, X, Y), T1),
 2181		holds(position(Unit1, D1, X1, Y), T1),
 2182		not_equal(Unit, Unit1),
 2183		has(Unit, weapon(A)),
 2184		range(weapon(A), L, U),
 2185		decrease(X1, X2, X),
 2186		less_than(X2, L),
 2187		decrement(X, NewX),
 2188		happens(walk(Unit, east, NewX, Y), T1, T2),
 2189		happens(attack(Unit), T2, T3)
 2190	]
 2191).
 2192
 2193l_events(
 2194	happens(attack(Unit), T1, T3),
 2195	[
 2196		holds(position(Unit, south, X, Y), T1),
 2197		holds(position(Unit1, D1, X, Y1), T1),
 2198		not_equal(Unit, Unit1),
 2199		has(Unit, weapon(A)),
 2200		range(weapon(A), L, U),
 2201		decrease(Y1, Y2, Y),
 2202		less_than(Y2, L),
 2203		decrement(Y, NewY),
 2204		happens(walk(Unit, south, X, NewY), T1, T2),
 2205		happens(attack(Unit), T2, T3)
 2206
 2207	]
 2208).
 2209
 2210l_events(
 2211	happens(attack(Unit), T1, T3),
 2212	[
 2213		holds(position(Unit, west, X, Y), T1),
 2214		holds(position(Unit1, D1, X1, Y), T1),
 2215		not_equal(Unit, Unit1),
 2216		has(Unit, weapon(A)),
 2217		range(weapon(A), L, U),
 2218		decrease(X, X2, X1),
 2219		less_than(X2, L),
 2220		increment(X, NewX),
 2221		happens(walk(Unit, west, NewX, Y), T1, T2),
 2222		happens(attack(Unit), T2, T3)
 2223	]
 2224).
 2225
 2226/* Case for cautious units to walk away when they spot enemies */
 2227
 2228l_events(
 2229	happens(walk_away(Unit), T1, T2),
 2230	[
 2231		holds(position(Unit, north, X, Y), T1),
 2232		decrement(X, X1),
 2233		happens(walk(Unit, west, X1, Y), T1, T2)
 2234	]
 2235).
 2236
 2237l_events(
 2238	happens(walk_away(Unit), T1, T2),
 2239	[
 2240		holds(position(Unit, east, X, Y), T1),
 2241		decrement(Y, Y1),
 2242		happens(walk(Unit, north, X, Y1), T1, T2)
 2243	]
 2244).
 2245
 2246l_events(
 2247	happens(walk_away(Unit), T1, T2),
 2248	[
 2249		holds(position(Unit, south, X, Y), T1),
 2250		increment(X, X1),
 2251		happens(walk(Unit, east, X1, Y), T1, T2)
 2252	]
 2253).
 2254
 2255l_events(
 2256	happens(walk_away(Unit), T1, T2),
 2257	[
 2258		holds(position(Unit, west, X, Y), T1),
 2259		increment(Y, Y1),
 2260		happens(walk(Unit, south, X, Y1), T1, T2)
 2261	]
 2262).
 2263
 2264/* Case when violent person cannot see another person, then look for one */
 2265
 2266/* Case to turn to look */
 2267
 2268l_events(
 2269	happens(look(Unit, Type), T1, T2),
 2270	[
 2271		holds(position(Unit, north, X, Y), T1),
 2272		holds(turns(Unit, N), T1),
 2273		less_than(N, 4),
 2274		happens(turn(Unit, N, west, X, Y), T1, T2)
 2275	]
 2276).
 2277
 2278l_events(
 2279	happens(look(Unit, Type), T1, T2),
 2280	[
 2281		holds(position(Unit, west, X, Y), T1),
 2282		holds(turns(Unit, N), T1),
 2283		less_than(N, 4),
 2284		happens(turn(Unit, N, south, X, Y), T1, T2)
 2285	]
 2286).
 2287
 2288l_events(
 2289	happens(look(Unit, Type), T1, T2),
 2290	[
 2291		holds(position(Unit, south, X, Y), T1),
 2292		holds(turns(Unit, N), T1),
 2293		less_than(N, 4),
 2294		happens(turn(Unit, N, east, X, Y), T1, T2)
 2295	]
 2296).
 2297
 2298l_events(
 2299	happens(look(Unit, Type), T1, T2),
 2300	[
 2301		holds(position(Unit, east, X, Y), T1),
 2302		holds(turns(Unit, N), T1),
 2303		less_than(N, 4),
 2304		happens(turn(Unit, N, north, X, Y), T1, T2)
 2305	]
 2306).
 2307
 2308/* Case when too many turns are made */
 2309
 2310l_events(
 2311	happens(look(Unit, Type), T1, T2),
 2312	[
 2313		holds(position(Unit, north, X, Y), T1),
 2314		holds(turns(Unit, N), T1),
 2315		greater_or_equal(N, 4),
 2316		decrement(Y, Y2),
 2317		greater_than(Y2, 1),
 2318		happens(walk(Unit, north, X, Y2), T1, T2)
 2319	]
 2320).
 2321
 2322l_events(
 2323	happens(look(Unit, Type), T1, T2),
 2324	[
 2325		holds(position(Unit, east, X, Y), T1),
 2326		holds(turns(Unit, N), T1),
 2327		greater_or_equal(N, 4),
 2328		increment(X, X2),
 2329		less_or_equal(X2, 20),
 2330		happens(walk(Unit, east, X2, Y), T1, T2)
 2331
 2332	]
 2333).
 2334
 2335l_events(
 2336	happens(look(Unit, Type), T1, T2),
 2337	[
 2338		holds(position(Unit, south, X, Y), T1),
 2339		holds(turns(Unit, N), T1),
 2340		greater_or_equal(N, 4),
 2341		increment(Y, Y2),
 2342		less_or_equal(Y2, 20),
 2343		happens(walk(Unit, south, X, Y2), T1, T2)
 2344
 2345	]
 2346).
 2347
 2348l_events(
 2349	happens(find(Unit, Type), T1, T2),
 2350	[
 2351		holds(position(Unit, west, X, Y), T1),
 2352		holds(turns(Unit, N), T1),
 2353		greater_or_equal(N, 4),
 2354		decrement(X, X2),
 2355		greater_or_equal(X2, 1),
 2356		happens(walk(Unit, west, X2, Y), T1, T2)
 2357
 2358	]
 2359).
 2360
 2361/* Case for cautious units to escape from attack */
 2362
 2363l_events(
 2364	happens(move_away(Unit, north), T1, T2),
 2365	[
 2366		holds(position(Unit, D, X, Y), T1),
 2367		decrement(X, X1),
 2368		happens(walk(Unit, west, X1, Y), T1, T2)
 2369	]
 2370).
 2371
 2372l_events(
 2373	happens(move_away(Unit, east), T1, T2),
 2374	[
 2375		holds(position(Unit, D, X, Y), T1),
 2376		decrement(Y, Y1),
 2377		happens(walk(Unit, north, X, Y1), T1, T2)
 2378	]
 2379).
 2380
 2381l_events(
 2382	happens(move_away(Unit, south), T1, T2),
 2383	[
 2384		holds(position(Unit, D, X, Y), T1),
 2385		increment(X, X1),
 2386		happens(walk(Unit, east, X1, Y), T1, T2)
 2387	]
 2388).
 2389
 2390l_events(
 2391	happens(move_away(Unit, west), T1, T2),
 2392	[
 2393		holds(position(Unit, D, X, Y), T1),
 2394		increment(Y, Y1),
 2395		happens(walk(Unit, south, X, Y1), T1, T2)
 2396	]
 2397).
 2398
 2399/* Case where the unit would turn and attack at the same time */
 2400
 2401l_events(
 2402	happens(turn_and_attack(Unit, D, Unit1), T1, T2),
 2403	[
 2404		holds(position(Unit, OldD, X, Y), T1),
 2405		has(Unit, weapon(A)),
 2406		power(weapon(A), P),
 2407		holds(in_range(Unit, Unit1, D, A), T1),
 2408		opposite(D, D1),
 2409		holds(health(Unit1, H), T1),
 2410		happens(turn_and_hit(Unit, D, X, Y, P, Unit1, H, D1), T1, T2)
 2411	]
 2412
 2413).
 2414
 2415/* Case when enemy unit is in shelter */
 2416
 2417l_events(
 2418	happens(turn_and_hit(Unit, D, X, Y, P, Unit1, H, D1), T1, T2),
 2419	[
 2420		holds(in_shelter(Unit1), T1),
 2421		holds(shelter(Unit1, H1, X1, Y1), T1),
 2422		decrease(H1, H2, P),
 2423		greater_than(H2, 0),
 2424		happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H2, D1, X1, Y1), T1, T2)
 2425	]
 2426).
 2427
 2428l_events(
 2429	happens(turn_and_hit(Unit, D, X, Y, P, Unit1, H, D1), T1, T2),
 2430	[
 2431		holds(in_shelter(Unit1), T1),
 2432		holds(shelter(Unit1, H1, X1, Y1), T1),
 2433		decrease(H1, H2, P),
 2434		less_or_equal(H2, 0),
 2435		happens(turn_hit_shelter(Unit, D, X, Y, Unit1, 0, D1, X1, Y1), T1, T2)
 2436	]
 2437).
 2438
 2439/* Case when enemy unit is not in shelter */
 2440
 2441l_events(
 2442	happens(turn_and_hit(Unit, D, X, Y, P, Unit1, H, D1), T1, T2),
 2443	[
 2444		holds(not(in_shelter(Unit1)), T1),
 2445		decrease(H, H1, P),
 2446		greater_than(H1, 0),
 2447		happens(turn_hit(Unit, D, X, Y, Unit1, H1, D1), T1, T2)
 2448	]
 2449).
 2450
 2451l_events(
 2452	happens(turn_and_hit(Unit, D, X, Y, P, Unit1, H, D1), T1, T2),
 2453	[
 2454		holds(not(in_shelter(Unit1)), T1),
 2455		decrease(H, H1, P),
 2456		less_or_equal(H1, 0),
 2457		happens(turn_hit(Unit, D, X, Y, Unit1, 0, D1), T1, T2)
 2458	]
 2459).
 2460
 2461/* Recursive case when the enemy unit is too far away */
 2462
 2463l_events(
 2464	happens(turn_and_attack(Unit, north, Unit1), T1, T3),
 2465	[
 2466		holds(position(Unit, Direction, X, Y), T1),
 2467		holds(position(Unit1, D1, X, Y1), T1),
 2468		not_equal(Unit, Unit1),
 2469		has(Unit, weapon(A)),
 2470		range(weapon(A), L, U),
 2471		decrease(Y, Y2, Y1),
 2472		greater_than(Y2, U),
 2473		decrement(Y, NewY),
 2474		happens(walk(Unit, north, X, NewY), T1, T2),
 2475		happens(attack(Unit), T2, T3)
 2476	]
 2477).
 2478
 2479l_events(
 2480	happens(turn_and_attack(Unit, east, Unit1), T1, T3),
 2481	[
 2482		holds(position(Unit, Direction, X, Y), T1),
 2483		holds(position(Unit1, D1, X1, Y), T1),
 2484		not_equal(Unit, Unit1),
 2485		has(Unit, weapon(A)),
 2486		range(weapon(A), L, U),
 2487		decrease(X1, X2, X),
 2488		greater_than(X2, U),
 2489		increment(X, NewX),
 2490		happens(walk(Unit, east, NewX, Y), T1, T2),
 2491		happens(attack(Unit), T2, T3)
 2492	]
 2493).
 2494
 2495l_events(
 2496	happens(turn_and_attack(Unit, south, Unit1), T1, T3),
 2497	[
 2498		holds(position(Unit, Direction, X, Y), T1),
 2499		holds(position(Unit1, D1, X, Y1), T1),
 2500		not_equal(Unit, Unit1),
 2501		has(Unit, weapon(A)),
 2502		range(weapon(A), L, U),
 2503		decrease(Y1, Y2, Y),
 2504		greater_than(Y2, U),
 2505		increment(Y, NewY),
 2506		happens(walk(Unit, south, X, NewY), T1, T2),
 2507		happens(attack(Unit), T2, T3)
 2508
 2509	]
 2510).
 2511
 2512l_events(
 2513	happens(turn_and_attack(Unit, west, Unit1), T1, T3),
 2514	[
 2515		holds(position(Unit, Direction, X, Y), T1),
 2516		holds(position(Unit1, D1, X1, Y), T1),
 2517		not_equal(Unit, Unit1),
 2518		has(Unit, weapon(A)),
 2519		range(weapon(A), L, U),
 2520		decrease(X, X2, X1),
 2521		greater_than(X2, U),
 2522		decrement(X, NewX),
 2523		happens(walk(Unit, west, NewX, Y), T1, T2),
 2524		happens(attack(Unit), T2, T3)
 2525	]
 2526).
 2527
 2528
 2529/* Recursive case when enemy unit is too close */
 2530
 2531l_events(
 2532	happens(turn_and_attack(Unit, north, Unit1), T1, T3),
 2533	[
 2534		holds(position(Unit, Direction, X, Y), T1),
 2535		holds(position(Unit1, D1, X, Y1), T1),
 2536		not_equal(Unit, Unit1),
 2537		has(Unit, weapon(A)),
 2538		range(weapon(A), L, U),
 2539		decrease(Y, Y2, Y1),
 2540		less_than(Y2, L),
 2541		increment(Y, NewY),
 2542		happens(walk(Unit, north, X, NewY), T1, T2),
 2543		happens(attack(Unit), T2, T3)
 2544	]
 2545).
 2546
 2547l_events(
 2548	happens(turn_and_attack(Unit, east, Unit1), T1, T3),
 2549	[
 2550		holds(position(Unit, Direction, X, Y), T1),
 2551		holds(position(Unit1, D1, X1, Y), T1),
 2552		not_equal(Unit, Unit1),
 2553		has(Unit, weapon(A)),
 2554		range(weapon(A), L, U),
 2555		decrease(X1, X2, X),
 2556		less_than(X2, L),
 2557		decrement(X, NewX),
 2558		happens(walk(Unit, east, NewX, Y), T1, T2),
 2559		happens(attack(Unit), T2, T3)
 2560	]
 2561).
 2562
 2563l_events(
 2564	happens(turn_and_attack(Unit, south, Unit1), T1, T3),
 2565	[
 2566		holds(position(Unit, Direction, X, Y), T1),
 2567		holds(position(Unit1, D1, X, Y1), T1),
 2568		not_equal(Unit, Unit1),
 2569		has(Unit, weapon(A)),
 2570		range(weapon(A), L, U),
 2571		decrease(Y1, Y2, Y),
 2572		less_than(Y2, L),
 2573		decrement(Y, NewY),
 2574		happens(walk(Unit, south, X, NewY), T1, T2),
 2575		happens(attack(Unit), T2, T3)
 2576
 2577	]
 2578).
 2579
 2580l_events(
 2581	happens(turn_and_attack(Unit, west, Unit1), T1, T3),
 2582	[
 2583		holds(position(Unit, Direction, X, Y), T1),
 2584		holds(position(Unit1, D1, X1, Y), T1),
 2585		not_equal(Unit, Unit1),
 2586		has(Unit, weapon(A)),
 2587		range(weapon(A), L, U),
 2588		decrease(X, X2, X1),
 2589		less_than(X2, L),
 2590		increment(X, NewX),
 2591		happens(walk(Unit, west, NewX, Y), T1, T2),
 2592		happens(attack(Unit), T2, T3)
 2593	]
 2594).
 2595
 2596
 2597/* Post conditions used to update the state */
 2598
 2599terminated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), shelter(Unit1, H1, X, Y), []).
 2600initiated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), shelter(Unit1, H, X, Y), [greater_than(H, 0)]).
 2601
 2602terminated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), cycles(T), []).
 2603initiated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), cycles(T), [modu(T, T1)]).
 2604
 2605terminated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), has_shelter(Unit1, true), [equal(H, 0)]).
 2606initiated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), has_shelter(Unit1, false), [equal(H, 0)]).
 2607
 2608terminated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), turns(Unit, N), []).
 2609initiated(happens(hit_shelter(Unit, Unit1, H, D, X, Y), T1, T2), turns(Unit, 0), []).
 2610
 2611terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), health(Unit1, H1), []).
 2612initiated(happens(hit_from(Unit, Unit1, H, D), T1, T2), health(Unit1, H), [greater_than(H, 0)]).
 2613
 2614terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), cycles(T), []).
 2615initiated(happens(hit_from(Unit, Unit1, H, D), T1, T2), cycles(T), [modu(T, T1)]).
 2616
 2617initiated(happens(hit_from(Unit, Unit1, H, D), T1, T2), dead(Unit1), [equal(H, 0)]).
 2618terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), person(Unit1, Type), [equal(H, 0)]).
 2619terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), position(Unit1, Direction, X, Y), [equal(H, 0)]).
 2620terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), hunger(Unit1, N), [equal(H, 0)]).
 2621terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), has_shelter(Unit1, Boolean), [equal(H, 0)]).
 2622terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), shelter(Unit1, N, X, Y), [equal(H, 0)]).
 2623terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), holds_wood(Unit1, N), [equal(H, 0)]).
 2624terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), holds_food(Unit1, N, A, B, C), [equal(H, 0)]).
 2625terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), turns(Unit1, N), [equal(H, 0)]).
 2626
 2627
 2628terminated(happens(hit_from(Unit, Unit1, H, D), T1, T2), turns(Unit, N), []).
 2629initiated(happens(hit_from(Unit, Unit1, H, D), T1, T2), turns(Unit, 0), []).
 2630
 2631
 2632terminated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), shelter(Unit1, H1, X1, Y1), []).
 2633initiated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), shelter(Unit1, H, X1, Y1), [greater_than(H, 0)]).
 2634
 2635terminated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), has_shelter(Unit1, true), [equal(H, 0)]).
 2636initiated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), has_shelter(Unit1, false), [equal(H, 0)]).
 2637
 2638
 2639terminated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), position(Unit, OldD, OldX, OldY), []).
 2640initiated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), position(Unit, D, X, Y), []).
 2641
 2642terminated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), cycles(T), []).
 2643initiated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), cycles(T), [modu(T, T1)]).
 2644
 2645terminated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), turns(Unit, N), []).
 2646initiated(happens(turn_hit_shelter(Unit, D, X, Y, Unit1, H, D1, X1, Y1), T1, T2), turns(Unit, 0), []).
 2647
 2648
 2649terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), health(Unit1, H1), []).
 2650initiated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), health(Unit1, H), [greater_than(H, 0)]).
 2651
 2652terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), position(Unit, OldD, OldX, OldY), []).
 2653initiated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), position(Unit, D, X, Y), []).
 2654
 2655terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), cycles(T), []).
 2656initiated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), cycles(T), [modu(T, T1)]).
 2657
 2658initiated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), dead(Unit1), [equal(H, 0)]).
 2659terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), person(Unit1, Type), [equal(H, 0)]).
 2660terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), position(Unit1, Direction, X1, Y1), [equal(H, 0)]).
 2661terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), hunger(Unit1, N), [equal(H, 0)]).
 2662terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), has_shelter(Unit1, Boolean), [equal(H, 0)]).
 2663terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), shelter(Unit1, N, X, Y), [equal(H, 0)]).
 2664terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), holds_wood(Unit1, N), [equal(H, 0)]).
 2665terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), holds_food(Unit1, N, A, B, C), [equal(H, 0)]).
 2666terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), turns(Unit1, N), [equal(H, 0)]).
 2667
 2668terminated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), turns(Unit, N), []).
 2669initiated(happens(turn_hit(Unit, D, X, Y, Unit1, H, D1), T1, T2), turns(Unit, 0), []).
 2670
 2671/************************** Logic for reducing hunger and reducing health if hunger is too low **************************/
 2672
 2673action(reduce_hunger(_, _)).
 2674
 2675action(need_food(_)).
 2676
 2677action(check_hunger(_)).
 2678
 2679action(lower_health(_,_)).
 2680
 2681action(lower_hunger(_, _)).
 2682
 2683/* Reactive rules */
 2684
 2685reactive_rule(
 2686	[
 2687		holds(cycles(7), T1),
 2688		holds(hunger(alex, N), T1)
 2689	],
 2690	[
 2691		happens(lower_hunger(alex, N), T1, T2)
 2692	],
 2693	99
 2694).
 2695
 2696reactive_rule(
 2697	[
 2698		holds(cycles(7), T1),
 2699		holds(hunger(amanda, N), T1)
 2700	],
 2701	[
 2702		happens(lower_hunger(amanda, N), T1, T2)
 2703	],
 2704	99
 2705).
 2706
 2707reactive_rule(
 2708	[
 2709		holds(cycles(7), T1),
 2710		holds(hunger(katherine, N), T1)
 2711	],
 2712	[
 2713		happens(lower_hunger(katherine, N), T2, T3)
 2714	],
 2715	99
 2716).
 2717
 2718reactive_rule(
 2719	[
 2720		holds(cycles(7), T1),
 2721		holds(hunger(peter, N), T1)
 2722	],
 2723	[
 2724		happens(lower_hunger(peter, N), T2, T3)
 2725	],
 2726	99
 2727).
 2728
 2729reactive_rule(
 2730	[
 2731		holds(cycles(7), T1),
 2732		holds(hunger(tom, N), T1)
 2733	],
 2734	[
 2735		happens(lower_hunger(tom, N), T2, T3)
 2736	],
 2737	99
 2738).
 2739
 2740
 2741
 2742reactive_rule(
 2743	[
 2744		happens(reduce_hunger(Unit, N), T1, T2)
 2745	],
 2746	[
 2747		happens(check_hunger(Unit), T3, T4)
 2748	],
 2749	91
 2750).
 2751
 2752/* Case where hunger is above zero */
 2753
 2754l_events(
 2755	happens(lower_hunger(Unit, N), T1, T2),
 2756	[
 2757		decrement(N, N1),
 2758		greater_than(N1, 0),
 2759		happens(reduce_hunger(Unit, N1), T1, T2)
 2760	]
 2761).
 2762
 2763/* Case when hunger is already zero, then initialise zero */
 2764
 2765l_events(
 2766	happens(lower_hunger(Unit, N), T1, T2),
 2767	[
 2768		decrement(N, N1),
 2769		less_or_equal(N1, 0),
 2770		happens(reduce_hunger(Unit, 0), T1, T2)
 2771	]
 2772).
 2773
 2774/* Base Case */
 2775
 2776l_events(
 2777	happens(check_hunger(Unit), T1, T2),
 2778	[
 2779		holds(hunger(Unit, N), T1),
 2780		greater_or_equal(N, 10)
 2781	]
 2782).
 2783
 2784/* Recursive as health lowers every cycle */
 2785
 2786/* Case where hunger is low, then lower health */
 2787
 2788
 2789l_events(
 2790	happens(check_hunger(Unit), T1, T3),
 2791	[
 2792		holds(hunger(Unit, N), T1),
 2793		less_than(N, 10),
 2794		holds(health(Unit, H), T1),
 2795		decrement(H, H1),
 2796		greater_than(H1, 0),
 2797		happens(lower_health(Unit, H1), T1, T2),
 2798		happens(check_hunger(Unit), T2, T3)
 2799	]
 2800).
 2801
 2802/* Case when hunger is low and health is already zero, then initialise zero */
 2803
 2804l_events(
 2805	happens(check_hunger(Unit), T1, T3),
 2806	[
 2807		holds(hunger(Unit, N), T1),
 2808		less_than(N, 10),
 2809		holds(health(Unit, H), T1),
 2810		decrement(H, H1),
 2811		less_or_equal(H1, 0),
 2812		happens(lower_health(Unit, 0), T1, T2),
 2813		happens(check_hunger(Unit), T2, T3)
 2814	]
 2815).
 2816
 2817terminated(happens(lower_health(Unit, H), T1, T2), health(Unit, H1), []).
 2818initiated(happens(lower_health(Unit, H), T1, T2), health(Unit, H), [greater_than(H, 0)]).
 2819
 2820initiated(happens(lower_health(Unit, H), T1, T2), cycles(T), [modu(T, T1)]).
 2821terminated(happens(lower_health(Unit, H), T1, T2), cycles(T), []).
 2822
 2823terminated(happens(lower_health(Unit, H), T1, T2), turns(Unit, N1), []).
 2824initiated(happens(lower_health(Unit, H), T1, T2), turns(Unit, 0), []).
 2825
 2826initiated(happens(lower_health(Unit, H), T1, T2), dead(Unit), [equal(H, 0)]).
 2827terminated(happens(lower_health(Unit, H), T1, T2), person(Unit, Type), [equal(H, 0)]).
 2828terminated(happens(lower_health(Unit, H), T1, T2), position(Unit, Direction, X, Y), [equal(H, 0)]).
 2829terminated(happens(lower_health(Unit, H), T1, T2), hunger(Unit, N), [equal(H, 0)]).
 2830terminated(happens(lower_health(Unit, H), T1, T2), has_shelter(Unit, Boolean), [equal(H, 0)]).
 2831terminated(happens(lower_health(Unit, H), T1, T2), shelter(Unit, N, X, Y), [equal(H, 0)]).
 2832terminated(happens(lower_health(Unit, H), T1, T2), holds_wood(Unit, N), [equal(H, 0)]).
 2833terminated(happens(lower_health(Unit, H), T1, T2), holds_food(Unit, N, A, B, C), [equal(H, 0)]).
 2834terminated(happens(lower_health(Unit, H), T1, T2), turns(Unit, N), [equal(H, 0)]).
 2835
 2836terminated(happens(reduce_hunger(Unit, N), T1, T2), hunger(Unit, N1), []).
 2837initiated(happens(reduce_hunger(Unit, N), T1, T2), hunger(Unit, N), []).
 2838
 2839terminated(happens(reduce_hunger(Unit, N), T1, T2), cycles(T), []).
 2840initiated(happens(reduce_hunger(Unit, N), T1, T2),  cycles(T), [modu(T, T1)]).
 2841
 2842terminated(happens(reduce_hunger(Unit, N), T1, T2), turns(Unit, N1), []).
 2843initiated(happens(reduce_hunger(Unit, N), T1, T2), turns(Unit, 0), []).
 2844
 2845/********************************************* Logic for eating food *********************************************/
 2846
 2847action(consume_food(_)).
 2848
 2849action(eat_food(_)).
 2850
 2851action(eat(_, _, _, _, _, _, _)).
 2852
 2853/* Reactive rule */
 2854
 2855reactive_rule(
 2856	[
 2857		happens(reduce_hunger(Unit, N), T1, T2)
 2858	],
 2859	[
 2860		happens(consume_food(Unit), T3, T4)
 2861	],
 2862	96
 2863).
 2864
 2865/* Cautious unit case */
 2866
 2867l_events(
 2868	happens(consume_food(Unit), T1, T2),
 2869	[
 2870		holds(person(Unit, cautious), T1),
 2871		holds(hunger(Unit, F), T1),
 2872		greater_than(F, 15)
 2873	]
 2874).
 2875
 2876l_events(
 2877	happens(consume_food(Unit), T1, T2),
 2878	[
 2879		holds(person(Unit, cautious), T1),
 2880		holds(hunger(Unit, F), T1),
 2881		less_or_equal(F, 15),
 2882		holds(holds_food(Unit, N, A, B, C), T1),
 2883		greater_or_equal(N, 1),
 2884		happens(eat_food(Unit), T1, T2)
 2885	]
 2886).
 2887
 2888/* Normal unit case */
 2889
 2890l_events(
 2891	happens(consume_food(Unit), T1, T2),
 2892	[
 2893		holds(person(Unit, normal), T1),
 2894		holds(hunger(Unit, F), T1),
 2895		greater_than(F, 12)
 2896	]
 2897).
 2898
 2899l_events(
 2900	happens(consume_food(Unit), T1, T2),
 2901	[
 2902		holds(person(Unit, normal), T1),
 2903		holds(hunger(Unit, F), T1),
 2904		less_or_equal(F, 12),
 2905		holds(holds_food(Unit, N, A, B, C), T1),
 2906		greater_or_equal(N, 1),
 2907		happens(eat_food(Unit), T1, T2)
 2908	]
 2909).
 2910
 2911/* Violent unit case */
 2912l_events(
 2913	happens(consume_food(Unit), T1, T2),
 2914	[
 2915		holds(person(Unit, violent), T1),
 2916		holds(hunger(Unit, F), T1),
 2917		greater_than(F, 9)
 2918	]
 2919).
 2920
 2921
 2922l_events(
 2923	happens(consume_food(Unit), T1, T2),
 2924	[
 2925		holds(person(Unit, violent), T1),
 2926		holds(hunger(Unit, F), T1),
 2927		less_or_equal(F, 9),
 2928		holds(holds_food(Unit, N, A, B, C), T1),
 2929		greater_or_equal(N, 1),
 2930		happens(eat_food(Unit), T1, T2)
 2931	]
 2932).
 2933
 2934
 2935
 2936/* Base cases */
 2937l_events(
 2938	happens(eat_food(Unit), T1, T2),
 2939	[
 2940		holds(hunger(Unit, 20), T1)
 2941	]
 2942).
 2943
 2944/* Different recursive cases of eating depending on what food points the unit is holding */
 2945
 2946l_events(
 2947	happens(eat_food(Unit), T1, T3),
 2948	[
 2949		holds(hunger(Unit, F), T1),
 2950		decrease(20, F1, F),
 2951		greater_or_equal(F1, 5),
 2952		holds(holds_food(Unit, N, A, B, C), T1),
 2953		greater_or_equal(C, 1),
 2954		happens(eat(Unit, 5, F, N, A, B, C), T1, T2),
 2955		happens(eat_food(Unit), T2, T3)
 2956	]
 2957).
 2958
 2959l_events(
 2960	happens(eat_food(Unit), T1, T3),
 2961	[
 2962		holds(hunger(Unit, F), T1),
 2963		decrease(20, F1, F),
 2964		greater_or_equal(F1, 5),
 2965		holds(holds_food(Unit, N, A, B, C), T1),
 2966		equal(C, 0),
 2967		greater_or_equal(B, 1),
 2968		happens(eat(Unit, 3, F, N, A, B, C), T1, T2),
 2969		happens(eat_food(Unit), T2, T3)
 2970	]
 2971).
 2972
 2973l_events(
 2974	happens(eat_food(Unit), T1, T3),
 2975	[
 2976		holds(hunger(Unit, F), T1),
 2977		decrease(20, F1, F),
 2978		greater_or_equal(F1, 5),
 2979		holds(holds_food(Unit, N, A, B, C), T1),
 2980		equal(C, 0),
 2981		equal(B, 0),
 2982		greater_or_equal(A, 1),
 2983		happens(eat(Unit, 1, F, N, A, B, C), T1, T2),
 2984		happens(eat_food(Unit), T2, T3)
 2985	]
 2986).
 2987
 2988l_events(
 2989	happens(eat_food(Unit), T1, T3),
 2990	[
 2991		holds(hunger(Unit, F), T1),
 2992		decrease(20, F1, F),
 2993		less_than(F1, 5),
 2994		greater_or_equal(F1, 3),
 2995		holds(holds_food(Unit, N, A, B, C), T1),
 2996		greater_or_equal(B, 1),
 2997		happens(eat(Unit, 3, F, N, A, B, C), T1, T2),
 2998		happens(eat_food(Unit), T2, T3)
 2999	]
 3000).
 3001
 3002l_events(
 3003	happens(eat_food(Unit), T1, T3),
 3004	[
 3005		holds(hunger(Unit, F), T1),
 3006		decrease(20, F1, F),
 3007		less_than(F1, 5),
 3008		greater_or_equal(F1, 3),
 3009		holds(holds_food(Unit, N, A, B, C), T1),
 3010		equal(B, 0),
 3011		greater_or_equal(A, 1),
 3012		happens(eat(Unit, 1, F, N, A, B, C), T1, T2),
 3013		happens(eat_food(Unit), T2, T3)
 3014	]
 3015).
 3016
 3017l_events(
 3018	happens(eat_food(Unit), T1, T3),
 3019	[
 3020		holds(hunger(Unit, F), T1),
 3021		decrease(20, F1, F),
 3022		less_than(F1, 3),
 3023		greater_or_equal(F1, 1),
 3024		holds(holds_food(Unit, N, A, B, C), T1),
 3025		greater_or_equal(A, 1),
 3026		happens(eat(Unit, 1, F, N, A, B, C), T1, T2),
 3027		happens(eat_food(Unit), T2, T3)
 3028	]
 3029).
 3030
 3031/* Post conditions to update the state */
 3032
 3033terminated(happens(eat(Unit, V, F, N, A, B, C), T1, T2), hunger(Unit, F), []).
 3034initiated(happens(eat(Unit, V, F, N, A, B, C), T1, T2), hunger(Unit, F1), [increase(F, F1, V)]).
 3035
 3036terminated(happens(eat(Unit, 5, F, N, A, B, C), T1, T2), holds_food(Unit, N, A, B, C), []).
 3037initiated(happens(eat(Unit, 5, F, N, A, B, C), T1, T2), holds_food(Unit, N1, A, B, C1), [decrease(N, N1, 5), decrement(C, C1)]).
 3038
 3039terminated(happens(eat(Unit, 3, F, N, A, B, C), T1, T2), holds_food(Unit, N, A, B, C), []).
 3040initiated(happens(eat(Unit, 3, F, N, A, B, C), T1, T2), holds_food(Unit, N1, A, B1, C), [decrease(N, N1, 3), decrement(B, B1)]).
 3041
 3042terminated(happens(eat(Unit, 1, F, N, A, B, C), T1, T2), holds_food(Unit, N, A, B, C), []).
 3043initiated(happens(eat(Unit, 1, F, N, A, B, C), T1, T2), holds_food(Unit, N1, A1, B, C), [decrease(N, N1, 1), decrement(A, A1)]).
 3044
 3045terminated(happens(eat(Unit, V, F, N, A, B, C), T1, T2), turns(Unit, N1), []).
 3046initiated(happens(eat(Unit, V, F, N, A, B, C), T1, T2), turns(Unit, 0), []).
 3047
 3048initiated(happens(eat(Unit, V, F, N, A, B, C), T1, T2), cycles(T), [modu(T, T1)]).
 3049terminated(happens(eat(Unit, V, F, N, A, B, C), T1, T2), cycles(T), []).
 3050
 3051
 3052/********************************************* Logic for getting more food *********************************************/
 3053
 3054
 3055action(check_food(_)).
 3056
 3057reactive_rule(
 3058	[
 3059		happens(eat(Unit, V, F, N, A, B, C), T1, T2)
 3060
 3061	],
 3062	[
 3063		happens(check_food(Unit), T3, T4)
 3064	],
 3065	94
 3066).
 3067
 3068/* Base Case */
 3069
 3070l_events(
 3071	happens(check_food(Unit), T1, T2),
 3072	[
 3073		holds(person(Unit, cautious), T1),
 3074		holds(holds_food(Unit, N, A, B, C), T1),
 3075		greater_or_equal(N, 10)
 3076	]
 3077).
 3078
 3079l_events(
 3080	happens(check_food(Unit), T1, T2),
 3081	[
 3082		holds(person(Unit, normal), T1),
 3083		holds(holds_food(Unit, N, A, B, C), T1),
 3084		greater_or_equal(N, 5)
 3085	]
 3086).
 3087
 3088l_events(
 3089	happens(check_food(Unit), T1, T2),
 3090	[
 3091		holds(person(Unit, violent), T1),
 3092		holds(holds_food(Unit, N, A, B, C), T1),
 3093		greater_or_equal(N, 0)
 3094	]
 3095).
 3096
 3097/* Recursive Case */
 3098
 3099l_events(
 3100	happens(check_food(Unit), T1, T3),
 3101	[
 3102		holds(person(Unit, cautious), T1),
 3103		holds(holds_food(Unit, N, A, B, C), T1),
 3104		less_than(N, 10),
 3105		happens(get_food(Unit), T1, T2),
 3106		happens(check_food(Unit), T2, T3)
 3107	]
 3108).
 3109
 3110l_events(
 3111	happens(check_food(Unit), T1, T3),
 3112	[
 3113		holds(person(Unit, normal), T1),
 3114		holds(holds_food(Unit, N, A, B, C), T1),
 3115		less_than(N, 5),
 3116		happens(get_food(Unit), T1, T2),
 3117		happens(check_food(Unit), T2, T3)
 3118	]
 3119).
 3120
 3121l_events(
 3122	happens(check_food(Unit), T1, T3),
 3123	[
 3124		holds(person(Unit, violent), T1),
 3125		holds(holds_food(Unit, N, A, B, C), T1),
 3126		less_than(N, 0),
 3127		happens(get_food(Unit), T1, T2),
 3128		happens(check_food(Unit), T2, T3)
 3129	]
 3130).
 3131
 3132
 3133/********************************************* Logic for fire *********************************************/
 3134event(fire(_,_)).
 3135action(on_fire(_,_)).
 3136action(burn(_,_)).
 3137reactive_rule(
 3138	[
 3139		happens(fire(X, Y), T1, T2)
 3140	],
 3141	[
 3142		happens(on_fire(X, Y), T3, T4)
 3143	],
 3144	99
 3145).
 3146
 3147l_events(
 3148	happens(on_fire(X, Y), T1, T2),
 3149	[
 3150		holds(position(Unit, D, X, Y), T1),
 3151		holds(health(Unit, N), T1),
 3152		decrease(N, N1, 10),
 3153		happens(burn(Unit, N1), T1, T2)
 3154	]
 3155).
 3156
 3157terminated(happens(burn(Unit, H), T1, T2), health(Unit, N1), []).
 3158initiated(happens(burn(Unit, H), T1, T2), health(Unit, H), [greater_than(H, 0)]).
 3159
 3160terminated(happens(burn(Unit, H), T1, T2), turns(Unit, N1), []).
 3161initiated(happens(burn(Unit, H), T1, T2), turns(Unit, 0), []).
 3162
 3163initiated(happens(burn(Unit, H), T1, T2), cycles(T), [modu(T, T1)]).
 3164terminated(happens(burn(Unit, H), T1, T2), cycles(T), []).
 3165
 3166initiated(happens(burn(Unit, H), T1, T2), dead(Unit), [equal(H, 0)]).
 3167terminated(happens(burn(Unit, H), T1, T2), person(Unit, Type), [equal(H, 0)]).
 3168terminated(happens(burn(Unit, H), T1, T2), position(Unit, Direction, X, Y), [equal(H, 0)]).
 3169terminated(happens(burn(Unit, H), T1, T2), hunger(Unit, N), [equal(H, 0)]).
 3170terminated(happens(burn(Unit, H), T1, T2), has_shelter(Unit, Boolean), [equal(H, 0)]).
 3171terminated(happens(burn(Unit, H), T1, T2), shelter(Unit, N, X, Y), [equal(H, 0)]).
 3172terminated(happens(burn(Unit, H), T1, T2), holds_wood(Unit, N), [equal(H, 0)]).
 3173terminated(happens(burn(Unit, H), T1, T2), holds_food(Unit, N, A, B, C), [equal(H, 0)]).
 3174terminated(happens(burn(Unit, H), T1, T2), turns(Unit, N), [equal(H, 0)]).
 3175
 3176/**************************************** Logic for unit to heal ****************************************/
 3177
 3178
 3179action(check_health(_)).
 3180action(heal(_, _)).
 3181
 3182reactive_rule(
 3183	[
 3184		holds(hunger(Unit, 20), T1)
 3185	],
 3186	[
 3187		happens(check_health(Unit), T1, T2)
 3188	],
 3189	90
 3190).
 3191
 3192
 3193l_events(
 3194	happens(check_health(Unit), T1, T2),
 3195	[
 3196		holds(health(Unit, H), T1),
 3197		less_than(H, 50),
 3198		happens(heal(Unit, H), T1, T2)
 3199	]
 3200).
 3201
 3202l_events(
 3203	happens(check_health(Unit), T1, T2),
 3204	[
 3205		holds(health(Unit, 50), T1)
 3206	]
 3207
 3208).
 3209
 3210terminated(happens(heal(Unit, H), T1, T2), health(Unit, H), []).
 3211initiated(happens(heal(Unit, H), T1, T2), health(Unit, H1), [increment(H, H1)]).
 3212
 3213terminated(happens(heal(Unit, H), T1, T2), turns(Unit, N), []).
 3214initiated(happens(heal(Unit, H), T1, T2), turns(Unit, 0), []).
 3215
 3216initiated(happens(heal(Unit, H), T1, T2), cycles(T), [modu(T, T1)]).
 3217terminated(happens(heal(Unit, H), T1, T2), cycles(T), []).
 3218
 3219/**************************************** Logic for unit to garrison in shelter ****************************************/
 3220
 3221reactive_rule(
 3222	[
 3223		happens(successful_shelter(Unit, N, X, Y), T1, T2),
 3224		holds(person(Unit, cautious), T2)
 3225	],
 3226	[
 3227		happens(go_to_shelter(Unit), T3, T4)
 3228	],
 3229	91
 3230).
 3231
 3232fluent(in_shelter(_)).
 3233
 3234l_events(
 3235	happens(go_to_shelter(Unit), T1, T2),
 3236	[
 3237		holds(in_shelter(Unit), T1)
 3238	]
 3239).
 3240
 3241/* Cases when next to shelter */
 3242
 3243l_events(
 3244	happens(go_to_shelter(Unit), T1, T3),
 3245	[
 3246		holds(position(Unit, north, X, Y), T1),
 3247		decrement(Y, Y1),
 3248		holds(shelter(Unit, H, X, Y1), T1),
 3249		happens(walk(Unit, north, X, Y1), T1, T2),
 3250		happens(go_to_shelter(Unit), T2, T3)
 3251	]
 3252).
 3253
 3254l_events(
 3255	happens(go_to_shelter(Unit), T1, T3),
 3256	[
 3257		holds(position(Unit, south, X, Y), T1),
 3258		increment(Y, Y1),
 3259		holds(shelter(Unit, H, X, Y1), T1),
 3260		happens(walk(Unit, south, X, Y1), T1, T2),
 3261		happens(go_to_shelter(Unit), T2, T3)
 3262	]
 3263
 3264).
 3265
 3266
 3267l_events(
 3268	happens(go_to_shelter(Unit), T1, T3),
 3269	[
 3270		holds(position(Unit, east, X, Y), T1),
 3271		increment(X, X1),
 3272		holds(shelter(Unit, H, X1, Y), T1),
 3273		happens(walk(Unit, east, X1, Y), T1, T2),
 3274		happens(go_to_shelter(Unit), T2, T3)
 3275	]
 3276
 3277).
 3278
 3279l_events(
 3280	happens(go_to_shelter(Unit), T1, T3),
 3281	[
 3282		holds(position(Unit, west, X, Y), T1),
 3283		decrement(X, X1),
 3284		holds(shelter(Unit, H, X1, Y), T1),
 3285		happens(walk(Unit, west, X1, Y), T1, T2),
 3286		happens(go_to_shelter(Unit), T2, T3)
 3287	]
 3288
 3289).
 3290
 3291/* Cases when not next to shelter, then go towards it */
 3292
 3293l_events(
 3294	happens(go_to_shelter(Unit), T1, T3),
 3295	[
 3296		holds(position(Unit, D, X, Y), T1),
 3297		holds(shelter(Unit, H, X1, Y1), T1),
 3298		decrease(Y, Y2, Y1),
 3299		greater_than(Y2, 1),
 3300		decrement(Y, Y3),		
 3301		happens(walk(Unit, north, X, Y3), T1, T2),
 3302		happens(go_to_shelter(Unit), T2, T3)
 3303	]
 3304).
 3305
 3306l_events(
 3307	happens(go_to_shelter(Unit), T1, T3),
 3308	[
 3309		holds(position(Unit, D, X, Y), T1),
 3310		holds(shelter(Unit, H, X1, Y1), T1),
 3311		decrease(Y1, Y2, Y),
 3312		greater_than(Y2, 1),
 3313		increment(Y, Y3),		
 3314		happens(walk(Unit, south, X, Y3), T1, T2),
 3315		happens(go_to_shelter(Unit), T2, T3)
 3316	]
 3317).
 3318
 3319l_events(
 3320	happens(go_to_shelter(Unit), T1, T3),
 3321	[
 3322		holds(position(Unit, D, X, Y), T1),
 3323		holds(shelter(Unit, H, X1, Y1), T1),
 3324		decrease(X1, X2, X),
 3325		greater_than(X2, 1),
 3326		increment(X, X3),		
 3327		happens(walk(Unit, east, X3, Y), T1, T2),
 3328		happens(go_to_shelter(Unit), T2, T3)
 3329	]
 3330).
 3331
 3332l_events(
 3333	happens(go_to_shelter(Unit), T1, T3),
 3334	[
 3335		holds(position(Unit, D, X, Y), T1),
 3336		holds(shelter(Unit, H, X1, Y1), T1),
 3337		decrease(X, X2, X1),
 3338		greater_than(X2, 1),
 3339		decrement(X, X3),		
 3340		happens(walk(Unit, west, X3, Y), T1, T2),
 3341		happens(go_to_shelter(Unit), T2, T3)
 3342	]
 3343).
 3344
 3345l_int(
 3346	holds(in_shelter(Unit), T),
 3347	[
 3348		holds(position(Unit, D, X, Y), T),
 3349		holds(shelter(Unit, H, X, Y), T)
 3350	]
 3351).
 3352
 3353
 3354
 3355
 3356/* Observations */
 3357
 3358
 3359observe(
 3360	[
 3361		start_game(amanda),
 3362		start_game(katherine),
 3363		start_game(peter),
 3364		start_game(tom),
 3365		start_game(alex)
 3366		
 3367	], 
 3368	1
 3369
 3370).
 3371
 3372
 3373
 3374observe([], 2).
 3375
 3376observe([], 3).
 3377
 3378observe([], 4).
 3379
 3380observe([], 5).
 3381
 3382observe([], T) :- T <15. % down from 30, slowing down around cycles 24 or so; future tests will deal with THAT