Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- % :- [flux_swi].
- %%% has(1) = has(gold) ; has(2) = has(arrow)
- %%%
- %%% Specify range of cave
- %%%
- xdim(10).
- ydim(12).
- %%%
- %%% Specify number of randomly generated pits
- %%%
- no_of_random_pits(12).
- % :- [wumpus_simulator].
- state_update(Z1,enter,Z2,[B,S,G]) :-
- update(Z1,[at(1,1),facing(1)],[],Z2),
- breeze_perception(1,1,B,Z2),
- stench_perception(1,1,S,Z2),
- glitter_perception(1,1,G,Z2).
- state_update(Z1,exit,Z2,[]) :-
- holds(facing(D),Z1),
- update(Z1,[],[at(1,1),facing(D)],Z2).
- state_update(Z1,turn,Z2,[]) :-
- holds(facing(D),Z1),
- (D#<4 #/\ D1#=D+1) #\/ (D#=4 #/\ D1#=1),
- update(Z1,[facing(D1)],[facing(D)],Z2).
- state_update(Z1,grab,Z2,[]) :-
- holds(at(X,Y),Z1),
- update(Z1,[has(1)],[gold(X,Y)],Z2).
- state_update(Z1,shoot,Z2,[S]) :-
- ( S=true, update(Z1,[dead],[has(2)],Z2)
- ; S=false, update(Z1,[],[has(2)],Z2) ).
- state_update(Z1,go,Z2,[B,S,G]) :-
- holds(at(X,Y),Z1), holds(facing(D),Z1),
- adjacent(X,Y,D,X1,Y1),
- update(Z1,[at(X1,Y1)],[at(X,Y)],Z2),
- breeze_perception(X1,Y1,B,Z2),
- stench_perception(X1,Y1,S,Z2),
- glitter_perception(X1,Y1,G,Z2).
- stench_perception(X,Y,Percept,Z) :-
- XE#=X+1, XW#=X-1, YN#=Y+1, YS#=Y-1,
- ( Percept=false, not_holds(wumpus(XE,Y),Z),
- not_holds(wumpus(XW,Y),Z),
- not_holds(wumpus(X,YN),Z),
- not_holds(wumpus(X,YS),Z) ;
- Percept=true,
- or_holds([wumpus(XE,Y),wumpus(X,YN),
- wumpus(XW,Y),wumpus(X,YS)],Z) ).
- breeze_perception(X,Y,Percept,Z) :-
- XE#=X+1, XW#=X-1, YN#=Y+1, YS#=Y-1,
- ( Percept=false, not_holds(pit(XE,Y),Z),
- not_holds(pit(XW,Y),Z),
- not_holds(pit(X,YN),Z),
- not_holds(pit(X,YS),Z) ;
- Percept=true,
- or_holds([pit(XE,Y),pit(X,YN),
- pit(XW,Y),pit(X,YS)],Z) ).
- glitter_perception(X,Y,Percept,Z) :-
- Percept=false, not_holds(gold(X,Y),Z) ;
- Percept=true, holds(gold(X,Y),Z).
- adjacent(X,Y,D,X1,Y1) :-
- xdim(XD), ydim(YD),
- X in 1..XD, X1 in 1..XD, Y in 1..YD, Y1 in 1..YD, D in 1..4,
- (D#=1) #/\ (X1#=X) #/\ (Y1#=Y+1) % north
- #\/ (D#=3) #/\ (X1#=X) #/\ (Y1#=Y-1) % south
- #\/ (D#=2) #/\ (X1#=X+1) #/\ (Y1#=Y) % east
- #\/ (D#=4) #/\ (X1#=X-1) #/\ (Y1#=Y). % west
- init(Z0) :- Z0 = [has(2),wumpus(WX,WY)|Z],
- xdim(XD), ydim(YD), XD1 is XD+1, YD1 is YD+1,
- WX in 1..XD, WY in 1..YD,
- not_holds(wumpus(1,1),Z0),
- not_holds_all(wumpus(_,_),Z),
- not_holds(dead,Z),
- not_holds(pit(1,1),Z),
- not_holds_all(pit(_,0),Z), %boundary
- not_holds_all(pit(_,YD1),Z),
- not_holds_all(pit(0,_),Z),
- not_holds_all(pit(XD1,_),Z),
- not_holds_all(at(_,_),Z),
- not_holds_all(facing(_),Z),
- duplicate_free(Z0).
- main :- init_simulator,
- init(Z0), execute(enter,Z0,Z1),
- Cpts=[1,1,[1,2]], Vis=[[1,1]], Btr=[],
- main_loop(Cpts,Vis,Btr,Z1).
- main_loop([X,Y,Choices|Cpts],Vis,Btr,Z) :-
- Choices=[Dir|Dirs] ->
- (explore(X,Y,Dir,Vis,Z,Z1) ->
- knows_val([X1,Y1],at(X1,Y1),Z1),
- hunt_wumpus(X1,Y1,Z1,Z2),
- (knows(gold(X1,Y1),Z2) ->
- execute(grab,Z2,Z3), go_home(Z3)
- ; Cpts1=[X1,Y1,[1,2,3,4],X,Y,Dirs|Cpts],
- Vis1=[[X1,Y1]|Vis], Btr1=[X,Y|Btr],
- main_loop(Cpts1,Vis1,Btr1,Z2) )
- ; main_loop([X,Y,Dirs|Cpts],Vis,Btr,Z) )
- ; backtrack(Cpts,Vis,Btr,Z).
- explore(X,Y,D,V,Z1,Z2) :-
- adjacent(X,Y,D,X1,Y1), \+ member([X1,Y1],V),
- knows_not(pit(X1,Y1),Z1),
- (knows_not(wumpus(X1,Y1),Z1);knows(dead,Z1)),
- turn_to(D,Z1,Z), execute(go,Z,Z2).
- backtrack(_,_,[],Z) :- execute(exit,Z,_).
- backtrack(Cpts,Vis,[X,Y|Btr],Z) :-
- go_back(X,Y,Z,Z1), main_loop(Cpts,Vis,Btr,Z1).
- go_back(X,Y,Z1,Z2) :-
- holds(at(X1,Y1),Z1), adjacent(X1,Y1,D,X,Y),
- turn_to(D,Z1,Z), execute(go,Z,Z2).
- turn_to(D,Z1,Z2) :-
- knows(facing(D),Z1) -> Z2=Z1
- ; execute(turn,Z1,Z), turn_to(D,Z,Z2).
- hunt_wumpus(X,Y,Z1,Z2) :-
- \+ knows(dead,Z1),
- knows_val([WX,WY],wumpus(WX,WY),Z1),
- in_direction(X,Y,D,WX,WY)
- -> turn_to(D,Z1,Z), execute(shoot,Z,Z2)
- ; Z2=Z1.
- in_direction(X,Y,D,X1,Y1) :-
- xdim(XD), ydim(YD),
- X in 1..XD, X1 in 1..XD, Y in 1..YD, Y1 in 1..YD, D in 1..4,
- (D#=1) #/\ (X1#=X) #/\ (Y1#>Y) % north
- #\/ (D#=3) #/\ (X1#=X) #/\ (Y1#<Y) % south
- #\/ (D#=2) #/\ (X1#>X) #/\ (Y1#=Y) % east
- #\/ (D#=4) #/\ (X1#<X) #/\ (Y1#=Y). % west
- go_home(Z) :- write('Planning...'),
- a_star_plan(Z,S), execute(S,Z,Z1), execute(exit,Z1,_).
- %%
- %% a_star_plan(Z,S)
- %%
- %% use A* planning to find situation S representing the shortest path to (1,1)
- %%
- :- dynamic visited/2.
- a_star_plan(Z,S) :-
- retractall(visited(_,_)),
- knows_val([X,Y],at(X,Y),Z), assertz(visited(X,Y)),
- a_star(Z,[[],0,100000],S).
- a_star(Z,[Sit,Cost,_|L],S) :-
- findall([A,H], a_star_do(Z,Sit,A,H), Actions),
- ( member([Action,0], Actions) -> S=do(Action,Sit)
- ;
- insert_all(Actions, Sit, Cost, L, L1),
- a_star(Z, L1, S) ).
- insert_all([],_,_,L,L).
- insert_all([[A,H]|As],S,C,L,L2) :-
- insert_all(As,S,C,L,L1),
- Cost is C+1, Heuristic is Cost+H,
- ins(do(A,S),Cost,Heuristic,L1,L2).
- ins(S1,C1,H1,[S2,C2,H2|L],L2) :-
- ( H1>H2 -> ins(S1,C1,H1,L,L1), L2=[S2,C2,H2|L1]
- ;
- L2=[S1,C1,H1,S2,C2,H2|L] ).
- ins(S,C,H,[],[S,C,H]).
- a_star_do(Z,S,A,H) :-
- ( S=do(go_to(X,Y),_) -> true ; knows_val([X,Y],at(X,Y),Z) ),
- ( D=4 ; D=3 ; D=2 ; D=1 ),
- adjacent(X,Y,D,X1,Y1), \+ visited(X1,Y1),
- knows_not(pit(X1,Y1),Z),
- ( \+ knows(dead,Z)->knows_not(wumpus(X1,Y1),Z)
- ; true ),
- A = go_to(X1,Y1),
- assertz(visited(X1,Y1)),
- H is X1+Y1-2.
- complex_action(do(A,S),Z1,Z2) :-
- execute(S,Z1,Z), execute(A,Z,Z2).
- complex_action(go_to(X,Y),Z1,Z2) :-
- holds(at(X1,Y1),Z1), adjacent(X1,Y1,D,X,Y),
- turn_to(D,Z1,Z), execute(go,Z,Z2).
- :- use_module(library(terms)).
- :- use_module(library(varnumbers)).
- :- use_module( library(random)).
- :- dynamic current_state/1.
- init_simulator :- init_scenario,
- retractall(current_state(_)), assertz(current_state([])).
- :- dynamic wumpus/2,pit/2,gold/2.
- init_scenario :-
- retractall(wumpus(_,_)), retractall(pit(_,_)), retractall(gold(_,_)),
- xdim(XD), ydim(YD),
- random(0,4294967296,N1), random(0,4294967296,N2), XW is N1 mod XD + 1, YW is N2 mod YD + 1,
- ( XW=1, YW=1 -> true ; assertz(wumpus(XW,YW)), write(wumpus(XW,YW)) ),
- random(0,4294967296,N3), random(0,4294967296,N4), XG is N3 mod XD + 1, YG is N4 mod YD + 1,
- assertz(gold(XG,YG)), write(gold(XG,YG)),
- no_of_random_pits(P), create_pits(P).
- create_pits(0) :- !.
- create_pits(M) :-
- xdim(XD), ydim(YD),
- random(0,4294967296,N1), random(0,4294967296,N2), XP is N1 mod XD + 1, YP is N2 mod YD + 1,
- ( XP+YP < 4 -> create_pits(M) ; assertz(pit(XP,YP)), write(pit(XP,YP)) ),
- M1 is M-1, create_pits(M1).
- perform(turn, []) :-
- write('turn'), nl,
- current_state([at(X,Y),facing(D)]),
- retract(current_state([at(X,Y),facing(D)])),
- ( D < 4 -> D1 is D+1 ; D1 is 1 ),
- assertz(current_state([at(X,Y),facing(D1)])).
- perform(enter, [Breeze,Stench,Glitter]) :-
- write('enter'), nl,
- current_state(Z),
- retract(current_state(Z)),
- assertz(current_state([at(1,1),facing(1)])),
- ( gold(1,1) -> Glitter = true ; Glitter = false ),
- ( (wumpus(1,2) ; wumpus(2,1)) -> Stench = true ;
- Stench = false ),
- ( (pit(2,1) ; pit(1,2)) -> Breeze = true ;
- Breeze = false ).
- perform(exit, []) :-
- write('exit'), nl,
- current_state([at(X,Y),facing(D)]),
- retract(current_state([at(X,Y),facing(D)])),
- assertz(current_state([])).
- perform(grab, []) :-
- write('grab'), nl.
- perform(shoot, [Scream]) :-
- write('shoot'), nl,
- current_state([at(X,Y),facing(D)]),
- wumpus(WX, WY),
- ( in_direction(X, Y, D, WX, WY), Scream = true ; Scream = false ).
- perform(go, [Breeze,Stench,Glitter]) :-
- write('go'), nl,
- current_state([at(X,Y),facing(D)]),
- retract(current_state([at(X,Y),facing(D)])),
- ( D = 1 -> X1 is X, Y1 is Y+1 ;
- D = 3 -> X1 is X, Y1 is Y-1 ;
- D = 2 -> X1 is X+1, Y1 is Y ;
- D = 4 -> X1 is X-1, Y1 is Y ),
- assertz(current_state([at(X1,Y1),facing(D)])),
- ( gold(X1,Y1) -> Glitter = true ; Glitter = false ),
- X_east is X1+1, X_west is X1-1, Y_north is Y1+1, Y_south is Y1-1,
- ( (wumpus(X_east,Y1) ; wumpus(X1,Y_north) ;
- wumpus(X_west,Y1) ; wumpus(X1,Y_south)) -> Stench = true ;
- Stench = false ),
- ( (pit(X_east,Y1) ; pit(X1,Y_north) ;
- pit(X_west,Y1) ; pit(X1,Y_south)) -> Breeze = true ;
- Breeze = false ).
- %% fluent.chr - CHR for SWI-Prolog
- %% $Id: fluent.chr, v 2.0 NOW $
- %%
- %% FLUX: a Prolog library for high-level programming of cognitive agents
- %% Copyright 2003, 2004 Michael Thielscher
- %% This file belongs to the flux kernel package distributed at
- %% http://www.fluxagent.org
- %%
- %% This library is free software; you can redistribute it and/or modify it
- %% under the terms of the GNU Library General Public License as published by
- %% the Free Software Foundation; either version 2 of the License, or (at your
- %% option) any later version.
- %%
- %% This library is distributed in the hope that it will be useful, but WITHOUT
- %% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- %% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
- %% License for more details.
- %%
- %% You should have received a copy of the GNU Library General Public License
- %% along with this library; if not, write to the Free Software Foundation,
- %% Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- %%
- %% Consult the file COPYING for license details.
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Preamble
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- % handler fluent.
- :- chr_constraint not_holds/2, not_holds_all/2, duplicate_free/1,
- or_holds/2, or_holds/3, cancel/2, cancelled/2.
- :- chr_option(check_guard_bindings,off).
- :- make,check,autoload.
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Constraint Handling Rules for state constraints
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- not_holds(F, [F1|Z]) <=> neq(F, F1), not_holds(F, Z).
- not_holds(_, []) <=> true.
- not_holds_all(F, [F1|Z]) <=> neq_all(F, F1), not_holds_all(F, Z).
- not_holds_all(_, []) <=> true.
- not_holds_all(F, Z) \ not_holds(G, Z) <=> inst(G, F) | true.
- not_holds_all(F, Z) \ not_holds_all(G, Z) <=> inst(G, F) | true.
- duplicate_free([F|Z]) <=> not_holds(F,Z), duplicate_free(Z).
- duplicate_free([]) <=> true.
- or_holds([F],Z) <=> F\=eq(_,_) | holds(F,Z).
- or_holds(V,_Z) <=> \+ ( member(F,V),F\=eq(_,_) ) | or_and_eq(V,D), call(D).
- or_holds(V,[]) <=> member(F, V, W), F\=eq(_,_) | or_holds(W,[]).
- or_holds(V,_Z) <=> member(eq(X,Y),V), or_neq(exists,X,Y,D), \+ call(D) | true.
- or_holds(V,Z) <=> member(eq(X,Y),V,W), \+ (and_eq(X,Y,D), call(D)) | or_holds(W,Z).
- not_holds(F, Z) \ or_holds(V, Z) <=> member(G, V, W), F==G | or_holds(W, Z).
- not_holds_all(F, Z) \ or_holds(V, Z) <=> member(G, V, W), inst(G, F)
- | or_holds(W, Z).
- or_holds(V, [F|Z]) <=> or_holds(V, [], [F|Z]).
- or_holds([G|V],W,[F|Z]) <=> true | ( G==F -> true ;
- G\=F -> or_holds(V,[G|W],[F|Z]) ;
- G=..[_|ArgX], F=..[_|ArgY],
- or_holds(V,[eq(ArgX,ArgY),G|W],[F|Z])).
- or_holds([],W,[_|Z]) <=> or_holds(W,Z).
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Constraint Handling Rules for cancellation of constraints on a fluent
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- cancel(F,Z) \ not_holds(G,Z) <=> \+ F\=G | true.
- cancel(F,Z) \ not_holds_all(G,Z) <=> \+ F\=G | true.
- cancel(F,Z) \ or_holds(V,Z) <=> member(G,V), \+ F\=G | true.
- cancel(F,Z), cancelled(F,Z) <=> true.
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Auxiliary clauses
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- neq(F, F1) :- or_neq(exists, F, F1).
- neq_all(F, F1) :- or_neq(forall, F, F1).
- or_neq(Q, Fx, Fy) :-
- functor(Fx, F, M), functor(Fy, G, N),
- ( F=G, M=N -> Fx =.. [_|ArgX], Fy =.. [_|ArgY], or_neq(Q, ArgX, ArgY, D), call(D)
- ; true ).
- or_neq(_, [], [], (0#\=0)).
- or_neq(Q, [X|X1], [Y|Y1], D) :-
- or_neq(Q, X1, Y1, D1),
- ( Q=forall, var(X), \+ is_domain(X) -> ( binding(X,X1,Y1,YE) ->
- D=((Y#\=YE)#\/D1) ; D=D1 )
- ; D=((X#\=Y)#\/D1) ).
- binding(X,[X1|ArgX],[Y1|ArgY],Y) :-
- X==X1 -> Y=Y1 ; binding(X,ArgX,ArgY,Y).
- and_eq([], [], (0#=0)).
- and_eq([X|X1], [Y|Y1], D) :-
- and_eq(X1, Y1, D1),
- D = ((X#=Y)#/\D1).
- or_and_eq([], (0#\=0)).
- or_and_eq([eq(X,Y)|Eq], (D1#\/D2)) :-
- and_eq(X,Y,D1),
- or_and_eq(Eq,D2).
- %% inst checks whether G is an instance of F and if so whether there is no
- %% domain variable which is bound to some value in this instance
- inst(G,F) :- subsumes_chk(F,G), var_chk(G,F).
- var_chk(X,Y) :- var(Y), X==Y.
- var_chk(_,Y) :- var(Y), \+ fd_var(Y).
- var_chk(X,Y) :- is_list(Y), var_chk_list(X,Y).
- var_chk(X,Y) :- compound(Y), \+ is_list(Y), X=..[_|Xs], Y=..[_|Ys], var_chk_list(Xs,Ys).
- var_chk_list([],[]).
- var_chk_list([X|Xs],[Y|Ys]) :- var_chk(X,Y), var_chk_list(Xs,Ys).
- member(X, [X|T], T).
- member(X, [H|T], [H|T1]) :- member(X, T, T1).
- is_domain(X) :- fd_var(X), \+ ( fd_max(X,sup), fd_min(X,inf)).
- fd_min(X,D):-M #=< X,fd_dom(M,D).
- fd_max(X,D):-M #>= X,fd_dom(M,D).
- %% $Id: flux.pl, v 2.0 2004/01/22 00:58:00 $
- %%
- %% FLUX: a Prolog library for high-level programming of cognitive agents
- %% Copyright 2003, 2004 Michael Thielscher
- %% This file belongs to the flux kernel package distributed at
- %% http://www.fluxagent.org
- %%
- %% This library is free software; you can redistribute it and/or modify it
- %% under the terms of the GNU Library General Public License as published by
- %% the Free Software Foundation; either version 2 of the License, or (at your
- %% option) any later version.
- %%
- %% This library is distributed in the hope that it will be useful, but WITHOUT
- %% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- %% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
- %% License for more details.
- %%
- %% You should have received a copy of the GNU Library General Public License
- %% along with this library; if not, write to the Free Software Foundation,
- %% Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- %%
- %% Consult the file COPYING for license details.
- :- use_module( library(clpfd)).
- :- autoload.
- :- expects_dialect(sicstus).
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Libraries
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% term utilities (Sicstus library)
- %%
- :- use_module(library(varnumbers)).
- :- use_module( library(terms)).
- %%
- %% List operations (Sicstus library)
- %%
- :- use_module( library(lists)).
- %%
- %% finite domain constraint solver (Sicstus library)
- %%
- %%
- %% constraint handling rules (Sicstus library)
- %%
- :- use_module( library(chr)).
- %%
- %% FLUX constraint handling rules
- %%
- :- autoload.
- % :- ['fluent.chr'].
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% State Specifications and Update
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% holds(F,Z)
- %%
- %% asserts that fluent F holds in state Z
- %%
- holds(F, [F|_]).
- holds(F, Z) :- nonvar(Z), Z=[F1|Z1], F\==F1, holds(F, Z1).
- %%
- %% holds(F,Z,Zp)
- %%
- %% asserts that fluent F holds in state Z
- %%
- %% state Zp is Z without F.
- %%
- holds(F, [F|Z], Z).
- holds(F, Z, [F1|Zp]) :- nonvar(Z), Z=[F1|Z1], F\==F1, holds(F, Z1, Zp).
- %%
- %% cancel(F,Z1,Z2)
- %%
- %% state Z2 is state Z1 with all (positive, negative, disjunctive)
- %% knowledge of fluent F canceled
- %%
- cancel(F,Z1,Z2) :-
- var(Z1) -> cancel(F,Z1), cancelled(F,Z1), Z2=Z1 ;
- Z1 = [G|Z] -> ( F\=G -> cancel(F,Z,Z3), Z2=[G|Z3]
- ; cancel(F,Z,Z2) ) ;
- Z1 = [] -> Z2 = [].
- %%
- %% minus(Z1,ThetaN,Z2)
- %%
- %% state Z2 is state Z1 minus the fluents in list ThetaN
- %%
- minus_(Z, [], Z).
- minus_(Z, [F|Fs], Zp) :-
- ( \+ not_holds(F, Z) -> holds(F, Z, Z1) ;
- \+ holds(F, Z) -> Z1 = Z
- ; cancel(F, Z, Z1), not_holds(F, Z1) ),
- minus_(Z1, Fs, Zp).
- %%
- %% plus(Z1,ThetaP,Z2)
- %%
- %% state Z2 is state Z1 plus the fluents in list ThetaP
- %%
- plus_(Z, [], Z).
- plus_(Z, [F|Fs], Zp) :-
- ( \+ holds(F, Z) -> Z1=[F|Z] ;
- \+ not_holds(F, Z) -> Z1=Z
- ; cancel(F, Z, Z2), not_holds(F, Z2), Z1=[F|Z2] ),
- plus_(Z1, Fs, Zp).
- %%
- %% update(Z1,ThetaP,ThetaN,Z2)
- %%
- %% state Z2 is state Z1 minus the fluents in list ThetaN
- %% plus the fluents in list ThetaP
- %%
- update(Z1, ThetaP, ThetaN, Z2) :-
- minus_(Z1, ThetaN, Z), plus_(Z, ThetaP, Z2).
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% State Knowledge
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% knows(F,Z)
- %%
- %% ground fluent F is known to hold in state Z
- %%
- knows(F, Z) :- \+ not_holds(F, Z).
- %%
- %% knows_not(F,Z)
- %%
- %% ground fluent F is known not to hold in state Z
- %%
- knows_not(F, Z) :- \+ holds(F, Z).
- %%
- %% knows_val(X,F,Z)
- %%
- %% there is an of the variables in X for which
- %% non-ground fluent F is known to hold in state Z
- %%
- %% Example:
- %%
- %% ?- knows_val([X], f(X,Y), [f(1,3),f(2,U),f(V,2)|_])
- %%
- %% X=1 More?
- %% X=2 More?
- %% No
- %%
- knows_val(X, F, Z) :- k_holds(F, Z), knows_val(X).
- k_holds(F, Z) :- nonvar(Z), Z=[F1|Z1],
- ( instance1(F1, F), F=F1 ; k_holds(F, Z1) ).
- :- dynamic known_val/1.
- knows_val(X) :- dom(X), \+ nonground(X), ambiguous(X) -> false.
- knows_val(X) :- retract(known_val(X)).
- dom([]).
- dom([X|Xs]) :- dom(Xs), ( is_domain(X) -> indomain(X)
- ; true ).
- ambiguous(X) :- retract(known_val(_)) -> true
- ;
- assertz(known_val(X)), false.
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Execution
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% execute(A,Z1,Z2)
- %%
- %% perform A and update current state Z1 to state Z2
- %%
- %% It assumes the definition of a predicate perform(A,Y) or perform(A,Y,E),
- %% which actually performs primitive action A and returns a list Y of
- %% sensing results and, in the ternary variant, a set of exogenous actions E.
- %%
- %% It also assumes the definition of a predicate state_update(Z1,A,Z2,Y),
- %% which specifies the effect of an action A with sensing result Y as
- %% update of state Z1 to state Z2. The effects of exogenous actions are assumed
- %% to be specified by a predicate state_update(Z1,A,Z2) without sensing result.
- %%
- %% The clauses for state_update must NOT allow for backtracking for fixed sensor result.
- %%
- %% For troubleshooting (qualification problem), it is assumed that accidental effects
- %% of non-exogenous actions are described by a predicate ab_state_update(Z1,A,Z2,Y).
- %% The initial state is assumed to be specified by init(Z0).
- %%
- %% The clauses for ab_state_update may allow for backtracking.
- %%
- %% The execution of non-primitive actions A is defined as the predicate
- %% complex_action(A,Z1,Z2) such that the final result of doing A in state Z1 is
- %% state Z2.
- %%
- %% A can be a primitive action, a list, a conditional of the form if(F,A1,A2)
- %% where F fluent, or the name of a complex action. The clause should be used
- %% for non-primitive A only if its executability is guaranteed also in case
- %% of possible accidents.
- %%
- execute(A,Z1,Z2) :-
- current_predicate(perform/2),
- perform(A,Y) -> ( current_predicate(ab_state_update/4)
- ->
- ( Z1=[sit(S)|Z], ! ; S=[], Z=Z1 ),
- ( state_update(Z,A,Z3,Y)
- ; ab_res([[A,Y]|S],Z3) ),
- !, Z2=[sit([[A,Y]|S])|Z3]
- ;
- state_update(Z1,A,Z2,Y) ) ;
- current_predicate(perform/3),
- perform(A,Y,E) -> ( current_predicate(ab_state_update/4)
- ->
- ( Z1=[sit(S)|Z], ! ; S=[], Z=Z1 ),
- ( state_update(Z,A,Z3,Y), state_updates(Z3,E,Z4)
- ; ab_res([[A,Y,E]|S],Z4) ),
- !, Z2=[sit([[A,Y,E]|S])|Z4]
- ;
- state_update(Z1,A,Z,Y), state_updates(Z,E,Z2) ) ;
- A = [A1|A2] ->
- execute(A1,Z1,Z), execute(A2,Z,Z2) ;
- A = if(F,A1,A2) ->
- (holds(F,Z1) -> execute(A1,Z1,Z2)
- ; execute(A2,Z1,Z2)) ;
- A = [] ->
- Z1=Z2 ;
- complex_action(A,Z1,Z2).
- ab_res([],Z) :- init(Z).
- ab_res([S1|S],Z) :-
- ab_res(S,Z1),
- ( S1=[A,Y] -> ( state_update(Z1,A,Z,Y) ; ab_state_update(Z1,A,Z,Y) )
- ;
- S1=[A,Y,E], ( state_update(Z1,A,Z2,Y) ; ab_state_update(Z1,A,Z2,Y) ),
- state_updates(Z2, E, Z) ).
- state_updates(Z, [], Z).
- state_updates(Z1, [A|S], Z2) :-
- state_update(Z1, A, Z), state_updates(Z, S, Z2).
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Planning
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% plan(PlanningProblemName,Z,P)
- %%
- %% P is an optimal plan for PlanningProblemName with starting state Z
- %%
- %% It assumes the definition of a predicate PlanningProblemName(Z0,P,Z)
- %% describing the search space such that plan P executed in starting
- %% state Z0 results in state Z which satisfies the planning goal,
- %% and the definition of plan_cost(PlanningProblemName,P,Z,C) such that
- %% C is the cost of plan P resulting in state Z; or
- %%
- %% the definition of a predicate is PlanningProblemName(Z0,P)
- %% describing the search space such that conditional plan P executed in
- %% starting state Z0 necessarily results in a state in which the planning
- %% goal is satisfied, and the definition of plan_cost(PlanningProblemName,P,C)
- %% such that C is the cost of plan P.
- %%
- %% For the definition of the search space, the predicates for knowledge
- %% described below can be used.
- %%
- :- dynamic plan_search_best/2.
- plan(Problem, Z, P) :-
- assertz(plan_search_best(_,-1)),
- plan_search(Problem, Z),
- retract(plan_search_best(P,C)),
- C =\= -1.
- plan_search(Problem, Z) :-
- current_predicate(Problem/2) ->
- ( PlanningProblem =.. [Problem,Z,P],
- call(PlanningProblem),
- plan_cost(Problem, P, C),
- plan_search_best(_,C1),
- ( C1 =< C, C1 =\= -1 -> fail
- ; retract(plan_search_best(_,C1)),
- assertz(plan_search_best(P,C)), fail )
- ;
- true ) ;
- PlanningProblem =.. [Problem,Z,P,Zn],
- call(PlanningProblem),
- plan_cost(Problem, P, Zn, C),
- plan_search_best(_,C1),
- ( C1 =< C, C1 =\= -1 -> fail
- ; retract(plan_search_best(_,C1)),
- assertz(plan_search_best(P,C)), fail )
- ;
- true.
- %%
- %% knows(F,S,Z0)
- %%
- %% ground fluent F is known to hold after doing S in state Z0
- %%
- %% S ::= [] | do(A,S)
- %% A ::= primitive action | if_true(F)| if_false(F)
- %% F ::= fluent
- %%
- knows(F, S, Z0) :- \+ ( res(S, Z0, Z), not_holds(F, Z) ).
- %%
- %% knows_not(F,S,Z0)
- %%
- %% ground fluent F is known not to hold after doing S in state Z0
- %%
- knows_not(F, S, Z0) :- \+ ( res(S, Z0, Z), holds(F, Z) ).
- %%
- %% knows_val(X,F,S,Z0)
- %%
- %% there is an instance of the variables in X for which
- %% non-ground fluent F is known to hold after doing S in state Z0
- %%
- knows_val(X, F, S, Z0) :-
- res(S, Z0, Z) -> findall(X, knows_val(X,F,Z), T),
- assertz(known_val(T)),
- false.
- knows_val(X, F, S, Z0) :-
- known_val(T), retract(known_val(T)), member(X, T),
- \+ ( res(S, Z0, Z), not_holds_all(F, Z) ).
- res([], Z0, Z0).
- res(do(A,S), Z0, Z) :-
- A = if_true(F) -> res(S, Z0, Z), holds(F, Z) ;
- A = if_false(F) -> res(S, Z0, Z), not_holds(F, Z) ;
- res(S, Z0, Z1), state_update(Z1, A, Z, _).
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% Ramification Problem
- %%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %%
- %% causes(Z1,P,N,Z2)
- %%
- %% state Z2 is the result of applying causal relationships to
- %% state Z1 wrt. positive effects P and negative effects N
- %%
- %% It is assumed that the causal relationships of a domain are specified
- %% by clauses for the predicate causes(Z1,P1,N1,Z2,P2,N2) such that an
- %% indirect effect causes an automatic state transition from
- %% state Z1 with positive effects P1 and negative effects N1 to
- %% state Z2 with positive effects P2 and negative effects N2
- %%
- causes(Z,P,N,Z2) :-
- causes(Z,P,N,Z1,P1,N1) -> causes(Z1,P1,N1,Z2)
- ; Z2=Z.
- %%
- %% ramify(Z1,ThetaP,ThetaN,Z2)
- %%
- %% state Z2 is the result of applying causal relationships after
- %% removing the negative direct effects ThetaN and adding the
- %% positive direct effects ThetaP to state Z2
- %%
- ramify(Z1,ThetaP,ThetaN,Z2) :-
- update(Z1,ThetaP,ThetaN,Z), causes(Z,ThetaP,ThetaN,Z2).
- %% additional predicates necessary for Sicstus
- nonground(X):- \+ ground(X).
- instance1(X,Y):- subsumes_chk(Y,X).
- ?-w_dt(((_G1917=2;true),(_G1928=_G1928;true),(_G1917=2;true)))
- % autoloading user:autoload/0 from /usr/local/lib/swipl-7.3.16/library/prolog_autoload
- % autoloading prolog_codewalk:must_be/2 from /usr/local/lib/swipl-7.3.16/library/error
- % autoloading record:member/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading user:maplist/2 from /usr/local/lib/swipl-7.3.16/library/apply
- % autoloading oset:reverse/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading prolog_codewalk:portray_clause/1 from /usr/local/lib/swipl-7.3.16/library/listing
- % autoloading prolog_codewalk:clause_info/4 from /usr/local/lib/swipl-7.3.16/library/prolog_clause
- % autoloading prolog_codewalk:initialization_layout/4 from /usr/local/lib/swipl-7.3.16/library/prolog_clause
- % autoloading prolog_codewalk:gtrace/0 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/gui_tracer
- % autoloading pce_principal:load_foreign_library/1 from /usr/local/lib/swipl-7.3.16/library/shlib
- % autoloading pce_principal:unlock_predicate/1 from /usr/local/lib/swipl-7.3.16/library/system
- % autoloading pce_expansion:push_operators/1 from /usr/local/lib/swipl-7.3.16/library/operators
- % autoloading pce_expansion:pop_operators/0 from /usr/local/lib/swipl-7.3.16/library/operators
- % autoloading pce_realise:last/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading prolog_debug:backtrace/1 from /usr/local/lib/swipl-7.3.16/library/prolog_stack
- % autoloading error:assertion/1 from /usr/local/lib/swipl-7.3.16/library/debug
- % autoloading pce_host:send/2 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/pce
- % autoloading pce_portray:portray_clause/1 from /usr/local/lib/swipl-7.3.16/library/listing
- % autoloading prolog_codewalk:clause_name/2 from /usr/local/lib/swipl-7.3.16/library/prolog_clause
- % Autoloader: iteration 1 resolved 28 predicates and loaded 18 files in 0.188 seconds. Restarting ...
- % autoloading pce_goal_expansion:pce_error/1 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/swi_compatibility
- % autoloading pce_goal_expansion:append/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading pce_expansion:pce_error/1 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/swi_compatibility
- % autoloading pce_expansion:append/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading pce_expansion:pce_info/1 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/swi_compatibility
- % autoloading pce_expansion:reverse/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading pce_expansion:maplist/3 from /usr/local/lib/swipl-7.3.16/library/apply
- % autoloading pce_expansion:flatten/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading pce_realise:pce_error/1 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/swi_compatibility
- % autoloading pce_host:get/3 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/pce
- % autoloading gui_tracer:debug/0 from /usr/local/lib/swipl-7.3.16/library/edinburgh
- % autoloading pce_global:append/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading pce_global:gensym/2 from /usr/local/lib/swipl-7.3.16/library/gensym
- % autoloading quintus:date_time_value/3 from /usr/local/lib/swipl-7.3.16/library/date
- % autoloading pce_principal:pce_info/1 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/swi_compatibility
- % autoloading pce_messages:get/3 from /usr/local/lib/swipl-7.3.16/xpce/prolog/lib/pce
- % Autoloader: iteration 2 resolved 3 predicates and loaded 16 files in 0.136 seconds. Restarting ...
- % Autoloader: loaded 31 files in 3 iterations in 0.447 seconds
- % autoloading user:expects_dialect/1 from /usr/local/lib/swipl-7.3.16/library/dialect
- % autoloading chr:expects_dialect/1 from /usr/local/lib/swipl-7.3.16/library/dialect
- % autoloading chr_translate:portray_clause/1 from /usr/local/lib/swipl-7.3.16/library/listing
- % autoloading chr_translate:flatten/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading chr_translate:selectchk/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading chr_translate:nth1/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading chr_translate:is_set/1 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading chr_translate:append/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading chr_translate:select/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading chr_translate:nth1/4 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading chr_translate:predsort/3 from /usr/local/lib/swipl-7.3.16/library/sort
- % autoloading chr_translate:numlist/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading sort:must_be/2 from /usr/local/lib/swipl-7.3.16/library/error
- % autoloading guard_entailment:member/2 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading guard_entailment:append/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading sicstus:read_line_to_codes/2 from /usr/local/lib/swipl-7.3.16/library/readutil
- % autoloading chr_runtime:permission_error/3 from /usr/local/lib/swipl-7.3.16/library/error
- % autoloading builtins:append/3 from /usr/local/lib/swipl-7.3.16/library/lists
- % autoloading block_directive:permission_error/3 from /usr/local/lib/swipl-7.3.16/library/error
- % autoloading block_directive:instantiation_error/1 from /usr/local/lib/swipl-7.3.16/library/error
- % autoloading block_directive:domain_error/2 from /usr/local/lib/swipl-7.3.16/library/error
- % Autoloader: iteration 1 resolved 2 predicates and loaded 18 files in 0.413 seconds. Restarting ...
- % Autoloader: loaded 2 files in 2 iterations in 0.807 seconds
- % autoloading user:make/0 from /usr/local/lib/swipl-7.3.16/library/make
- % autoloading user:check/0 from /usr/local/lib/swipl-7.3.16/library/check
- % Checking undefined predicates ...
- % Checking trivial failures ...
- % Checking redefined system and global predicates ...
- % autoloading check:predicate_name/2 from /usr/local/lib/swipl-7.3.16/library/prolog_clause
- % substitute/4 Redefined global predicate
- % prolog_flag/2 Redefined global predicate
- % sublist/2 Redefined global predicate
- % Checking predicates with declarations but without clauses ...
- % Checking predicates that need autoloading ...
- % autoloading check:clause_info/4 from /usr/local/lib/swipl-7.3.16/library/prolog_clause
- % autoloading check:clause_name/2 from /usr/local/lib/swipl-7.3.16/library/prolog_clause
- % Autoloader: loaded 0 files in 1 iterations in 0.412 seconds
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement