1:- use_module(library('clp/clpfd')). 2:- use_module(library('chr/chr_runtime')). 3:- use_module(library(chr)). 4
5:-type_prolog(swi). 6
7:- ensure_loaded('Interpreters/flux/flux2.pl').
15xdim(10).
16ydim(12).
22no_of_random_pits(12).
23
24
25:- [wumpus_simulator_2_3]. 26
27state_update(Z1,enter,Z2,[B,S,G]) :-
28 update(Z1,[at(1,1),facing(1)],[],Z2),
29 breeze_perception(1,1,B,Z2),
30 stench_perception(1,1,S,Z2),
31 glitter_perception(1,1,G,Z2).
32
33state_update(Z1,exit,Z2,[]) :-
34 holds(facing(D),Z1),
35 update(Z1,[],[at(1,1),facing(D)],Z2).
36
37state_update(Z1,turn,Z2,[]) :-
38 holds(facing(D),Z1),
39 (D#<4 #/\ D1#=D+1) #\/ (D#=4 #/\ D1#=1),
40 update(Z1,[facing(D1)],[facing(D)],Z2).
41
42state_update(Z1,grab,Z2,[]) :-
43 holds(at(X,Y),Z1),
44 update(Z1,[has(1)],[gold(X,Y)],Z2).
45
46state_update(Z1,shoot,Z2,[S]) :-
47 ( S=true, update(Z1,[dead],[has(2)],Z2)
48 ; S=false, update(Z1,[],[has(2)],Z2) ).
49
50state_update(Z1,go,Z2,[B,S,G]) :-
51 holds(at(X,Y),Z1), holds(facing(D),Z1),
52 adjacent(X,Y,D,X1,Y1),
53 update(Z1,[at(X1,Y1)],[at(X,Y)],Z2),
54 breeze_perception(X1,Y1,B,Z2),
55 stench_perception(X1,Y1,S,Z2),
56 glitter_perception(X1,Y1,G,Z2).
57
58stench_perception(X,Y,Percept,Z) :-
59 XE #= X+1, XW #= X-1, YN #= Y+1, YS #= Y-1,
60 ( Percept=false, not_holds(wumpus(XE,Y),Z),
61 not_holds(wumpus(XW,Y),Z),
62 not_holds(wumpus(X,YN),Z),
63 not_holds(wumpus(X,YS),Z) ;
64 Percept=true,
65 or_holds([wumpus(XE,Y),wumpus(X,YN),
66 wumpus(XW,Y),wumpus(X,YS)],Z) ).
67
68breeze_perception(X,Y,Percept,Z) :-
69 XE#=X+1, XW#=X-1, YN#=Y+1, YS#=Y-1,
70 ( Percept=false, not_holds(pit(XE,Y),Z),
71 not_holds(pit(XW,Y),Z),
72 not_holds(pit(X,YN),Z),
73 not_holds(pit(X,YS),Z) ;
74 Percept=true,
75 or_holds([pit(XE,Y),pit(X,YN),
76 pit(XW,Y),pit(X,YS)],Z) ).
77
78glitter_perception(X,Y,Percept,Z) :-
79 Percept=false, not_holds(gold(X,Y),Z) ;
80 Percept=true, holds(gold(X,Y),Z).
81
82adjacent(X,Y,D,X1,Y1) :-
83 xdim(XD), ydim(YD),
84 X in 1..XD, X1 in 1..XD, Y in 1..YD, Y1 in 1..YD, D in 1..4,
85 (D#=1) #/\ (X1#=X) #/\ (Y1#=Y+1) % north
86 #\/ (D#=3) #/\ (X1#=X) #/\ (Y1#=Y-1) % south
87 #\/ (D#=2) #/\ (X1#=X+1) #/\ (Y1#=Y) % east
88 #\/ (D#=4) #/\ (X1#=X-1) #/\ (Y1#=Y). % west
89
90init(Z0) :- Z0 = [has(2),wumpus(WX,WY)|Z],
91 xdim(XD), ydim(YD), XD1 is XD+1, YD1 is YD+1,
92 WX in 1..XD, WY in 1..YD,
93 not_holds(wumpus(1,1),Z0),
94 not_holds_all(wumpus(_,_),Z),
95 not_holds(dead,Z),
96 not_holds(pit(1,1),Z),
97 not_holds_all(pit(_,0),Z), %boundary
98 not_holds_all(pit(_,YD1),Z),
99 not_holds_all(pit(0,_),Z),
100 not_holds_all(pit(XD1,_),Z),
101 not_holds_all(at(_,_),Z),
102 not_holds_all(facing(_),Z),
103 duplicate_free(Z0).
104
105flux2main :- init_simulator,
106 init(Z0), execute(enter,Z0,Z1),
107 Cpts=[1,1,[1,2]], Vis=[[1,1]], Btr=[],
108 main_loop(Cpts,Vis,Btr,Z1).
109
110main_loop([X,Y,Choices|Cpts],Vis,Btr,Z) :-
111 Choices=[Dir|Dirs] ->
112 (explore(X,Y,Dir,Vis,Z,Z1) ->
113 knows_val([X1,Y1],at(X1,Y1),Z1),
114 hunt_wumpus(X1,Y1,Z1,Z2),
115 (knows(gold(X1,Y1),Z2) ->
116 execute(grab,Z2,Z3), go_home(Z3)
117 ; Cpts1=[X1,Y1,[1,2,3,4],X,Y,Dirs|Cpts],
118 Vis1=[[X1,Y1]|Vis], Btr1=[X,Y|Btr],
119 main_loop(Cpts1,Vis1,Btr1,Z2) )
120 ; main_loop([X,Y,Dirs|Cpts],Vis,Btr,Z) )
121 ; backtrack(Cpts,Vis,Btr,Z).
122
123explore(X,Y,D,V,Z1,Z2) :-
124 adjacent(X,Y,D,X1,Y1), \+ member([X1,Y1],V),
125 knows_not(pit(X1,Y1),Z1),
126 (knows_not(wumpus(X1,Y1),Z1);knows(dead,Z1)),
127 turn_to(D,Z1,Z), execute(go,Z,Z2).
128
129backtrack(_,_,[],Z) :- execute(exit,Z,_).
130backtrack(Cpts,Vis,[X,Y|Btr],Z) :-
131 go_back(X,Y,Z,Z1), main_loop(Cpts,Vis,Btr,Z1).
132
133go_back(X,Y,Z1,Z2) :-
134 holds(at(X1,Y1),Z1), adjacent(X1,Y1,D,X,Y),
135 turn_to(D,Z1,Z), execute(go,Z,Z2).
136
137turn_to(D,Z1,Z2) :-
138 knows(facing(D),Z1) -> Z2=Z1
139 ; execute(turn,Z1,Z), turn_to(D,Z,Z2).
140
141hunt_wumpus(X,Y,Z1,Z2) :-
142 \+ knows(dead,Z1),
143 knows_val([WX,WY],wumpus(WX,WY),Z1),
144 in_direction(X,Y,D,WX,WY)
145 -> turn_to(D,Z1,Z), execute(shoot,Z,Z2)
146 ; Z2=Z1.
147
148in_direction(X,Y,D,X1,Y1) :-
149 xdim(XD), ydim(YD),
150 X in 1..XD, X1 in 1..XD, Y in 1..YD, Y1 in 1..YD, D in 1..4,
151 (D#=1) #/\ (X1#=X) #/\ (Y1#>Y) % north
152 #\/ (D#=3) #/\ (X1#=X) #/\ (Y1#<Y) % south
153 #\/ (D#=2) #/\ (X1#>X) #/\ (Y1#=Y) % east
154 #\/ (D#=4) #/\ (X1#<X) #/\ (Y1#=Y). 155
156go_home(Z) :- write('Planning...'),
157 a_star_plan(Z,S), execute(S,Z,Z1), execute(exit,Z1,_).
165:- dynamic visited/2. 166
167a_star_plan(Z,S) :-
168 retractall(visited(_,_)),
169 knows_val([X,Y],at(X,Y),Z), assertz(visited(X,Y)),
170 a_star(Z,[[],0,100000],S).
171
172a_star(Z,[Sit,Cost,_|L],S) :-
173 findall([A,H], a_star_do(Z,Sit,A,H), Actions),
174 ( member([Action,0], Actions) -> S=do(Action,Sit)
175 ;
176 insert_all(Actions, Sit, Cost, L, L1),
177 a_star(Z, L1, S) ).
178
179insert_all([],_,_,L,L).
180
181insert_all([[A,H]|As],S,C,L,L2) :-
182 insert_all(As,S,C,L,L1),
183 Cost is C+1, Heuristic is Cost+H,
184 ins(do(A,S),Cost,Heuristic,L1,L2).
185
186ins(S1,C1,H1,[S2,C2,H2|L],L2) :-
187 ( H1>H2 -> ins(S1,C1,H1,L,L1), L2=[S2,C2,H2|L1]
188 ;
189 L2=[S1,C1,H1,S2,C2,H2|L] ).
190
191ins(S,C,H,[],[S,C,H]).
192
193a_star_do(Z,S,A,H) :-
194 ( S=do(go_to(X,Y),_) -> true ; knows_val([X,Y],at(X,Y),Z) ),
195 ( D=4 ; D=3 ; D=2 ; D=1 ),
196 adjacent(X,Y,D,X1,Y1), \+ visited(X1,Y1),
197 knows_not(pit(X1,Y1),Z),
198 ( \+ knows(dead,Z)->knows_not(wumpus(X1,Y1),Z)
199 ; true ),
200 A = go_to(X1,Y1),
201 assertz(visited(X1,Y1)),
202 H is X1+Y1-2.
203
204complex_action(do(A,S),Z1,Z2) :-
205 execute(S,Z1,Z), execute(A,Z,Z2).
206
207complex_action(go_to(X,Y),Z1,Z2) :-
208 holds(at(X1,Y1),Z1), adjacent(X1,Y1,D,X,Y),
209 turn_to(D,Z1,Z), execute(go,Z,Z2)