El famoso problema del 15-puzzle en Prolog

Uno de los problemas clásicos dentro del campo de la Inteligencia Artificial simbólica es el 15-puzzle. Es exactamente igual que el 8-puzzle, pero con un tablero más grande. La idea es que tenemos un tablero cuadrado NxN (en el caso del 15-puzzle, N=4; en el 8-puzzle, N=3) donde hay piezas desordenadas y tenemos que ordenarlas para que se siga la secuencia numérica en orden. Realmente hay una pieza que falta y que usamos de hueco para intercambiar posiciones. Las piezas se pueden mover arriba, abajo, a la izquierda o a la derecha pero solo si la casilla a donde vamos es donde está el hueco (y el hueco pasa a donde estaba la pieza antes).

Este problema se puede resolver de distintas formas. Nos servirá para probar diferentes técnicas de resolución en Prolog.

Tablero que vamos a resolver (resolución óptima en 34 movimientos):

Solución por backtracking

Ya que Prolog implementa backtracking por nosotros de forma transparente, esta solución es la más natural y sencilla que podemos hacer en Prolog. La idea es partir de un estado inicial (en este caso va a ser el de la foto) y proveer predicados de movimientos (izquierda, derecha, arriba, abajo) entre un estado y otro que solo se puedan dar si el movimiento es posible dada las reglas. Vamos almacenando el historial de movimientos válidos en una lista hasta llegar al tablero resuelto. El propio backtracking de Prolog nos irá descartando los movimientos que aunque fueron válidos no nos llevaban a la solución final.

Nuestra primera versión será esto:

medium_state(table(13,9,5,4,15,6,1,8,void,10,2,11,14,3,7,12)).
end_state(table(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,void)).


solve(S0, H, H) :-
    end_state(S0).
solve(S0, H0, H) :-
    move(M, S0, S),
    solve(S, [M|H0], H).

move(left, table(X1,void,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(void,X1,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,void,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,void,X2,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,void,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,X2,void,X3,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,void,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,void,X5,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,void,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,void,X6,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,X7,void,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,X6,void,X7,X9,X10,X11,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,void,X11,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,void,X9,X11,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,void,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,void,X10,X12,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,void,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,void,X11,X13,X14,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,void,X15,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,void,X13,X15,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,void,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,void,X14,X16)).
move(left, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,void), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,void,X15)).
    
move(right, S0, S) :-
    move(left, S, S0).

move(up, table(X1,X2,X3,X4,void,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(void,X2,X3,X4,X1,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,void,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,void,X3,X4,X5,X2,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,void,X8,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,X2,void,X4,X5,X6,X3,X8,X9,X10,X11,X12,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,void,X9,X10,X11,X12,X13,X14,X15,X16), table(X1,X2,X3,void,X5,X6,X7,X4,X9,X10,X11,X12,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,void,X10,X11,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,void,X6,X7,X8,X5,X10,X11,X12,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,void,X11,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,void,X7,X8,X9,X6,X11,X12,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,void,X12,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,X6,void,X8,X9,X10,X7,X12,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,void,X13,X14,X15,X16), table(X1,X2,X3,X4,X5,X6,X7,void,X9,X10,X11,X8,X13,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,void,X14,X15,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,void,X10,X11,X12,X9,X14,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,void,X15,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,void,X11,X12,X13,X10,X15,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,void,X16), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,void,X12,X13,X14,X11,X16)).
move(up, table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,void), table(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,void,X13,X14,X15,X12)).

move(down, S0, S) :-
    move(up, S, S0).

La mayor parte del código es definir los movimientos posibles (aprovechamos que left/right y up/down son inversos para reducir código). El predicado solve tiene dos reglas. En una, se comprueba si ya hemos llegado al estado final. En la otra, se hace un movimiento y se vuelve a llamar a solve. El movimiento realizado se guarda en una lista que usamos de historial.

Este código podría funcionar en ciertos problemas pero en este puzzle no, ya que es muy fácil caer en bucles de movimientos de los que no se puede salir. Es por ello que hay que modificar solve para introducir un set de estados ya visitados. Si volvemos a llegar a un estado ya visitado, no aceptamos el movimiento y Prolog por backtracking intentará buscar otra solución (y deshacerá el historial, ...)

solve(S0, _, H, H) :-
    end_state(S0).
solve(S0, Visited, H0, H) :-
    move(M, S0, S),
    \+ member(S, Visited),
    solve(S, [S|Visited], [M|H0], H).

% ?- medium_state(S), solve(S, [], [], H).

Este código ya sí, generará una solución. Pero tiene dos problemas: la solución tardará mucho en calcularse y el camino que obtengamos en el historial no será óptimo probablemente. ¿Por qué? Porque Prolog por defecto tiene una estrategia de búsqueda que es Depth First Search. Es decir, ante una disyuntiva de qué camino tomar, elige el que añade más pasos sobre el estado donde se encuentra. Esta opción se eligió porque es muy eficiente en uso de memoria, pero es muy mala en CPU y en este problema no garantiza optimalidad, aunque sí encontrar una solución (si la solución existe y evitamos bucles infinitos).

Breadth First Search

Un algoritmo alternativo es Breadth First Search. En este caso, tendremos que modificar el predicado solve nuevamente, pero el resto puede ser igual. En este caso, vamos a ir guardando los estados que visitar en una lista, de modo que los primeros estados que vayamos descubriendo son los primeros que vamos a ir analizando. Solo cuando hayamos acabado con los estados de N movimientos, pasará a los de N+1 movimientos. En este caso concreto, la solución sí será óptima. Sin embargo, ahora el historial y el set de visitados deben arrastrarse en cada estado, lo que aumenta el uso de memoria.

solve([state(S0,_,H)|_], H) :-
    end_state(S0).
solve([state(S0, Visited, H0)|States], H) :-
    findall(state(S, [S0|Visited], [M|H0]), (move(M, S0, S),\+ member(S, Visited)), NewStates),
    append(States, NewStates, AllStates),
    solve(AllStates, H).

% ?- medium_state(S), solve([state(S, [], [])], H).

Con este nuevo solve, vamos añadiendo los estados que tenemos que visitar a una lista, añadiéndolos al final y siempre que no estén repetidos dentro del set de visitados de cada estado. Además se guarda el histórico de como se ha llegado a cada estado. Con ciertas instancias del puzzle, este método puede ser ya bastante rápido, sobre todo si sabemos que se necesitan pocos movimientos para acabar. Pero en otros casos puede tardar bastante todavía y encima, gasta mucha más memoria. Por suerte, hay otros algoritmos.

Algoritmo A*

Tanto DFS como BFS son algoritmos de búsqueda no informados. Eso quiere decir que van explorando las posibles soluciones sin ninguna "pista" que les indique por donde es mejor ir. A* es un algoritmo de búsqueda informado. En este caso, calculamos una heurística, que es una pista de por donde tiene que seguir la búsqueda, acortando el número de nodos a comprobar (idealmente). Si queremos obtener un resultado óptimo al finalizar el algoritmo deberemos usar heurísticas admisibles. Una heurística se considera admisible si no estima de más el costo de una acción futura.

Una heurística muy popular es calcular la distancia de Manhattan de cada elemento respecto a donde debería estar. Es admisible y no supone mucha carga calcularla. Otras heurísticas interesantes son la Walking Distance y los patrones precalculados

solve([_-state(S0,H,_)|_], _, H) :-
    end_state(S0).
solve([_-state(S0, H0, N0)|States], Visited, H) :-
    findall(F-state(S, [M|H0], N), (
        move(M, S0, S),
        \+ member(_-state(S,_,_), States),
        \+ member(S, Visited),
        h_value(S, HVal),
        N is N0+1,
        F is HVal + N
    ), NewStates),
    append(States, NewStates, AllStates),!,
    keysort(AllStates, OrderedAllStates),
    solve(OrderedAllStates, [S0|Visited], H).

h_value(S, H) :-
    S =.. [_|Ls],
    maplist(distance(Ls), Ls, Ds),
    sum_list(Ds, H).

distance(_, void, 0) :- !.
distance(Ls, E, D) :-
    nth0(N, Ls, E),
    X0 is N // 4,
    Y0 is N mod 4,
    X1 is (E-1) // 4,
    Y1 is (E-1) mod 4,
    D is abs(X1-X0)+abs(Y1-Y0).

% ?- medium_state(S), solve([0-state(S, [], 0)], [], H).

Con este código implementamos A* en Prolog. La lista de estados a visitar (o abiertos) es lo primero que se le pasa a solve. Cada estado tiene primero su valor de F para que el predicado estándar keysort/2 pueda ordenar los estados según F. Después cada estado tiene su valor, su histórico y su número N de coste hasta llegar al estado. Es necesario para calcular en los nuevos estados el nuevo F. Para cada estado nuevo, que no esté en la lista, ni se haya visitado, se calcula el valor de la heurística H (distancia de Manhattan). Se calcula F con la suma del nuevo valor N (en este caso el coste siempre es 1, todos los movimientos cuestan igual) y el valor de H. Posteriormente se añade a la lista y se reordenan.

Algunos tiempos por aquí en mi máquina, sin ser muy exhaustivo: