Nicht-Deterministische Merge-Sortierung nicht Permutationen Lexicographisch

Question

Ich habe versucht, eine Seite in All Sorts of Permutations (Functional Pearl) von Christiansen, Danilenko und Dylus, ein Papier für die kommende ICFP 2016 erwähnt reproduzieren. Abschnitt 8 (“ Schlussbemerkung ”) behauptet dass durch die Wahl eines bestimmten nichtdeterministischen Prädikats eine monadische Mischsortierung alle Permutationen einer Folge in lexikografischer Reihenfolge erzeugen kann.

haben wir nur die nicht-determinis Prädikat coinCmp, betrachten, während es andere nicht-deterministische Prädikate, die die Reihenfolge der Aufzählung beeinflussen verwendet werden kann. Die folgende Funktion hebt beispielsweise ein Prädikat cmp in einen nicht deterministischen Kontext auf.

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

Wenn wir diese Funktion verwenden, um eine Vergleichsfunktion heben und es zu einer monadische Version von Mergesort passieren, erhalten wir eine besondere Art von Permutation Funktion: es Permutationen in lexikographischer Reihenfolge auflistet.

Ich bin mir ziemlich sicher, was ich hier geschrieben habe, merge sort, aber wenn ausgeführt, ist die Bestellung nicht wie angekündigt.

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]] 

Und die tatsächliche lexikographische Ordnung Referenz —

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

Answer 1

Lassen Sie uns eine Variante deinterleave versuchen, die die erste und die letzte Hälfte der Liste spaltet , anstatt geradzahlige und ungeradzahlige Elemente wie im po zu spalten STED-Code:

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

Ergebnis:

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

Leider ist dies löst nicht das Problem, da ich zum ersten Mal gehofft, wie Rowan Blush unten weist darauf hin. : -/