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.