Start state

8

7

6

5

4

3

2

1

Goal State

1

2

3

4

5

6

7

8

According to the scoring of the original kif file, the shortest solutions are 30 moves, which the version I've put on Swish manages to find, but takes about 15 seconds.

The 8 puzzle is commonly used in AI textbooks as an introduction to heuristic search, with the heuristic here being the sum of the "Manhattan distances" of all blocks from their goal positions.

After guessing a reward for a state, we then need to prune bad values. As is common with games and puzzles, the value of the states as we head toward the goal is not monotonic, ie the value doesn't steadily increase. For instance in chess, winning often means sacrificing a valuable piece to lure the opponent into a losing position. To get a computer to understand short term pain for long term gain, we need to give a wide fudge factor. In this example, giving a wide fudge factor comes at the expense of time and space.

Tightening the pruning based on the heuristic value from:

badval(move(_Parent, _, _, goal(_, Val))) :-
    bestval(Best),
    Val < Best - 4.

deadstate(Limit, NoSteps, move(Parent, Action, Child, Goal)) :-
    memberchk(step(Limit), Parent),
    (    deadleaf(move(Parent, Action, Child, Goal))
    ;    cycle(NoSteps, move(Parent, Action, Child, Goal))
    ;    badval(move(Parent, Action, Child, Goal))
    ).

to Val < Max - 3 speeds up getting a solution to about a tenth, ie under 1.5 seconds, but at the price of increasing the path to 34 actions.

This puzzle will overwhelm most computers without using a guestimate heuristic value to keep the search space manageable.

Heuristics

The only values GDL can definitively value are terminals as wins, loses or draws. The values provided for nonterminals are something less than 100 which we've been ignoring. The sliding block puzzle brings in a combinatorial explosion which is unmanageable unless we try give each nonterminal state a guestimate value.

:- dynamic true/1, does/2, bestval/1.

update_bestval(Val) :-
    (bestval(Best); Best = 0),
    (    Val > Best
    ->   retractall(bestval(_)),
         assertz(bestval(Val))
    ;    true
    ).

findreward(Role, State, goal(Role, Reward)) :-
    update_state(State),
    (    terminal
    ->   goal(Role, Reward)
    ;    heuristic(State, goal(Role, Reward))
    ),
    update_bestval(Reward).

The full code is:

:- dynamic true/1, does/2, bestval/1.

role(player).

index(1).
index(2).
index(3).
tile(1).
tile(2).
tile(3).
tile(4).
tile(5).
tile(6).
tile(7).
tile(8).
tile(b).

init(cell(1, 1, 8)).
init(cell(1, 2, 7)).
init(cell(1, 3, 6)).
init(cell(2, 1, 5)).
init(cell(2, 2, 4)).
init(cell(2, 3, 3)).
init(cell(3, 1, 2)).
init(cell(3, 2, 1)).
init(cell(3, 3, b)).
init(step(0)).

inorder :- 
    true(cell(1, 1, 1)),
    true(cell(1, 2, 2)),
    true(cell(1, 3, 3)),
    true(cell(2, 1, 4)),
    true(cell(2, 2, 5)),
    true(cell(2, 3, 6)),
    true(cell(3, 1, 7)),
    true(cell(3, 2, 8)),
    true(cell(3, 3, b)).

legal(player, move(X, Y)) :-
    true(cell(U, Y, b)),
    (succ(X, U) ; succ(U, X)), 
    index(X).

legal(player, move(X, Y)) :-
    true(cell(X, V, b)), 
    (succ(Y, V) ; succ(V, Y)), 
    index(Y).

next(step(X)) :- 
    true(step(Y)),
    succ(Y, X).

next(cell(X, Y, b)) :- 
    does(player, move(X, Y)).

next(cell(U, Y, Z)) :-
    does(player, move(X, Y)), 
    true(cell(U, Y, b)), 
    true(cell(X, Y, Z)), 
    Z \== b.

next(cell(X, V, Z)) :-
    does(player, move(X, Y)),
    true(cell(X, V, b)),
    true(cell(X, Y, Z)),
    Z \== b.

next(cell(U, V, Z)) :-
    true(cell(U, V, Z)), 
    does(player, move(X, Y)), 
    (X \== U ; Y \== V), 
    true(cell(X1, Y1, b)), 
    (X1 \== U ; Y1 \== V).


goal(player, 100) :- inorder.
goal(player, 0) :- \+inorder.
terminal :- inorder.
terminal :- true(step(60)).

manhattan_distance(cell(R1, C1, T), cell(R2, C2, T), Distance) :-
    Distance is abs(R1 - R2) + abs(C1 - C2).

heuristic_(_, [], Value, Value).
heuristic_(Goal, [step(_)|State], Value, Acc) :-
    heuristic_(Goal, State, Value, Acc).
heuristic_(Goal, [cell(_, _, b)|State], N, Acc) :-
    heuristic_(Goal, State, N, Acc).
heuristic_(Goal, [cell(R1, C1, T)|State], N, Acc) :-
    T \== b,
    memberchk(cell(R2, C2, T), Goal),
    manhattan_distance(cell(R1, C1, T), cell(R2, C2, T), Distance),
    M is N + 5 - Distance,
    heuristic_(Goal, State, M, Acc).

heuristic(State, goal(Player, Value)) :-
    Goal = [cell(1, 1, 1), cell(1, 2, 2), cell(1, 3, 3), 
            cell(2, 1, 4), cell(2, 2, 5), cell(2, 3, 6), 
            cell(3, 1, 7), cell(3, 2, 8), cell(3, 3, b)],
    role(Player),
    heuristic_(Goal, State, 0, Value).

findinits(Start) :-
  findall(Base, init(Base), Unsorted),
  sort(Unsorted, Start).

update_state(State) :-
  retractall(true(_)), 
  forall(member(Base, State), assertz(true(Base))).

update_does(Player, Action) :-
  retractall(does(Player, _)), 
  assertz(does(Player, Action)).

findlegals(Role, Legals) :-
    findall(legal(Role, Action), legal(Role, Action), Unsorted),
    sort(Unsorted, Legals).

findnext(legal(Role, Action), Next) :-
    update_does(Role, Action),
    findall(Base, next(Base), Unsorted),
    sort(Unsorted, Next).

update_bestval(Val) :-
    (bestval(Best); Best = 0),
    (    Val > Best
    ->   retractall(bestval(_)),
         assertz(bestval(Val))
    ;    true
    ).

findreward(Role, State, goal(Role, Reward)) :-
    update_state(State),
    (    terminal
    ->   goal(Role, Reward)
    ;    heuristic(State, goal(Role, Reward))
    ),
    update_bestval(Reward).

combinelists(_, [], [], [], []).
combinelists(State, [legal(Player, Action)|Legals], [Next|Nexts], [Goal|Goals],
             [move(State, does(Player, Action), Next, Goal)|Moves]) :-
    combinelists(State, Legals, Nexts, Goals, Moves).

generatemoves_(_, []) :-
    terminal.

generatemoves_(Parent, Moves) :-
    \+terminal,
    role(Player),
    findlegals(Player, Legals),
    maplist(findnext, Legals, Nexts),
    maplist(findreward(Player), Nexts, Rewards),
    combinelists(Parent, Legals, Nexts, Rewards, Moves).

generatemoves(Parent, Moves) :-
    update_state(Parent),
    generatemoves_(Parent, Moves), !.

remove_culdesacs([], Graph, Graph).
remove_culdesacs([move(Parent, _, _, _)|DeadEnds], GraphIn, Acc) :-
    findall(move(Grandparent, Action, Parent, Goal),
            (   member(move(Grandparent, Action, Parent, Goal), GraphIn),
                \+memberchk(move(Parent, _, _, _), GraphIn)
            ), Ps),
    subtract(GraphIn, Ps, GraphOut),
    append(Ps, DeadEnds, Unsorted),
    sort(Unsorted, NewDeadEnds),
    remove_culdesacs(NewDeadEnds, GraphOut, Acc).

