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

正确的多维枚举器可以用临时状态对象

表示

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

*选择＆GT;拿15。 runSelect $ do {a＆lt;-Select [0 ..]; b＆lt; -Select [0 ..];返回（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）]
  *选择＆GT;拿15。 runSelect $ do {a＆lt;-Select [0 ..]; b＆lt; -Select [0 ..]; c＆lt; -Select [0 ..];返回（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）]

请注意，这仍然不是Cantor-tuples（(0,1,1)不应该在(1,0,0)之前），但是也可以以类似的方式使其正确。

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

无限输入的非确定性

4 个答案: