closest pair pseudo code example - algorithm

I have been reading Algorithm design manual. I have the same question as What is the meaning of "from distinct vertex chains" in this nearest neighbor algorithm? but I am not able to follow the answers there.
A different idea might be to repeatedly connect the closest pair of endpoints whose connection will not create a problem, such as premature termination of the cycle. Each vertex begins as its own single vertex chain. After merging everything together, we will end up with a single chain containing all the points in it. Connecting the final two endpoints gives us a cycle. At any step during the execution of this closest-pair heuristic, we will have a set of single vertices and vertex-disjoint chains available to merge. In pseudocode:
ClosestPair(P)
Let n be the number of points in set P.
For i = 1 to n − 1 do
d = ∞
For each pair of endpoints (s, t) from distinct vertex chains
if dist(s, t) ≤ d then sm = s, tm = t, and d = dist(s, t)
Connect (sm, tm) by an edge
Connect the two endpoints by an edge
Please note that sm and tm should be sm and tm.
I am not able to follow above logic. Please demonstrate the computation for the simple example which is given in the book: -21, -5, -1, 0, 1, 3, and 11. Show the computations step by step, so that one can follow above code easily.

First example
In the following notation, I use parentheses to denote chains. Each vertex starts out as its first chain. The inner loop iterates over all pairs of chain endpoints, i.e. all pairs of nodes which have a parenthesis written immediately next to them, but only those pairs where the two endpoints come from different chains. The results of this inner loop are a pair of endpoints which minimize the distance d. I'll assume that pairs are sorted s < t, and furthermore that pairs are traversed in lexicographical order. In that case, the rightmost pair matching that minimal d will be returned, due to the ≤ in the code.
(-21), (-5), (-1), (0), (1), (3), (11) d = 1, sm = 0, tm = 1
(-21), (-5), (-1), (0 , 1), (3), (11) d = 1, sm = -1, tm = 0
(-21), (-5), (-1 , 0 , 1), (3), (11) d = 2, sm = 1, tm = 3
(-21), (-5), (-1 , 0 , 1 , 3), (11) d = 4, sm = -5, tm = -1
(-21), (-5 , -1 , 0 , 1 , 3), (11) d = 8, sm = 3, tm = 11
(-21), (-5 , -1 , 0 , 1 , 3 , 11) d = 16, sm = -21, tm = -5
(-21 , -5 , -1 , 0 , 1 , 3 , 11) d = 32 to close the loop
So in this example, the code works as intended.
Second example
Figure 1.4 will give an example where this code does not work, i.e. will yield a suboptimal result. Labeling the vertices like this
A <--(1+e)--> B <--(1+e)--> C
^ ^ ^
| | |
(1-e) (1-e) (1-e)
| | |
v v v
D <--(1+e)--> E <--(1+e)--> F
In this case you'll get
(A), (B), (C), (D), (E), (F) d = 1-e, sm = C, tm = F
(C, F), (A), (B), (D), (E) d = 1-e, sm = B, tm = E
(C, F), (B, E), (A), (D) d = 1-e, sm = A, tm = D
(C, F), (B, E), (A, D) d = 1+e, sm = E, tm = F
(B, E, F, C), (A, D) d = 1+e, sm = A, tm = B
(D, A, B, E, F, C) d = sqrt((2+2e)^2+(1-e)^2) to close
which is not the optimal solution.

Related

Identifying non-intersecting (super-)sets

