Пролог для восьмерки

введите здесь описание изображения

%999 represent Blank tile.

goal([999,0,1, 2,3,4, 5,6,7]).

%To move left in any row ther are two cases:
%Case_1: Blank tile in the second index.
%Case_2: Blank tile in the third index.

% move left in the top row
move([X0,999,X2, X3,X4,X5, X6,X7,X8],
     [999,X0,X2, X3,X4,X5, X6,X7,X8]). %second

move([X0,X1,999, X3,X4,X5, X6,X7,X8],
     [X0,999,X1, X3,X4,X5, X6,X7,X8]). %third


% move left in the middle row
move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,X1,X2, 999,X3,X5, X6,X7,X8]). %second

move([X0,X1,X2, X3,X4,999, X6,X7,X8]
    ,[X0,X1,X2, X3,999,X4, X6,X7,X8]). %third

% move left in the bottom row
move([X0,X1,X2, X3,X4,X5, X6,999,X8],
     [X0,X1,X2, X3,X4,X5, 999,X6,X8]). %second

move([X0,X1,X2, X3,X4,X5, X6,X7,999],
     [X0,X1,X2, X3,X4,X5, X6,999,X7]). %third

% To move right in any row there are two cases:
% Case_1: 999 tile in the first index.
% Case_2: 999 tile in the second index.

% move right in the top row
move([999,X1,X2, X3,X4,X5, X6,X7,X8],
     [X1,999,X2, X3,X4,X5, X6,X7,X8]). %first

move([X0,999,X2, X3,X4,X5, X6,X7,X8],
     [X0,X2,999, X3,X4,X5, X6,X7,X8]). %seond

%% move right in the middle row
move([X0,X1,X2, 999,X4,X5, X6,X7,X8],
     [X0,X1,X2, X4,999,X5, X6,X7,X8]). %first

move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,X1,X2, X3,X5,999,X6,X7,X8]). %second

%% move right in the bottom row
move([X0,X1,X2, X3,X4,X5, 999,X7,X8],
     [X0,X1,X2, X3,X4,X5, X7,999,X8]). %first

move([X0,X1,X2, X3,X4,X5, X6,999,X8],
     [X0,X1,X2, X3,X4,X5, X6,X8,999]). %second

%It is not possible to move up when existing in the top row.
% so, moving up will only be possible from bottom and middle rows from
% the three indecies.

%% move up from the middle row
move([X0,X1,X2, 999,X4,X5, X6,X7,X8],
     [999,X1,X2, X0,X4,X5, X6,X7,X8]). %first

move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,999,X2, X3,X1,X5, X6,X7,X8]). %second

move([X0,X1,X2, X3,X4,999, X6,X7,X8],
     [X0,X1,999, X3,X4,X2, X6,X7,X8]).  %third

%% move up from the bottom row
move([X0,X1,X2, X3,X4,X5, 999,X7,X8],
     [X0,X1,X2, 999,X4,X5, X3,X7,X8]). %first

move([X0,X1,X2, X3,X4,X5, X6,999,X8],
     [X0,X1,X2, X3,999,X5, X6,X4,X8]). %second

move([X0,X1,X2, X3,X4,X5, X6,X7,999],
     [X0,X1,X2, X3,X4,999, X6,X7,X5]). %third

%  moving down only from the middle and top rows from the three
%  indicies.

%  move down from the top row
move([999,X1,X2, X3,X4,X5, X6,X7,X8],
     [X3,X1,X2, 999,X4,X5, X6,X7,X8]). %first

move([X0,999,X2, X3,X4,X5, X6,X7,X8],
     [X0,X4,X2, X3,999,X5, X6,X7,X8]). %second

move([X0,X1,999, X3,X4,X5, X6,X7,X8],
     [X0,X1,X5, X3,X4,999, X6,X7,X8]). %third

%% move down from the middle row
move([X0,X1,X2, 999,X4,X5, X6,X7,X8],
     [X0,X1,X2, X6,X4,X5, 999,X7,X8]). %first

move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,X1,X2, X3,X7,X5, X6,999,X8]). %second

move([X0,X1,X2, X3,X4,999, X6,X7,X8],
     [X0,X1,X2, X3,X4,X8, X6,X7,999]). %third



dfs(S, Path, Path) :-
    goal(S),!.

dfs(S, Checked, Path) :-
    % try a move
    move(S, S2),
    % ensure the resulting state is new
    \+member(S2, Checked),
    % and that this state leads to the goal
    dfs(S2, [S2|Checked], Path).