removestep(move(Parent, _, _, _), NoStep) :-
    select(step(_), Parent, NoStep).

deadleaf(move(_Parent, _, Child, goal(_, Value))) :-
    Value < 100,
    update_state(Child),
    terminal.

cycle(NoSteps, move(_Parent, _, Child, _)) :-
    select(step(_), Child, NoStep),
    memberchk(NoStep, NoSteps).

badval(move(_Parent, _, _, goal(_, Val))) :-
    bestval(Best),
    Val < Best - 4.

deadstate(Limit, NoSteps, move(Parent, Action, Child, Goal)) :-
    memberchk(step(Limit), Parent),
    (    deadleaf(move(Parent, Action, Child, Goal))
    ;    cycle(NoSteps, move(Parent, Action, Child, Goal))
    ;    badval(move(Parent, Action, Child, Goal))
    ).

childless(M, Graph, move(Parent, _, Child, _)) :-
    succ(N, M),
    member(step(N), Parent),
    \+memberchk(move(Child, _, _, _), Graph).

prune(Limit, Unpruned, Pruned) :-
    maplist(removestep, Unpruned, NoSteps),
    exclude(deadstate(Limit, NoSteps), Unpruned, G3),
    partition(childless(Limit, G3), G3, Childless, G4),
    remove_culdesacs(Childless, G4, Pruned).

getchildren(Parent, Visited, Children) :-
    generatemoves(Parent, Moves),
    findall(Move, 
            (member(Move, Moves), \+memberchk(Move, Visited)), 
            NoDuplicates),  
    sort(NoDuplicates, Children).

depthfirst(_, [], RGraph, Graph) :-
    reverse(RGraph, Graph).

depthfirst(Limit, [move(Parent, Action, Child, Goal)|Frontier], Visited, Acc) :-
    memberchk(step(Depth), Child),
    Depth \== Limit,
    depthfirst(Limit, Frontier, [move(Parent, Action, Child, Goal)|Visited], Acc).

depthfirst(Limit, [move(Parent, Action, Child, Goal)|Frontier], Visited, Acc) :-
    memberchk(step(Limit), Child),
    getchildren(Child, Visited, GrandChildren),
    append(GrandChildren, Frontier, NewFrontier),
    depthfirst(Limit, NewFrontier, 
               [move(Parent, Action, Child, Goal)|Visited], Acc).

iterative_deepening(_, Graph, Graph) :-
    memberchk(move(_, _, _, goal(_, 100)), Graph).

iterative_deepening(Depth, GraphIn, Acc) :-
    \+memberchk(move(_, _, _, goal(_, 100)), GraphIn),
    depthfirst(Depth, GraphIn, [], Unpruned),
    Unpruned \== GraphIn,
    prune(Depth, Unpruned, GraphOut),
    succ(Depth, Limit),
    iterative_deepening(Limit, GraphOut, Acc).

getactions(Start, Graph, [Node|_], Actions, [Action|Actions]) :-
    member(move(Start, Action, Node, _), Graph).

getactions(Start, Graph, [Child|Path], Actions, Acc) :-
    member(move(Parent, Action, Child, _), Graph),
    Parent \== Start,
    getactions(Start, Graph, [Parent, Child|Path], [Action|Actions], Acc).

route(Actions) :-
    retractall(bestval(_)),
    assertz(bestval(0)),
    findinits(Start),
    getchildren(Start, [], G1),
    prune(0, G1, G2),
    iterative_deepening(1, G2, G3),
    member(move(_, _, End, goal(_, 100)), G3),
    getactions(Start, G3, [End], [], Actions).

EightPuzzle (last edited 2021-09-26 08:25:27 by RobertLaing)