泛化Haskell“Streaming”庫的合並功能

Question

目標是概括Streaming.merge函數，

merge :: (Monad m, Ord a) => Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s) 

到任意數量的源流。 該戰略是使用Data.Heap.Heap的Stream (Of a) mr由排序a 。 即bigMerge將具有簽名

bigMerge :: (Monad m, Ord a) => [Stream (Of a) m r] -> Stream (Of a) m [r]

（該列表也可以用Heap代替。）

我所擁有的是一種不太正確的相當邪惡的混合物。 它是這樣的：

對於完整的，首先關閉進口：

import qualified Data.Heap as H
import Data.Heap (Heap)
import Data.List (sortBy)
import Data.Function (on)
import Streaming
import qualified Streaming.Prelude as S
import Streaming.Internal (Stream(..))  -- shouldn't!

為了使用Heap ，需要一個Ord類的元素：

data Elt a m r = Elt Int (Maybe a) (Stream(Of a) m r)

引入額外的Int以在輸入列表中攜帶流的索引，以便返回的[r]可以按正確的順序使用元素構建。 Maybe a攜帶流的當前值。

Eq和Ord實例是：

instance Eq a => Eq (Elt a m r) where
(Elt i ma _) == (Elt i' ma' _) = 
    if i == i' then error "Internal error: Index clash in ==" 
    else ma == ma'

instance Ord a => Ord (Elt a m r) where
(Elt i ma s) <= (Elt i' ma' s') | i==i' = error "Internal error: Index clash in <="
                                | otherwise = cmp (i, ma, s) (i', ma', s')
    where 
    cmp _                      (_, Nothing, Return _) = True
    cmp (_, Nothing, Return _) _                      = False
    cmp (i, Just a, _)         (i', Just a', _)       = if a == a' then i <= i' else a <= a'
    cmp (i, _, _)              (i', _, _)             = i <= i'

基本上，任何東西都是<= a Return ，所有其他情況都使用a和/或i對Elt s 進行排序。 （ errors用於調試目的。）

一些輔助功能使Elt從Stream和Heap從列表Stream 。

eltFromStream :: (Monad m, Ord a) => Int -> Stream (Of a) m r -> m (Elt a m r)
eltFromStream i (Return r) = return $ Elt i Nothing (Return r)
eltFromStream i (Effect m) = do
    stream' <- m
    return $ Elt i Nothing stream'
eltFromStream i (Step (a :> rest)) = return $ Elt i (Just a) rest

heapFromStreams :: (Monad m, Ord a) => [Stream (Of a) m r] -> m (Heap (Elt a m r))
heapFromStreams strs = H.fromList <$> (sequence $ fmap (uncurry eltFromStream) (zip [0..] strs))

核心部分是loop函數

loop :: (Monad m, Ord a) => Heap (Elt a m r) -> m (Heap (Elt a m r))
loop h = do
let (Elt i ma s, h') = unsafeUncons h
elt <- case s of
    Return r         -> return $ Elt i Nothing (Return r)
    Effect m         -> Elt i Nothing <$> m
    Step (a :> rest) -> return $ Elt i (Just a) rest
return $ H.insert elt h'

厚顏無恥的unsafeUncons是

unsafeUncons :: Heap a -> (a, Heap a)
unsafeUncons h = case H.uncons h of
Nothing -> error "Internal error"
Just x -> x

heapMerge中使用了loop函數，將Heap變成Stream

heapMerge :: (Monad m, Ord a) => Heap (Elt a m r) -> Stream (Of a) m [r]
heapMerge h = case (ma,s) of
    (Nothing, Return _) -> Return $ getRs h
    (_, Effect m) -> error "TODO"
    (Just a, _)  -> do
        h' <- lift $ loop h
        Step (a :> heapMerge h')
    where
        Elt i ma s = H.minimum h

getRs只是將Return值組合成一個列表

getRs :: (Monad m, Ord a) => Heap (Elt a m r) -> [r]
getRs h = snd <$> sortBy (compare `on` fst) (map f (H.toUnsortedList h))
where
    f :: Monad m => Elt a m r -> (Int, r)
    f (Elt i _ (Return r)) = (i,r)
    f _ = error "Internal error: Call getR only after stream has finished!"

然后，最后，

bigMerge :: (Monad m, Ord a) => [Stream (Of a) m r] -> Stream (Of a) m [r]
bigMerge streams = 
if null streams then Return [] 
else do
    h <- lift $ heapFromStreams streams
    heapMerge h

這很復雜， Effect沒有正確處理，它依賴Return , Step , Effect而不是inspect和next 。 它確實在簡單的輸入上產生正確的結果，例如

s1 = S.each [2,4,5::Int]
s2 = S.each [1,2,4,5::Int]
s3 = S.each [3::Int]
S.print $ merge [s1,s2,s3]

我確信有一種方法可以正確且更慣用地執行此操作。 一方面， Elt的Maybe a可能是多余的，我可以直接讓(Stream (Of a) mr)成為Ord的實例，如果Effect只是模式匹配，沒有執行，那么這應該沒問題。 但是Stream (Of (Heap (Stream (Of a) mr, Int))) (Heap (Int,r))看起來很奇怪。 “帶索引的流” IStream amr = IStream Int ((Heap (Stream (Of a) mr) deriving Functor是r一個函子，因此，如果使用適當的==和<= ，我會查看Stream (IStream am) m (Heap (Int, r)) ?

streaming庫的這個功能方面對我來說仍然有點困惑，所以任何幫助將不勝感激。

Answer 1

bigMerge的簽名看起來非常像Data.Traversable的sequenceA簽名：

sequenceA :: Applicative f => [f r] -> f [r]

問題當然是我們不能對Stream使用標准的Applicative實例，因為它是連接而不是合並。 但是我們可以嘗試通過 newtype 創建我們自己的實例：

{-# LANGUAGE DeriveFunctor #-}
import Streaming
import qualified Streaming.Prelude as S

newtype MergeStream a m r = 
    MergeStream { getMergeStream :: Stream (Of a) m r } deriving Functor

-- BEWARE! Only valid for ORDERED streams!
instance (Monad m, Ord a) => Applicative (MergeStream a m) where
    pure x = MergeStream (pure x)
    MergeStream f <*> MergeStream x = MergeStream (uncurry ($) <$> S.merge f x) 

現在，使用示例中的s1 、 s2和s3以及標准Traversable函數：

ghci> S.toList_ $ getMergeStream . traverse MergeStream $ [s1,s2,s3]
[1,2,2,3,4,4,5,5]

這似乎有效。 也就是說，出於效率原因，您嘗試使用Stream內部結構和堆實現bigMerge可能仍然值得。