15

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

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

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

使用Cantor 配对函数将列表列表折叠成单个列表可以解决此问题。例如，我们可以定义一个类似绑定的运算符，它通过以下方式更智能地对其输出进行排序

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

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

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)- 我的直觉说，这个问题的一个好的解决方案将根据“大小”的一些概念对输出进行排序，这可能是算法的显式输入，或者可以隐式给出（如这个例子，其中输入的“大小”是它在输入列表中的位置）。组合输入时，组合的“大小”应该是输入大小的某个函数（可能是总和）。

我缺少这个问题的优雅解决方案吗？

4

4 回答 4

7

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函数，但是你必须放弃单子接口，它本质上是基于括号的>>=，因此一次两次展平尺寸。

于 2013-12-20T21:06:25.447 回答
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<‌-Select [0..]; b<‌-选择[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)]
*选择> 取 15 。runSelect $ do { a<‌-Select [0..]; b<‌-选择[0..]；c<‌-选择[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)]

请注意，这仍然不是康托元组（(0,1,1)不应该出现在之前(1,0,0)），但也可以以类似的方式使其正确。

于 2013-12-21T04:18:06.157 回答
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..]
于 2013-12-21T14:16:21.307 回答
4

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

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

Ideone 中的示例。

于 2013-12-20T22:20:40.940 回答