1:- use_module(library('clp/clpfd')).    2:- use_module(library('chr/chr_runtime')).    3:- use_module(library(chr)).    4
    5type_prolog(swi).
    6
    7:- [flux].
   15xdim(10).
   16ydim(12).
   22no_of_random_pits(12).
   23
   24
   25:- [wumpus_simulator].   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
  105main :- 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). % west
  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)