2

我正在尝试编写一个可以解决魔方的haskell程序。首先我尝试了这个，但没有找到避免编写大量代码的方法，所以我尝试使用 IDA* 搜索这个任务。

但我不知道这里哪种启发式方法合适：我尝试将问题划分为子问题，并测量距离处于简化状态的距离，但结果令人失望：程序无法减少从标准立方体移动三步的立方体在合理的时间内。我尝试测量边缘的一部分，然后对它们求和，或者使用最大值......但这些都不起作用，结果几乎相同。

所以我想知道代码的问题是什么：我使用的启发式是不可接受的吗？还是我的代码导致了一些我没有检测到的无限循环？或两者？以及如何解决这个问题？代码（相关部分）如下：

--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

我知道这个启发式是不一致的，但不确定它是否真的可以接受，也许问题是它的不可接受性？

任何想法，提示和建议都非常感谢，在此先感谢。

4

1 回答 1

1

你的启发式是不可接受的。可接受的启发式必须是解决方案实际成本的下限。

您正在尝试使用第一层不正确的侧片数量作为启发式方法，或者可能是第一层不正确的侧片的面数，这就是您实际编写的. 无论哪种方式，启发式都是不可接受的。

下面的立方体只是1远离被解决，但4第一层的碎片位置不正确4，面的颜色错误。任何一种启发式方法都会说这个谜题至少需要4移动来解决，而它只能通过移动来解决1。启发式是不可接受的，因为它们不是解决方案实际成本的下限。

在此处输入图像描述

于 2015-07-26T20:15:35.460 回答