%SS: state start
%SE: state end
%path(SS, Checked, MoveList):-
   % move(SS, Snext),
   % \+member(Snext, Checked),
   % path(Snext,[Snext|Checked], [Snext, SS|MoveList]).

%path(_,_, MoveList):-
    %output(MoveList).

% Printing
%output([]) :- nl.
%output([[A,B]|MoveList]) :-
%   output(MoveList),
%   write(B), write(' -> '), write(A), nl.

find :-
    dfs([6,1,3 4,999,5, 7,2,0],_,_).

prolog sliding-tile-puzzle
person yara elbenasy    schedule 21.05.2021    source источник
comment
Добро пожаловать в Stack Overflow. Вы опубликовали проблему и некоторый код, но забыли объяснить, с какой именно проблемой вам нужна помощь. Пожалуйста, отредактируйте ваш вопрос, чтобы объяснить вашу проблему. Если вы начнете с тура и прочитаете Как спросить это может помочь вам лучше задать вопрос.   -  person David Buck    schedule 21.05.2021
comment
Вы забыли запятую в начальном списке в find, но это все равно не работает..   -  person David Tonhofer    schedule 21.05.2021
comment
Подход хороший, хотя не уверен, в чем проблема. У меня есть альтернативный код, использующий матричное представление [ [A,B,C], [D,E,F], [G,H,I] ] с использованием итеративного углубления, которое находит решение из 26 ходов (т.е. самое короткое) после длительного поиска.   -  person David Tonhofer    schedule 22.05.2021
comment
В чем разница между неосведомленным поиском и возвратом? Я бы сказал, что это то же самое - поиск с возвратом является поиском в глубину.   -  person David Tonhofer    schedule 22.05.2021

Ответы (2)


arrow_upward
0
arrow_downward

Другое альтернативное решение, где:

  • состояния представлены в виде терминов, а
  • итеративный поиск с углублением управляется с помощью предиката length/2.

При такой реализации решение было найдено примерно за 40 секунд (SWI-Prolog, v.8.2.4).

ids :-
   start(State),
   length(Moves, N),
   dfs([State], Moves, Path), !,
   show([start|Moves], Path),
   format('~nmoves = ~w~n', [N]).

dfs([State|States], [], Path) :-
   goal(State), !,
   reverse([State|States], Path).

dfs([State|States], [Move|Moves], Path) :-
   move(State, Next, Move),
   not(memberchk(Next, [State|States])),
   dfs([Next,State|States], Moves, Path).

show([], _).
show([Move|Moves], [State|States]) :-
   State = state(A,B,C,D,E,F,G,H,I),
   format('~n~w~n~n', [Move]),
   format('~w ~w ~w~n',[A,B,C]),
   format('~w ~w ~w~n',[D,E,F]),
   format('~w ~w ~w~n',[G,H,I]),
   show(Moves, States).

% Empty position is marked with '*'

start( state(6,1,3,4,*,5,7,2,0) ).

goal( state(*,0,1,2,3,4,5,6,7) ).

move( state(*,B,C,D,E,F,G,H,J), state(B,*,C,D,E,F,G,H,J), right).
move( state(*,B,C,D,E,F,G,H,J), state(D,B,C,*,E,F,G,H,J), down ).
move( state(A,*,C,D,E,F,G,H,J), state(*,A,C,D,E,F,G,H,J), left ).
move( state(A,*,C,D,E,F,G,H,J), state(A,C,*,D,E,F,G,H,J), right).
move( state(A,*,C,D,E,F,G,H,J), state(A,E,C,D,*,F,G,H,J), down ).
move( state(A,B,*,D,E,F,G,H,J), state(A,*,B,D,E,F,G,H,J), left ).
move( state(A,B,*,D,E,F,G,H,J), state(A,B,F,D,E,*,G,H,J), down ).
move( state(A,B,C,*,E,F,G,H,J), state(*,B,C,A,E,F,G,H,J), up   ).
move( state(A,B,C,*,E,F,G,H,J), state(A,B,C,E,*,F,G,H,J), right).
move( state(A,B,C,*,E,F,G,H,J), state(A,B,C,G,E,F,*,H,J), down ).
move( state(A,B,C,D,*,F,G,H,J), state(A,*,C,D,B,F,G,H,J), up   ).
move( state(A,B,C,D,*,F,G,H,J), state(A,B,C,D,F,*,G,H,J), right).
move( state(A,B,C,D,*,F,G,H,J), state(A,B,C,D,H,F,G,*,J), down ).
move( state(A,B,C,D,*,F,G,H,J), state(A,B,C,*,D,F,G,H,J), left ).
move( state(A,B,C,D,E,*,G,H,J), state(A,B,*,D,E,C,G,H,J), up   ).
move( state(A,B,C,D,E,*,G,H,J), state(A,B,C,D,*,E,G,H,J), left ).
move( state(A,B,C,D,E,*,G,H,J), state(A,B,C,D,E,J,G,H,*), down ).
move( state(A,B,C,D,E,F,*,H,J), state(A,B,C,D,E,F,H,*,J), left ).
move( state(A,B,C,D,E,F,*,H,J), state(A,B,C,*,E,F,D,H,J), up   ).
move( state(A,B,C,D,E,F,G,*,J), state(A,B,C,D,E,F,*,G,J), left ).
move( state(A,B,C,D,E,F,G,*,J), state(A,B,C,D,*,F,G,E,J), up   ).
move( state(A,B,C,D,E,F,G,*,J), state(A,B,C,D,E,F,G,J,*), right).
move( state(A,B,C,D,E,F,G,H,*), state(A,B,C,D,E,*,G,H,F), up   ).
move( state(A,B,C,D,E,F,G,H,*), state(A,B,C,D,E,F,G,*,H), left ).

