如何使用 Select monad 来解决 n-queens？

Question

我正在尝试了解 Select monad works. Apparently, it is a cousin of Cont 及其如何用于回溯搜索。

我有这个基于列表的 n 皇后问题解决方案：

-- All the ways of extracting an element from a list.
oneOf :: [Int] -> [(Int,[Int])] 
oneOf [] = [] 
oneOf (x:xs) = (x,xs) : map (\(y,ys) -> (y,x:ys)) (oneOf xs)

-- Adding a new queen at col x, is it threathened diagonally by any of the
-- existing queens?
safeDiag :: Int -> [Int] -> Bool
safeDiag x xs = all (\(y,i) -> abs (x-y) /= i) (zip xs [1..])

nqueens :: Int -> [[Int]]
nqueens queenCount = go [] [1..queenCount]
  where
    -- cps = columsn of already positioned queens. 
    -- fps = columns that are still available
    go :: [Int] -> [Int] -> [[Int]]
    go cps [] = [cps]
    go cps fps = [ps | (p,nfps) <- oneOf fps, ps <- go (p:cps) nfps, safeDiag p cps]

我正在努力调整此解决方案以改用 Select。

似乎 Select 可以让您抽象出用于比较答案的 "evaluation function"。该函数传递给 runSelect。我觉得我的解决方案中的 safeDiag 之类的东西可以用作评估函数，但是如何构建 Select 计算本身呢？

此外，单独使用 Select monad 是否足够，还是我需要在列表上使用 transformer 版本？

Answer 1

Select 可以看作是 "compact" space 中搜索的抽象，由某些谓词引导。您在评论中提到了 SAT，您是否尝试过将问题建模为 SAT 实例并将其扔给基于 Select 的求解器（本着 this paper 的精神）？您可以专门搜索以在 $\varphi$ 中硬连接 N-queens 特定约束，并将 SAT 求解器转变为 N-queens 求解器。

Answer 2

受jd823592的回答启发，看了paper中的SAT例子，写了这段代码：

import Data.List 
import Control.Monad.Trans.Select

validBoard :: [Int] -> Bool
validBoard qs = all verify (tails qs)
  where
    verify [] = True
    verify (x : xs) = and $ zipWith (\i y -> x /= y && abs (x-y) /= i) [1..] xs

nqueens :: Int -> [Int]
nqueens boardSize = runSelect (traverse selectColumn columns) validBoard
  where
  columns = replicate boardSize [1..boardSize]
  selectColumn candidates = select $ \s -> head $ filter s candidates ++ candidates

它似乎到达（尽管很慢）一个有效的解决方案：

ghci> nqueens 8
[1,5,8,6,3,7,2,4]

不过我不是很懂。特别是，sequence 对 Select 的工作方式，将一个在整个板上工作的函数 (validBoard) 转换为采用单个列索引的函数，看起来非常神奇。

基于sequence的解决方案有一个缺陷，即在一个列中放置一个皇后不排除后续皇后选择同一列的可能性；我们最终会不必要地探索注定的分支。

如果我们希望我们的列选择受到先前决策的影响，我们需要超越 Applicative 并使用 Monad:

的力量

nqueens :: Int -> [Int]
nqueens boardSize = fst $ runSelect (go ([],[1..boardSize])) (validBoard . fst)
  where
  go (cps,[]) = return (cps,[])
  go (cps,fps) = (select $ \s ->
    let candidates = map (\(z,zs) -> (z:cps,zs)) (oneOf fps)
    in  head $ filter s candidates ++ candidates) >>= go

monadic 版本仍然存在仅检查已完成的板的问题，当发现部分完成的板有冲突时，原始的基于列表的解决方案会立即回溯。我不知道如何使用 Select.

Answer 3

我意识到这个问题已经有将近 4 年的历史了，并且已经有了答案，但是为了将来遇到这个问题的任何人，我想补充一些额外的信息。具体来说，我想尝试回答两个问题：

多个 Select return 单个值如何组合成单个 Select return 一系列值？
是否有可能在解决方案路径注定要失败时尽早return？

链接 Selects

Select 在 transformers 库中实现为一个 monad 转换器（看图），但让我们看一下如何为 Select 实现 >>=单独：

(>>=) :: Select r a -> (a -> Select r b) -> Select r b
Select g >>= f = Select $ \k ->
  let choose x = runSelect (f x) k
  in  choose $ g (k . choose)

我们首先定义一个新的 Select，它接受类型为 a -> r 的输入 k（回想一下 Select 包装类型为 (a -> r) -> a 的函数).您可以将 k 视为一个函数，它 return 是给定 a 类型 r 的“分数”，Select 函数可用于确定a 到 return.

