Nondeterminism for infinite inputs

Question

Using lists to model nondeterminism is problematic if the inputs can take infinitely many values. For example

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

This will return [(0,1),(0,2),(0,3),...] and never get around to showing you any pair whose first element is not 0.

Using the Cantor pairing function to collapse a list of lists into a single list can get around this problem. For example, we can define a bind-like operator that orders its outputs more intelligently by

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

If we now wrap this up as a monad, we can enumerate all possible pairs

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)

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

which is a much more desirable result. However, if we were to ask for triples instead, the ordering on the outputs isn't as "nice" and it's not even clear to me that all outputs are eventually included --

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

Note that (2,0,1) appears before (0,1,1) in the ordering -- my intuition says that a good solution to this problem will order the outputs according to some notion of "size", which could be an explicit input to the algorithm, or could be given implicitly (as in this example, where the "size" of an input is its position in the input lists). When combining inputs, the "size" of a combination should be some function (probably the sum) of the size of the inputs.

Is there an elegant solution to this problem that I am missing?

Answer 1

TL;DR: It flattens two dimensions at a time, rather than flattening three at once. You can't tidy this up in the monad because >>= is binary, not ternary etc.

---

I'll assume you defined

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

to interleave the list of lists.

You like that because it goes diagonally:

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

gives

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 it's pleasingly keeping the "sizes" in order, but the pattern appears to be broken for triples, and you doubt completeness, but you needn't. It's doing the same trick, but twice, rather than for all three at once:

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

The second pair is treated as a single source of data, so notice that:

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]

and (adding some spaces/newlines for clarity of pattern):

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 you can see it's using exactly the same pattern. This doesn't preserve total sums and it oughtn't because we're getting to three dimensions by flattening two dimensions first before flattening the third in. The pattern is obscured, but it's just as guaranteed to make it to the end of the list.

Sadly if you want to do three dimensions in a sum-preserving way, you'll have to write cantor2, cantor3 and cantor4 functions, possibly a cantorN function, but you'll have to ditch the monadic interface, which is inherently based on the bracketing of >>=, hence two-at-a-time flattening of dimensions.

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> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; return (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)]
*Select> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; c<‌-Select [0..]; return (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)]

Note that this is still not quite Cantor-tuples ((0,1,1) shouldn't come before (1,0,0)), but getting it correct would be possible as well in a similar manner.