Пятнашки
Развиваем тему решателей пятнашек. Теперь используем алгоритм IDA*
Работает - очень быстро. Малые требования к ресурсам.
| 2 | 5 | 4 | 6 |
| 1 | 13 | 11 | 3 |
| 14 | 12 | 7 | 10 |
| 8 | 15 | 9 | 0 |
В пятнашки можно поиграть :)
Результат движения пустой клетки(U-вверх, D-вниз, R-вправо,L-влево):
ULURULDRDLLUULDRRDDLLURRDRULDLLURRDRULURDLDR
Те же 44 хода. Но в отличии от A*, в котором расчет получался за 8 мин., теперь получаем время решения 1 сек.
program fifth;
//uses crt;
{// IDA* algorithm}
const dx:array of integer = (0,-1,0,1);//смещения пустой клетки
dy:array of integer = (1,0,-1,0);
{//var moveDescription:Array = new Array("D", "L", "U", "R"); }
move_desc:array of char = ('D','L','U','R');// Возможные ходы
opposite_move:array of integer = (2, 3, 0, 1);// Противоположные ходы (2, 3, 0, 1)
{//var oppositeMove:Array = new Array(2, 3, 0, 1); }
const infinity = 10000;
var x0, // координаты пустой клетки
y0:integer; // координаты пустой клетки
var goalX:Array[0..15] of integer; //goalX[i] - координата x i-й пятнашки, ...
goalY:Array[0..15] of integer;
board:Array[0..3,0..3] of integer; // доска
step:integer;
var boardGoal : Array[0..3,0..3] of integer; // доска целевого состояния
var minPrevIteration, deepness:integer; // глубина
var resultString:string; //результат
//минимум стоимости среди нерассмотренных узлов
//--------------------------------
//инициализирует целевое состояние
procedure initGoalArrays;
begin
var i:integer;
for i:=0 to 14 do
begin
goalX[i+1] := i mod 4;
goalY[i+1] := i div 4;
end;
goalX[0]:= 4;
goalY[0]:= 4;
end;
//меняет местами две пятнашки
procedure swap(y1, x1, y2, x2:integer);
begin
var value1,value2:integer;
value1 := board[y1][x1];
value2 := board[y2][x2];
board[y1][x1] := value2;
board[y2][x2] := value1;
end;
//определяет "решаемость" пятнашек
function isSolvable:Boolean;
begin
var count, transpos, value, i,j:integer;
count:= 0;
transpos:= 0;
value:= 0;
var a:Array[0..16] of integer;
for i:= 0 to 3 do begin
if (i mod 2 = 0) then begin
for j:= 0 to 3 do begin
value := board[i][j];
if (value > 0) then begin
a[count] := value;
inc(count);
end;
end;
end
else begin
for j := 3 downto 0 do begin
value := board[i][j];
if (value > 0) then begin
a[count]:= value;
inc(count);
end;
end;
end;
end;
for i:= 0 to count - 2 do begin
for j:= i + 1 to count-1 do begin
if (a[i] > a[j]) then begin
inc(transpos);
end;
end;
end;
isSolvable:=false;
if (transpos mod 2) = 1 then begin
isSolvable:= true;
end;
end;
//718508644774274130
//10446283839894545490
//эвристическая оценочная функция Манхеттеновское расстояние
function estimate:integer;
begin
var manhattan,i,j,value,m:integer;
manhattan:=0;
for i:= 0 to 3 do
for j:= 0 to 3 do begin
value := board[i][j];
if ((value > 0) {and (value <> boardGoal[i][j])}) then begin
m:=abs(i - goalY[value]) + abs(j - goalX[value]);
manhattan := manhattan + m;
end;
end;
estimate:=manhattan;
end;
//поиск в глубину с обрезанием f=g+h < deepness
function recSearch(g, previousMove, x0, y0:integer):Boolean;
begin
var h,i:integer;
h := estimate;
// h = минимум ходов к цели
if (h = 0) then begin
recSearch:= true; // если это цель - ура!
exit;
end;
// если то, что мы прошли (g) + то, что нам как минимум осталось (h)
// больше допустимой глубины - выход.
var f:integer;
f:= g + h;
if (f > deepness) then begin
//нaходим минимум стоимости среди "обрезаных" узлов
if (minPrevIteration > f) then minPrevIteration := f;
recSearch:= false;
exit;
end;
var newx,newy:integer;
var res:boolean;
// делаем всевозможные ходы
for i:= 0 to 3 do begin
if opposite_move[i] <> previousMove then begin
// новые координаты пустой клетки
newx:= x0 + dx[i];
newy:= y0 + dy[i];
if ((newy <= 3) and (newy >= 0) and (newx <= 3) and (newx >= 0)) then begin
swap(y0, x0, newy, newx); // двигаем пустую клетку на новое место
res:= recSearch(g + 1, i, newx, newy); // рекурсивный поиск с новой позиции
swap(y0, x0, newy, newx); // возвращаем пустую клетку назад
if (res = true) then begin //если было найдено решение
resultString := move_desc[i] + resultString; //записываем этот ход
inc(step);
recSearch:= true; // и выходим
exit;
end;
end;
end;
end;
recSearch:= false; //цели не нашли
end;
// итерация глубины и IDA*
function idaStar:Boolean;
begin
var res:Boolean;
var j,i:integer;
res:= false;
deepness := estimate; // начинаем с h для начального состояния
while deepness <= 50 do begin
minPrevIteration := infinity; // инициализация для поиска минимума
// поиск пустой клетки
for i:= 0 to 3 do
for j:= 0 to 3 do begin
if (board[i][j] = 0) then begin
x0 := j;
y0 := i;
end;
end;
step:=0;
res := recSearch(0, -1, x0, y0);
deepness := minPrevIteration;
if res then break;
end;
idaStar:= res;
end;
// ----------------------------
begin
initGoalArrays();
// Исходная доска
board[0][0] := 2;
board[0][1] := 5;
board[0][2] := 4;
board[0][3] := 6;
board[1][0] := 1;
board[1][1] := 13;
board[1][2] := 11;
board[1][3] := 3;
board[2][0] := 14;
board[2][1] := 12;
board[2][2] := 7;
board[2][3] := 10;
board[3][0] := 8;
board[3][1] := 15;
board[3][2] := 9;
board[3][3] := 0;
// Целевая доска
boardGoal[0][0] := 1;
boardGoal[0][1] := 2;
boardGoal[0][2] := 3;
boardGoal[0][3] := 4;
boardGoal[1][0] := 5;
boardGoal[1][1] := 6;
boardGoal[1][2] := 7;
boardGoal[1][3] := 8;
boardGoal[2][0] := 9;
boardGoal[2][1] := 10;
boardGoal[2][2] := 11;
boardGoal[2][3] := 12;
boardGoal[3][0] := 13;
boardGoal[3][1] := 14;
boardGoal[3][2] := 15;
boardGoal[3][3] := 0;
if not isSolvable then begin// если задача нерешаема
writeln('Задача неразрешима');
end
else if (estimate = 0) then begin//если это уже цель
writeln('Это уже цель');
end
else if (idaStar) then begin //делаем IDA* поиск
writeln('Количество ходов:',step);
writeln('Путь:'+ resultString); //выводим результат
end
else
writeln('IDA* failed');
end.