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
   20% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   21%  CODE FILE SECTION
   22:- nop(ensure_loaded('adv_plan_opers')).   23% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   24:- op(900, fy, '~').   25
   26precond_matches_effect(Cond, Cond).
   27
   28precond_matches_effects(path(Spatial, Here, There), StartEffects) :-
   29  find_path(Spatial, Here, There, _Route, StartEffects).
   30precond_matches_effects(exists(Spatial, Object), StartEffects) :-
   31  in_model(h(Spatial, _, Object, _, _), StartEffects)
   32  ;
   33  in_model(h(Spatial, _, _, Object, _), StartEffects).
   34precond_matches_effects(Cond, Effects) :-
   35  member(E, Effects),
   36  precond_matches_effect(Cond, E).
   37
   38% oper(Action, Preconds, Effects)
   39oper(goto(Spatial, (*), ExitName),
   40     [ Here \= $self, There \= $self,
   41       h(Spatial, in, $self, Here, _),
   42       h(Spatial, exit(ExitName), Here, There, _)], % path(Spatial, Here, There)
   43     [ h(Spatial, in, $self, There, _),
   44       ~ h(Spatial, in, $self, Here, _)]).
   45oper(take(Spatial, Thing), % from same room
   46     [ Thing \= $self, exists(Spatial, Thing),
   47       There \= $self,
   48       h(Spatial, At, Thing, There, _),
   49       h(Spatial, At, $self, There, _)],
   50     [ h(Spatial, held_by, Thing, $self, _),
   51       ~ h(Spatial, At, Thing, There, _)]).
   52oper(take(Spatial, Thing), % from something else
   53     [ Thing \= $self, exists(Spatial, Thing),
   54       h(Spatial, How, Thing, What, _),
   55       h(Spatial, At, What, There, _),
   56       h(Spatial, At, $self, There, _) ],
   57     [ h(Spatial, held_by, Thing, $self, _),
   58       ~ h(Spatial, How, Thing, There, _)]):- extra.
   59oper(drop(Spatial, Thing),
   60     [ Thing \= $self, exists(Spatial, Thing),
   61       h(Spatial, held_by, Thing, $self, _)],
   62     [ ~ h(Spatial, held_by, Thing, $self, _)] ).
   63oper(emote(Spatial, say, Player, [please, give, me, the, Thing]),
   64     [ Thing \= $self, exists(Spatial, Thing),
   65       h(Spatial, held_by, Thing, Player, _),
   66       h(Spatial, How, Player, Where, _),
   67       h(Spatial, How, $self, Where, _) ],
   68     [ h(Spatial, held_by, Thing, $self, _),
   69       ~ h(Spatial, held_by, Thing, Player, _)] ):- extra.
   70oper(give(Spatial, Thing, Recipient),
   71     [ Thing \= $self, Recipient \= $self,
   72       exists(Spatial, Thing), exists(Spatial, Recipient),
   73       Where \= $self,
   74       h(Spatial, held_by, Thing, $self, _),
   75       h(Spatial, in, Recipient, Where, _), exists(Spatial, Where),
   76       h(Spatial, in, $self, Where, _)],
   77     [ h(Spatial, held_by, Thing, Recipient, _),
   78       ~ h(Spatial, held_by, Thing, $self, _)
   79     ] ).
   80oper(put(Spatial, Thing, Relation, What), % in something else
   81     [ Thing \= $self, What \= $self, Where \= $self,
   82       Thing \= What, What \= Where, Thing \= Where,
   83       h(Spatial, held_by, Thing, $self, _), exists(Spatial, Thing),
   84       h(Spatial, in, What, Where, _), exists(Spatial, What), exists(Spatial, Where),
   85       h(Spatial, in, $self, Where, _)],
   86     [ h(Spatial, Relation, Thing, What, _),
   87       ~ h(Spatial, held_by, Thing, $self, _)] ).
   88oper(put(Spatial, Thing, Relation, Where), % in room
   89     [ Thing \= $self, exists(Spatial, Thing),
   90       h(Spatial, held_by, Thing, $self, _),
   91       h(Spatial, Relation, $self, Where, _)],
   92     [ h(Spatial, Relation, Thing, Where, _),
   93       ~ h(Spatial, held_by, Thing, $self, _)] ) :- extra.
   94
   95% Return an operator after substituting Agent for $self.
   96operagent(Agent, Action, Conds, Effects) :-
   97  oper(Action, Conds0, Effects0),
   98  subst(equivalent, $self, Agent, Conds0, Conds),
   99  subst(equivalent, $self, Agent, Effects0, Effects).
  100
  101% Return the initial list of operators.
  102initial_operators(Agent, Operators) :-
  103  findall(oper(Action, Conds, Effects),
  104          operagent(Agent, Action, Conds, Effects),
  105          Operators).
  106
  107precondition_matches_effect(Cond, Effect) :-
  108  % player_format('      Comparing cond ~w with effect ~w: ', [Cond, Effect]),
  109  Cond = Effect. %, player_format('match~n', []).
  110%precondition_matches_effect(~ ~ Cond, Effect) :-
  111%  precondition_matches_effect(Cond, Effect).
  112%precondition_matches_effect(Cond, ~ ~ Effect) :-
  113%  precondition_matches_effect(Cond, Effect).
  114precondition_matches_effects(Cond, Effects) :-
  115  member(E, Effects),
  116  precondition_matches_effect(Cond, E).
  117preconditions_match_effects([Cond|Tail], Effects) :-
  118  precondition_matches_effects(Cond, Effects),
  119  preconditions_match_effects(Tail, Effects).
  120
  121% plan(steps, orderings, bindings, links)
  122% step(id, operation)
  123new_plan(_Agent, CurrentState, GoalState, Plan) :-
  124  Plan = plan([step(start , oper(true, [], CurrentState)),
  125               step(finish, oper(true, GoalState, []))],
  126              [before(start, finish)],
  127              [],
  128              []).
  129
  130
  131% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  132%  CODE FILE SECTION
  133:- nop(ensure_loaded('adv_util_ordering')).  134% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  135
  136isbefore(I, J, Orderings) :-
  137  member(before(I, J), Orderings).
  138%isbefore(I, K, Orderings) :-
  139%  select(before(I, J), Orderings, Remaining),
  140%  isbefore(J, K, Remaining).
  141
  142% These will fail to create inconsistent orderings.
  143%add_ordering(B, Orderings, Orderings) :-
  144%  member(B, Orderings), !.
  145%add_ordering(before(I, K), Orderings, [before(I, K)|Orderings]) :-
  146%  I \= K,
  147%  \+ isbefore(K, I, Orderings),
  148%  bugout('    ADDED ~w to orderings.~n', [before(I, K)], planner).
  149%add_ordering(B, O, O) :-
  150%  bugout('    FAILED to add ~w to orderings.~n', [B], planner),
  151%  fail.
  152
  153add_ordering(B, Orderings, Orderings) :-
  154  member(B, Orderings), !.
  155add_ordering(before(I, J), Order0, Order1) :-
  156  I \= J,
  157  \+ isbefore(J, I, Order0),
  158  add_ordering3(before(I, J), Order0, Order0, Order1).
  159add_ordering(B, Order0, Order0) :-
  160  once(pick_ordering(Order0, List)),
  161  bugout('  FAILED add_ordering ~w to ~w~n', [B, List], planner),
  162  fail.
  163
  164% add_ordering3(NewOrder, ToCheck, OldOrderings, NewOrderings)
  165add_ordering3(before(I, J), [], OldOrderings, NewOrderings) :-
  166  union([before(I, J)], OldOrderings, NewOrderings).
  167add_ordering3(before(I, J), [before(J, K)|Rest], OldOrderings, NewOrderings) :-
  168  I \= K,
  169  union([before(J, K)], OldOrderings, Orderings1),
  170  add_ordering3(before(I, J), Rest, Orderings1, NewOrderings).
  171add_ordering3(before(I, J), [before(H, I)|Rest], OldOrderings, NewOrderings) :-
  172  H \= J,
  173  union([before(H, J)], OldOrderings, Orderings1),
  174  add_ordering3(before(I, J), Rest, Orderings1, NewOrderings).
  175add_ordering3(before(I, J), [before(H, K)|Rest], OldOrderings, NewOrderings) :-
  176  I \= K,
  177  H \= J,
  178  add_ordering3(before(I, J), Rest, OldOrderings, NewOrderings).
  179
  180% insert(E, L, L1) inserts E into L producing L1
  181% E is not added it is already there.
  182insert(X, [], [X]).
  183insert(A, [A|R], [A|R]).
  184insert(A, [B|R], [B|R1]) :-
  185   A \== B,
  186   insert(A, R, R1).
  187
  188add_orderings([], Orderings, Orderings).
  189add_orderings([B|Tail], Orderings, NewOrderings) :-
  190  add_ordering(B, Orderings, Orderings2),
  191  add_orderings(Tail, Orderings2, NewOrderings).
  192
  193del_ordering_node(I, [before(I, _)|Tail], Orderings) :-
  194  del_ordering_node(I, Tail, Orderings).
  195del_ordering_node(I, [before(_, I)|Tail], Orderings) :-
  196  del_ordering_node(I, Tail, Orderings).
  197del_ordering_node(I, [before(X, Y)|Tail], [before(X, Y)|Orderings]) :-
  198  X \= I,
  199  Y \= I,
  200  del_ordering_node(I, Tail, Orderings).
  201del_ordering_node(_I, [], []).
  202
  203ordering_nodes(Orderings, Nodes) :-
  204  setof(Node,
  205        Other^(isbefore(Node, Other, Orderings);isbefore(Other, Node, Orderings)),
  206        Nodes).
  207
  208pick_ordering(Orderings, List) :-
  209  ordering_nodes(Orderings, Nodes),
  210  pick_ordering(Orderings, Nodes, List).
  211
  212pick_ordering(Orderings, Nodes, [I|After]) :-
  213  select(I, Nodes, RemainingNodes),
  214  forall(member(J, RemainingNodes), \+ isbefore(J, I, Orderings) ),
  215  pick_ordering(Orderings, RemainingNodes, After).
  216pick_ordering(_Orderings, [], []).
  217
  218test_ordering :-
  219  bugout('ORDERING TEST:~n', planner),
  220  Unordered =
  221   [ before(start, finish),
  222     before(start, x),
  223     before(start, y), before(y, finish),
  224     before(x, z),
  225     before(z, finish)
  226   ],
  227  once(add_orderings(
  228   Unordered,
  229   [],
  230   Orderings)),
  231  bugout('  unordered was ~w~n', [Unordered], planner),
  232  bugout('  ordering is ~w~n', [Orderings], planner),
  233  pick_ordering(Orderings, List),
  234  bugout('  picked ~w~n', [List], planner),
  235  fail.
  236test_ordering :- bugout('  END ORDERING TEST~n', planner).
  237
  238
  239% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  240%  CODE FILE SECTION
  241:- nop(ensure_loaded('adv_planner_conds')).  242% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  243
  244
  245cond_is_achieved(step(J, _Oper), C, plan(Steps, Orderings, _, _)) :-
  246  member(step(I, oper(_, _, Effects)), Steps),
  247  precondition_matches_effects(C, Effects),
  248  isbefore(I, J, Orderings),
  249  bugout('      Cond ~w of step ~w is achieved!~n', [C, J], planner).
  250cond_is_achieved(step(J, _Oper), C, plan(_Steps, _Orderings, _, _)) :-
  251  bugout('      Cond ~w of step ~w is NOT achieved.~n', [C, J], planner),
  252  !, fail.
  253
  254% Are the preconditions of a given step achieved by the effects of other
  255% steps, or are already true?
  256step_is_achieved(step(_J, oper(_, [], _)), _Plan).  % No conditions, OK.
  257step_is_achieved(step(J, oper(_, [C|Tail], _)), plan(Steps, Orderings, _, _)) :-
  258  cond_is_achieved(step(J, _), C, plan(Steps, Orderings, _, _)),
  259  step_is_achieved(step(J, oper(_, Tail, _)), plan(Steps, Orderings, _, _)).
  260
  261all_steps_are_achieved([Step|Tail], Plan) :-
  262  step_is_achieved(Step, Plan),
  263  all_steps_are_achieved(Tail, Plan).
  264all_steps_are_achieved([], _Plan).
  265
  266is_solution(plan(Steps, O, B, L)) :-
  267  all_steps_are_achieved(Steps, plan(Steps, O, B, L)).
  268
  269% Create a new step given an operator.
  270operator_as_step(oper(Act, Cond, Effect), step(Id, oper(Act, Cond, Effect))) :-
  271  Act =.. [Functor|_],
  272  atom_concat(Functor, '_step_', Prefix),
  273  gensym(Prefix, Id).
  274
  275% Create a list of new steps given a list of operators.
  276operators_as_steps([], []).
  277operators_as_steps([Oper | OpTail], [Step | StepTail]) :-
  278  copy_term(Oper, FreshOper), % Avoid instantiating operator database.
  279  operator_as_step(FreshOper, Step),
  280  operators_as_steps(OpTail, StepTail).
  281
  282cond_as_goal(ID, Cond, goal(ID, Cond)).
  283conds_as_goals(_, [], []).
  284conds_as_goals(ID, [C|R], [G|T]) :-
  285  cond_as_goal(ID, C, G),
  286  conds_as_goals(ID, R, T).
  287
  288cond_equates(Cond0, Cond1) :- Cond0 = Cond1.
  289cond_equates(h(Spatial, X, Y, Z, _), h(Spatial, X, Y, Z, _)).
  290cond_equates(~ ~ Cond0, Cond1) :- cond_equates(Cond0, Cond1).
  291cond_equates(Cond0, ~ ~ Cond1) :- cond_equates(Cond0, Cond1).
  292
  293cond_negates(~ Cond0, Cond1) :- cond_equates(Cond0, Cond1).
  294cond_negates(Cond0, ~ Cond1) :- cond_equates(Cond0, Cond1).
  295
  296% Protect 1 link from 1 condition
  297% protect(link_to_protect, threatening_step, threatening_cond, ...)
  298protect(causes(StepI, _Cond0, _StepJ), StepI, _Cond1, Order0, Order0) :-
  299  !. % Step does not threaten itself.
  300protect(causes(_StepI, _Cond0, StepJ), StepJ, _Cond1, Order0, Order0) :-
  301  !. % Step does not threaten itself.
  302%protect(causes(_StepI, Cond, _StepJ), _StepK, Cond, Order0, Order0) :-
  303%  !. % Cond does not threaten itself.
  304protect(causes(_StepI, Cond0, _StepJ), _StepK, Cond1, Order0, Order0) :-
  305  \+ cond_negates(Cond0, Cond1),
  306  !.
  307protect(causes(StepI, Cond0, StepJ), StepK, _Cond1, Order0, Order0) :-
  308  bugout('  THREAT: ~w <> causes(~w, ~w, ~w)~n',
  309         [StepK, StepI, Cond0, StepJ], planner),
  310  fail.
  311protect(causes(StepI, _Cond0, StepJ), StepK, _Cond1, Order0, Order1) :-
  312  % Protect by moving threatening step before or after this link.
  313  add_ordering(before(StepK, StepI), Order0, Order1),
  314  bugout('    RESOLVED with ~w~n', [before(StepK, StepI)], planner)
  315  ;
  316  add_ordering(before(StepJ, StepK), Order0, Order1),
  317  bugout('    RESOLVED with ~w~n', [before(StepJ, StepK)], planner).
  318protect(causes(StepI, Cond0, StepJ), StepK, _Cond1, Order0, Order0) :-
  319  bugout('  FAILED to resolve THREAT ~w <> causes(~w, ~w, ~w)~n',
  320         [StepK, StepI, Cond0, StepJ], planner),
  321  once(pick_ordering(Order0, Serial)),
  322  bugout('    ORDERING is ~w~n', [Serial], planner),
  323  fail.
  324
  325% Protect 1 link from 1 step's multiple effects
  326protect_link(_Link, _StepID, [], Order0, Order0).
  327protect_link(Link, StepID, [Cond|Effects], Order0, Order2):-
  328  protect(Link, StepID, Cond, Order0, Order1),
  329  protect_link(Link, StepID, Effects, Order1, Order2).
  330
  331% Protect all links from 1 step's multiple effects
  332% protect_links(links_to_protect, threatening_step, threatening_cond, ...)
  333protect_links([], _StepID, _Effects, Order0, Order0).
  334protect_links([Link|Tail], StepID, Effects, Order0, Order2) :-
  335  protect_link(Link, StepID, Effects, Order0, Order1),
  336  protect_links(Tail, StepID, Effects, Order1, Order2).
  337
  338% Protect 1 link from all steps' multiple effects
  339protect_link_all(_Link, [], Order0, Order0).
  340protect_link_all(Link, [step(StepID, oper(_, _, Effects))|Steps], Order0, Order2) :-
  341  protect_link(Link, StepID, Effects, Order0, Order1),
  342  protect_link_all(Link, Steps, Order1, Order2).
  343
  344%add_binding((X\=Y), Bindings0, Bindings) :-
  345%  X \= Y, % if they can't bind, don't bother to add them.
  346add_binding((X\=Y), Bindings, [(X\=Y)|Bindings]) :-
  347  X \== Y, % if they're distinct,
  348  % \+ \+ X=Y, % but could bind
  349  bindings_valid(Bindings).
  350
  351bindings_valid([]).
  352bindings_valid([(X\=Y)|Bindings]) :-
  353  X \== Y,
  354  bindings_valid(Bindings).
  355%bindings_valid(B) :-
  356%  bugout('  BINDINGS are *INVALID*: ~w~n', [B], planner),
  357%  fail.
  358
  359bindings_safe([]) :- bugout('  BINDINGS are SAFE~n', planner).
  360bindings_safe([(X\=Y)|Bindings]) :-
  361  X \= Y,
  362  bindings_safe(Bindings).
  363%bindings_safe(B) :-
  364%  bugout('  BINDINGS are *UNSAFE*: ~w~n', [B], planner),
  365%  fail.
  366
  367
  368% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  369%  CODE FILE SECTION
  370:- nop(ensure_loaded('adv_planner_main')).  371% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  372
  373
  374choose_operator([goal(GoalID, GoalCond)|Goals0], Goals0,
  375                 _Operators,
  376                 plan(Steps, Order0, Bindings, OldLinks),
  377                 plan(Steps, Order9, Bindings, NewLinks),
  378                 Depth, Depth ) :-
  379  % Achieved by existing step?
  380  member(step(StepID, oper(_Action, _Preconds, Effects)), Steps),
  381  precondition_matches_effects(GoalCond, Effects),
  382  add_ordering(before(StepID, GoalID), Order0, Order1),
  383  % Need to protect new link from all existing steps
  384  protect_link_all(causes(StepID, GoalCond, GoalID), Steps, Order1, Order9),
  385  union([causes(StepID, GoalCond, GoalID)], OldLinks, NewLinks),
  386  bindings_valid(Bindings),
  387  bugout('  EXISTING step ~w satisfies ~w~n', [StepID, GoalCond], planner).
  388choose_operator([goal(_GoalID, X \= Y)|Goals0], Goals0,
  389                 _Operators,
  390                 plan(Steps, Order, Bindings, Links),
  391                 plan(Steps, Order, NewBindings, Links),
  392                 Depth, Depth ) :-
  393  add_binding((X\=Y), Bindings, NewBindings),
  394  bugout('  BINDING ADDED: ~w~n', [X\=Y], planner).
  395choose_operator([goal(GoalID, ~ GoalCond)|Goals0], Goals0,
  396                 _Operators,
  397                 plan(Steps, Order0, Bindings, OldLinks),
  398                 plan(Steps, Order9, Bindings, NewLinks),
  399                 Depth, Depth ) :-
  400  % Negative condition achieved by start step?
  401  memberchk(step(start, oper(_Action, _Preconds, Effects)), Steps),
  402  \+ precondition_matches_effects(GoalCond, Effects),
  403  add_ordering(before(start, GoalID), Order0, Order1),
  404  % Need to protect new link from all existing steps
  405  protect_link_all(causes(start, GoalCond, GoalID), Steps, Order1, Order9),
  406  union([causes(start, ~ GoalCond, GoalID)], OldLinks, NewLinks),
  407  bindings_valid(Bindings),
  408  bugout('  START SATISFIES NOT ~w~n', [GoalCond], planner).
  409choose_operator([goal(GoalID, exists(Spatial, GoalCond))|Goals0], Goals0,
  410                 _Operators,
  411                 plan(Steps, Order0, Bindings, OldLinks),
  412                 plan(Steps, Order9, Bindings, NewLinks),
  413                 Depth, Depth ) :-
  414  memberchk(step(start, oper(_Action, _Preconds, Effects)), Steps),
  415  ( in_model(h(Spatial, _How, GoalCond, _Where, _), Effects);
  416    in_model(h(Spatial, _How, _What, GoalCond, _), Effects)),
  417  add_ordering(before(start, GoalID), Order0, Order1),
  418  % Need to protect new link from all existing steps
  419  protect_link_all(causes(start, GoalCond, GoalID), Steps, Order1, Order9),
  420  union([causes(start, exists(Spatial, GoalCond), GoalID)], OldLinks, NewLinks),
  421  bindings_valid(Bindings),
  422  bugout('  START SATISFIES exists(Spatial, ~w)~n', [GoalCond], planner).
  423choose_operator([goal(GoalID, GoalCond)|Goals0], Goals2,
  424                 Operators,
  425                 plan(OldSteps, Order0, Bindings, OldLinks),
  426                 plan(NewSteps, Order9, Bindings, NewLinks),
  427                 Depth0, Depth ) :-
  428  % Condition achieved by new step?
  429  Depth0 > 0,
  430  Depth is Depth0 - 1,
  431  %operators_as_steps(Operators, FreshSteps),
  432  copy_term(Operators, FreshOperators),
  433  % Find a new operator.
  434  %member(step(StepID, oper(Action, Preconds, Effects)), FreshSteps),
  435  member(oper(Action, Preconds, Effects), FreshOperators),
  436  precondition_matches_effects(GoalCond, Effects),
  437  operator_as_step(oper(Action, Preconds, Effects),
  438                   step(StepID, oper(Action, Preconds, Effects)) ),
  439  % Add ordering constraints.
  440  add_orderings([before(start, StepID),
  441                 before(StepID, GoalID),
  442                 before(StepID, finish)],
  443                Order0, Order1),
  444  % Need to protect existing links from new step.
  445  protect_links(OldLinks, StepID, Effects, Order1, Order2),
  446  % Need to protect new link from all existing steps
  447  protect_link_all(causes(StepID, GoalCond, GoalID), OldSteps, Order2, Order9),
  448  % Add the step.
  449  append(OldSteps, [step(StepID, oper(Action, Preconds, Effects))], NewSteps),
  450  % Add causal constraint.
  451  union([causes(StepID, GoalCond, GoalID)], OldLinks, NewLinks),
  452  % Add consequent goals.
  453  conds_as_goals(StepID, Preconds, NewGoals),
  454  append(Goals0, NewGoals, Goals2),
  455  bindings_valid(Bindings),
  456  bugout('  ~w CREATED ~w to satisfy ~w~n',
  457         [Depth, StepID, GoalCond], autonomous),
  458  pprint(oper(Action, Preconds, Effects), planner),
  459  once(pick_ordering(Order9, List)),
  460  bugout('    Orderings are ~w~n', [List], planner).
  461choose_operator([goal(GoalID, GoalCond)|_G0], _G2, _Op, _P0, _P2, D, D) :-
  462  bugout('  CHOOSE_OPERATOR FAILED on goal:~n    goal(~w, ~w)~n',
  463         [GoalID, GoalCond], planner),
  464  !, fail.
  465choose_operator(G0, _G2, _Op, _P0, _P2, D, D) :-
  466  bugout('  !!! CHOOSE_OPERATOR FAILED: G0 = ~w~n', [G0], planner), !, fail.
  467
  468planning_loop([], _Operators, plan(S, O, B, L), plan(S, O, B, L), _Depth, _TO ) :-
  469  bugout('FOUND SOLUTION?~n', planner),
  470  bindings_safe(B).
  471planning_loop(Goals0, Operators, Plan0, Plan2, Depth0, Timeout) :-
  472  %Limit > 0,
  473  get_time(Now),
  474  (Now > Timeout -> throw(timeout(planner)); true),
  475  bugout('GOALS ARE: ~w~n', [Goals0], planner),
  476  choose_operator(Goals0, Goals1, Operators, Plan0, Plan1, Depth0, Depth),
  477  %Limit2 is Limit - 1,
  478  planning_loop(Goals1, Operators, Plan1, Plan2, Depth, Timeout).
  479%planning_loop(_Goals0, _Operators, Plan0, Plan0, _Limit) :-
  480%  Limit < 1,
  481%  bugout('Search limit reached!~n', planner),
  482%  fail.
  483
  484serialize_plan(plan([], _Orderings, _B, _L), []) :- !.
  485
  486serialize_plan(plan(Steps, Orderings, B, L), Tail) :-
  487  select(step(_, oper(true, _, _)), Steps, RemainingSteps),
  488  !,
  489  serialize_plan(plan(RemainingSteps, Orderings, B, L), Tail).
  490
  491serialize_plan(plan(Steps, Orderings, B, L), [Action|Tail]) :-
  492  select(step(StepI, oper(Action, _, _)), Steps, RemainingSteps),
  493  \+ (member(step(StepJ, _Oper), RemainingSteps),
  494      isbefore(StepJ, StepI, Orderings)),
  495  serialize_plan(plan(RemainingSteps, Orderings, B, L), Tail).
  496
  497serialize_plan(plan(_Steps, Orderings, _B, _L), _) :-
  498  bugout('serialize_plan FAILED!~n', planner),
  499  pick_ordering(Orderings, List),
  500  bugout('  Orderings are ~w~n', [List], planner),
  501  fail.
  502
  503select_unsatisfied_conditions([], [], _Model) :- !.
  504select_unsatisfied_conditions([Cond|Tail], Unsatisfied, ModelData) :-
  505  precondition_matches_effects(Cond, ModelData),
  506  !,
  507  select_unsatisfied_conditions(Tail, Unsatisfied, ModelData).
  508select_unsatisfied_conditions([~ Cond|Tail], Unsatisfied, ModelData) :-
  509  \+ precondition_matches_effects(Cond, ModelData),
  510  !,
  511  select_unsatisfied_conditions(Tail, Unsatisfied, ModelData).
  512select_unsatisfied_conditions([Cond|Tail], [Cond|Unsatisfied], ModelData) :-
  513  !,
  514  select_unsatisfied_conditions(Tail, Unsatisfied, ModelData).
  515
  516depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  517                    Depth, Timeout) :-
  518  bugout('PLANNING DEPTH is ~w~n', [Depth], autonomous),
  519  planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan, Depth, Timeout),
  520  !.
  521depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  522                    Depth0, Timeout) :-
  523  Depth0 =< 7,
  524  Depth is Depth0 + 1,
  525  depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  526                      Depth, Timeout).
  527
  528generate_plan(FullPlan, Mem0) :-
  529  equals_efffectly(model, Spatial, _),
  530  thought(inst(Agent), Mem0),
  531  initial_operators(Agent, Operators),
  532  bugout('OPERATORS are:~n', planner), pprint(Operators, planner),
  533  thought_model(Spatial, ModelData, Mem0),
  534  %bugout('CURRENT STATE is ~w~n', [Model0], planner),
  535  thought(goals(Goals), Mem0),
  536  new_plan(Agent, ModelData, Goals, SeedPlan),
  537  bugout('SEED PLAN is:~n', planner), pprint(SeedPlan, planner),
  538  !,
  539  %planning_loop(Operators, SeedPlan, FullPlan),
  540  conds_as_goals(finish, Goals, PlannerGoals),
  541  get_time(Now),
  542  Timeout is Now + 60, % seconds
  543  catch(
  544    depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
  545                        1, Timeout),
  546    timeout(planner),
  547    (bugout('PLANNER TIMEOUT~n', autonomous), fail)
  548  ),
  549  bugout('FULL PLAN is:~n', planner), pprint(FullPlan, planner).
  550
  551% ----
  552
  553
  554path2directions([Here, There], [goto(Spatial, (*), ExitName)], ModelData) :-
  555  in_model(h(Spatial, exit(ExitName), Here, There, _), ModelData).
  556path2directions([Here, There], [goto(Spatial, in, There)], ModelData) :-
  557  in_model(h(Spatial, descended, Here, There, _), ModelData).
  558path2directions([Here, Next|Trail], [goto(Spatial, (*), ExitName)|Tail], ModelData) :-
  559  in_model(h(Spatial, exit(ExitName), Here, Next, _), ModelData),
  560  path2directions([Next|Trail], Tail, ModelData).
  561path2directions([Here, Next|Trail], [goto(Spatial, in, Next)|Tail], ModelData) :-
  562  in_model(h(Spatial, descended, Here, Next, _), ModelData),
  563  path2directions([Next|Trail], Tail, ModelData).
  564
  565find_path1(_Spatial, [First|_Rest], Dest, First, _ModelData) :-
  566  First = [Dest|_].
  567find_path1(Spatial, [[Last|Trail]|Others], Dest, Route, ModelData) :-
  568  findall([Z, Last|Trail],
  569          (in_model(h(Spatial, _How, Last, Z, _), ModelData), \+ member(Z, Trail)),
  570          List),
  571  append(Others, List, NewRoutes),
  572  find_path1(Spatial, NewRoutes, Dest, Route, ModelData).
  573find_path(Spatial, Start, Dest, Route, ModelData) :-
  574  find_path1(Spatial, [[Start]], Dest, R, ModelData),
  575  reverse(R, RR),
  576  path2directions(RR, Route, ModelData)