在我们的新 Select 中，我们定义了一个名为 choose 的函数。此函数将一些 x 传递给函数 f，这是单子绑定的 a -> m b 部分：它将 m a 计算的结果转换为新的计算 m b.所以 f 将采用 x 和 return 一个新的 Select，然后 choose 使用我们的评分函数 k 运行。您可以将 choose 视为一个函数，询问“如果我 selected x 并将其传递到下游，最终结果会是什么？”

第二行，我们returnchoose $ g (k . choose)。函数 k . choose 是 choose 和我们原来的评分函数 k 的组合：它接受一个值，计算 selecting 该值的下游结果，并且 returns 下游结果的分数。换句话说，我们创建了一种“千里眼”评分函数：不是 return 给定值的分数，而是 return 我们将得到的最终结果的分数 如果我们select编辑那个值。通过将我们的“千里眼”评分函数传递给 g（我们绑定的原始 Select），我们能够 select 导致最终结果的中间值我们正在寻找。一旦我们有了那个中间值，我们只需将它传递回 choose 和 return 结果。

这就是我们如何能够将单值 Select 串在一起，同时传入一个对值数组进行操作的评分函数：每个 Select 都对假设的最终结果进行评分select是一个值，不一定是值本身。应用实例遵循相同的策略，唯一的区别是下游 Select 的计算方式（不是将候选值传递给 a -> m b 函数，而是将候选函数映射到第二个 Select.)

早点回来

那么，我们如何在 returning 的早期使用 Select 呢？我们需要某种方式来访问构建 Select 的代码范围内的评分函数。一种方法是在另一个 Select 中构造每个 Select，如下所示：

sequenceSelect :: Eq a => [a] -> Select Bool [a]
sequenceSelect [] = return []
sequenceSelect domain@(x:xs) = select $ \k ->
  if k [] then runSelect s k else []
  where
    s = do
      choice <- elementSelect (x:|xs)
      fmap (choice:) $ sequenceSelect (filter (/= choice) domain)

这使我们能够测试正在进行的序列，并在递归失败时将其短路。（我们可以通过调用 k [] 来测试序列，因为评分函数包括我们递归排列的所有前置项。）

这是完整的解决方案：

import Data.List
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.Trans.Select

validBoard :: [Int] -> Bool
validBoard qs = all verify (tails qs)
  where
    verify [] = True
    verify (x:xs) = and $ zipWith (\i y -> x /= y && abs (x - y) /= i) [1..] xs

nqueens :: Int -> [Int]
nqueens boardSize = runSelect (sequenceSelect [1..boardSize]) validBoard

sequenceSelect :: Eq a => [a] -> Select Bool [a]
sequenceSelect [] = return []
sequenceSelect domain@(x:xs) = select $ \k ->
  if k [] then runSelect s k else []
  where
    s = do
      choice <- elementSelect (x:|xs)
      fmap (choice:) $ sequenceSelect (filter (/= choice) domain)

elementSelect :: NonEmpty a -> Select Bool a
elementSelect domain = select $ \p -> epsilon p domain

-- like find, but will always return something
epsilon :: (a -> Bool) -> NonEmpty a -> a
epsilon _ (x:|[]) = x
epsilon p (x:|y:ys) = if p x then x else epsilon p (y:|ys)

简而言之：我们递归地构造一个 Select，在我们使用它们时从域中删除元素，并在域已用尽或我们走错路时终止递归。

另一个新增功能是 epsilon 函数（基于 Hilbert 的 epsilon operator）。对于大小为 N 的域，它最多会检查 N - 1 个项目……这听起来可能不是一个巨大的节省，但正如您从上面的解释中知道的那样，p 通常会启动整个域的剩余部分计算，因此最好将谓词调用保持在最低限度。

sequenceSelect 的优点在于它的通用性：它可用于创建任何 Select Bool [a]，其中

我们正在不同元素的有限域内搜索
我们想要创建一个序列，其中每个元素只包含一次（即域的排列）
我们想测试部分序列，如果它们未通过谓词就放弃它们

希望这有助于澄清事情！

P.S。这是 Observable notebook 的 link，其中我在 Javascript 中实现了 Select monad 以及 n-queens 求解器的演示：https://observablehq.com/@mattdiamond/the-select-monad

如何使用 Select monad 来解决 n-queens？

How to use the Select monad to solve n-queens?

haskell

monads

backtracking

n-queens

链接 Selects

早点回来