1%:- module(flux,[]).
    2%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3%%
    4%% Libraries
    5%%
    6%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- lib(fd).
   13:- reexport(swi_fd).   14
   15flux_version(3.1).
   20:- use_module(library(chr)).
   24:- ensure_loaded('fluent3.chr').   25
   26:- tell('fluent3.pl'),listing,told.   27
   28
   29%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   30%%
   31%% State Specifications and Update
   32%%
   33%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   40holds(F, [F|_]).
   41holds(F, Z) :- nonvar(Z), Z=[F1|Z1], F\==F1, holds(F, Z1).
   50holds(F, [F|Z], Z).
   51holds(F, Z, [F1|Zp]) :- nonvar(Z), Z=[F1|Z1], F\==F1, holds(F, Z1, Zp).
   59cancel(F,Z1,Z2) :-
   60   var(Z1)    -> cancel(F,Z1), cancelled(F,Z1), Z2=Z1 ;
   61   Z1 = [G|Z] -> ( F\=G -> cancel(F,Z,Z3), Z2=[G|Z3]
   62                         ; cancel(F,Z,Z2) ) ;
   63   Z1 = []    -> Z2 = [].
   70minus_(Z, [], Z).
   71minus_(Z, [F|Fs], Zp) :-
   72   ( \+ not_holds(F, Z) -> holds(F, Z, Z1) ;
   73     \+ holds(F, Z)     -> Z1 = Z
   74                         ; cancel(F, Z, Z1), not_holds(F, Z1) ),
   75   minus_(Z1, Fs, Zp).
   82plus_(Z, [], Z).
   83plus_(Z, [F|Fs], Zp) :-
   84   ( \+ holds(F, Z)     -> Z1=[F|Z] ;
   85     \+ not_holds(F, Z) -> Z1=Z
   86                         ; cancel(F, Z, Z2), not_holds(F, Z2), Z1=[F|Z2] ),
   87   plus_(Z1, Fs, Zp).
   95update(Z1, ThetaP, ThetaN, Z2) :-
   96   minus_(Z1, ThetaN, Z), plus_(Z, ThetaP, Z2).
   97
   98
   99%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  100%%
  101%% State Knowledge
  102%%
  103%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  110knows(F, Z) :- \+ not_holds(F, Z).
  117knows_not(F, Z) :- \+ holds(F, Z).
  133knows_val(X, F, Z) :- k_holds(F, Z), knows_val(X).
  134
  135k_holds(F, Z) :- nonvar(Z), Z=[F1|Z1],
  136                 ( instance(F1, F), F=F1 ; k_holds(F, Z1) ).
  137
  138:-local variable(known_val).
  139:-setval(known_val,[]).  140
  141knows_val(X) :- dom(X), \+ nonground(X), ambiguous(X) -> false.
  142knows_val(X) :- getval(known_val,X), X \== [], setval(known_val, []).
  143
  144dom([]).
  145dom([X|Xs]) :- dom(Xs), ( is_domain(X) -> indomain(X)
  146                                        ; true ).
  147
  148ambiguous(X) :- 
  149   ( getval(known_val, Val), 
  150     Val \== [] -> setval(known_val, [])
  151   ;
  152                    setval(known_val, X), 
  153                    false
  154   ).
  155
  156%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  157%%
  158%% Execution
  159%%
  160%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  193execute(A,Z1,Z2) :-
  194   is_predicate(perform/2),
  195   perform(A,Y)    -> ( is_predicate(ab_state_update/4) ->
  196                           ( Z1=[sit(S)|Z], ! ; S=[], Z=Z1 ),
  197                           ( state_update(Z,A,Z3,Y)
  198                             ; ab_res([[A,Y]|S],Z3) ),
  199                           !, Z2=[sit([[A,Y]|S])|Z3]
  200                        ;
  201			state_update(Z1,A,Z2,Y) ) ;
  202
  203   is_predicate(perform/3),
  204   perform(A,Y,E)  -> ( is_predicate(ab_state_update/4) ->
  205                           ( Z1=[sit(S)|Z], ! ; S=[], Z=Z1 ),
  206                           ( state_update(Z,A,Z3,Y), state_updates(Z3,E,Z4)
  207                             ; ab_res([[A,Y,E]|S],Z4) ),
  208                           !, Z2=[sit([[A,Y,E]|S])|Z4]
  209                        ;
  210			state_update(Z1,A,Z,Y), state_updates(Z,E,Z2) ) ;
  211
  212   A = [A1|A2]     ->
  213                      execute(A1,Z1,Z), execute(A2,Z,Z2) ;
  214
  215   A = if(F,A1,A2) ->
  216                      (holds(F,Z1) -> execute(A1,Z1,Z2)
  217                                    ; execute(A2,Z1,Z2)) ;
  218
  219   A = []          ->
  220                      Z1=Z2 ;
  221
  222   complex_action(A,Z1,Z2).
  223
  224ab_res([],Z) :- init(Z).
  225ab_res([S1|S],Z) :-
  226   ab_res(S,Z1),
  227   ( S1=[A,Y] -> ( state_update(Z1,A,Z,Y) ; ab_state_update(Z1,A,Z,Y) )
  228     ;
  229     S1=[A,Y,E], ( state_update(Z1,A,Z2,Y) ; ab_state_update(Z1,A,Z2,Y) ),
  230                 state_updates(Z2, E, Z) ).
  231
  232state_updates(Z, [], Z).
  233state_updates(Z1, [A|S], Z2) :-
  234   state_update(Z1, A, Z), state_updates(Z, S, Z2).
  235
  236%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  237%%
  238%% Planning
  239%%
  240%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  241
  242%%
  243%% plan(PlanningProblemName,Z,P)
  244%%
  245%% P is an optimal plan for PlanningProblemName with starting state Z
  246%%
  247%% It assumes the definition of a predicate PlanningProblemName(Z0,P,Z)
  248%% describing the search space such that plan P executed in starting
  249%% state Z0 results in state Z which satisfies the planning goal,
  250%% and the definition of plan_cost(PlanningProblemName,P,Z,C) such that
  251%% C is the cost of plan P resulting in state Z; or
  252%%
  253%% the definition of a predicate is PlanningProblemName(Z0,P)
  254%% describing the search space such that conditional plan P executed in
  255%% starting state Z0 necessarily results in a state in which the planning
  256%% goal is satisfied, and the definition of plan_cost(PlanningProblemName,P,C)
  257%% such that C is the cost of plan P.
  258%%
  259%% For the definition of the search space, the predicates for knowledge
  260%% described below can be used.
  261%%
  262
  263:- local variable(plan_search_best).
  264
  265plan(Problem, Z, P) :-
  266   setval(plan_search_best(_ : -1)),
  267   plan_search(Problem, Z),
  268   getval(plan_search_best,P:C),
  269   C =\= -1.
  270
  271plan_search(Problem, Z) :-
  272    is_predicate(Problem/2) ->
  273       ( PlanningProblem =.. [Problem,Z,P],
  274         call(PlanningProblem),
  275         plan_cost(Problem, P, C),
  276         getval(plan_search_best,_:C1),
  277         ( C1 =< C, C1 =\= -1 -> false
  278                               ;
  279                               setval(plan_search_best,P:C), false )
  280         ;
  281         true ) ;
  282    PlanningProblem =.. [Problem,Z,P,Zn],
  283    call(PlanningProblem),
  284    plan_cost(Problem, P, Zn, C),
  285    getval(plan_search_best,_:C1),
  286    ( C1 =< C, C1 =\= -1 -> false
  287                              ;
  288                            setval(plan_search_best,P:C),
  289                            false
  290    )
  291    ;
  292    true.
  304knows(F, S, Z0) :- \+ ( res(S, Z0, Z), not_holds(F, Z) ).
  311knows_not(F, S, Z0) :- \+ ( res(S, Z0, Z), holds(F, Z) ).
  312
  313%%
  314%% knows_val(X,F,S,Z0)
  315%%
  316%% there is an instance of the variables in X for which
  317%% non-ground fluent F is known to hold after doing S in state Z0
  318%%
  319
  320:-local variable(known_vals).
  321
  322knows_val(X, F, S, Z0) :-
  323   setval(known_vals,[]),
  324   res(S, Z0, Z),
  325   findall(X, knows_val(X,F,Z), T),
  326   getval(known_vals,T1),
  327   ( T1=[] -> T2=T ; intersection(T,T1,T2) ),
  328   setval(known_vals, T2),
  329   false.
  330knows_val(X, _, _, _) :-
  331   getval(known_vals, T), 
  332   member(X, T),
  333   setval(known_vals, []).
  334
  335
  336res([], Z0, Z0).
  337res(do(A,S), Z0, Z) :-
  338   ( A = if_true(F)  -> res(S, Z0, Z), holds(F, Z) 
  339   ;
  340                        ( A = if_false(F) -> res(S, Z0, Z),
  341                                             not_holds(F, Z) 
  342                        ;
  343                                             res(S, Z0, Z1),
  344                                             state_update(Z1, A, Z, _)
  345                        )
  346   ).
  347
  348
  349%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  350%%
  351%% Ramification Problem
  352%%
  353%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  367causes(Z,P,N,Z2) :-
  368   causes(Z,P,N,Z1,P1,N1) -> causes(Z1,P1,N1,Z2)
  369                           ; Z2=Z.
  378ramify(Z1,ThetaP,ThetaN,Z2) :-
  379   update(Z1,ThetaP,ThetaN,Z), causes(Z,ThetaP,ThetaN,Z2).
  380
  381
  382
  383/*
  384Warning: The predicates below are not defined. If these are defined
  385Warning: at runtime using assert/1, use :- dynamic Name/Arity.
  386Warning:
  387Warning: fd:ab_state_update/4, which is referenced by
  388Warning:        flux.pl:226:44: 2-nd clause of fd:ab_res/2
  389Warning:        flux.pl:228:45: 2-nd clause of fd:ab_res/2
  390Warning: fd:causes/6, which is referenced by
  391Warning:        flux.pl:367:3: 1-st clause of fd:causes/4
  392Warning: fd:complex_action/3, which is referenced by
  393Warning:        flux.pl:221:3: 1-st clause of fd:execute/3
  394Warning: fd:init/1, which is referenced by
  395Warning:        flux.pl:223:16: 1-st clause of fd:ab_res/2
  396Warning: fd:no_global_bindings/2, which is referenced by
  397Warning:        fluent3.chr:262:35: 1-st clause of fd:inst/2
  398Warning: fd:nonground/1, which is referenced by
  399Warning:        flux.pl:140:27: 1-st clause of fd:knows_val/1
  400Warning: fd:perform/2, which is referenced by
  401Warning:        flux.pl:194:3: 1-st clause of fd:execute/3
  402Warning: fd:perform/3, which is referenced by
  403Warning:        flux.pl:203:3: 1-st clause of fd:execute/3
  404Warning: fd:plan_cost/3, which is referenced by
  405Warning:        flux.pl:274:9: 1-st clause of fd:plan_search/2
  406Warning: fd:plan_cost/4, which is referenced by
  407Warning:        flux.pl:283:4: 1-st clause of fd:plan_search/2
  408Warning: fd:state_update/3, which is referenced by
  409Warning:        flux.pl:233:3: 2-nd clause of fd:state_updates/3
  410Warning: fd:state_update/4, which is referenced by
  411Warning:        flux.pl:226:19: 2-nd clause of fd:ab_res/2
  412Warning:        flux.pl:228:19: 2-nd clause of fd:ab_res/2
  413Warning:        flux.pl:196:29: 1-st clause of fd:execute/3
  414Warning:        flux.pl:200:24: 1-st clause of fd:execute/3
  415Warning:        flux.pl:205:29: 1-st clause of fd:execute/3
  416Warning:        flux.pl:209:24: 1-st clause of fd:execute/3
  417Warning:        flux.pl:343:45: 2-nd clause of fd:res/3
  418Warning: '$chr_initialization'/0, which is referenced by
  419Warning:        fluent3.chr:275: 6-th clause of exception/3
  420Warning: '$chr_prolog_global_variable'/1, which is referenced by
  421Warning:        fluent3.chr:275: 6-th clause of exception/3
  422*/
  423:- fixup_exports.