Swap( Empty, Tile, Ts, Ts1)

Mandist(X/Y, X1/Y1, D):- dif(X, X1, Dx),

Dif(Y, Y1, Dy),

D is Dx + Dy. % D - это манхэттенское расстояние

% между двумя клетками

dif(A, B, D):- % D равно IA-B|

D is A-B, D >= 0,!;

D is B-A.

% Эвристическая оценка h представляет собой сумму расстояний от каждой фишки

% до ее "исходной" клетки плис утроенное значение "оценки упорядоченности"

h([Empty | Tiles], H):-

goal([Empty1 | GoalSquares]),

totdist(Tiles, GoalSquares, D), % Суммарное расстояние от исходных клеток

seq(Tiles, S), % Оценка упорядоченности

H is D + 3*S.

totdist([], [], 0).

totdist([Tile | Tiles], [Square | Squares], D):-

Mandist(Tile, Square, D1),

Totdist(Tiles, Squares, D2),

D is D1 + D2.

% seq(TilePositions, Score): оценка упорядоченности

seq([First | OtherTiles], S):-

seq([First | OtherTiles], First, S).

seq([Tile1, Tile2 | Tiles], First, S):-

Score(Tile1, Tile2, S1),

seq([Tile2 | Tiles], First, S2),

S is S1 + S2.

seq([Last], First, S):-

Score(Last, First, S).

score(2/2, _, 1):-!. % Оценка фишки, стоящей в центре, равна 1

score(1/3, 2/3,0):-!. % Оценка фишки, за которой следует

% допустимый преемник, равна 0

score(2/3, 3/3, 0):-!.

score(3/3, 3/2, 0):-!.

score(3/2, 3/1, 0):-!.

score(3/1, 2/1, 0):-!.

score(2/1, 1/1, 0):-!.

score(1/1, 1/2, 0):-!.

score(1/2, 1/3, 0):-!.

score(_, _, 2). % Оценка фишки, за которой следует

% недопустимый преемник, равна 2

goal([2/2,1/3,2/3,3/3,3/2,3/1,2/1,1/1,1/2]). % Исходные клетки для фишек

% Показать путь решения как список позиций на доске

showsol([]).

showsol([P | L]):-

Showsol(L),

Nl, write('---'),

Showpos(P).

% Показать позицию на доске

showpos([S0,S1,S2,S3,S4,S5,S6,S7,S8]):-

member(Y, [3,2,1]), % Последовательность координат Y

nl, member(X, [1,2,3]), % Последовательность координат х

member(Tile-X/Y, % Фишка в клетке X/Y

[' '-S0,1-S1,2-S2,3-S3,4-S4,5-S5, 6-S6,7-S7, 8-S8 ]),

Write(Tile),

fail; % Выполнить перебор с возвратом к следующей клетке

true. % Обработка всех клеток закончена

% Начальные позиции для некоторых задач

start1([2/2,1/3,3/2,2/3,3/3,3/1,2/1,1/1,1/2]). % Требует 4 хода

start2([2/1,1/2,1/3,3/3,3/2,3/1,2/2,1/1,2/3]). % Требует 5 ходов

start3([2/2,2/3,1/3,3/1,1/2,2/1,3/3,1/1,3/2]). % Требует 19 ходов

% Пример запроса:?- start1(Pos), bestfirst(Pos, Sol), showsol(Sol).

%-----Поиск по заданному критерию

Evrpoisk(Start,Solve):-

max_f(Fmax), % Fmax > любой f-оценки

propag([],l(Start,0/0),Fmax,_,yes,Solve).

propag(P,l(B,_),_,_,yes,[B|P]):-

goal(B). % рассматриваемый лист – цель поиска.

Propag(P,l(B,F/G),Extr,Tree1,Is_solv,Solve):-

F=<Extr, % получение дерева из приемников листа

Bagof(B1/C,(s(B,B1,C),not(member(B1,P))),Successers),

!,suc_list(G,Successers,TT), %after -s

Opt_f(TT,F1),

Propag(P,tr(B,F1/G,TT),Extr,Tree1,Is_solv,Solve).

Propag(P,l(B,F/G),Extr,Tree1,never,Solve):-

F=<Extr. % Нет приемников – тупик

propag(P,tr(B,F/G,[T|TT]),Extr,Tree1,Is_solv,Solve):-

F=<Extr, % Продолжить дерево

Opt_f(TT,OF),

Min(Extr,OF,Extr1),

propag([B|P],T,Extr1,T1,Is_solv1,Solve),

continue(P,tr(B,F/G,[T1,TT]),Extr,Tree1,Is_solv1,Is_solv,Solve).

propag(_,tr(_,_,[]),_,_,never,_):-!. % Тупиковое дерево - нет решений

Propag(_,Tree,Extr,Tree,no,_):-

f(Tree,F),F>Extr. % Рост остановлен

Continue(_,_,_,_,yes,yes,Solve).

continue(P,tr(B,F/G,[T1,TT]),Extr,Tree1,no,Is_solv,Solve):-

Insert(T1,TT,NTT),

Opt_f(NTT,F1),

Propag(P,tr(B,F1/G,NTT),Extr,Tree1,Is_solv,Solve).

continue(P,tr(B,F/G,[T1,TT]),Extr,Tree1,never,Is_solv,Solve):-

Opt_f(TT,F1),