I am looking for an algorithm to identify non-intersecting (super-)sets in a set of sets.
Lets, assume I have a set of sets containing the sets A, B, C and D, i.e. {A, B, C, D}. Each set may or may not intersect some or all of the other sets.
I would like to identify non-intersecting (super-)sets.
Examples:
If A & B intersect and C & D intersect but (A union B) does not intersect (C union D), I would like the output of {(A union B), (C union D)}
If only C & D intersect, I would like the output {A, B, (C union D)}
I am sure this problem has long been solved. Can somebody point me in the right direction?
Even better would be of course if somebody had already done the work and had an implementation in python they were willing to share. :-)
I would turn this from a set problem into a graph problem by constructing a graph whose nodes are the graphs with edges connecting sets with an intersection.
Here is some code that does it. It takes a dictionary mapping the name of the set to the set. It returns an array of sets of set names that connect.
def set_supersets (sets_by_label):
element_mappings = {}
for label, this_set in sets_by_label.items():
for elt in this_set:
if elt not in element_mappings:
element_mappings[elt] = set()
element_mappings[elt].add(label)
graph_conn = {}
for elt, sets in element_mappings.items():
for s in sets:
if s not in graph_conn:
graph_conn[s] = set()
for t in sets:
if t != s:
graph_conn[s].add(t)
seen = set()
answer = []
for s, sets in graph_conn.items():
if s not in seen:
todo = [s]
this_group = set()
while 0 < len(todo):
t = todo.pop()
if t not in seen:
this_group.add(t)
seen.add(t)
for u in graph_conn[t]:
todo.append(u)
answer.append(this_group)
return answer
print(set_supersets({
"A": set([1, 2]),
"B": set([1, 3]),
"C": set([4, 5]),
"D": set([3, 6])
}))

highest product of 3 implementation in haskell

