haskell - 如何使用 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 年的历史了，并且已经有了答案，但是为了将来遇到这个问题的任何人，我想补充一些额外的信息。具体来说，我想尝试回答两个问题:

返回单个值的多个选择如何组合以创建返回值序列的单个选择？

当解决方案路径注定失败时，是否可以提前返回？

链接选择
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，它接受类型为 k 的输入 a -> r(回想一下 Select 包装了一个类型为 (a -> r) -> a 的函数)。您可以将 k 视为一个函数，它为给定的 r 返回类型为 a 的“分数”，Select 函数可以使用它来确定要返回哪个 a。
在我们新的 Select 中，我们定义了一个名为 choose 的函数。该函数将一些 x 传递给函数 f ，它是 monadic 绑定(bind)的 a -> m b 部分:它将 m a 计算的结果转换为新计算 m b 。所以 f 将获取 x 并返回一个新的 Select ，然后 choose 使用我们的评分函数 k 运行。您可以将 choose 视为一个函数，它询问“如果我选择 x 并将其传递给下游，最终结果会是什么？”
在第二行，我们返回 choose $ g (k . choose) 。函数 k . choose 是 choose 和我们原来的评分函数 k 的组合:它接收一个值，计算选择该值的下游结果，并返回该下游结果的分数。换句话说，我们创建了一种“透视”评分函数:它不返回给定值的分数，而是返回我们选择该值时将获得的最终结果的分数。通过将我们的“千里眼”评分函数传递给 g(我们绑定(bind)到的原始 Select)，我们能够选择导致我们正在寻找的最终结果的中间值。一旦我们有了这个中间值，我们只需将它传回 choose 并返回结果。
这就是我们如何能够在传入对值数组进行操作的评分函数时将单值 Select 串在一起的方式:每个 Select 正在对选择值的假设最终结果进行评分，而不一定是值本身。应用实例遵循相同的策略，唯一的区别是下游 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