Question

目前我的数据如下：

这只是人为的“滴答”数据，第一个表示刻度值，第二个表示“午夜过夜”

因此对于股票数据，我需要将这些数据分类为“条形图”。那就是我需要在给定时间内将所有条形图组合在一起。

一个例子是4秒钟。午夜0-3秒的蜱虫将是1巴，午夜过后4-7秒将是另一个酒吧。

我有一个看起来像这样会计算1 bar大小的导管/接收器：

{-# LANGUAGE OverloadedStrings #-}

import Data.Maybe (isJust, fromJust)
import qualified Data.ByteString.Char8 as C
import Control.Applicative ((<$>), (<*>))

import Data.Conduit -- the core library
import qualified Data.Conduit.List as CL -- some list-like functions
import qualified Data.Conduit.Binary as CB -- bytes
import qualified Data.Conduit.Text as CT

data MyData = MyData Int Int
    deriving (Show)

binaryToData :: C.ByteString -> Maybe MyData
binaryToData bn = do
    let parts = C.split '-' bn
    case parts of
        (a:b:[]) -> MyData <$> (fst <$> (C.readInt a)) <*> (fst <$> (C.readInt b))
        _ -> Nothing

streamGenerator =
    CB.sourceFile "sample.txt" =$=
    CB.lines =$=
    CL.map binaryToData =$=
    CL.filter isJust =$=
    CL.map fromJust =$=
    CL.groupBy (\(MyData _ x) (MyData _ y) -> (x `quot` 4) == (y `quot` 4))

main :: IO ()
main = do
    mlines <- runResourceT $ streamGenerator $$ CL.consume
    print mlines

但是，我需要同时关闭流中的多个条形信息。例如，对于每2秒钟我需要4秒钟。如果被调用的2秒柱位于4秒柱的中间，我想输出前4秒柱。

这就是我的意思：

标准栏（数字表示该栏应包含的午夜过去的秒数）：

2 second bar : 0-1, 2-3, 4-5, etc...
4 second bar : 0-3, 4-7, 8-11, etc...
combo: (0-1, null), (2-3, 0-3), (4-5, 0-3),  (6-7, 4-7), etc...

因此，而不是我目前的2和4秒的分组管道：

4 second bar : [[MyData 3 150,MyData 2 151],[MyData 4 152,MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155],[MyData 6 156]]
2 second bar : [[MyData 3 150,MyData 2 151],[MyData 4 152],[MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155],[MyData 6 156]]

我想要这个管道流：

[([MyData 3 150,MyData 2 151], [MyData 3 150,MyData 2 151])
,([MyData 4 152], [MyData 3 150,MyData 2 151])
,([MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155], [MyData 4 152,MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155])
,([MyData 6 156],[MyData 4 152,MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155])]

但如果不做一些丑陋的事情，我似乎无法做到这一点。

Answer 1

如果您不介意的话，我可以使用我的pipes库回答您的问题，因为这是我感到满意的。如果您愿意，可以将此解决方案翻译为conduit。

这个需要回击的干净解决方案，但是pipes还没有推迟，所以我继续实施它（我将在不久的将来作为扩展库包含）：

import Control.Monad
import Control.Proxy
import Control.Proxy.Trans.State

-- Pushback primitives, soon to be in a `pipes` library

require :: (Monad m, Proxy p) => a' -> StateP [a] p a' a b' b m a
require a' = StateP $ \s -> runIdentityP $ do
    case s of
        [] -> do
            a <- request a'
            return (a, s)
        a:as -> do
            return (a, as)

pushback :: (Monad m, Proxy p) => a -> StateP [a] p a' a b' b m ()
pushback a = StateP $ \as -> runIdentityP $ return ((), a:as)

evalPushback = evalStateK []

有了这些，解决方案很简单：

data MyData = MyData Int Int deriving (Eq, Show)

-- Consumes ticks up until the deadline or the end of input
-- Returns the list of all ticks before the deadline
ticksUntil
 :: (Monad m, Proxy p)
 => Int -> () -> Consumer (StateP [Maybe MyData] p) (Maybe MyData) m [MyData]
ticksUntil deadline () = go where
    go = do
        x <- require ()
        case x of
            Just m@(MyData _ time) ->
                if (time < deadline)
                then do
                    ms <- go
                    return (m:ms)
                else do
                    pushback x
                    return []
            Nothing -> return []

bars
 :: (Monad m, Proxy p)
 => () -> Pipe (StateP [Maybe MyData] p) (Maybe MyData) ([MyData], [MyData]) m r
bars () = loop1 2 [] where
    -- First half of a 4-second window
    loop1 deadline b4 = do
        b2 <- (ticksUntil deadline >-> unitU) ()
        respond (b2, b4)
        loop2 (deadline + 2) b2 b4

    -- Second half of a 4-second window
    loop2 deadline b2 b4 = do
        b2' <- (ticksUntil deadline >-> unitU) ()
        let b4' = b2 ++ b2'
        respond (b2', b4')
        loop1 (deadline + 2) b4'

sample :: [MyData]
sample = [
    MyData 3 150,
    MyData 2 151,
    MyData 4 152,
    MyData 5 154,
    MyData 7 154,
    MyData 1 155,
    MyData 9 155,
    MyData 6 156]

-- Use the same trick as conduit: Nothing signals termination
source :: (Monad m, Proxy p) => () -> Producer p (Maybe MyData) m ()
source () = runIdentityP $ do
    (fromListS sample >-> mapD Just) ()
    respond Nothing

main = runProxy $
     source                 -- feed sample data
 >-> evalPushback bars      -- group the data into bars
 >-> filterD (/= ([], []))  -- Ignore empty bars
 >-> printD                 -- print outgoing bars

魔法在bars函数中。它只是在两种状态之间切换。 loop1是第一个状态，它期望第4个中有2个值的第一个条形，而loop2是第二个状态，它期望第二个条形的2个值。

实现这一点最困难的部分不是编写代码，而是了解您的规范。幸运的是，我想我想出了你的意思，因为我的代码产生了与你的测试例完全相同的行为：

>>> main
([MyData 3 150,MyData 2 151],[MyData 3 150,MyData 2 151])
([MyData 4 152],[MyData 3 150,MyData 2 151])
([MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155],[MyData 4 152,MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155])
([MyData 6 156],[MyData 4 152,MyData 5 154,MyData 7 154,MyData 1 155,MyData 9 155])

如果您对pipes感兴趣，那么我建议您查看pipes library，特别是Control.Proxy.Tutorial上的教程，它解释了我在代码中使用的很多习惯用法。

使用导管从流中构建库存条数据 - 如何获得多个深度？

1 个答案: