2013-12-20 7 views
15

非決定性をモデル化するためにリストを使用することは、入力が無限に多くの値をとることができる場合には問題があります。例無限の入力に対する非決定性

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

のためにこれは[(0,1),(0,2),(0,3),...]を返し、あなたの最初の要素が0ではない任意のペアを示す程度取得することはありません。

Cantor pairing functionを使用すると、リストのリストを1つのリストにまとめてこの問題を回避できます。例えば、我々は今、モナドとしてこれを包む場合は、我々はすべての可能なペア

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) 

この結果を列挙することができます

(>>>=) :: [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 [email protected](h:t) 
    | n <= 0 = xs 
    | otherwise = f h : mapN (n-1) f t 

することで、よりインテリジェントにその出力を順序付けバインド-like演算子を定義することができます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)] 

これはもっと望ましい結果です。 (2,0,1)が前に表示されていることを

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

注 - 私たちが代わりにトリプルをお願いしていた場合は、出力の順序は、「素敵」と、それはすべての出力が最終的に含まれていることを私にしてもはっきりしていないようではありません(0,1,1) - 私の直感では、この問題に対する良い解決策は、 "size"という概念に基づいて出力を並べ替えることで、アルゴリズムへの明示的な入力となるか、暗黙的に与えることができると言います(この例のように、ここで、入力の「サイズ」は入力リストにおけるその位置である)。入力を組み合わせる場合、組み合わせの「サイズ」は、入力のサイズの関数(おそらく合計)でなければなりません。

この問題に対する洗練された解決策はありますか?

+0

[]をlogictに置き換えることはできますか? –

+0

おそらく!それがどのように実装されているかを見ていきます。私は何かのためにそれを使用したいからではなく、教育上の理由からこれに大いに興味があります。 –

+4

これは本当にクールです。いいモナドなインターフェイスを与える方法はわかりませんが、スペース充填曲線のコンセプトは、あなたが望む振る舞いを(n次元にすることができるので)与えることができますか? – jberryman

答えて

7

TL; DR:一度に3つの平坦化を行うのではなく、一度に2つのディメンションを平坦化します。 >>=がバイナリであるので、あなたは、など


三ない、モナドでこれを整理することができない私はあなたのリストのリストをインターリーブする

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

を定義したと仮定します。そのような

あなたはそれが斜めに行くので:

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

ので、それが楽しくために、「大きさ」を保つことだが、パターンがtriplesのために壊れているように見える、とあなた

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] 

を与えます完全性は疑いますが、必要はありません。これは、同じトリックをやってますが、二回、むしろすべての3つの場合よりも、一度だ:

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

第二の対は、単一のデータソースとして扱われ、そのことに注意してください:

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] 

をして(追加しますパターンの明瞭さのためにいくつかの空白/改行):

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

これは全く同じパターンを使用していることがわかります。これは総計を保持しておらず、3次元を平坦化する前に2次元を平坦化することによって3次元になっているため、パターンが不明瞭になりますが、リストの最後まで保証されます。あなたは合計保存方法で3次元を行いたい場合

悲しいことに、あなたはcantor2cantor3cantor4機能、おそらくcantorN関数を記述する必要がありますが、あなたはしている、モナドインタフェースを捨てる必要があります本質的に>>=のブラケティングに基づいており、それゆえ、次元の2つの時点での平坦化に基づいている。

4

正しい多次元列挙子はN次元空間を持っていると、列挙によって触れられていないN-1次元部分空間のリストのタプルで表される

{-# 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)) 

ここでは、一時的な状態オブジェクトを表すことができます。

その後、

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

Example in Ideoneうまく順序付けられたリストを生成するために、以下を使用することができます。

+0

あなたの投稿にあなたの出力を含めないと、クリックスルーとスクロールがどのように対称的であるかを見ることができます。 –

+0

@ chunksOf50私のSpaceオブジェクトを構築する方法は、publicにとってあまりにも醜いので、D。 –

4
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 

*選択> 15を取ります。 runSelect $ do {a <- [0 ..]を選択します。 b <- [0 ..]を選択します。 (0,0)、(1,0)、(1,1)、(0,2)、(1,2)、(2,0)、(1,2,3) )、(2,1)、(2,2)、(0,3)、(1,3)、(2,3)、(3,0)、(3,1)、(3,2)]
*選択> 15を取る。 runSelect $ do {a <- [0 ..]を選択します。 b <- [0 ..]を選択します。 c <- [0 ..]を選択します。
[(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)]

注これはまだかなりカントールタプル(ないこと(0,1,1)(1,0,0)の前に来るべきではありませんが、それを正しいものにすることも同じように可能です。

4

omegaパッケージには、あなたが望むものを正確に行い、すべての要素が最終的に訪問されることを保証:

import Control.Applicative 
import Control.Monad.Omega 

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

別のオプションは、LogicTを使用することです。これにより、必要に応じて柔軟性が増し、(>>-)などの操作があり、すべての組み合わせが最終的に遭遇することが保証されます。

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..] 
関連する問題