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

Question

我试图了解Selectmonad是如何工作的.显然,它是表兄,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 年的历史了并且已经有了答案，但是为了将来遇到这个问题的任何人，我想补充一些额外的信息。具体来说，我想尝试回答两个问题：

• 返回单个值的多个选择如何组合以创建返回值序列的单个选择？
• 当解决方案注定失败时，是否有可能提前返回？

链接选择

选择是作为一个单子转换实施transformers库（去图），但是让我们来看看一个可能如何实现>>=对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)

我们首先定义一个 new Select，它接受一个ktype的输入a -> r（回想一下它Select包装了一个 type 的函数(a -> r) -> a）。您可以将其k视为一个函数，它返回r给定类型的“分数”，aSelect 函数可以使用它来确定a要返回的内容。

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

在第二行，我们返回choose $ g (k . choose)。该函数k . choose是choose我们原来的评分函数的组成k：它接收一个值，计算选择该值的下游结果，并返回该下游结果的分数。换句话说，我们创建了一种“千里眼”的评分函数：它不返回给定值的分数，而是返回我们选择该值时将获得的最终结果的分数。通过将我们的“千里眼”评分函数传递给g（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 运算符）。对于大小为 N 的域，它最多会检查 N - 1 个项目......这听起来可能不是一个巨大的节省，但正如您从上面的解释中知道的那样，p通常会开始整个计算的其余部分，所以最好将谓词调用保持在最低限度。

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

• 我们在不同元素的有限域中搜索
• 我们想要创建一个包含每个元素恰好一次的序列（即域的排列）
• 我们想测试部分序列并在它们不符合谓词时放弃它们

希望这有助于澄清事情！

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