Нетерминизм для бесконечных входных данных

Использование списков в модель недетерминированности проблематично, если входы могут принимать бесконечно много значений. Например

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

Это вернет [(0,1),(0,2),(0,3),...] и никогда не сможет показать вам любую пару, чей первый элемент не является 0.

Используя функцию Cantor pairing, чтобы свернуть список списков в один список, можно обойти эту проблему. Например, мы можем определить оператор типа привязки, который упорядочивает свои выходы более разумно с помощью

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

Если мы теперь завершим это как монаду, мы можем перечислить все возможные пары

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) в упорядочении - моя интуиция говорит, что хорошее решение этой проблемы будет упорядочивать выходы в соответствии с некоторым понятием "размер" , что может быть явным входом в алгоритм, или может быть дано неявно (как в этом примере, где "размер" ввода - это его позиция во входных списках). При объединении входов "размер" комбинации должен быть некоторой функцией (вероятно, суммой) размера входов.

Есть ли элегантное решение этой проблемы, которое мне не хватает?

ОТВЕТЫ

Ответ 1

TL; DR: он сглаживает два измерения за раз, а не сглаживает три раза. Вы не можете убрать это в монаде, потому что >>= является двоичным, а не тройным и т.д.

Предполагаю, что вы определили

(>>>=) :: [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, но вам придется выровняйте монадический интерфейс, который по своей сути основан на брекетинге >>=, следовательно, двукратное сглаживание размеров.

Ответ 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'

Пример в Ideone.

Ответ 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

* Выберите > принять 15. runSelect $do {a <-Select [0..]; b < -выбрать [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)]
* Выберите > взять 15. runSelect $do {a <-Select [0..]; b < -выбрать [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)]

Обратите внимание, что это все еще не совсем канторские кортежи ((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..]