无限输入的非确定性

Question

如果输入可以采用无限多的值，则使用列表对不确定性建模是有问题的。例如

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

这将返回 [(0,1),(0,2),(0,3),...] 并且永远不会向您展示任何第一个元素不是 0 的对。

使用Cantor pairing function 将列表列表折叠成单个列表可以解决此问题。例如，我们可以定义一个类似绑定的运算符，通过

对其输出进行更智能的排序

(>>>=) :: [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

如果我们现在把它包装成一个 monad，我们可以枚举所有可能的对

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)

这会导致

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

这是一个更理想的结果。但是，如果我们要改为三元组，输出的顺序就不是“很好”，而且我什至不清楚所有输出最终都包括在内--

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

请注意，(2,0,1) 在排序中出现在(0,1,1) 之前——我的直觉是，这个问题的一个好的解决方案将根据“大小”的一些概念对输出进行排序，这可能是算法的显式输入，或者可以隐式给出（如本例中，输入的“大小”是其在输入列表中的位置）。组合输入时，组合的“大小”应该是输入大小的某个函数（可能是总和）。

我想念的这个问题有什么优雅的解决方案吗？

Answer 1

TL;DR：它一次展平两个维度，而不是一次展平三个。你不能在 monad 中整理它，因为 >>= 是二进制的，而不是三进制的等等。

---

我假设你已经定义了

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

交错列表列表。

你喜欢这样，因为它是对角线的：

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

给予

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]

所以它很高兴保持“大小”的顺序，但triples 的模式似乎被打破了，你怀疑完整性，但你不需要。它做同样的把戏，但两次，而不是一次全部三个：

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

所以你可以看到它使用完全相同的模式。这不会保留总和，也不应该因为我们通过在展平第三个维度之前先展平两个维度来达到三个维度。模式是模糊的，但它可以保证到达列表的末尾.

遗憾的是，如果您想以求和的方式处理三个维度，则必须编写 cantor2、cantor3 和 cantor4 函数，可能还有 cantorN 函数，但您必须编写抛弃 monadic 接口，它本质上是基于 >>= 的包围，因此一次两次扁平化维度。

Answer 2

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

*Select> 取 15 。 runSelect $ do { a [(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)]
*选择> 取 15 。 runSelect $ do { a [(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) 之前），但也可以通过类似的方式使其正确。

Answer 3

一个正确的多维枚举器可以用一个临时状态对象来表示

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

这里N 维空间由N-1 维子空间列表的元组表示，这些子空间已被枚举触及和尚未触及。

然后您可以使用以下内容生成有序列表

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

Example in Ideone.

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