I'd like the algorithm for highest product of 3 problem implemented in haskell. Here's the problem statement:
Given an array of integers, find the highest product you can get from
three of the integers.
For example given [1, 2, 3, 4], the algorithm should return 24. And given [-10, -10, 5, 1, 6], the highest product of 3 would be 600 = -10*-10*6.
My attempt (assumed no negatives for the first try):
sol2' a b c [] = a*b*c
sol2' a b c (x:xs) = sol2' a' b' c' xs
where
a' = if (x > a) then x else a
b' = if (x > a && a > b) then a else b
c' = if (x > a && a > b && b > c) then b else c
sol2 li = sol2' a b c li
where a = 0
b = 0
c = 0
I tested the implementation with [3, 5, 1, 2, 4, 10, 0, 4, 8, 11] but the return value is 550, which is supposed to be 880.
Positive numbers
You are on the right track in the sense that you look for the highest numbers. The problem is however that a, b and c are not always ordered.
Indeed say for instance that we have the numbers [6,2,4]. Then the way (a,b,c) will evolve through the recursion is:
(0,0,0) -> (6,0,0) -> (2,6,0) -> (4,2,6)
But now a=4, so that means that if we now encounter 3, we will not replace that value, whereas we can do this since we can remove the 2.
Although there are many ways to solve this, probably the best way to do this is to maintain order: ensure that a <= b <= c.
So we can use:
sol1 = sol2' (0,0,0)
sol2' (a,b,c) [] = a*b*c
sol2' t#(a,b,c) (x:xs) = sol2' f xs
where f | x >= c = (b,c,x)
| x >= b = (b,x,c)
| x > a = (x,b,c)
| otherwise = t
this produces the expected:
Prelude> sol1 [1,2,3,4]
24
Prelude> sol1 [3, 5, 1, 2, 4, 10, 0, 4, 8, 11]
880
Intermezzo: keep track of numbers if negative are present
Your program first takes (0,0,0) as the first three values. But in case for instance the list contains only negative numbers (i.e. [-1,-2,-3]) we of course want to keep track of these first. We can do this for instance by initializing our tuple with elements from the list:
import Data.List(sort)
sol1 (xa:xb:xc:xs) = sol2' (a,b,c) xs
where [a,b,c] = sort [xa,xb,xc]
So now we take the first three elements, sort these, and use these as the first tuple. The remaining of the list is processed. This function will error in case sol1 is not given a list with at least three elements, but in that case there probably is no answer. We can use a Maybe to handle the fact that the function is non-total.
all numbers
Of course we also want to deal with negative numbers. Multiplying two negative numbers results in a positive number. So by keeping track of the two smallest numbers as well, we can then do the math properly. So first we will use another argument (d,e) to keep track of the smallest numbers with d <= e:
sol1_all = sol2_all' (0,0,0) (0,0)
sol2_all' (a,b,c) (d,e) [] = -- ...
sol2_all' t#(a,b,c) u#(d,e) (x:xs) = sol2_all' f g xs
where f | x >= c = (b,c,x)
| x >= b = (b,x,c)
| x > a = (x,b,c)
| otherwise = t
g | x <= d = (x,d)
| x <= e = (d,x)
| otherwise = u
So now we have obtained the greatest numbers (a,b,c) and the smallest numbers (d,e). If d and e are indeed negative, then the only way to produce a large . So now we have the following possibilities to consider a*b*c and c*d*e. So we can write it as:
sol2_all' (a,b,c) (d,e) [] = max (a*b*c) (c*d*e)
sol2_all' t#(a,b,c) u#(d,e) (x:xs) = sol2_all' f g xs
where f | x >= c = (b,c,x)
| x >= b = (b,x,c)
| x > a = (x,b,c)
| otherwise = t
g | x <= d = (x,d)
| x <= e = (d,x)
| otherwise = u
Note however that this will not always produce the correct result here because we can count two numbers in both tuples. We can solve this by properly initializing the tuples:
import Data.List(sort)
sol1_all (xa:xb:xc:xs) = sol2_all' (a,b,c) (a,b) xs
where [a,b,c] = sort [xa,xb,xc]
sol2_all' (a,b,c) (d,e) [] = max (a*b*c) (c*d*e)
sol2_all' t#(a,b,c) u#(d,e) (x:xs) = sol2_all' f g xs
where f | x >= c = (b,c,x)
| x >= b = (b,x,c)
| x > a = (x,b,c)
| otherwise = t
g | x <= d = (x,d)
| x <= e = (d,x)
| otherwise = u
Rationale behind picking different (possibly equivalent) elements
How do we know that we will not use an element twice? Since we only use a*b*c or c*d*e this will - in the case of a list with three element - boils down to max(a*b*c,a*b*c) (a, b, and c here the result of sort). So uniqueness is guaranteed. Since we will only add elements in the first tuple if these are at least greater than a, and less than b, we know that in order for an x to be added in both tuples, it should be a <= x <= b. In that case we will obtain tuples (x,b,c) and (a,x). But since we evaluate in that case x*b*c and a*x*c, x will thus not occur in any expression twice.
Leetcode challenge
I submitted a Python version of this code to the Leetcode Challenge and it was accepted:
class Solution:
def maximumProduct(self, nums):
a,b,c = d,e,_ = sorted(nums[:3])
for x in nums[3:]:
if x >= c:
a,b,c = b,c,x
elif x >= b:
a,b = b,x
elif x >= a:
a = x
if x <= d:
d,e = x,d
elif x < e:
e = x
return max(a*b*c,c*d*e)
There are somewhat more efficient solutions, but I would lean toward something more straightforward like:
import Data.List (subsequences)
f :: (Num a, Ord a) => [a] -> a
f = maximum . map product . filter ((==3) . length) . subsequences
Thinking about functional algorithms as sequences of transformations on collections makes them much more idiomatic than transforming imperative loops into recursive functions.
Note if you are doing this with really long lists where efficiency is a concern, you can sort the list first, then take the lowest two and the highest three, and the algorithm will still work:
takeFirstLast xs = (take 2 sorted) ++ (drop (length sorted - 3) sorted)
where sorted = sort xs
However, my original way is plenty fast up to lists of size 100 or so, and is a lot easier to understand. I don't believe in sacrificing readability for speed until I'm told it's an actual requirement.

What is wrong with this implementation of IDA* algorithm in Haskell? Bad heuristic or simply bad code?

