1/*
    2% NomicMUD: A MUD server written in Prolog
    3% Maintainer: Douglas Miles
    4% Dec 13, 2035
    5%
    6% Bits and pieces:
    7%
    8% LogicMOO, Inform7, FROLOG, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    9% 
   10% Copyright (C) 2004 Marty White under the GNU GPL 
   11% Sept 20,1999 - Douglas Miles
   12% July 10,1996 - John Eikenberry 
   13%
   14% Logicmoo Project changes:
   15%
   16% Main file.
   17%
   18*/
   19
   20action_handle_goals(Agent, Mem0, Mem0):- 
   21  \+ thought(goals([_|_]), Mem0), !,
   22 bugout3('~w: no goals exist~n', [Agent], autonomous).
   23
   24action_handle_goals(Agent, Mem0, Mem1):- 
   25 bugout3('~w: goals exist: generating a plan...~n', [Agent], autonomous),
   26 Knower = Agent,
   27 generate_plan(Knower, Agent, NewPlan, Mem0), !,
   28 serialize_plan(Knower, Agent, NewPlan, Actions), !,
   29 bugout3('Planned actions are ~w~n', [Actions], autonomous),
   30 Actions = [Action|_],
   31 add_todo(Action, Mem0, Mem1).
   32
   33% If goals exist, forget them (since ite above failed)
   34action_handle_goals(Agent, Mem0, Mem9) :-
   35 forget(goals([G0|GS]), Mem0, Mem1),
   36 memorize(goals([]), Mem1, Mem2),
   37 bugout3('~w: Can\'t solve goals ~p. Forgetting them.~n', [Agent,[G0|GS]], autonomous),
   38 memorize_appending(skipped_goals([G0|GS]),Mem2,Mem9),!.
   39
   40
   41
   42has_satisfied_goals(Agent, Mem0, Mem3):-  
   43 forget(goals([G0|GS]), Mem0, Mem1),
   44 Goals = [G0|GS],
   45 agent_thought_model(Agent, ModelData, Mem0),
   46 select_unsatisfied_conditions(Goals, Unsatisfied, ModelData) ->
   47 subtract(Goals,Unsatisfied,Satisfied), !,
   48 Satisfied \== [],
   49 memorize(goals(Unsatisfied), Mem1, Mem2),
   50 bugout3('~w Goals some Satisfied: ~p.  Unsatisfied: ~p.~n', [Agent, Satisfied, Unsatisfied], autonomous),
   51 memorize_appending(goals_satisfied(Satisfied), Mem2, Mem3), !.
   52
   53% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   54% CODE FILE SECTION
   55:- nop(ensure_loaded('adv_plan_opers')).   56% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   57:- op(900, fy, '~').   58
   59/*
   60Situation:
   61
   62Person is in Kitchen
   63Floyd is in Pantry
   64The Pantry is North of Kitchen
   65
   66
   67Person wants goal satification to be easy.
   68Person thinks to know their environment, goal satisfiation will be easier.
   69Person goal is to know environment.
   70Person thinks if one is being an explorer, they will know their environment.
   71Person think doing what explorers do will make persons goal satisfaction easier.
   72Person thinks being an explorer means to find unexplored exits and travel to them.
   73Person thinks exits are known by looking.
   74Person goal is to have looked
   75Person the way to satifiy the goal to have looked is to: add_todo(Person,look(Person))
   76Person DOES look(Person)
   77Person notices exits: north, south, east, west.
   78Person thinks north is unexplored
   79Person thinks going north will be acting like an explorer
   80Person goal is to go north
   81Person makes plan to go north.. the plan is very simple: [go_dir(Person,walk,north)]
   82Person DOES go_dir(Person,walk,north)
   83Person leaves kitchen to the north
   84Kitchen(thus Person) sees Person departing kitchen to the north
   85Person enters pantry from the south
   86Pantry(thus Floyed and Person) sees Person enter pantry arriving from the south
   87Floyd belives Person was somewhere other than pantry before
   88Floyd belives Person traveled north and there might be an exit in the opposite dirrection (south) leading somewhere other than pantry
   89Person belives pantry is where they end up if they go north from kitchen
   90Person belives kitchen is where they end up if they go south from pantry
   91
   92
   93look(Person) is a cheap and effective strategy
   94
   95
   96event(trys(go_dir(Person,walk,north)))
   97  
   98
   99
  100
  101
  102precond_matches_effect(Cond, Cond).
  103
  104precond_matches_effects(path(Here, There), StartEffects) :- 
  105 find_path(Here, There, _Route, StartEffects).
  106precond_matches_effects(exists(Object), StartEffects) :-
  107 in_model(h(_, Object, _), StartEffects)
  108 ;
  109 in_model(h(_, _, Object), StartEffects).
  110precond_matches_effects(Cond, Effects) :-
  111 in_model(E, Effects),
  112 precond_matches_effect(Cond, E).
  113*/
  114 
  115% oper(_Self, Action, Desc, Preconds, Effects)
  116
  117sequenced(_Self,
  118  [ %Preconds:
  119  Here \= Self, There \= Self,
  120  \+ props(Self, knows_verbs(goto, f)),
  121  h(WasRel, Self, Here),
  122  props(Here, inherit(place, t)),
  123  props(There, inherit(place, t)),
  124  \+ in_state(~(open), There),
  125  \+ in_state(~(open), Here),
  126  \+ in_state(~(open), Dir),
  127  reverse_dir(Dir,RDir),
  128  h(exit(Dir), Here, There), % path(Here, There)
  129  % %Action:
  130  did(go_dir(Self, Walk, Dir)),
  131  %PostConds:
  132  ~h(WasRel, Self, Here),
  133  notice(Here,leaves(Self,Here,WasRel)),
  134  notice(Self,msg(cap(subj(actor(Self))),does(Walk), from(place(Here)), via(exit(Dir)) , Rel, to(place(There)))),
  135  h(Rel, Self, There),
  136  notice(There,enters(Self,There,RDir))]).
  137
  138only_goto:- true.
  139planner_only:- nb_current(opers, planner).
  140
  141:- discontiguous(implications/4).  142
  143implications(does, go_dir(Agent, Walk, ExitName),
  144     [ h(In, Agent, Here), h(exit(ExitName), Here, There) ],
  145     [ event(moving_in_dir(Agent, Walk, ExitName, In, Here, In, There)) ]).
  146
  147
  148implications(event, moving_in_dir(Object, Manner, ExitName, From, Here, To, There),
  149     [ Here \= There,  h(exit(ExitName), Here, There), h(exit(ReverseExit), There, Here) ],
  150     [  event(departing(Object, From, Here, Manner, ExitName)),
  151        event(arriving(Object, To, There, Manner,  ReverseExit))
  152        ]).
  153
  154implications(event, departing(Agent, In, There, _Walk, ExitName),
  155    [ h(In, Agent, There), h(exit(ExitName), There, _)], [~h(In, Agent, There)]).
  156
  157implications(event, arriving(Agent, In, Here, _Walk, ReverseExit),
  158    [~h(In, Agent, Here), h(exit(ReverseExit), Here, _)], [ h(In, Agent, Here)]).
  159
  160
  161:- discontiguous(oper/4).  162% oper(_Self, Action, Preconds, Effects)
  163oper(Self, Action, Preconds, Effects):- % Hooks to KR above
  164 fail, sequenced(Self, Whole),
  165 append(Preconds,[did(Action)|Effects],Whole).
  166
  167
  168
  169oper(Agent, go_dir(Agent, Walk, ExitName),
  170     [ Here \= Agent, There \= Agent, Here \= There, 
  171       k(In, Agent, Here),
  172       b(exit(ExitName), Here, _),
  173       h(exit(ExitName), Here, There),       
  174       ReverseExit \= ExitName, 
  175       h(exit(ReverseExit), There, Here)],
  176     [ 
  177        % implies believe(Agent, ~h(in, Agent, Here)),
  178        precept_local(Here, departing(Agent, In, Here, Walk, ExitName)),        
  179     ~h(In, Agent, Here),  
  180      h(In, Agent, There),
  181      %b(exit(ExitName), Here, There),
  182      %b(exit(ReverseExit), There, Here),
  183        % implies, believe(Agent, h(in, Agent, There)),
  184       precept_local(There, arriving(Agent, In, There, Walk,  ReverseExit))
  185   %  ~b(In, Agent, Here),  
  186   %   b(In, Agent, There),
  187        % There \= Here
  188        ]):- dif(ExitName, escape).
  189
  190
  191% Return an operator after substituting Agent for Agent.
  192oper(Agent, go_dir(Agent, _Walk, ExitName),
  193     [ b(in, Agent, Here),     
  194       b(exit(ExitName), Here, There),             
  195       Here \= Agent, There \= Agent, Here \= There
  196       ], % path(Here, There)
  197     [ ~b(in, Agent, Here),
  198        b(in, Agent, There)
  199     ]):- fail.
  200
  201% equiv(precept_local(Here, departing(Agent, In, Here, Walk, ExitName)))  ~h(in, Agent, Here)
  202
  203oper(Agent, go_dir(Agent, Walk, Escape),
  204     [ Object \= Agent, Here \= Agent,
  205       k(OldIn, Agent, Object),
  206       h(NewIn, Object, Here),
  207       Object \= Here      
  208     ],
  209     [ 
  210        precept_local(Object, departing(Agent, OldIn, Object, Walk, Escape)),
  211        % implies believe(Agent, ~h(in, Agent, Object)),
  212       ~k(OldIn, Agent, Object),        
  213        k(NewIn, Agent, Here),        
  214        precept_local(Here, arriving(Agent, NewIn, Here, Walk, EscapedObject))
  215        % implies, believe(Agent, h(in, Agent, Here))
  216     ]) :- Escape = escape, EscapedObject = escaped, \+ only_goto.
  217
  218
  219% Looking causes Percepts
  220oper(Agent, looky(Agent),
  221     [ Here \= Agent,
  222       % believe(Agent, h(_, Agent, _)),
  223       h(Sub, Agent, Here)       
  224       ], 
  225     [ foreach(
  226         (h(Sub, Child, Here), must_det(h(At, Child, Where))), 
  227             precept(Agent, h(At, Child, Where))) ] ) :- \+ only_goto.
  228
  229
  230
  231% the World agent has a *goal that no events go unhandled
  232oper(world, handle_events(Here),
  233     [ precept_local(Here, Event)],               
  234     [ ~precept_local(Here, Event), 
  235       foreach((h(in, Agent, Here),prop(Agent,inherited(preceptQ))),precept(Agent,Event))]):- \+ only_goto.
  236
  237
  238% deducer Agents who preceive leavers from some exit believe the departing point is an exit 
  239oper(Agent, precept(Agent, departing(Someone, In, Here, Walk, ExitName)),
  240     [ did(go_dir(Someone, Walk, ExitName)),
  241       prop(Agent,inherited(deducer)),
  242       h(In, Agent, Here) ],
  243     [ believe(Agent, h(exit(ExitName), Here, _)),
  244       believe(Agent, prop(Someone,inherited(actor)))]):- \+ only_goto.
  245
  246% deducer Agents who preceive arivers from some entrance believe the entry location is an exit 
  247oper(Agent, precept(Agent, arriving(Someone, In, Here, Walk, ExitName)),
  248     [ did(go_dir(Someone, Walk, ExitName)),
  249       prop(Agent,inherited(deducer)),
  250       believe(Agent, h(In, Agent, Here)) ],
  251
  252     [ believe(Agent, h(exit(ExitName), Here, _)),
  253       believe(Agent, did(go_dir(Someone, Walk, ExitName))),
  254       believe(Agent, h(In, Someone, Here)),
  255       believe(Agent, prop(Someone,inherited(actor)))]):- \+ only_goto.
  256
  257% deducer Agents who preceive arivers from some entrance believe the entry location is an exit 
  258oper(Agent, precept(Agent, arriving(Someone, In, Here, Walk, ExitName)),
  259     [ did(go_dir(Someone, Walk, ExitName)),
  260       isa(Agent,deducer),
  261       b(Agent, 
  262                [precept_local(There, departing(Someone, In, There, Walk, EnterName)),
  263                in(Agent, Here)]) ],
  264     [ b(Agent, 
  265                [exit(ExitName, Here, There),
  266                did(go_dir(Someone, Walk, EnterName)),
  267                in(Someone, Here),
  268                isa(Someone,actor)])]):- \+ only_goto.
  269
  270
  271% h = is really true
  272% b = is belived
  273% k = is belived and really true
  274oper(Agent, take(Agent, Thing), % from same room
  275  [ Thing \= Agent, exists(Thing),
  276    There \= Agent,
  277   k(takeable, Agent, Thing),
  278   h(At, Thing, There)
  279  ],
  280  [ ~ k(At, Thing, There),
  281      moves( At, Thing, There, take, held_by, Thing, Agent),
  282      k(held_by, Thing, Agent)]):- \+ only_goto.
  283
  284oper(Agent, drop(Agent, Thing),
  285  [ Thing \= Agent, exists(Thing), 
  286      k(held_by, Thing, Agent),
  287      k(At, Agent, Where)],
  288  [ ~ h(held_by, Thing, Agent),
  289      moves(held_by, Thing, Agent, drop, At, Thing, Where),
  290      k(At, Thing, Where)] ):- \+ only_goto.
  291
  292oper(Agent, put(Agent, Thing, Relation, Where), % in somewhere
  293  [ Thing \= Agent, exists(Thing), exists(Where),
  294      k(held_by, Thing, Agent),
  295      k(touchable, Agent, Where),
  296      has_rel(Relation, Where),
  297    ~ is_closed(Relation, Where)],
  298  [ ~ k(held_by, Thing, Agent),
  299      moves(held_by, Thing, Agent, put, Relation, Thing, Where),
  300      k(Relation, Thing, Where)] ):- \+ only_goto.
  301     
  302
  303oper(Agent, give(Agent, Thing, Recipient), % in somewhere
  304  [ Thing \= Agent, Recipient \= Agent,
  305      exists(Thing), exists(Recipient),
  306      k(held_by, Thing, Agent),
  307      k(touchable, Agent, Recipient),
  308      k(touchable, Recipient, Agent)],
  309  [ ~ k(held_by, Thing, Agent),
  310      moves(held_by, Thing, Agent, give, held_by, Thing, Recipient),
  311      k(held_by, Thing, Recipient)] ):- \+ only_goto.
  312
  313oper(Agent, tell(Agent, Player, [please, give, Recipient, the(Thing)]),
  314    [   Recipient \= Player, Agent \= Player,
  315        Thing \= Agent, Thing \= Recipient, Thing \= Player,
  316        exists(Thing), exists(Recipient), exists(Player),
  317        k(held_by, Thing, Player),
  318        k(touchable, Player, Recipient),
  319        k(touchable, Recipient, Player)],
  320    [ ~ k(held_by, Thing, Player),
  321        moves(held_by, Thing, Player, give, held_by, Thing, Recipient),
  322        k(held_by, Thing, Recipient)] ):- \+ only_goto.
  323
  324% Return an operator after substituting Agent for Self.
  325operagent(Agent, Action, BConds, BEffects) :- oper_splitk(Agent, Action, Conds, Effects),
  326  once((oper_beliefs(Agent, Conds, BConds),
  327  oper_beliefs(Agent, Effects, BEffects))).
  328
  329oper_beliefs(_Agent, [], []):- !.
  330oper_beliefs(Agent, [ believe(Agent2,H)|Conds], [H|BConds]):- Agent == Agent2, !,
  331  oper_beliefs(Agent, Conds, BConds).
  332oper_beliefs(Agent, [ A\=B|Conds], [A\=B|BConds]):- !,
  333  oper_beliefs(Agent, Conds, BConds).
  334oper_beliefs(Agent, [ exists(B)|Conds], [exists(B)|BConds]):-
  335  oper_beliefs(Agent, Conds, BConds).
  336oper_beliefs(Agent, [ _|Conds], BConds):-
  337  oper_beliefs(Agent, Conds, BConds).
  338
  339% Return the initial list of operators.
  340initial_operators(Agent, Operators) :-
  341 findall(oper(Agent, Action, Conds, Effects),
  342   operagent(Agent, Action, Conds, Effects),
  343   Operators).
  344
  345
  346precondition_matches_effect(Cond, Effect) :-
  347 % player_format('  Comparing cond ~w with effect ~w: ', [Cond, Effect]),
  348 Cond = Effect. %, player_format('match~n', []).
  349
  350%precondition_matches_effect(~ ~ Cond, Effect) :-
  351% precondition_matches_effect(Cond, Effect).
  352%precondition_matches_effect(Cond, ~ ~ Effect) :-
  353% precondition_matches_effect(Cond, Effect).
  354
  355precondition_matches_effects(Cond, Effects) :-
  356 member(E, Effects),
  357 precondition_matches_effect(Cond, E).
  358preconditions_match_effects([Cond|Tail], Effects) :-
  359 precondition_matches_effects(Cond, Effects),
  360 preconditions_match_effects(Tail, Effects).
  361
  362% plan(steps, orderings, bindings, links)
  363% step(id, operation)
  364new_plan(Self, CurrentState, GoalState, Plan) :-
  365 Plan = plan([step(start , oper(Self, true, [], CurrentState)),
  366    step(finish, oper(Self, true, GoalState, []))],
  367    [before(start, finish)],
  368    [],
  369    []).
  370
  371
  372% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  373% CODE FILE SECTION
  374:- nop(ensure_loaded('adv_util_ordering')).  375% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  376
  377isbefore(I, J, Orderings) :-
  378 member(before(I, J), Orderings).
  379%isbefore(I, K, Orderings) :-
  380% select(before(I, J), Orderings, Remaining),
  381% isbefore(J, K, Remaining).
  382
  383% These will fail to create inconsistent orderings.
  384%add_ordering(B, Orderings, Orderings) :-
  385% member(B, Orderings), !.
  386%add_ordering(before(I, K), Orderings, [before(I, K)|Orderings]) :-
  387% I \= K,
  388% \+ isbefore(K, I, Orderings),
  389% bugout3(' ADDED ~w to orderings.~n', [before(I, K)], planner).
  390%add_ordering(B, O, O) :-
  391% bugout3(' FAILED to add ~w to orderings.~n', [B], planner),
  392% fail.
  393
  394add_ordering(B, Orderings, Orderings) :-
  395 member(B, Orderings), !.
  396add_ordering(before(I, J), Order0, Order1) :-
  397 I \= J,
  398 \+ isbefore(J, I, Order0),
  399 add_ordering3(before(I, J), Order0, Order0, Order1).
  400add_ordering(B, Order0, Order0) :-
  401 once(pick_ordering(Order0, List)),
  402 bugout3(' FAILED add_ordering ~w to ~w~n', [B, List], planner),
  403 fail.
  404
  405% add_ordering3(NewOrder, ToCheck, OldOrderings, NewOrderings)
  406add_ordering3(before(I, J), [], OldOrderings, NewOrderings) :-
  407 union([before(I, J)], OldOrderings, NewOrderings).
  408add_ordering3(before(I, J), [before(J, K)|Rest], OldOrderings, NewOrderings) :-
  409 I \= K,
  410 union([before(J, K)], OldOrderings, Orderings1),
  411 add_ordering3(before(I, J), Rest, Orderings1, NewOrderings).
  412add_ordering3(before(I, J), [before(H, I)|Rest], OldOrderings, NewOrderings) :-
  413 H \= J,
  414 union([before(H, J)], OldOrderings, Orderings1),
  415 add_ordering3(before(I, J), Rest, Orderings1, NewOrderings).
  416add_ordering3(before(I, J), [before(H, K)|Rest], OldOrderings, NewOrderings) :-
  417 I \= K,
  418 H \= J,
  419 add_ordering3(before(I, J), Rest, OldOrderings, NewOrderings).
  420
  421% insert(E, L, L1) inserts E into L producing L1
  422% E is not added it is already there.
  423insert(X, [], [X]).
  424insert(A, [A|R], [A|R]).
  425insert(A, [B|R], [B|R1]) :-
  426 A \== B,
  427 insert(A, R, R1).
  428
  429add_orderings([], Orderings, Orderings).
  430add_orderings([B|Tail], Orderings, NewOrderings) :-
  431 add_ordering(B, Orderings, Orderings2),
  432 add_orderings(Tail, Orderings2, NewOrderings).
  433
  434del_ordering_node(I, [before(I)|Tail], Orderings) :-
  435 del_ordering_node(I, Tail, Orderings).
  436del_ordering_node(I, [before(_, I)|Tail], Orderings) :-
  437 del_ordering_node(I, Tail, Orderings).
  438del_ordering_node(I, [before(X, Y)|Tail], [before(X, Y)|Orderings]) :-
  439 X \= I,
  440 Y \= I,
  441 del_ordering_node(I, Tail, Orderings).
  442del_ordering_node(_I, [], []).
  443
  444ordering_nodes(Orderings, Nodes) :-
  445 setof(Node,
  446  Other^(isbefore(Node, Other, Orderings);isbefore(Other, Node, Orderings)),
  447  Nodes).
  448
  449pick_ordering(Orderings, List) :-
  450 ordering_nodes(Orderings, Nodes),
  451 pick_ordering(Orderings, Nodes, List).
  452
  453pick_ordering(Orderings, Nodes, [I|After]) :-
  454 select(I, Nodes, RemainingNodes),
  455 forall(member(J, RemainingNodes), \+ isbefore(J, I, Orderings) ),
  456 pick_ordering(Orderings, RemainingNodes, After).
  457pick_ordering(_Orderings, [], []).
  458
  459test_ordering :-
  460 bugout3('ORDERING TEST:~n', planner),
  461 Unordered =
  462 [ before(start, finish),
  463  before(start, x),
  464  before(start, y), before(y, finish),
  465  before(x, z),
  466  before(z, finish)
  467 ],
  468 once(add_orderings(
  469 Unordered,
  470 [],
  471 Orderings)),
  472 bugout3(' unordered was ~w~n', [Unordered], planner),
  473 bugout3(' ordering is ~w~n', [Orderings], planner),
  474 pick_ordering(Orderings, List),
  475 bugout3(' picked ~w~n', [List], planner),
  476 fail.
  477test_ordering :- bugout3(' END ORDERING TEST~n', planner).
  478
  479
  480% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  481% CODE FILE SECTION
  482:- nop(ensure_loaded('adv_planner_conds')).  483% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  484
  485
  486cond_is_achieved(step(J, _Oper), C, plan(Steps, Orderings, _)) :-
  487 member(step(I, oper(_Self, _, _, Effects)), Steps),
  488 precondition_matches_effects(C, Effects),
  489 isbefore(I, J, Orderings),
  490 bugout3('  Cond ~w of step ~w is achieved!~n', [C, J], planner).
  491cond_is_achieved(step(J, _Oper), C, plan(_Steps, _Orderings, _)) :-
  492 bugout3('  Cond ~w of step ~w is NOT achieved.~n', [C, J], planner),
  493 !, fail.
  494
  495% Are the preconditions of a given step achieved by the effects of other
  496% steps, or are already true?
  497step_is_achieved(step(_J, oper(_Self, _, [])), _Plan). % No conditions, OK.
  498step_is_achieved(step(J, oper(Self, _, [C|Tail])), plan(Steps, Orderings, _)) :-
  499 cond_is_achieved(step(J), C, plan(Steps, Orderings, _)),
  500 step_is_achieved(step(J, oper(Self, _, Tail)), plan(Steps, Orderings, _)).
  501
  502all_steps_are_achieved([Step|Tail], Plan) :-
  503 step_is_achieved(Step, Plan),
  504 all_steps_are_achieved(Tail, Plan).
  505all_steps_are_achieved([], _Plan).
  506
  507is_solution(plan(Steps, O, B, L)) :-
  508 all_steps_are_achieved(Steps, plan(Steps, O, B, L)).
  509
  510% Create a new step given an operator.
  511operator_as_step(oper(Self, Act, Cond, Effect), step(Id, oper(Self, Act, Cond, Effect))) :-
  512 Act =.. [Functor|_],
  513 atom_concat(Functor, '_step_', Prefix),
  514 gensym(Prefix, Id).
  515
  516% Create a list of new steps given a list of operators.
  517operators_as_steps([], []).
  518operators_as_steps([Oper | OpTail], [Step | StepTail]) :-
  519 copy_term(Oper, FreshOper), % Avoid instantiating operator database.
  520 operator_as_step(FreshOper, Step),
  521 operators_as_steps(OpTail, StepTail).
  522
  523cond_as_goal(ID, Cond, goal(ID, Cond)).
  524conds_as_goals(_, [], []).
  525conds_as_goals(ID, [C|R], [G|T]) :-
  526 cond_as_goal(ID, C, G),
  527 conds_as_goals(ID, R, T).
  528
  529cond_equates(Cond0, Cond1) :- Cond0 = Cond1.
  530cond_equates(h(X, Y, Z), h(X, Y, Z)).
  531cond_equates(~ ~ Cond0, Cond1) :- cond_equates(Cond0, Cond1).
  532cond_equates(Cond0, ~ ~ Cond1) :- cond_equates(Cond0, Cond1).
  533
  534cond_negates(~ Cond0, Cond1) :- cond_equates(Cond0, Cond1).
  535cond_negates(Cond0, ~ Cond1) :- cond_equates(Cond0, Cond1).
  536
  537% Protect 1 link from 1 condition
  538% protect(link_to_protect, threatening_step, threatening_cond, ...)
  539protect(causes(StepI, _Cond0, _StepJ), StepI, _Cond1, Order0, Order0) :-
  540 !. % Step does not threaten itself.
  541protect(causes(_StepI, _Cond0, StepJ), StepJ, _Cond1, Order0, Order0) :-
  542 !. % Step does not threaten itself.
  543%protect(causes(_StepI, Cond, _StepJ), _StepK, Cond, Order0, Order0) :-
  544% !. % Cond does not threaten itself.
  545protect(causes(_StepI, Cond0, _StepJ), _StepK, Cond1, Order0, Order0) :-
  546 \+ cond_negates(Cond0, Cond1),
  547 !.
  548protect(causes(StepI, Cond0, StepJ), StepK, _Cond1, Order0, Order0) :-
  549 bugout3(' THREAT: ~w <> causes(~w, ~w, ~w)~n',
  550   [StepK, StepI, Cond0, StepJ], planner),
  551 fail.
  552protect(causes(StepI, _Cond0, StepJ), StepK, _Cond1, Order0, Order1) :-
  553 % Protect by moving threatening step before or after this link.
  554 add_ordering(before(StepK, StepI), Order0, Order1),
  555 bugout3(' RESOLVED with ~w~n', [before(StepK, StepI)], planner)
  556 ;
  557 add_ordering(before(StepJ, StepK), Order0, Order1),
  558 bugout3(' RESOLVED with ~w~n', [before(StepJ, StepK)], planner).
  559protect(causes(StepI, Cond0, StepJ), StepK, _Cond1, Order0, Order0) :-
  560 bugout3(' FAILED to resolve THREAT ~w <> causes(~w, ~w, ~w)~n',
  561   [StepK, StepI, Cond0, StepJ], planner),
  562 once(pick_ordering(Order0, Serial)),
  563 bugout3(' ORDERING is ~w~n', [Serial], planner),
  564 fail.
  565
  566% Protect 1 link from 1 step's multiple effects
  567protect_link(_Link, _StepID, [], Order0, Order0).
  568protect_link(Link, StepID, [Cond|Effects], Order0, Order2):-
  569 protect(Link, StepID, Cond, Order0, Order1),
  570 protect_link(Link, StepID, Effects, Order1, Order2).
  571
  572% Protect all links from 1 step's multiple effects
  573% protect_links(links_to_protect, threatening_step, threatening_cond, ...)
  574protect_links([], _StepID, _Effects, Order0, Order0).
  575protect_links([Link|Tail], StepID, Effects, Order0, Order2) :-
  576 protect_link(Link, StepID, Effects, Order0, Order1),
  577 protect_links(Tail, StepID, Effects, Order1, Order2).
  578
  579% Protect 1 link from all steps' multiple effects
  580protect_link_all(_Link, [], Order0, Order0).
  581protect_link_all(Link, [step(StepID, oper(_Self, _, _, Effects))|Steps], Order0, Order2) :-
  582 protect_link(Link, StepID, Effects, Order0, Order1),
  583 protect_link_all(Link, Steps, Order1, Order2).
  584
  585%add_binding((X\=Y), Bindings0, Bindings) :-
  586% X \= Y, % if they can't bind, don't bother to add them.
  587add_binding((X\=Y), Bindings, [(X\=Y)|Bindings]) :-
  588 X \== Y, % if they're distinct,
  589 % \+ \+ X=Y, % but could bind
  590 bindings_valid(Bindings).
  591
  592bindings_valid([]).
  593bindings_valid([(X\=Y)|Bindings]) :-
  594 X \== Y,
  595 bindings_valid(Bindings).
  596%bindings_valid(B) :-
  597% bugout3(' BINDINGS are *INVALID*: ~w~n', [B], planner),
  598% fail.
  599
  600bindings_safe([]) :- bugout3(' BINDINGS are SAFE~n', planner).
  601bindings_safe([(X\=Y)|Bindings]) :-
  602 X \= Y,
  603 bindings_safe(Bindings).
  604%bindings_safe(B) :-
  605% bugout3(' BINDINGS are *UNSAFE*: ~w~n', [B], planner),
  606% fail.
  607
  608
  609% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  610% CODE FILE SECTION
  611:- nop(ensure_loaded('adv_planner_main')).  612% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  613
  614
  615choose_operator([goal(GoalID, GoalCond)|Goals0], Goals0,
  616     _Operators,
  617     plan(Steps, Order0, Bindings, OldLinks),
  618     plan(Steps, Order9, Bindings, NewLinks),
  619     Depth, Depth ) :-
  620 % Achieved by existing step?
  621 member(step(StepID, oper(_Self, _Action, _Preconds, Effects)), Steps),
  622 precondition_matches_effects(GoalCond, Effects),
  623 add_ordering(before(StepID, GoalID), Order0, Order1),
  624 % Need to protect new link from all existing steps
  625 protect_link_all(causes(StepID, GoalCond, GoalID), Steps, Order1, Order9),
  626 union([causes(StepID, GoalCond, GoalID)], OldLinks, NewLinks),
  627 bindings_valid(Bindings),
  628 bugout3(' EXISTING step ~w satisfies ~w~n', [StepID, GoalCond], planner).
  629choose_operator([goal(_GoalID, X \= Y)|Goals0], Goals0,
  630     _Operators,
  631     plan(Steps, Order, Bindings, Links),
  632     plan(Steps, Order, NewBindings, Links),
  633     Depth, Depth ) :-
  634 add_binding((X\=Y), Bindings, NewBindings),
  635 bugout3(' BINDING ADDED: ~w~n', [X\=Y], planner).
  636choose_operator([goal(GoalID, ~ GoalCond)|Goals0], Goals0,
  637     _Operators,
  638     plan(Steps, Order0, Bindings, OldLinks),
  639     plan(Steps, Order9, Bindings, NewLinks),
  640     Depth, Depth ) :-
  641 % Negative condition achieved by start step?
  642 memberchk(step(start, oper(_Self, _Action, _Preconds, Effects)), Steps),
  643 \+ precondition_matches_effects(GoalCond, Effects),
  644 add_ordering(before(start, GoalID), Order0, Order1),
  645 % Need to protect new link from all existing steps
  646 protect_link_all(causes(start, GoalCond, GoalID), Steps, Order1, Order9),
  647 union([causes(start, ~ GoalCond, GoalID)], OldLinks, NewLinks),
  648 bindings_valid(Bindings),
  649 bugout3(' START SATISFIES NOT ~w~n', [GoalCond], planner).
  650choose_operator([goal(GoalID, exists(GoalCond))|Goals0], Goals0,
  651     _Operators,
  652     plan(Steps, Order0, Bindings, OldLinks),
  653     plan(Steps, Order9, Bindings, NewLinks),
  654     Depth, Depth ) :-
  655 memberchk(step(start, oper(_Self, _Action, _Preconds, Effects)), Steps),
  656 ( in_model(h(_Prep, GoalCond, _Where), Effects);
  657 in_model(h(_Prep, _What, GoalCond), Effects)),
  658 add_ordering(before(start, GoalID), Order0, Order1),
  659 % Need to protect new link from all existing steps
  660 protect_link_all(causes(start, GoalCond, GoalID), Steps, Order1, Order9),
  661 union([causes(start, exists(GoalCond), GoalID)], OldLinks, NewLinks),
  662 bindings_valid(Bindings),
  663 bugout3(' START SATISFIES exists(~w)~n', [GoalCond], planner).
  664choose_operator([goal(GoalID, GoalCond)|Goals0], Goals2,
  665     Operators,
  666     plan(OldSteps, Order0, Bindings, OldLinks),
  667     plan(NewSteps, Order9, Bindings, NewLinks),
  668     Depth0, Depth ) :-
  669 % Condition achieved by new step?
  670 Depth0 > 0,
  671 Depth is Depth0 - 1,
  672 %operators_as_steps(Operators, FreshSteps),
  673 copy_term(Operators, FreshOperators),
  674 % Find a new operator.
  675 %member(step(StepID, oper(_Self, Action, Preconds, Effects)), FreshSteps),
  676 member(oper(Self, Action, Preconds, Effects), FreshOperators),
  677 precondition_matches_effects(GoalCond, Effects),
  678 operator_as_step(oper(Self, Action, Preconds, Effects),
  679     step(StepID, oper(Self, Action, Preconds, Effects)) ),
  680 % Add ordering constraints.
  681 add_orderings([before(start, StepID),
  682     before(StepID, GoalID),
  683     before(StepID, finish)],
  684    Order0, Order1),
  685 % Need to protect existing links from new step.
  686 protect_links(OldLinks, StepID, Effects, Order1, Order2),
  687 % Need to protect new link from all existing steps
  688 protect_link_all(causes(StepID, GoalCond, GoalID), OldSteps, Order2, Order9),
  689 % Add the step.
  690 append(OldSteps, [step(StepID, oper(Self, Action, Preconds, Effects))], NewSteps),
  691 % Add causal constraint.
  692 union([causes(StepID, GoalCond, GoalID)], OldLinks, NewLinks),
  693 % Add consequent goals.
  694 conds_as_goals(StepID, Preconds, NewGoals),
  695 append(Goals0, NewGoals, Goals2),
  696 bindings_valid(Bindings),
  697 bugout3(' ~w CREATED ~w to satisfy ~w~n',
  698   [Depth, StepID, GoalCond], autonomous),
  699 pprint(oper(Self, Action, Preconds, Effects), planner),
  700 once(pick_ordering(Order9, List)),
  701 bugout3(' Orderings are ~w~n', [List], planner).
  702choose_operator([goal(GoalID, GoalCond)|_G0], _G2, _Op, _P0, _P2, D, D) :-
  703 bugout3(' CHOOSE_OPERATOR FAILED on goal:~n goal(~w, ~w)~n',
  704   [GoalID, GoalCond], planner),
  705 !, fail.
  706choose_operator(G0, _G2, _Op, _P0, _P2, D, D) :-
  707 bugout3(' !!! CHOOSE_OPERATOR FAILED: G0 = ~w~n', [G0], planner), !, fail.
  708
  709planning_loop([], _Operators, plan(S, O, B, L), plan(S, O, B, L), _Depth, _TO ) :-
  710 bugout3('FOUND SOLUTION?~n', planner),
  711 bindings_safe(B).
  712planning_loop(Goals0, Operators, Plan0, Plan2, Depth0, Timeout) :-
  713 %Limit > 0,
  714 get_time(Now),
  715 (Now > Timeout -> throw(timeout(planner)); true),
  716 bugout3('GOALS ARE: ~w~n', [Goals0], planner),
  717 choose_operator(Goals0, Goals1, Operators, Plan0, Plan1, Depth0, Depth),
  718 %Limit2 is Limit - 1,
  719 planning_loop(Goals1, Operators, Plan1, Plan2, Depth, Timeout).
  720%planning_loop(_Goals0, _Operators, Plan0, Plan0, _Limit) :-
  721% Limit < 1,
  722% bugout3('Search limit reached!~n', planner),
  723% fail.
  724
  725serialize_plan(_Knower, _Agent, plan([], _Orderings, _B, _L), []) :- !.
  726
  727serialize_plan(Knower, Agent, plan(Steps, Orderings, B, L), Tail) :-
  728 select(step(_, oper(Agent, true, _)), Steps, RemainingSteps),
  729 !,
  730 serialize_plan(Knower, Agent, plan(RemainingSteps, Orderings, B, L), Tail).
  731
  732serialize_plan(Knower, Agent, plan(Steps, Orderings, B, L), [Action|Tail]) :-
  733 select(step(StepI, oper(Agent, Action, _)), Steps, RemainingSteps),
  734 \+ (member(step(StepJ, _Oper), RemainingSteps),
  735  isbefore(StepJ, StepI, Orderings)),
  736 serialize_plan(Knower, Agent, plan(RemainingSteps, Orderings, B, L), Tail).
  737
  738serialize_plan(Knower, Agent, plan(_Steps, Orderings, _B, _L)) :-
  739 bugout3('serialize_plan FAILED: Knower=~p, Agent=~p !~n',[Knower, Agent], planner),
  740 pick_ordering(Orderings, List),
  741 bugout3(' Orderings are ~w~n', [List], planner),
  742 fail.
  743
  744select_unsatisfied_conditions([], [], _Model) :- !.
  745select_unsatisfied_conditions([Cond|Tail], Unsatisfied, ModelData) :-
  746 precondition_matches_effects(Cond, ModelData),
  747 !,
  748 select_unsatisfied_conditions(Tail, Unsatisfied, ModelData).
  749select_unsatisfied_conditions([~ Cond|Tail], Unsatisfied, ModelData) :-
  750 \+ precondition_matches_effects(Cond, ModelData),
  751 !,
  752 select_unsatisfied_conditions(Tail, Unsatisfied, ModelData).
  753select_unsatisfied_conditions([Cond|Tail], [Cond|Unsatisfied], ModelData) :-
  754 !,
  755 select_unsatisfied_conditions(Tail, Unsatisfied, ModelData).
  756
  757
  758depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  759     Depth, Timeout) :-
  760 bugout3('PLANNING DEPTH is ~w~n', [Depth], autonomous),
  761 planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan, Depth, Timeout),
  762 !.
  763depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  764     Depth0, Timeout) :-
  765 Depth0 =< 7,
  766 Depth is Depth0 + 1,
  767 depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  768      Depth, Timeout).
  769
  770generate_plan(Knower, Agent, FullPlan, Mem0) :-
  771 initial_operators(Knower, Operators),
  772 bugout3('OPERATORS are:~n', planner), pprint(Operators, planner),
  773
  774 agent_thought_model(Agent, ModelData, Mem0),
  775
  776 %bugout3('CURRENT STATE is ~w~n', [Model0], planner),
  777 thought(goals(Goals), Mem0),
  778 new_plan(Agent, ModelData, Goals, SeedPlan),
  779 bugout3('SEED PLAN is:~n', planner), pprint(SeedPlan, planner),
  780 !,
  781 %planning_loop(Operators, SeedPlan, FullPlan),
  782 conds_as_goals(finish, Goals, PlannerGoals),
  783 get_time(Now),
  784 Timeout is Now + 60, % seconds
  785 catch(
  786 depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  787      1, Timeout),
  788 timeout(planner),
  789 (bugout3('PLANNER TIMEOUT~n', autonomous), fail)
  790 ),
  791 bugout3('FULL PLAN is:~n', planner), pprint(FullPlan, planner).
  792
  793% ----
  794
  795
  796path2dir1(Here, There, go_dir(_Self, _Walk, Dir), ModelData):- 
  797 in_model(h(exit(Dir), Here, There), ModelData).
  798path2dir1(Here, There, goto_obj(_Self, _Walk, There), ModelData) :-
  799 in_model(h(descended, Here, There), ModelData).
  800
  801path2directions([Here, There], [GOTO], ModelData):-
  802  path2dir1(Here, There, GOTO, ModelData).
  803path2directions([Here, Next|Trail], [GOTO|Tail], ModelData) :-
  804 path2dir1(Here, Next, GOTO, ModelData),
  805 path2directions([Next|Trail], Tail, ModelData).
  806
  807
  808find_path1([First|_Rest], Dest, First, _ModelData) :-
  809 First = [Dest|_].
  810find_path1([[Last|Trail]|Others], Dest, Route, ModelData) :-
  811 findall([Z, Last|Trail],
  812   (in_model(h(_Prep, Last, Z), ModelData), \+ member(Z, Trail)),
  813   List),
  814 append(Others, List, NewRoutes),
  815 find_path1(NewRoutes, Dest, Route, ModelData).
  816find_path(Start, Dest, Route, ModelData) :-
  817 find_path1([[Start]], Dest, R, ModelData),
  818 reverse(R, RR),
  819 path2directions(RR, Route, ModelData)