Пример запуска:

?- time(ids).

start

6 1 3
4 * 5
7 2 0

left

6 1 3
* 4 5
7 2 0

up

* 1 3
6 4 5
7 2 0

right

1 * 3
6 4 5
7 2 0

down

1 4 3
6 * 5
7 2 0

right

1 4 3
6 5 *
7 2 0

down

1 4 3
6 5 0
7 2 *

left

1 4 3
6 5 0
7 * 2

left

1 4 3
6 5 0
* 7 2

up

1 4 3
* 5 0
6 7 2

right

1 4 3
5 * 0
6 7 2

right

1 4 3
5 0 *
6 7 2

down

1 4 3
5 0 2
6 7 *

left

1 4 3
5 0 2
6 * 7

left

1 4 3
5 0 2
* 6 7

up

1 4 3
* 0 2
5 6 7

right

1 4 3
0 * 2
5 6 7

right

1 4 3
0 2 *
5 6 7

up

1 4 *
0 2 3
5 6 7

left

1 * 4
0 2 3
5 6 7

left

* 1 4
0 2 3
5 6 7

down

0 1 4
* 2 3
5 6 7

right

0 1 4
2 * 3
5 6 7

right

0 1 4
2 3 *
5 6 7

up

0 1 *
2 3 4
5 6 7

left

0 * 1
2 3 4
5 6 7

left

* 0 1
2 3 4
5 6 7

moves = 26
% 97,719,612 inferences, 40.344 CPU in 40.991 seconds (98% CPU, 2422175 Lips)
true.
person slago    schedule 22.05.2021

arrow_upward
0
arrow_downward

Альтернативный подход, при котором текущее состояние (представляющее состояние доски) в пространстве поиска представлено матрицей: список из 3 списков. Позиции в этой матрице задаются координатами столбца и строки, каждая из которых находится в диапазоне от 0 до 2:

 +--------------> Col (0,1,2)
 |
 |   [[A0,B0,C0],
 |    [D0,E0,F0],
 |    [G0,H0,I0]]
 V
 Row (0,1,2)

Если позиция матрицы должна представлять собой пустую ячейку, мы записываем пустой список в этой позиции (потому что это выглядит красиво), в противном случае мы пишем одно из целых чисел 0..7.

target( [[ [] ,0 ,1],   
         [  2 ,3 ,4],
         [  5 ,6 ,7]]).

from( [[6 ,1  ,3],
       [4 ,[] ,5],
       [7 ,2  ,0]]).

% A *backtrackable* predicate which proposes a new position (RowNew,ColNew)
% for the hole at position (Row,Col). The hole is moved in direction 
% MoveDirection
% This is not as nice as pattern matching over a pair of
% states because you can't make it run "backwards" to determine a
% move and input matrix from an output matrix.

% new_hole_position(Row,Col,RowNew,ColNew,MoveDirection)

new_hole_position(Row,Col,RowNew,Col,down)  :- Row < 2, RowNew is Row+1. 
new_hole_position(Row,Col,RowNew,Col,up)    :- Row > 0, RowNew is Row-1. 
new_hole_position(Row,Col,Row,ColNew,right) :- Col < 2, ColNew is Col+1.
new_hole_position(Row,Col,Row,ColNew,left)  :- Col > 0, ColNew is Col-1.

% Pick the value at (Row,Col) from MatrixIn into ValOld and
% Put ValNew at (Row,Col), giving MatrixOut. This is used to
% generate a new state from an existing state and a "hole move".