I am trying to write a haskell program which can solve rubiks' cube. Firstly I tried this, but did not figure a way out to avoid writing a whole lot of codes, so I tried using an IDA* search for this task.
But I do not know which heuristic is appropriate here: I tried dividing the problem into subproblems, and measuring the distance from being in a reduced state, but the result is disappointing: the program cannot reduce a cube that is three moves from a standard cube in a reasonable amount of time. I tried measuring parts of edges, and then either summing them, or using the maximums... but none of these works, and the result is almost identical.
So I want to know what the problem with the code is: is the heuristic I used non-admissible? Or is my code causing some infinite loops that I did not detect? Or both? And how to fix that? The code (the relevant parts) goes as follows:
--Some type declarations
data Colors = R | B | W | Y | G | O
type R3 = (Int, Int, Int)
type Cube = R3 -> Colors
points :: [R3] --list of coordinates of facelets of a cube; there are 48 of them.
mU :: Cube -> Cube --and other 5 similar moves.
type Actions = [Cube -> Cube]
turn :: Cube -> Actions -> Cube --chains the actions and turns the cube.
edges :: [R3] --The edges of cubes
totheu1 :: Cube -> Int -- Measures how far away the cube is from having the cross of the first layer solved.
totheu1 c = sum $ map (\d -> if d then 0 else 1)
[c (-2, 3, 0) == c (0, 3, 0),
c (2, 3, 0) == c (0, 3, 0),
c (0, 3, -2) == c (0, 3, 0),
c (0, 3, 2) == c (0, 3, 0),
c (0, 2, -3) == c (0, 0, -3),
c (-3, 2, 0) == c (-3, 0, 0),
c (0, 2, 3) == c (0, 0, 3),
c (3, 2, 0) == c (3, 0, 0)]
expandnr :: (Cube -> Cube) -> Cube -> [(Cube, String)] -- Generates a list of tuples of cubes and strings,
-- the result after applying a move, and the string represents that move, while avoiding moving on the same face as the last one,
-- and avoiding repetitions caused by commuting moves, like U * D = D * U.
type StateSpace = (Int, [String], Cube) -- Int -> f value, [String] = actions applied so far, Cube = result cube.
fstst :: StateSpace -> Int
fstst s#(x, y, z) = x
stst :: StateSpace -> [String]
stst s#(x, y, z) = y
cbst :: StateSpace -> Cube
cbst s#(x, y, z) = z
stage1 :: Cube -> StateSpace
stage1 c = (\(x, y, z) -> (x, [sconcat y], z)) t
where
bound = totheu1 c
t = looping c bound
looping c bound = do let re = search (c, [""]) (\j -> j) 0 bound
let found = totheu1 $ cbst re
if found == 0 then re else looping c found
sconcat [] = ""
sconcat (x:xs) = x ++ (sconcat xs)
straction :: String -> Actions -- Converts strings to actions
search :: (Cube, [String]) -> (Cube -> Cube) -> Int -> Int -> StateSpace
search cs#(c, s) k g bound
| f > bound = (f, s, c)
| totheu1 c == 0 = (0, s, c)
| otherwise = ms
where
f = g + totheu1 c
olis = do
(succs, st) <- expandnr k c
let [newact] = straction st
let t = search (succs, s ++ [st]) newact (g + 1) bound
return t
lis = map fstst olis
mlis = minimum lis
ms = olis !! (ind)
Just ind = elemIndex mlis lis
I know that this heuristic is inconsistent, but am not sure if it is really admissible, maybe the problem is its non-admissibility?
Any ideas, hints, and suggestions are well appreciated, thanks in advance.
Your heuristic is inadmissible. An admissible heuristic must be a lower bound on the real cost of a solution.
You are trying to use as a heuristic the number of side pieces of the first layer that aren't correct, or perhaps the number of faces of the side pieces of the first layer that aren't correct, which is what you have actually written. Either way the heuristic is inadmissible.
The following cube is only 1 move away from being solved, but 4 of the pieces in the first layer are in incorrect positions and 4 of the faces have the wrong color. Either heuristic would say that this puzzle will take at least 4 moves to solve when it can be solved in only 1 move. The heuristics are inadmissible, because they are not lower bounds on the real cost of the solution.

Simplifying recursive mean calculation

