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

Question

我试图了解 Select monad 是如何工作的。显然，它是Cont的表亲，可以用于回溯搜索。

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

-- 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 可以让您抽象出用于比较答案的“评估函数”。该函数被传递给runSelect。我觉得我的解决方案中的safeDiag 之类的东西可以用作评估函数，但是如何构建Select 计算本身呢？

另外，单独使用 Select monad 就足够了吗，还是我需要在列表上使用转换器版本？

Answer 1

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

• 如何将多个返回单个值的 Select 组合成一个返回一系列值的 Select？
• 当解决方案路径注定失败时，是否可以提前返回？

链接选择

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 视为一个函数，它为给定的a 返回r 类型的“分数”，Select 函数可以使用它来确定返回哪个a。

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

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

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

提前返回

那么，我们如何在提早返回的同时使用 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 函数（基于希尔伯特的epsilon operator）。对于大小为 N 的域，它最多会检查 N - 1 个项目......这听起来可能不会节省很多，但正如您从上面的解释中知道的那样，p 通常会启动整个计算的其余部分，所以最好尽量减少谓词调用。

sequenceSelect 的好处在于它的通用性：它可以用来创建任何Select Bool [a] 的地方

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

希望这有助于澄清事情！

---

附：这是一个 Observable 笔记本的链接，我在其中用 Javascript 实现了 Select monad 以及 n-queens 求解器的演示：https://observablehq.com/@mattdiamond/the-select-monad

Answer 2

Select 可以被视为在“紧凑”空间中搜索的抽象，由一些谓词引导。您在 cmets 中提到了 SAT，您是否尝试过将问题建模为 SAT 实例并将其扔给基于 Select 的求解器（本着 this paper 的精神）？您可以专门搜索以硬连线 中的 N-queens 特定约束，并将 SAT 求解器转换为 N-queens 求解器。

Answer 3

受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的方案有个缺陷，就是把一个queue放在一个列中，不排除后续queen选择同一列的可能性；我们最终会不必要地探索注定要失败的分支。

如果我们希望我们的列选择受到先前决策的影响，我们需要超越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。