Nichtdeterminismus für unendliche Eingaben

Question

Die Verwendung von Listen zur Modellierung von Nichtdeterminismus ist problematisch, wenn die Eingaben unendlich viele Werte annehmen können. Zum Beispiel

pairs = [ (a,b) | a <- [0..], b <- [0..] ] 

Dies wird [(0,1),(0,2),(0,3),...] zurückkehren und nie Paar bekommen, um dem zu zeigen Ihnen erstes Element ist nicht 0.

Verwenden Sie die Cantor pairing function, um eine Liste von Listen in eine einzelne Liste zu reduzieren, um dieses Problem zu umgehen. Zum Beispiel können wir eine bind artigen Operator definieren, die seine Ausgaben intelligenter Aufträge durch

(>>>=) :: [a] -> (a -> [b]) -> [b] 
as >>>= f = cantor (map f as) 

cantor :: [[a]] -> [a] 
cantor xs = go 1 xs 
    where 
    go _ [] = [] 
    go n xs = hs ++ go (n+1) ts 
     where 
     ys = filter (not.null) xs 
     hs = take n $ map head ys 
     ts = mapN n tail ys 

mapN :: Int -> (a -> a) -> [a] -> [a] 
mapN _ _ [] = [] 
mapN n f xs@(h:t) 
    | n <= 0 = xs 
    | otherwise = f h : mapN (n-1) f t 

Wenn wir das jetzt einpacken als Monade, können wir alle möglichen Paare

newtype Select a = Select { runSelect :: [a] } 

instance Monad Select where 
    return a = Select [a] 
    Select as >>= f = Select $ as >>>= (runSelect . f) 

pairs = runSelect $ do 
    a <- Select [0..] 
    b <- Select [0..] 
    return (a,b) 

Diese Ergebnisse aufzählen in

>> take 15 pairs 
[(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0),(0,4),(1,3),(2,2),(3,1),(4,0)] 

was ein viel wünschenswertes Ergebnis ist. Wenn wir jedoch stattdessen für Tripel stellen waren, die Ordnung an den Ausgängen ist nicht so „nett“ und es ist nicht einmal mir klar, dass alle Ausgänge schließlich enthalten sind -

>> take 15 triples 
[(0,0,0),(0,0,1),(1,0,0),(0,1,0),(1,0,1),(2,0,0),(0,0,2),(1,1,0),(2,0,1),(3,0,0),(0,1,1),(1,0,2),(2,1,0),(3,0,1),(4,0,0)] 

Beachten Sie, dass (2,0,1) erscheint vor (0,1,1) in der Reihenfolge - meine Intuition sagt, dass eine gute Lösung für dieses Problem die Ausgaben nach einem Begriff der "Größe" ordnen wird, die eine explizite Eingabe in den Algorithmus sein könnte oder implizit gegeben werden könnte (wie in diesem Beispiel) wobei die "Größe" einer Eingabe ihre Position in den Eingabelisten ist. Bei der Kombination von Eingängen sollte die "Größe" einer Kombination eine Funktion (wahrscheinlich die Summe) der Größe der Eingänge sein.

Gibt es eine elegante Lösung für dieses Problem, das ich vermisse?

Answer 1

TL; DR: Es flacht zwei Dimensionen gleichzeitig ab, anstatt drei auf einmal abzuflachen. Sie können dies in der Monade nicht aufzuräumen, weil >>= binär ist, nicht ternäre usw.

---

Ich werde Sie davon ausgehen, definiert

(>>>=) :: [a] -> (a -> [b]) -> [b] 
as >>>= f = cantor $ map f as 

, um die Liste der Listen verschachteln.

Sie mögen das, weil es diagonal geht:

sums = runSelect $ do 
    a <- Select [0..] 
    b <- Select [0..] 
    return (a+b) 

gibt

ghci> take 36 sums 
[0,1,1,2,2,2,3,3,3,3,4,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7] 

so dass es angenehm ist die „Größen“ in Ordnung zu halten, aber das Muster für triples gebrochen zu sein scheint, und Sie Zweifeln Sie Vollständigkeit, aber Sie brauchen nicht.Es tut den gleichen Trick, aber zweimal, anstatt für alle drei auf einmal:

triplePairs = runSelect $ do 
    a <- Select [0..] 
    b <- Select [0..] 
    c <- Select [0..] 
    return $ (a,(b,c)) 

Das zweite Paar wird als eine einzige Datenquelle behandelt, so feststellen, dass:

ghci> map fst $ take 36 pairs 
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7] 
ghci> map fst $ take 36 triplePairs 
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7] 

und (Hinzufügen einige Leerzeichen/Zeilenumbrüche für Klarheit des Musters):

ghci> map snd $ take 36 pairs 
[0, 1,0, 2,1,0, 3,2,1,0, 4,3,2,1,0, 5,4,3,2,1,0, 6,5,4,3,2,1,0, 7,6,5,4,3,2,1,0] 
ghci> map snd $ take 36 triplePairs 
[(0,0), (0,1),(0,0), (1,0),(0,1),(0,0), (0,2),(1,0),(0,1),(0,0), 
(1,1),(0,2),(1,0),(0,1),(0,0), 
(2,0),(1,1),(0,2),(1,0),(0,1),(0,0), 
(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0), 
(1,2),(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0)] 

so können Sie sehen, dass es genau das gleiche Muster verwendet. Dies bewahrt nicht die Gesamtsummen und das sollte nicht so sein, weil wir zu drei Dimensionen gelangen, indem wir zunächst zwei Dimensionen abflachen, bevor wir die dritte abflachen. Das Muster ist verdeckt, aber es ist genauso garantiert am Ende der Liste .

Leider, wenn Sie drei Dimensionen in einer Summe erhalt Art und Weise tun wollen, werden Sie cantor2, cantor3 und cantor4 Funktionen schreiben, möglicherweise eine cantorN Funktion, aber Sie werden die monadische Schnittstelle Graben müssen, das ist inhärent basierend auf der Klammerung von >>=, daher Zwei-zu-einer-Zeit-Abflachung von Dimensionen. durch ein Tupel von Listen von N-1 Unterräumen

Answer 2

Ein korrekter multidimentional enumerator mit einem temporären Zustand Objekt könnte

{-# LANGUAGE MultiParamTypeClasses #-} 
{-# LANGUAGE FlexibleInstances #-} 
{-# LANGUAGE OverlappingInstances #-} 

class Space a b where 
    slice :: a -> ([b], a) 

instance Space [a] a where 
    slice (l:ls) = ([l], ls) 
    slice [] = ([], []) 

instance (Space sp x) => Space ([sp], [sp]) x where 
    slice (fs, b:bs) = let 
     ss = map slice (b : fs) 
     yield = concat $ map fst ss 
    in (yield, (map snd ss, bs)) 

Hier ein N dimensionaler Raum dargestellt wird dargestellt, haben und ist nicht von der Aufzählung berührt worden .

Sie können dann die folgende verwenden, um eine gut geordnete Liste

enumerate :: (Space sp x) => sp -> [x] 
enumerate sp = let (sl, sp') = slice sp 
       in sl ++ enumerate sp' 

Example in Ideone zu produzieren.

Answer 3

import Control.Applicative 
import Control.Arrow 

data Select a = Select [a] 
       | Selects [Select a] 

instance Functor Select where 
    fmap f (Select x) = Select $ map f x 
    fmap f (Selects xss) = Selects $ map (fmap f) xss 

instance Applicative Select where 
    pure = Select . (:[]) 
    Select fs <*> xs = Selects $ map (`fmap`xs) fs 
    Selects fs <*> xs = Selects $ map (<*>xs) fs 

instance Monad Select where 
    return = pure 
    Select xs >>= f = Selects $ map f xs 
    Selects xs >>= f = Selects $ map (>>=f) xs 

runSelect :: Select a -> [a] 
runSelect = go 1 
where go n xs = uncurry (++) . second (go $ n+1) $ splitOff n xs 
     splitOff n (Select xs) = second Select $ splitAt n xs 
     splitOff n (Selects sls) = (concat hs, Selects $ tsl ++ rl) 
     where ((hs, tsl), rl) = first (unzip . map (splitOff n)) $ splitAt n sls 

* Wählen Sie> 15 nehmen. runSelect $ do {a <-Wählen Sie [0 ..]; b <-Wählen Sie [0 ..]; zurück (a, b)}
[(0,0), (0,1), (1,0), (1,1), (0,2), (1,2), (2,0), (2,1), (2,2), (0,3), (1,3), (2,3), (3,0), (3,1), (3,2)]
* Wählen Sie> 15. runSelect $ do {a <-Wählen Sie [0 ..]; b <-Wählen Sie [0 ..]; c <-Wählen Sie [0 ..]; zurück (a, b, c)}
[(0,0,0), (0,0,1), (0,1,0), (0,1,1), (1,0,0), (1,0,1), (1,1,0), (1,1,1), (0,0,2), (0,1,2), (0,2,0), (0,2,1), (0,2,2), (1,0,2), (1,1,2)]

Beachten Sie, dass dies noch nicht ganz Cantor-Tupel ist ((0,1,1) sollte nicht vor (1,0,0)) kommen, aber es wäre in ähnlicher Weise möglich, es richtig zu bekommen.

Answer 4

Das omega Paket genau das tut, was Sie wollen, und garantiert, dass jedes Element schließlich besucht werden:

import Control.Applicative 
import Control.Monad.Omega 

main = print . take 200 . runOmega $ 
    (,,) <$> each [0..] <*> each [0..] <*> each [0..] 

---

Eine weitere Option LogicT zu verwenden wäre. Es gibt mehr Flexibilität (wenn Sie benötigen) und verfügt über Operationen wie (>>-), die sicherstellen, dass jede Kombination schließlich auftritt.

import Control.Applicative 
import Control.Monad 
import Control.Monad.Logic 

-- | Convert a list into any MonadPlus. 
each :: (MonadPlus m) => [a] -> m a 
each = msum . map return 

-- | A fair variant of '(<*>)` that ensures that both branches are explored. 
(<@>) :: (MonadLogic m) => m (a -> b) -> m a -> m b 
(<@>) f k = f >>- (\f' -> k >>- (\k' -> return $ f' k')) 
infixl 4 <@> 

main = print . observeMany 200 $ 
    (,,) <$> each [0..] <@> each [0..] <@> each [0..]