If we have
Ei = mean [abs (Hi - p) for p in Pi]
H = mean [H0, H1, ... Hi, ... Hn]
P = concat [P0, P1, ... Pi, ... Pn]
then does there exist a more efficient way to compute
E = mean [abs (H - p) for p in P]
in terms of H, P, and the Eis and His, given that H, E, and P go on to be used as Hi, Ei, and Pi for some i, at a higher recursive level?
If we store the length of Pi as Li at each stage, then we can let
L = sum [L0, L1, ... Li, ... Ln]
allowing us to perform the somewhat easier calculation
E = sum ([abs (H - p) for p in P] / L)
but the use of the abs function seems to severely restrict the kinds of algebraic manipulations we can use to simplify the numerator.
No. Imagine you have just two groups, and one group has H1 = 1 and the other group has H2 = 2. Imagine that every p in P1 is either 0 or 2, and every p in P2 in is either 1 or 3. Now you will always have E1 = 1 and E2 = 1, regardless of the actual values in P1 and P2. However, you can see that if all p in P1 are 2, and all p in P2 are 1, then E will be minimized (specifically 0.5) because H = 1.5. Or all p in P1 could be 0 and all p in P2 could be 3, in which case E would be maximized. (specifically 1.5). And you could get any answer for E in between 0.5 and 1.5 depending on the distribution of the p. If you don't actually go and look at all the individual p, there's no way to tell what exact value of E you will get between 0.5 and 1.5. So you can't do any better than O(n) time to compute E, where n is the total size of P, which is the same running time if you just compute your desired quantity E directly from it's definition formula.

8-puzzle has a solution in prolog using manhattan distance

