在 Haskell 中找到骑士之旅的一种解决方案

Question

我正在尝试解决Haskell中的Knight's Open Tour，并提出一个解决方案来生成所有可能的解决方案：

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×8的棋盘测试时，上述功能并没有停止，这是因为解决方案space大得离谱（19,591,828,170,979,904根据1打开不同的游览） .所以我只想找到一个解决方案。首先，我试过：

-- First try    
head (knightsTour 8)

希望Haskell懒惰的评价能挽救局面。但这并没有发生，解决方案仍然永远运行。然后，我试了：

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

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

为什么惰性求值不能像我预期的那样只产生第一个找到的解？在我看来，在这两种尝试中，只需要第一种解决方案。
如何更改上面的代码以仅生成第一个解决方案？

Answer 1

首先是个好消息：您的代码正在按照您的预期运行，并且只生成第一个解决方案！

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

例如，这是使用 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's rule 实现，那么即使对于非常大的 (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))

在 Haskell 中找到骑士之旅的一种解决方案

Finding one solution to Knight's Tour in Haskell

haskell

lazy-evaluation

knights-tour