pick_and_put_matrix(Row,Col,MatrixIn,ValOld,ValNew,MatrixOut) :-
   pick_and_put(Row,MatrixIn,RowlistOld,RowlistNew,MatrixOut),
   pick_and_put(Col,RowlistOld,ValOld,ValNew,RowlistNew).

pick_and_put(Index,ListIn,ValOld,ValNew,ListOut) :-
   length(Prefix,Index), 
   append([Prefix,[ValOld],Suffix],ListIn),
   append([Prefix,[ValNew],Suffix],ListOut),
   !.

% Moving the hole from (Row,Col) to (RowNew,ColNew)

move_hole(Row,Col,RowNew,ColNew,MatrixIn,MatrixOut) :-
   pick_and_put_matrix(Row,Col,MatrixIn,[],Val,MatrixMid),
   pick_and_put_matrix(RowNew,ColNew,MatrixMid,Val,[],MatrixOut).

% Find out where the hole is in MatrixIn as we don't
% keep track of that information.

cur_hole_position(Row,Col,MatrixIn) :-
   nth0(Row,MatrixIn,RowList),
   cur_hole_position_in_row(Col,RowList),!.
   
cur_hole_position_in_row(Col,RowList) :- 
   nth0(Col,RowList,[]).

% For showing off, the number of states visited is counted in
% a thread-local variable that is non-backtrackably incremented.

nb_inc_counter :-
  nb_getval(counter,X),
  XX is X+1,
  nb_setval(counter,XX).
  
% The search proper. Perform a single move from one state (matrix) 
% to the next state (matrix)
%
% move(+CurrentState,+GoalState,
%      -SolutionAsGrowingOpenListToWhichOneAppends
%      +StatesOnPathSoAsToNotVisitAStateTwiceToWhichOnePrepends,
%      +DepthCountdownForIterativeDeepening)

move(Matrix,Matrix,[],_,_) :- !.
move(MatrixIn,MatrixTarget,[MatrixMid|Moves],MatrixesOnPath,Depth) :-
   Depth > 1, 
   nb_inc_counter,
   cur_hole_position(Row,Col,MatrixIn),
   new_hole_position(Row,Col,RowNew,ColNew,_MoveDirection),
   move_hole(Row,Col,RowNew,ColNew,MatrixIn,MatrixMid),
   \+ member(MatrixMid,MatrixesOnPath),
   SmallerDepth is Depth-1,
   move(MatrixMid,MatrixTarget,Moves,[MatrixMid|MatrixesOnPath],SmallerDepth).

% Printout curclicues

print_and_reset_counter :-
   nb_getval(counter,C),
   (C>0 
    -> format("Examined ~d positions~n",[C]) 
    ;  true),
   nb_setval(counter,0).

format_moves([Matrix],_) :-
   format_matrix(Matrix).
format_moves([Matrix,Matrix2|Moves],Index) :-
   format_matrix(Matrix),
   format("Move ~d~n",[Index]),
   Index2 is Index+1,
   format_moves([Matrix2|Moves],Index2).

format_matrix([[A,B,C],[D,E,F],[G,H,I]]) :-
   enlarge(A,AE),
   enlarge(B,BE),
   enlarge(C,CE),
   enlarge(D,DE),
   enlarge(E,EE),
   enlarge(F,FE),
   enlarge(G,GE),
   enlarge(H,HE),
   enlarge(I,IE),
   format("+--------+~n",[]),
   format("|~s,~s,~s|~n",[AE,BE,CE]),
   format("|~s,~s,~s|~n",[DE,EE,FE]),
   format("|~s,~s,~s|~n",[GE,HE,IE]),
   format("+--------+~n",[]).
   
enlarge(X,XE) :-
   format(string(S)," ~q",[X]),
   sub_string(S,_,2,0,XE).

% "Main" predicate.

run(Moves) :- 
   from(MatrixFrom),
   target(MatrixTarget),  
   nb_setval(counter,0),
   between(1,30,MaxDepth), % backtrackable; iterative deepening
   print_and_reset_counter,
   format("Maximum depth is ~d~n",[MaxDepth]),
   move(MatrixFrom,MatrixTarget,Moves,[MatrixFrom],MaxDepth),
   announce_success([MatrixFrom|Moves]).

announce_success(Moves) :-   
   length(Moves,Length),
   AdjustedLength is Length-1,
   nb_getval(counter,C),
   format("Found a solution of ~d moves by examination of ~d positions.~n",[AdjustedLength,C]),
   format_moves(Moves,1).

И так:

?- run(Moves).
Maximum depth is 1
Maximum depth is 2
Examined 1 positions
Maximum depth is 3
Examined 5 positions
Maximum depth is 4
Examined 13 positions
Maximum depth is 5
Examined 21 positions
Maximum depth is 6
Examined 37 positions
Maximum depth is 7
Examined 69 positions
Maximum depth is 8
Examined 133 positions
Maximum depth is 9
Examined 213 positions
Maximum depth is 10
Examined 373 positions
Maximum depth is 11
Examined 645 positions
Maximum depth is 12
Examined 1189 positions
Maximum depth is 13
Examined 1941 positions
Maximum depth is 14
Examined 3437 positions
Maximum depth is 15
Examined 5797 positions
Maximum depth is 16
Examined 10517 positions
Maximum depth is 17
Examined 17349 positions
Maximum depth is 18
Examined 30965 positions
Maximum depth is 19
Examined 51765 positions
Maximum depth is 20
Examined 93333 positions
Maximum depth is 21
Examined 154709 positions
Maximum depth is 22
Examined 277093 positions
Maximum depth is 23
Examined 461541 positions
Maximum depth is 24
Examined 829917 positions
Maximum depth is 25
Examined 1378229 positions
Maximum depth is 26
Examined 2472253 positions
Maximum depth is 27
Found a solution of 26 moves by examination of 3712817 positions.
+--------+
| 6, 1, 3|
| 4,[], 5|
| 7, 2, 0|
+--------+
Move 1
+--------+
| 6, 1, 3|
|[], 4, 5|
| 7, 2, 0|
+--------+
Move 2
+--------+
|[], 1, 3|
| 6, 4, 5|
| 7, 2, 0|
+--------+
Move 3
+--------+
| 1,[], 3|
| 6, 4, 5|
| 7, 2, 0|
+--------+
Move 4
+--------+
| 1, 4, 3|
| 6,[], 5|
| 7, 2, 0|
+--------+
Move 5
+--------+
| 1, 4, 3|
| 6, 2, 5|
| 7,[], 0|
+--------+
Move 6
+--------+
| 1, 4, 3|
| 6, 2, 5|
|[], 7, 0|
+--------+
Move 7
+--------+
| 1, 4, 3|
|[], 2, 5|
| 6, 7, 0|
+--------+
Move 8
+--------+
| 1, 4, 3|
| 2,[], 5|
| 6, 7, 0|
+--------+
Move 9
+--------+
| 1, 4, 3|
| 2, 5,[]|
| 6, 7, 0|
+--------+
Move 10
+--------+
| 1, 4,[]|
| 2, 5, 3|
| 6, 7, 0|
+--------+
Move 11
+--------+
| 1,[], 4|
| 2, 5, 3|
| 6, 7, 0|
+--------+
Move 12
+--------+
|[], 1, 4|
| 2, 5, 3|
| 6, 7, 0|
+--------+
Move 13
+--------+
| 2, 1, 4|
|[], 5, 3|
| 6, 7, 0|
+--------+
Move 14
+--------+
| 2, 1, 4|
| 5,[], 3|
| 6, 7, 0|
+--------+
Move 15
+--------+
| 2, 1, 4|
| 5, 3,[]|
| 6, 7, 0|
+--------+
Move 16
+--------+
| 2, 1, 4|
| 5, 3, 0|
| 6, 7,[]|
+--------+
Move 17
+--------+
| 2, 1, 4|
| 5, 3, 0|
| 6,[], 7|
+--------+
Move 18
+--------+
| 2, 1, 4|
| 5,[], 0|
| 6, 3, 7|
+--------+
Move 19
+--------+
| 2, 1, 4|
| 5, 0,[]|
| 6, 3, 7|
+--------+
Move 20
+--------+
| 2, 1,[]|
| 5, 0, 4|
| 6, 3, 7|
+--------+
Move 21
+--------+
| 2,[], 1|
| 5, 0, 4|
| 6, 3, 7|
+--------+
Move 22
+--------+
| 2, 0, 1|
| 5,[], 4|
| 6, 3, 7|
+--------+
Move 23
+--------+
| 2, 0, 1|
| 5, 3, 4|
| 6,[], 7|
+--------+
Move 24
+--------+
| 2, 0, 1|
| 5, 3, 4|
|[], 6, 7|
+--------+
Move 25
+--------+
| 2, 0, 1|
|[], 3, 4|
| 5, 6, 7|
+--------+
Move 26
+--------+
|[], 0, 1|
| 2, 3, 4|
| 5, 6, 7|
+--------+
person David Tonhofer    schedule 22.05.2021
comment
Определенно хочу использовать хорошую эвристику и альфа-бета вместо перебора. - person David Tonhofer; 22.05.2021