The 8-puzzle will be represented by a 3x3 list of lists positions where the empty box will be represented by the value 9, as shown below: [[9,1,3],[5,2,6],[4,7,8]]
Possibility Solution: Only half of the initial positions of the 8-puzzle are solvable. There is a formula that allows to know from the beginning if you can solve the puzzle.To determine whether an 8-puzzle is solvable, for each square containing a value N is calculated how many numbers less than N there after the current cell. For example, to the initial status:
1 no numbers less then = 0
Empty (9) - has to subsequently 3,5,2,6,4,7,8 = 7
3 have = 1 to 2
5 has subsequently to 2,4 = 2
2 no number under it happen = 0
6 is subsequently 4 = 1
4 no numbers less then = 0
7 no minor numbers after = 0
8 no numbers less then = 0
After that, we calculate the Manhattan distance between the position of the empty and
position (3.3). For the above example, the empty box is in the position (1.2), so
Manhattan distance that is:
d = abs (3-1) + abs (3-2) = 3
Finally, add up all the calculated values​​. If the result is even, implies that the
puzzle is solvable, but it is odd not be resolved.
0 +7 +1 +2 +0 +1 +0 +0 +0 +3 = 14
The solution is designed to create a knowledge base with all possible states of a number on the board and we'll see how many numbers less than N there after the current position.
Here's my code:
%***********************Have Solution*********************************
posA(9,8). posA(8,7). posA(7,6). posA(6,5). posA(5,4). posA(4,3). posA(3,2). posA(2,1). posA(1,0).
posB(9,7). posB(8,7). posB(8,6). posB(7,6). posB(7,5). posB(7,4).
posB(6,5). posB(6,4). posB(6,3). posB(6,2). posB(5,4). posB(5,3). posB(5,2). posB(5,1). posB(5,0).
posB(4,3). posB(4,2). posB(3,2). posB(3,1). posB(2,1). posB(2,0). posB(1,0).
posC(9,6). posC(8,6). posC(8,5). posC(7,6). posC(7,5). posC(7,4). posC(6,5). posC(6,4). posC(6,3).
posC(5,4). posC(5,3). posC(5,2). posC(4,3). posC(4,2). posC(4,1). posC(4,0).
posC(3,2). posC(3,1). posC(3,0). posC(2,1). posC(1,0).
posD(9,5). posD(8,5). posD(8,4). posD(7,5). posD(7,4). posD(7,3). posD(6,5). posD(6,4). posD(6,3).
posD(6,2). posD(5,4). posD(5,3). posD(5,2). posD(5,1). posD(4,3). posD(4,2). posD(4,1). posD(5,0).
posD(3,2). posD(3,1). posD(3,0). posD(2,1). posD(1,0).
posE(9,4). posE(8,4). posE(8,3). posE(7,4). posE(7,3). posE(7,2). posE(6,4). posE(6,3). posE(6,2). posE(6,1).
posE(5,4). posE(5,3). posE(5,2). posE(5,1). posE(5,0). posE(4,3). posE(4,2). posE(4,1). posE(4,0).
posE(3,2). posE(3,1). posE(3,0). posE(2,1). posE(2,0). posE(1,0).
posF(9,3). posF(8,3). posF(8,2). posF(7,1). posF(7,2). posF(7,3). posF(6,0). posF(6,1). posF(6,2).
posF(6,3). posF(5,0). posF(5,1). posF(5,2). posF(5,3). posF(4,0). posF(4,1). posF(4,2). posF(4,3).
posF(2,0). posF(2,1). posF(3,0). posF(3,1). posF(3,2). posF(1,0).
posG(9,2). posG(8,0). posG(8,1). posG(8,2). posG(7,0). posG(7,1). posG(7,2).
posG(6,0). posG(6,1). posG(6,2). posG(5,0). posG(5,1). posG(5,2). posG(4,0). posG(4,1). posG(4,2).
posG(3,0). posG(3,1). posG(3,2). posG(2,0). posG(2,1). posG(1,0).
posH(9,1). posH(8,0). posH(8,1). posH(7,0). posH(7,1). posH(6,0). posH(6,1). posH(5,0). posH(5,1).
posH(4,0). posH(4,1). posH(3,0). posH(3,1). posH(2,0). posH(1,1). posH(1,0).
posI(9,0). posI(8,0). posI(7,0). posI(6,0). posI(5,0). posI(4,0). posI(3,0). posI(2,0). posI(1,0).
haveSolution([[A,B,C],[D,E,F],[G,H,I]]):- distManhattan([A,B,C,D,E,F,G,H,I], Z),
posA(A,Pa), posB(B,Pb), posC(C,Pc),
posD(D,Pd), posE(E,Pe), posF(F,Pf),
posG(G,Pg), posH(H,Ph), posI(I,Pi),
P is Pa+Pb+Pc+Pd+Pe+Pf+Pg+Ph+Pg+Pi+Z, 0 is P mod 2,
write('The 8-puzzle have solution').
%%*************************Manhattan distance***********************
distManhattan([A,B,C,D,E,F,G,H,I], Dist):- A=9, Dist is abs(3-1)+abs(3-1), !;
B=9, Dist is abs(3-1)+abs(3-2), !;
C=9, Dist is abs(3-1)+abs(3-3), !;
D=9, Dist is abs(3-2)+abs(3-1), !;
E=9, Dist is abs(3-2)+abs(3-2), !;
F=9, Dist is abs(3-2)+abs(3-3), !;
G=9, Dist is abs(3-3)+abs(3-1), !;
H=9, Dist is abs(3-3)+abs(3-2), !;
I=9, Dist is abs(3-3)+abs(3-3).
The problem is that I am making a mistake because there are situations where I can have more than one alternative, eg>:
| 1 | 9 | 3 |
| 5 | 2 | 6 |
| 4 | 7 | 8 |
posA(1,0)+posB(9,7)+posC(3,1)+posD(5,2)+posE(2,0)+posF(6,1)+posG(4,0)+posH(7,0)+posI(8,0).
The right solution for posC(C,Pc) is posC(3,1), that is 1; but there are other ramifications that sometimes cause incorrect outputs ... what am I doing wrong in my code and how I can change it?
This answer looks at the problem from a different point of view:
Single board configurations are represented using the compound structure board/9.
Configurations that are equal up to sliding a single piece are connected by relation m/2.
So let's define m/2!
m(board(' ',B,C,D,E,F,G,H,I), board(D, B ,C,' ',E,F,G,H,I)).
m(board(' ',B,C,D,E,F,G,H,I), board(B,' ',C, D ,E,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board(' ',A, C , D, E ,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board( A ,C,' ', D, E ,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board( A ,E, C , D,' ',F,G,H,I)).
m(board(A,B,' ',D,E,F,G,H,I), board(A,' ',B,D,E, F ,G,H,I)).
m(board(A,B,' ',D,E,F,G,H,I), board(A, B ,F,D,E,' ',G,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board(' ',B,C,A, E ,F, G ,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board( A ,B,C,E,' ',F, G ,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board( A ,B,C,G, E ,F,' ',H,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C,' ',D, F ,G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A,' ',C, D ,B, F ,G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C, D ,F,' ',G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C, D ,H, F ,G,' ',I)).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B,' ',D, E ,C,G,H, I )).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B, C ,D,' ',E,G,H, I )).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B, C ,D, E ,I,G,H,' ')).
m(board(A,B,C,D,E,F,' ',H,I), board(A,B,C,' ',E,F,D, H ,I)).
m(board(A,B,C,D,E,F,' ',H,I), board(A,B,C, D ,E,F,H,' ',I)).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D,' ',F, G ,E, I )).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D, E ,F,' ',G, I )).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D, E ,F, G,I,' ')).
m(board(A,B,C,D,E,F,G,H,' '), board(A,B,C,D,E,' ',G, H ,F)).
m(board(A,B,C,D,E,F,G,H,' '), board(A,B,C,D,E, F ,G,' ',H)).
Almost done!
To connect the steps, we use the meta-predicate path/4 together
with length/2 for performing iterative deepening.
The following problem instances are from #CapelliC's answer:
?- length(Path,N), path(m,Path,/* from */ board(1,' ',3,5,2,6,4,7, 8 ),
/* to */ board(1, 2 ,3,4,5,6,7,8,' ')).
N = 6, Path = [board(1,' ',3,5,2,6,4,7,8), board(1,2,3,5,' ',6,4,7,8),
board(1,2,3,' ',5,6,4,7,8), board(1,2,3,4,5,6,' ',7,8),
board(1,2,3,4,5,6,7,' ',8), board(1,2,3,4,5,6,7,8,' ')] ? ;
N = 12, Path = [board(1,' ',3,5,2,6,4,7,8), board(1,2,3,5,' ',6,4,7,8),
board(1,2,3,5,7,6,4,' ',8), board(1,2,3,5,7,6,' ',4,8),
board(1,2,3,' ',7,6,5,4,8), board(1,2,3,7,' ',6,5,4,8),
board(1,2,3,7,4,6,5,' ',8), board(1,2,3,7,4,6,' ',5,8),
board(1,2,3,' ',4,6,7,5,8), board(1,2,3,4,' ',6,7,5,8),
board(1,2,3,4,5,6,7,' ',8), board(1,2,3,4,5,6,7,8,' ')] ? ;
...
?- length(Path,N), path(m,Path,/* from */ board(8,7,4,6,' ',5,3,2, 1 ),
/* to */ board(1,2,3,4, 5 ,6,7,8,' ')).
N = 27, Path = [board(8,7,4,6,' ',5,3,2,1), board(8,7,4,6,5,' ',3,2,1),
board(8,7,4,6,5,1,3,2,' '), board(8,7,4,6,5,1,3,' ',2),
board(8,7,4,6,5,1,' ',3,2), board(8,7,4,' ',5,1,6,3,2),
board(' ',7,4,8,5,1,6,3,2), board(7,' ',4,8,5,1,6,3,2),
board(7,4,' ',8,5,1,6,3,2), board(7,4,1,8,5,' ',6,3,2),
board(7,4,1,8,5,2,6,3,' '), board(7,4,1,8,5,2,6,' ',3),
board(7,4,1,8,5,2,' ',6,3), board(7,4,1,' ',5,2,8,6,3),
board(' ',4,1,7,5,2,8,6,3), board(4,' ',1,7,5,2,8,6,3),
board(4,1,' ',7,5,2,8,6,3), board(4,1,2,7,5,' ',8,6,3),
board(4,1,2,7,5,3,8,6,' '), board(4,1,2,7,5,3,8,' ',6),
board(4,1,2,7,5,3,' ',8,6), board(4,1,2,' ',5,3,7,8,6),
board(' ',1,2,4,5,3,7,8,6), board(1,' ',2,4,5,3,7,8,6),
board(1,2,' ',4,5,3,7,8,6), board(1,2,3,4,5,' ',7,8,6),
board(1,2,3,4,5,6,7,8,' ')] ? ;
N = 29, Path = [...] ? ;
...
Here is a solver, not an answer to the original question. Joel76 already addressed the problem in comments, and thus he will get the deserved reputation when he will answer.
But the 8-puzzle was interesting to solve, and pose some efficiency problem. Here is my best effort, where I used library(nb_set) in attempt to achieve reasonable efficiency on full solutions enumeration.
Note: nb_set is required to keep track of visited also on failed paths. The alternative is a :- dynamic visited/1. but that turned out to be too much slow.
/* File: 8-puzzle.pl
Author: Carlo,,,
Created: Feb 4 2013
Purpose: solve 8-puzzle
*/
:- module(eight_puzzle,
[eight_puzzle/3
]).
:- use_module(library(nb_set)).
% test cases from Stack Overflow thread with Joel76
test0(R) :- eight_puzzle([1,2,3,4,5,6,7,8,0], [1,0,3, 5,2,6, 4,7,8], R).
test1(R) :- eight_puzzle([1,2,3,4,5,6,7,8,0], [8,7,4, 6,0,5, 3,2,1], R).
%% eight_puzzle(+Target, +Start, -Moves) is ndet
%
% public interface to solver
%
eight_puzzle(Target, Start, Moves) :-
empty_nb_set(E),
eight_p(E, Target, Start, Moves).
%% -- private here --
eight_p(_, Target, Target, []) :-
!.
eight_p(S, Target, Current, [Move|Ms]) :-
add_to_seen(S, Current),
setof(Dist-M-Update,
( get_move(Current, P, M),
apply_move(Current, P, M, Update),
distance(Target, Update, Dist)
), Moves),
member(_-Move-U, Moves),
eight_p(S, Target, U, Ms).
%% get_move(+Board, +P, -Q) is semidet
%
% based only on coords, get next empty cell
%
get_move(Board, P, Q) :-
nth0(P, Board, 0),
coord(P, R, C),
( R < 2, Q is P + 3
; R > 0, Q is P - 3
; C < 2, Q is P + 1
; C > 0, Q is P - 1
).
%% apply_move(+Current, +P, +M, -Update)
%
% swap elements at position P and M
%
apply_move(Current, P, M, Update) :-
assertion(nth0(P, Current, 0)), % constrain to this application usage
( P > M -> (F,S) = (M,P) ; (F,S) = (P,M) ),
nth0(S, Current, Sv, A),
nth0(F, A, Fv, B),
nth0(F, C, Sv, B),
nth0(S, Update, Fv, C).
%% coord(+P, -R, -C)
%
% from linear index to row, col
% size fixed to 3*3
%
coord(P, R, C) :-
R is P // 3,
C is P mod 3.
%% distance(+Current, +Target, -Dist)
%
% compute Manatthan distance between equals values
%
distance(Current, Target, Dist) :-
aggregate_all(sum(D),
( nth0(P, Current, N), coord(P, Rp, Cp),
nth0(Q, Target, N), coord(Q, Rq, Cq),
D is abs(Rp - Rq) + abs(Cp - Cq)
), Dist).
%% add_to_seen(+S, +Current)
%
% fail if already in, else store
%
add_to_seen(S, [A,B,C,D,E,F,G,H,I]) :-
Sig is
A*100000000+
B*10000000+
C*1000000+
D*100000+
E*10000+
F*1000+
G*100+
H*10+
I,
add_nb_set(Sig, S, true)
Test case that Joel76 posed to show the bug in my first effort:
?- time(eight_puzzle:test1(R)).
% 25,791 inferences, 0,012 CPU in 0,012 seconds (100% CPU, 2137659 Lips)
R = [5, 8, 7, 6, 3, 0, 1, 2, 5|...] ;
% 108,017 inferences, 0,055 CPU in 0,055 seconds (100% CPU, 1967037 Lips)
R = [5, 8, 7, 6, 3, 0, 1, 2, 5|...] ;
% 187,817,057 inferences, 93,761 CPU in 93,867 seconds (100% CPU, 2003139 Lips)
false.

Resources