1/*
    2:- lib(fd).
    3:- lib(chr).
    4:- chr2pl(fluent), [fluent].
    5:- local plus/3.
    6
    7*/
    8:- use_module(library('clp/clpfd')).    9:- use_module(library('chr/chr_runtime')).   10:- use_module(library(chr)).   11:- use_module(library(quintus)).   12% :- use_module(library(sicstus)).
   13:- ensure_loaded('fluent_swi.chr').   14% :- local plus/3.
   15
   16
   17
   18or_holds(V, [F|Z]) <=> or_holds(V, [], [F|Z]).
   19
   20or_holds([G|V],W,[F|Z]) <=> true | ( G==F -> true ;
   21                            G\=F -> or_holds(V,[G|W],[F|Z]) ;
   22                            G=..[_|ArgX], F=..[_|ArgY],
   23                            or_holds(V,[eq(ArgX,ArgY),G|W],[F|Z])).
   24
   25
   26
   27/*
   28Examples
   29
   30   Success:
   31   fluent_instance(atom,X).
   32   fluent_instance(f(a,b),X).
   33   fluent_instance(f(a,b),f(X,Y)).
   34   fluent_instance(f(a,X),f(Y,X)).
   35   fluent_instance(f(a,X),f(X,Y)).
   36   fluent_instance(f(X,Y),f(Y,X)).
   37   fluent_instance([a,b,c],[A,B,C]).
   38   fluent_instance([a,f(1,b,X),Y|Z],T).
   39   X::1..5, fluent_instance(3,X).
   40   X::2..4, Y::1..5, fluent_instance(X,Y).
   41
   42   Fail:
   43   fluent_instance(f(a,b),f(X,X)).
   44   fluent_instance(X,a).
   45   X::2..4, Y::1..5, fluent_instance(Y,X).
   46*/
   47
   48% fluent_instance(X,Y):-!,subsumes_term(xyz(X),xyz(Y)).
   49fluent_instance(X,Y):-not(not((X=@=Y,contains_term(xyz(X),xyz(Y))))).
   50
   51
   52holds(F, [F|_]).
   53holds(F, Z) :- nonvar(Z), Z=[F1|Z1], \+ F==F1, holds(F, Z1).
   54
   55holds(F, [F|Z], Z).
   56holds(F, Z, [F1|Zp]) :- nonvar(Z), Z=[F1|Z1], \+ F==F1, holds(F, Z1, Zp).
   57
   58minus(Z, [], Z).
   59minus(Z, [F|Fs], Zp) :-
   60   ( \+ not_holds(F, Z) -> holds(F, Z, Z1) ;
   61     \+ holds(F, Z)     -> Z1 = Z
   62                         ; cancel(F, Z, Z1), not_holds(F, Z1) ),
   63   minus(Z1, Fs, Zp).
   64
   65plus(Z, [], Z).
   66plus(Z, [F|Fs], Zp) :-
   67   ( \+ holds(F, Z)     -> Z1=[F|Z] ;
   68     \+ not_holds(F, Z) -> Z1=Z
   69                         ; cancel(F, Z, Z2), not_holds(F, Z2), Z1=[F|Z2] ),
   70   plus(Z1, Fs, Zp).
   71
   72update(Z1, ThetaP, ThetaN, Z2) :-
   73   minus(Z1, ThetaN, Z), plus(Z, ThetaP, Z2).
   74
   75knows(F, Z) :- \+ not_holds(F, Z).
   76
   77knows_not(F, Z) :- \+ holds(F, Z).
   78
   79knows_val(X, F, Z) :- holds(F, Z), \+ nonground(X).
   80
   81execute(E, Z1, Z2) :-
   82   E = [] -> Z2 = Z1
   83   ;
   84   E = [A|P] -> execute(P, Z1, Z), execute(A, Z, Z2)
   85   ;
   86   elementary_action(E) -> perform(E, SV), state_update(Z1, E, Z2, SV)
   87   ;
   88   execute_compound_action(E, Z1, Z2).
   89
   90:- op(950, xfy, ('#')).   91:- dynamic(plan_search_best/2).   92
   93plan(Proc, Plan, Z0) :-
   94   write('Planning ...'), nl,
   95   assert(plan_search_best(void,0)),
   96   plan_search(Proc, Z0),
   97   plan_search_best(Plan,_),
   98   retract(plan_search_best(Plan,_)),
   99   Plan \= void.
  100
  101plan_search(Proc, Z0) :-
  102   do(Proc, [], Plan, Z0),
  103   plan_cost(Proc, Plan, Cost),
  104   plan_search_best(BestPlan,BestCost),
  105   ( BestPlan \= void -> Cost < BestCost
  106                       ; true ),
  107   retract(plan_search_best(BestPlan,BestCost)),
  108   assert(plan_search_best(Plan,Cost)),
  109   fail
  110   ;
  111   true.
  112
  113do(E, S0, S, Z0) :-
  114   E = [] -> S=S0
  115   ;
  116   E = [E1|L] -> do(E1, S0, S1, Z0),
  117                 do(L, S1, S, Z0)
  118   ;
  119   E = '#'(E1,E2) -> ( do(E1, S0, S, Z0) ; do(E2, S0, S, Z0) )
  120   ;
  121   plan_proc(E, E1) -> do(E1, S0, S, Z0)
  122   ;
  123   E = ?(P) -> P =.. [Pred|Args],
  124               append(Args, [S0,Z0], ExtArgs),
  125               P1 =.. [Pred|ExtArgs],
  126               call(P1),
  127	       S = S0
  128   ;
  129   elementary_action(E) -> S = [E|S0]
  130   ;
  131   compound_action(E) -> S = [E|S0].
  132
  133res([], Z, Z).
  134res([A|S], Z0, Z) :-
  135   res(S, Z0, Z1),
  136   state_update(Z1, A, Z, _).
  137
  138knows(F, S, Z0) :- \+ ( res(S, Z0, Z), not_holds(F,Z) ).
  139
  140knows_not(F, S, Z0) :- \+ ( res(S, Z0, Z), holds(F,Z) ).
  141
  142:- dynamic(knowledge_value_sit/1).  143
  144knows_val(X, F, S, Z0) :-
  145   res(S, Z0, Z) ->
  146     knows_val(X, F, Z),
  147     assert(knowledge_value_sit(X)),
  148     fail.
  149knows_val(X, F, S, Z0) :-
  150   knowledge_value_sit(X),
  151   retract(knowledge_value_sit(X)),
  152   \+ ( res(S, Z0, Z), not_holds(F, Z) )