|
|
pl:prolog:pllib:sliding_puzzle [2019/06/27 15:50] |
pl:prolog:pllib:sliding_puzzle [2019/06/27 15:50] (aktualna) |
| ====== Sliding puzzle ====== |
| {{tag>puzzle problem_solving}} |
| ===== Description ===== |
| Program solve scrabble shown on ukladanka.png |
| |
| {{:prolog:pllib:sliding_puzzle.png|}} |
| |
| **Source**: PrologTutorial (on-line tutorial |
| |
| |
| |
| ===== Download ===== |
| Program source code: {{sliding_puzzle.pl}} |
| ===== Listing ===== |
| <code prolog> |
| /* 8_puzzle.pl */ |
| |
| |
| |
| %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
| %%% |
| |
| %%% A* Algorithm |
| |
| %%% |
| |
| %%% |
| |
| %%% Nodes have form S#D#F#A |
| |
| %%% where S describes the state or configuration |
| |
| %%% D is the depth of the node |
| |
| %%% F is the evaluation function value |
| |
| %%% A is the ancestor list for the node |
| |
| |
| |
| :- op(400,yfx,'#'). /* Node builder notation */ |
| |
| |
| |
| solve(State,Soln) :- f_function(State,0,F), |
| |
| search([State#0#F#[]],S), reverse(S,Soln). |
| |
| |
| |
| f_function(State,D,F) :- h_function(State,H), |
| |
| F is D + H. |
| |
| |
| |
| search([State#_#_#Soln|_], Soln) :- goal(State). |
| |
| search([B|R],S) :- expand(B,Children), |
| |
| insert_all(Children,R,Open), |
| |
| search(Open,S). |
| |
| |
| |
| insert_all([F|R],Open1,Open3) :- insert(F,Open1,Open2), |
| |
| insert_all(R,Open2,Open3). |
| |
| insert_all([],Open,Open). |
| |
| |
| |
| insert(B,Open,Open) :- repeat_node(B,Open), ! . |
| |
| insert(B,[C|R],[B,C|R]) :- cheaper(B,C), ! . |
| |
| insert(B,[B1|R],[B1|S]) :- insert(B,R,S), !. |
| |
| insert(B,[],[B]). |
| |
| |
| |
| repeat_node(P#_#_#_, [P#_#_#_|_]). |
| |
| |
| |
| cheaper( _#_#F1#_ , _#_#F2#_ ) :- F1 < F2. |
| |
| |
| |
| expand(State#D#_#S,All_My_Children) :- |
| |
| bagof(Child#D1#F#[Move|S], |
| |
| (D1 is D+1, |
| |
| move(State,Child,Move), |
| |
| f_function(Child,D1,F)), |
| |
| All_My_Children). |
| |
| |
| |
| %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
| %%% |
| |
| %%% 8-puzzle solver |
| |
| %%% |
| |
| %%% |
| |
| %%% State have form A/B/C/D/E/F/G/H/I |
| |
| %%% where {A,...,I} = {0,...,8} |
| |
| %%% 0 represents the empty tile |
| |
| %%% |
| |
| |
| |
| goal(1/2/3/8/0/4/7/6/5). |
| |
| |
| |
| %%% The puzzle moves |
| |
| |
| |
| left( A/0/C/D/E/F/H/I/J , 0/A/C/D/E/F/H/I/J ). |
| |
| left( A/B/C/D/0/F/H/I/J , A/B/C/0/D/F/H/I/J ). |
| |
| left( A/B/C/D/E/F/H/0/J , A/B/C/D/E/F/0/H/J ). |
| |
| left( A/B/0/D/E/F/H/I/J , A/0/B/D/E/F/H/I/J ). |
| |
| left( A/B/C/D/E/0/H/I/J , A/B/C/D/0/E/H/I/J ). |
| |
| left( A/B/C/D/E/F/H/I/0 , A/B/C/D/E/F/H/0/I ). |
| |
| |
| |
| up( A/B/C/0/E/F/H/I/J , 0/B/C/A/E/F/H/I/J ). |
| |
| up( A/B/C/D/0/F/H/I/J , A/0/C/D/B/F/H/I/J ). |
| |
| up( A/B/C/D/E/0/H/I/J , A/B/0/D/E/C/H/I/J ). |
| |
| up( A/B/C/D/E/F/0/I/J , A/B/C/0/E/F/D/I/J ). |
| |
| up( A/B/C/D/E/F/H/0/J , A/B/C/D/0/F/H/E/J ). |
| |
| up( A/B/C/D/E/F/H/I/0 , A/B/C/D/E/0/H/I/F ). |
| |
| |
| |
| right( A/0/C/D/E/F/H/I/J , A/C/0/D/E/F/H/I/J ). |
| |
| right( A/B/C/D/0/F/H/I/J , A/B/C/D/F/0/H/I/J ). |
| |
| right( A/B/C/D/E/F/H/0/J , A/B/C/D/E/F/H/J/0 ). |
| |
| right( 0/B/C/D/E/F/H/I/J , B/0/C/D/E/F/H/I/J ). |
| |
| right( A/B/C/0/E/F/H/I/J , A/B/C/E/0/F/H/I/J ). |
| |
| right( A/B/C/D/E/F/0/I/J , A/B/C/D/E/F/I/0/J ). |
| |
| |
| |
| down( A/B/C/0/E/F/H/I/J , A/B/C/H/E/F/0/I/J ). |
| |
| down( A/B/C/D/0/F/H/I/J , A/B/C/D/I/F/H/0/J ). |
| |
| down( A/B/C/D/E/0/H/I/J , A/B/C/D/E/J/H/I/0 ). |
| |
| down( 0/B/C/D/E/F/H/I/J , D/B/C/0/E/F/H/I/J ). |
| |
| down( A/0/C/D/E/F/H/I/J , A/E/C/D/0/F/H/I/J ). |
| |
| down( A/B/0/D/E/F/H/I/J , A/B/F/D/E/0/H/I/J ). |
| |
| |
| |
| %%% the heuristic function |
| |
| h_function(Puzz,H) :- p_fcn(Puzz,P), |
| |
| s_fcn(Puzz,S), |
| |
| H is P + 3*S. |
| |
| |
| |
| |
| |
| %%% the move |
| |
| move(P,C,left) :- left(P,C). |
| |
| move(P,C,up) :- up(P,C). |
| |
| move(P,C,right) :- right(P,C). |
| |
| move(P,C,down) :- down(P,C). |
| |
| |
| |
| %%% the Manhattan distance function |
| |
| p_fcn(A/B/C/D/E/F/G/H/I, P) :- |
| |
| a(A,Pa), b(B,Pb), c(C,Pc), |
| |
| d(D,Pd), e(E,Pe), f(F,Pf), |
| |
| g(G,Pg), h(H,Ph), i(I,Pi), |
| |
| P is Pa+Pb+Pc+Pd+Pe+Pf+Pg+Ph+Pg+Pi. |
| |
| |
| |
| a(0,0). a(1,0). a(2,1). a(3,2). a(4,3). a(5,4). a(6,3). a(7,2). a(8,1). |
| |
| b(0,0). b(1,1). b(2,0). b(3,1). b(4,2). b(5,3). b(6,2). b(7,3). b(8,2). |
| |
| c(0,0). c(1,2). c(2,1). c(3,0). c(4,1). c(5,2). c(6,3). c(7,4). c(8,3). |
| |
| d(0,0). d(1,1). d(2,2). d(3,3). d(4,2). d(5,3). d(6,2). d(7,2). d(8,0). |
| |
| e(0,0). e(1,2). e(2,1). e(3,2). e(4,1). e(5,2). e(6,1). e(7,2). e(8,1). |
| |
| f(0,0). f(1,3). f(2,2). f(3,1). f(4,0). f(5,1). f(6,2). f(7,3). f(8,2). |
| |
| g(0,0). g(1,2). g(2,3). g(3,4). g(4,3). g(5,2). g(6,2). g(7,0). g(8,1). |
| |
| h(0,0). h(1,3). h(2,3). h(3,3). h(4,2). h(5,1). h(6,0). h(7,1). h(8,2). |
| |
| i(0,0). i(1,4). i(2,3). i(3,2). i(4,1). i(5,0). i(6,1). i(7,2). i(8,3). |
| |
| |
| |
| %%% the out-of-cycle function |
| |
| s_fcn(A/B/C/D/E/F/G/H/I, S) :- |
| |
| s_aux(A,B,S1), s_aux(B,C,S2), s_aux(C,F,S3), |
| |
| s_aux(F,I,S4), s_aux(I,H,S5), s_aux(H,G,S6), |
| |
| s_aux(G,D,S7), s_aux(D,A,S8), s_aux(E,S9), |
| |
| S is S1+S2+S3+S4+S5+S6+S7+S8+S9. |
| |
| |
| |
| s_aux(0,0) :- !. |
| |
| s_aux(_,1). |
| |
| |
| |
| s_aux(X,Y,0) :- Y is X+1, !. |
| |
| s_aux(8,1,0) :- !. |
| |
| s_aux(_,_,2). |
| |
| |
| |
| %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
| %%% |
| |
| %%% 8-puzzle animation -- using VT100 character graphics |
| |
| %%% |
| |
| %%% |
| |
| %%% |
| |
| |
| |
| puzzle(P) :- solve(P,S), |
| |
| animate(P,S), |
| |
| message. |
| |
| |
| |
| animate(P,S) :- initialize(P), |
| |
| cursor(1,2), write(S), |
| |
| cursor(1,22), write('Hit ENTER to step solver.'), |
| |
| get0(_X), |
| |
| play_back(S). |
| |
| |
| |
| :- dynamic location/3. %%% So that location of a tile |
| |
| %%% can be retracted/asserted. |
| |
| %%% Location(s) asserted and retracted |
| |
| %%% by puzzle animator below |
| |
| |
| |
| initialize(A/B/C/D/E/F/H/I/J) :- |
| |
| cls, |
| |
| retractall(location(_,_,_)), |
| |
| assert(location(A,20,5)), |
| |
| assert(location(B,30,5)), |
| |
| assert(location(C,40,5)), |
| |
| assert(location(F,40,10)), |
| |
| assert(location(J,40,15)), |
| |
| assert(location(I,30,15)), |
| |
| assert(location(H,20,15)), |
| |
| assert(location(D,20,10)), |
| |
| assert(location(E,30,10)), draw_all. |
| |
| |
| |
| draw_all :- draw(1), draw(2), draw(3), draw(4), |
| |
| draw(5), draw(6), draw(7), draw(8). |
| |
| |
| |
| %%% play_back([left,right,up,...]). |
| |
| play_back([M|R]) :- call(M), get0(_X), play_back(R). |
| |
| play_back([]) :- cursor(1,24). %%% Put cursor out of the way |
| |
| |
| |
| message :- nl,nl, |
| |
| write(' ********************************************'), nl, |
| |
| write(' * Enter 8-puzzle goals in the form ... *'), nl, |
| |
| write(' * ?- puzzle(0/8/1/2/4/3/7/6/5). *'), nl, |
| |
| write(' * Enter goal ''message'' to reread this. *'), nl, |
| |
| write(' ********************************************'), nl, nl. |
| |
| |
| |
| |
| |
| cursor(X,Y) :- put(27), put(91), %%% ESC [ |
| |
| write(Y), |
| |
| put(59), %%% ; |
| |
| write(X), |
| |
| put(72). %%% M |
| |
| |
| |
| %%% clear the screen, quickly |
| |
| cls :- put(27), put("["), put("2"), put("J"). |
| |
| |
| |
| %%% video attributes -- bold and blink not working |
| |
| plain :- put(27), put("["), put("0"), put("m"). |
| |
| reverse_video :- put(27), put("["), put("7"), put("m"). |
| |
| |
| |
| |
| |
| %%% Tile objects, character map(s) |
| |
| %%% Each tile should be drawn using the character map, |
| |
| %%% drawn at 'location', which is asserted and retracted |
| |
| %%% by 'playback'. |
| |
| character_map(N, [ [' ',' ',' ',' ',' ',' ',' '], |
| |
| [' ',' ',' ', N ,' ',' ',' '], |
| |
| [' ',' ',' ',' ',' ',' ',' '] ]). |
| |
| |
| |
| |
| |
| %%% move empty tile (spot) to the left |
| |
| left :- retract(location(0,X0,Y0)), |
| |
| Xnew is X0 - 10, |
| |
| location(Tile,Xnew,Y0), |
| |
| assert(location(0,Xnew,Y0)), |
| |
| right(Tile),right(Tile),right(Tile), |
| |
| right(Tile),right(Tile), |
| |
| right(Tile),right(Tile),right(Tile), |
| |
| right(Tile),right(Tile). |
| |
| |
| |
| up :- retract(location(0,X0,Y0)), |
| |
| Ynew is Y0 - 5, |
| |
| location(Tile,X0,Ynew), |
| |
| assert(location(0,X0,Ynew)), |
| |
| down(Tile),down(Tile),down(Tile),down(Tile),down(Tile). |
| |
| |
| |
| right :- retract(location(0,X0,Y0)), |
| |
| Xnew is X0 + 10, |
| |
| location(Tile,Xnew,Y0), |
| |
| assert(location(0,Xnew,Y0)), |
| |
| left(Tile),left(Tile),left(Tile),left(Tile),left(Tile), |
| |
| left(Tile),left(Tile),left(Tile),left(Tile),left(Tile). |
| |
| |
| |
| down :- retract(location(0,X0,Y0)), |
| |
| Ynew is Y0 + 5, |
| |
| location(Tile,X0,Ynew), |
| |
| assert(location(0,X0,Ynew)), |
| |
| up(Tile),up(Tile),up(Tile),up(Tile),up(Tile). |
| |
| |
| |
| |
| |
| draw(Obj) :- reverse_video, character_map(Obj,M), |
| |
| location(Obj,X,Y), |
| |
| draw(X,Y,M), plain. |
| |
| |
| |
| %%% hide tile |
| |
| hide(Obj) :- character_map(Obj,M), |
| |
| location(Obj,X,Y), |
| |
| hide(X,Y,M). |
| |
| |
| |
| hide(_,_,[]). |
| |
| hide(X,Y,[R|G]) :- hide_row(X,Y,R), |
| |
| Y1 is Y + 1, |
| |
| hide(X,Y1,G). |
| |
| |
| |
| hide_row(_,_,[]). |
| |
| hide_row(X,Y,[_|R]) :- cursor(X,Y), |
| |
| write(' '), |
| |
| X1 is X + 1, |
| |
| hide_row(X1,Y,R). |
| |
| |
| |
| %%% draw tile |
| |
| draw(_,_,[]). |
| |
| draw(X,Y,[R|G]) :- draw_row(X,Y,R), |
| |
| Y1 is Y + 1, |
| |
| draw(X,Y1,G). |
| |
| |
| |
| draw_row(_,_,[]). |
| |
| draw_row(X,Y,[P|R]) :- cursor(X,Y), |
| |
| write(P), |
| |
| X1 is X + 1, |
| |
| draw_row(X1,Y,R). |
| |
| |
| |
| %%% Move an Object up |
| |
| up(Obj) :- hide(Obj), |
| |
| retract(location(Obj,X,Y)), |
| |
| Y1 is Y - 1, |
| |
| assert(location(Obj,X,Y1)), |
| |
| draw(Obj). |
| |
| |
| |
| down(Obj) :- hide(Obj), |
| |
| retract(location(Obj,X,Y)), |
| |
| Y1 is Y + 1, |
| |
| assert(location(Obj,X,Y1)), |
| |
| draw(Obj). |
| |
| |
| |
| left(Obj) :- hide(Obj), |
| |
| retract(location(Obj,X,Y)), |
| |
| X1 is X - 1, |
| |
| assert(location(Obj,X1,Y)), |
| |
| draw(Obj). |
| |
| |
| |
| right(Obj) :- hide(Obj), |
| |
| retract(location(Obj,X,Y)), |
| |
| X1 is X + 1, |
| |
| assert(location(Obj,X1,Y)), |
| |
| draw(Obj). |
| |
| |
| |
| :- message. |
| |
| |
| |
| % ?- solve(0/8/1/2/4/3/7/6/5, S). |
| |
| </code> |
| ===== Comments ===== |
| |