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

Posted 2023-02-22

【中文标题】如何使用 Select monad 解决 n-queens？

【英文标题】：How to use the Select monad to solve n-queens?

【发布时间】：2017-02-21 21:12:13

【问题描述】：

我试图了解 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 就足够了吗，还是我需要在列表上使用转换器版本？

【问题讨论】：

你确定你想要Select monad吗？我对Select 的理解是它试图证明存在可能的解决方案（作为证人证明）。 Select 的典型示例是 SAT 求解器。您可能可以通过 SelectT 在 list monad 上强制执行某些操作，但我更确定您会真正使用 select monad。

@Alec 我读到Select 非常适合回溯搜索，而 n-queens 是这种类型的原型问题，所以我认为它是 monad 的一个很好的用例。

区别可能在于回溯找到所有解决方案和回溯直到找到解决方案。再说一次，我之前只玩过一次Select，所以不要把我说的话当回事。

不是Select monad，而是这个项目：queenslogic 使用Logic monad 通过回溯解决n-queens。

相关：julesh.com/2021/03/30/selection-functions-and-lenses

【参考方案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

【讨论】：

不错的答案。措辞上的一个小问题：shift 似乎没有捕捉到“其余计算”意义上的延续。正如您所写，它只是明确地掌握了评分功能。

返回所有解决方案有多容易？

@danidiaz 好点！我实际上是在考虑删除shift，因为它只是一个便利功能，并没有真正做那么多（而且名称本身可能具有误导性）。

@is7s 这是一个有趣的问题...我不认为有一个简单的方法可以做到这一点，但我会考虑一下。

@is7s 请记住，Select 包装了(a -> r) -> a 类型的函数...如果它返回所有解决方案，则类型将是([a] -> Bool) -> [[a]]，更像(a -> r) -> m a。但是，可以使用包装(a -> m r) -> m a 的SelectT 转换器使其工作。

【参考方案2】：

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

【参考方案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。

【讨论】：

“特别是，sequence 为 Select [...] 工作的方式似乎很神奇”——是的，这个应用实例确实令人费解。