为哈斯克尔的骑士之旅寻找一种解决方案

Question

我正在尝试解决哈斯克尔的骑士公开之旅，并提出一个解决方案来生成所有可能的解决方案：

knightsTour :: Int -> [[(Int, Int)]]
knightsTour size = go 1 [(1, 1)]
where
maxSteps = size^2
isValid (x, y) = x >= 1 && x <= size && y >= 1 && y <= size
go :: Int -> [(Int, Int)] -> [[(Int, Int)]]
go count acc | count == maxSteps = return $ reverse acc
go count acc = do
next <- nextSteps (head acc)
guard $ isValid next && next `notElem` acc
go (count + 1) (next : acc)

fs = replicateM 2 [(*1), (*(-1))]
nextSteps :: (Int, Int) -> [(Int, Int)]
nextSteps (x, y) = do
(x', y') <- [(1, 2), (2, 1)]
[f, f'] <- fs
return (x + f x', y + f' y')

但是，当用 8 x 8 棋盘进行测试时，上述功能永远不会停止，这是因为解决方案空间非常大(根据 19,591,828,170,979,904 个不同的开放巡回赛(。所以我只想找到一个解决方案。首先，我尝试了：

-- First try    
head (knightsTour 8)

希望哈斯克尔的懒惰评估可以挽救这一天。但这并没有发生，解决方案仍然永远运行。 然后，我尝试了：

-- second try
import Data.List (find)
import Data.Maybe (fromMaybe)
knightsTour' :: Int -> [(Int, Int)]
knightsTour' size = go 1 [(1, 1)]
where
maxSteps = size^2
isValid (x, y) = x >= 1 && x <= size && y >= 1 && y <= size
go :: Int -> [(Int, Int)] -> [(Int, Int)]
go count acc | count == maxSteps = reverse acc
go count acc =
let
nextSteps' = [step | step <- nextSteps (head acc), isValid step && step `notElem` acc]
in
fromMaybe [] (find (not . null) $ fmap (step -> go (count+1) (step:acc)) nextSteps')
fs = replicateM 2 [(*1), (*(-1))]
nextSteps :: (Int, Int) -> [(Int, Int)]
nextSteps (x, y) = do
(x', y') <- [(1, 2), (2, 1)]
[f, f'] <- fs
return (x + f x', y + f' y')

但是上面的解决方案仍然无法提供，因为它仍然永远运行。 我的问题是：

1. 为什么惰性评估不能工作，因为我期望只生成找到的第一个解决方案？在我看来，在这两种尝试中，只需要第一个解决方案。
2. 如何更改上面的代码以仅生成第一个解决方案？

Answer 1

首先是好消息：你的代码正在做你期望的事情，并且只产生第一个解决方案！

这也是一个坏消息：找到第一个解决方案真的需要这么长时间。我认为您大大低估了需要遇到多少"死胡同"才能产生解决方案。

例如，以下是使用Debug.Trace模块对初始版本的调整，让我们知道您在尝试查找第一条路径时遇到了多少死胡同：

import Control.Monad
import Debug.Trace (trace)
import System.Environment (getArgs)
knightsTour :: Int -> [[(Int, Int)]]
knightsTour size = go 1 [(1, 1)]
where
maxSteps = size * size
isValid (x, y) = x >= 1 && x <= size && y >= 1 && y <= size
go :: Int -> [(Int, Int)] -> [[(Int, Int)]]
go count acc | count == maxSteps = return $ reverse acc
go count acc = do
let nextPossible' = [ next |
next <- nextSteps (head acc)
, isValid next && next `notElem` acc]
nextPossible = if null nextPossible'
then trace ("dead end; count: " ++ show count) []
else nextPossible'
next <- nextPossible
-- guard $ isValid next && next `notElem` acc
go (count + 1) (next : acc)

fs = replicateM 2 [(*1), (*(-1))]
nextSteps :: (Int, Int) -> [(Int, Int)]
nextSteps (x, y) = do
(x', y') <- [(1, 2), (2, 1)]
[f, f'] <- fs
return (x + f x', y + f' y')
main :: IO ()
main = do
[n] <- getArgs
print (head $ knightsTour (read n))

现在，让我们看看对于不同的电路板尺寸，这为我们提供了多少输出：

/tmp$ ghc -o kntest -O2 kntest.hs 
[1 of 1] Compiling Main             ( kntest.hs, kntest.o )
Linking kntest ...
/tmp$ ./kntest 5 2>&1 | wc
27366  109461  547424
/tmp$ ./kntest 6 2>&1 | wc
783759 3135033 15675378
/tmp$ ./kntest 7 2>&1 | wc
818066 3272261 16361596

好的，所以我们在 5 的电路板尺寸上遇到了 27,365 个死胡同，在 7 的电路板尺寸上遇到了超过 80 万个死胡同。对于 8 大小的电路板，我将其重定向到一个文件：

/tmp$ ./kntest 8 2> kn8.deadends.txt

它仍在运行。在这一点上，它遇到了超过3800万个死胡同：

/tmp$ wc -l kn8.deadends.txt 
38178728 kn8.deadends.txt

这些死胡同中有多少是真正接近终点的？

/tmp$ wc -l kn8.deadends.txt ; fgrep 'count: 61' kn8.deadends.txt | wc -l ; fgrep 'count: 62' kn8.deadends.txt | wc -l; fgrep 'count: 63' kn8.deadends.txt | wc -l ; wc -l kn8.deadends.txt
52759655 kn8.deadends.txt
1448
0
0
64656651 kn8.deadends.txt

所以现在已经有超过6400万个死胡同了，它仍然没有找到超过61步的死胡同。

现在它是8500万，如果我花太长时间写剩下的，当我完成这个答案时，它可能会超过1亿。

你可以做一些事情来加快你的程序(比如使用向量来跟踪已经访问过的点而不是O(n(notElem查找(，但从根本上说，它需要很长时间才能得到第一个答案，因为它真的比你最初想象的要长得多。

---

编辑：如果你添加一个非常简单，天真的Warnsdorf规则实现，那么你几乎可以立即获得第一个骑士之旅，即使对于非常大(40x40(的板：

import Control.Monad
import System.Environment (getArgs)
import Data.List (sort)
knightsTour :: Int -> [[(Int, Int)]]
knightsTour size = go 1 [(1, 1)]
where
maxSteps = size * size
isValid (x, y) = x >= 1 && x <= size && y >= 1 && y <= size
getValidFor from acc = do
next <- nextSteps from
guard $ isValid next && next `notElem` acc
return next
go :: Int -> [(Int, Int)] -> [[(Int, Int)]]
go count acc | count == maxSteps = return $ reverse acc
go count acc = do
let allPoss = getValidFor (head acc) acc
sortedPossible = map snd $ sort $
map (x -> (length $ getValidFor x acc, x))
allPoss
next <- sortedPossible
go (count + 1) (next : acc)
fs = replicateM 2 [(*1), (*(-1))]
nextSteps :: (Int, Int) -> [(Int, Int)]
nextSteps (x, y) = do
(x', y') <- [(1, 2), (2, 1)]
[f, f'] <- fs
return (x + f x', y + f' y')
main :: IO ()
main = do
[n] <- getArgs
print (head $ knightsTour (read n))