3

我一直在尝试复制Christiansen、Danilenko 和 Dylus 在即将到来的 ICFP 2016 的论文All Sorts of Permutations (Functional Pearl)中提到的一个旁白。第 8 节（“最后的评论”）声称，通过选择一个特定的非确定性谓词，一元合并排序可以按字典顺序产生序列的所有排列。

我们只考虑了非确定性谓词coinCmp，而还有其他可用于影响枚举顺序的非确定性谓词。例如，以下函数将谓词cmp提升到非确定性上下文。

liftCmp :: MonadPlus μ
        ⇒ (α → α → Bool) → Cmp α μ
liftCmp p x y = return (p x y) ⊕ return (not (p x y))

当我们使用这个函数来提升一个比较函数并将它传递给一个单子版本的归并排序时，我们得到了一种特殊的排列函数：它按字典顺序枚举排列。

我很确定我在这里写的是合并排序，但是在运行时排序并不像宣传的那样。

import Control.Applicative (Alternative((<|>)))
import Control.Monad (MonadPlus, join)
import Data.Functor.Identity (Identity)

-- Comparison in a context
type Comparison a m = a -> a -> m Bool

-- Ordering lifted into the Boring Monad
boringCmp :: (a -> a -> Bool) -> Comparison a Identity
boringCmp p x y = return (p x y)

-- Arbitrary ordering in a non-deterministic context
cmp :: MonadPlus m => Comparison a m
cmp _ _ = return True <|> return False

-- Ordering lifted into a non-deterministic context
liftCmp :: MonadPlus m => (a -> a -> Bool) -> Comparison a m
liftCmp p x y = let b = p x y in return b <|> return (not b)

mergeM :: Monad m => Comparison a m -> [a] -> [a] -> m [a]
mergeM _ ls         []         = return ls
mergeM _ []         rs         = return rs
mergeM p lls@(l:ls) rrs@(r:rs) = do
    b <- p l r
    if b
    then (l:) <$> mergeM p ls rrs
    else (r:) <$> mergeM p lls rs

mergeSortM :: Monad m => Comparison a m -> [a] -> m [a]
mergeSortM _ []  = return []
mergeSortM _ [x] = return [x]
mergeSortM p xs  = do
    let (ls, rs) = deinterleave xs
    join $ mergeM p <$> mergeSortM p ls <*> mergeSortM p rs
  where
    deinterleave :: [a] -> ([a], [a])
    deinterleave [] = ([], [])
    deinterleave [l] = ([l], [])
    deinterleave (l:r:xs) = case deinterleave xs of (ls, rs) -> (l:ls, r:rs)

λ mergeSortM (boringCmp (<=)) [2,1,3] :: Identity [Int]
Identity [1,2,3]

λ mergeSortM cmp [2,1,3] :: [[Int]]
[[2,3,1],[2,1,3],[1,2,3],[3,2,1],[3,1,2],[1,3,2]]

λ mergeSortM (liftCmp (<=)) [2,1,3] :: [[Int]]
[[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]

以及实际的字典顺序供参考——

λ sort it
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
4

1 回答 1

1

让我们尝试一个变体deinterleave，它拆分列表的前半部分和后半部分，而不是像发布的代码中那样拆分偶数和奇数索引元素：

deinterleave :: [a] -> ([a], [a])
deinterleave ys = splitAt (length ys `div` 2) ys

结果：

> mergeSortM (liftCmp (<=)) [2,1,3] :: [[Int]]
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]

不幸的是，这并没有像我最初希望的那样解决问题，正如 Rowan Blush 在下面指出的那样。：-/

于 2016-08-07T12:10:29.113 回答