Generate and Prune

Danger ahead in PuzzleSolving is combinatorial explosion, what Richard Bellman termed the curse of dimensionality. An advantage IterativeDeepening is that by generating the graph step-by-step, we can also prune dead ends early, thereby avoiding the search space mushrooming into a pyramid of doom, keeping our problem space a skinny tree for efficiency.

SWI Prolog has a handy builtin exclude(:Goal, +List1, ?List2) ideal for pruning listified graphs. We'll use the example below with some cycle traps at m and optional paths to target t to test our algorithms.

tree_nroute.svg

Filtering out cycles

If a freshly generated Child is in the visited list as a Parent, we have a cycle to get filtered out. The following predicate will spot these.

cycle(Limit, Graph, arc(Limit, _, Child)) :-
      memberchk(arc(_, Child, _), Graph).

prune(Limit, _End, GraphIn, GraphOut) :-
    exclude(cycle(Limit, GraphIn), GraphIn, GraphOut).

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

prune will get more elaborate, but iterative_deepening will follow the above template for the rest of this example.

ButtonsAndLights is an example of a puzzle whose problem space can be kept very skinny simply by filtering out cycles.

Nipping dead leaves in the bud

In this example, we know a Child node is a terminal if it doesn't have a grandchild node. Unless it's our goal node, there's no need to keep it.

deadleaf(Limit, End, arc(Limit, _, Child)) :-
    Child \== End,
    \+arc(Child, _).

prune(Limit, End, GraphIn, GraphOut) :-
    exclude(cycle(Limit, GraphIn), GraphIn, G1),
    exclude(deadleaf(Limit, End), G1, GraphOut).

For route(a, t, Path), filtering so far reduces our problem space to this:

tree_pruned1.svg

Pruning k has left e childless and open to pruning, and similarly for other deadend nodes added in the last iteration of depthfirst. Getting rid of ancestors made childless by the above skipping of dead-end leaves involves backpropagation, a style of programing associated with Bellman's dynamic programming. We're going to work back from Limit - 1 to 1, discarding arcs whose child nodes no longer lead anywhere.

WolfGoatCabbage is a nice example of a problem space that gets cleaned up by pruning dead leaves as they appear.

Pruning becomes more elaborate in TowerOfHanoi where removing cycles creates "dead leaves" in the sense that they are nodes with no forward path towards the goal, so they can be treated like non-goal terminals. Then EightPuzzle introduces pruning nodes whose guestimate or heuristic value indicates they are simply cluttering up the search space.

Removing cul de sacs

prune is going to get refactored to use partition(:Pred, +List, ?Included, ?Excluded) so we have a list of dead leaves to backpropogate from.

prune(Limit, End, GraphIn, GraphOut) :-
    exclude(cycle(Limit, GraphIn), GraphIn, G1),
    partition(deadleaf(Limit, End), G1, Included, Graph1),
    remove_culdesacs(Included, Graph1, GraphOut).

remove_culdesacs uses SWI Prolog's built in set difference predicate subtract(+Set, +Delete, -Result).

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

The search or problem space from a to t now gets chopped down to this:

tree_pruned2.svg

The worse case scenario, a to s, would leave the paths on the same level as s in the problem space since their terminal isn't known when the search is over:

tree_pruned.svg

No answer

The code handles route(a, x, Path). by promptly returning false.

The combined code to be used as a template for PuzzleSolving is this:

arc(a, b).
arc(a, c).
arc(a, d).
arc(b, e).
arc(b, f).
arc(c, g).
arc(c, h).
arc(c, i).
arc(d, j).
arc(e, k).
arc(f, l).
arc(f, m).
arc(h, n).
arc(i, o).
arc(i, p).
arc(j, q).
arc(j, r).
arc(j, s).
arc(m, f).
arc(m, m).
arc(m, t).
arc(n, t).

cycle(Limit, Graph, arc(Limit, _, Child)) :-
      memberchk(arc(_, Child, _), Graph).

deadleaf(Limit, End, arc(Limit, _, Child)) :-
    Child \== End,
    \+arc(Child, _).

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

prune(Limit, End, GraphIn, GraphOut) :-
    exclude(cycle(Limit, GraphIn), GraphIn, G1),
    partition(deadleaf(Limit, End), G1, Included, Graph1),
    remove_culdesacs(Included, Graph1, GraphOut).

getchildren(Depth, Parent, Children) :-
    findall(arc(Depth, Parent, Child), arc(Parent, Child), Unsorted),
    sort(Unsorted, Children).

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

depthfirst(Limit, [arc(Depth, Parent, Child)|Frontier], Visited, Acc) :-
    \+succ(Depth, Limit),
    depthfirst(Limit, Frontier, [arc(Depth, Parent, Child)|Visited], Acc).

depthfirst(Limit, [arc(Depth, Parent, Child)|Frontier], Visited, Acc) :-
    succ(Depth, Limit),
    getchildren(Limit, Child, GrandChildren),
    append(GrandChildren, Frontier, NewFrontier),
    depthfirst(Limit, NewFrontier, [arc(Depth, Parent, Child)|Visited], Acc).

iterative_deepening(Limit, End, Graph, Graph) :-
    memberchk(arc(Limit, _, End), Graph).

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

getpath(Start, Graph, [Node|Path], [Start, Node|Path]) :-
    member(arc(1, Start, Node), Graph).

getpath(Start, Graph, [Child|Path], Acc) :-
    member(arc(_, Parent, Child), Graph),
    getpath(Start, Graph, [Parent, Child|Path], Acc).

route(Start, End, Path) :-
    getchildren(1, Start, GraphIn),
    iterative_deepening(1, End, GraphIn, GraphOut),
    format("~w~n", [GraphOut]),
    getpath(Start, GraphOut, [End], Path).

PrunedIterativeDeepening (last edited 2021-09-24 07:41:54 by RobertLaing)