From 3e78fa99dd0ba41d019530ced029ff227cc4f0ec Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Wed, 26 Apr 2023 09:47:04 +0700 Subject: [PATCH] BarAggregator: update bar timestamp on close --- src/ATrade/BarAggregator.hs | 24 ++++++----- test/Test/BarAggregator.hs | 82 ++++++++++++++++++++++++++++--------- 2 files changed, 77 insertions(+), 29 deletions(-) diff --git a/src/ATrade/BarAggregator.hs b/src/ATrade/BarAggregator.hs index f385e52..0534352 100644 --- a/src/ATrade/BarAggregator.hs +++ b/src/ATrade/BarAggregator.hs @@ -72,25 +72,28 @@ handleTicks ticks aggregator = foldl f ([], aggregator) ticks handleTick :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator) handleTick tick = runState $ do lLastTicks %= M.insert (security tick, datatype tick) tick - tws <- gets tickTimeWindows + timeWindows <- gets tickTimeWindows mybars <- gets bars - if (any (isInTimeInterval tick) tws) + if any (isInTimeInterval tick) timeWindows then case M.lookup (security tick) mybars of Just series -> case bsBars series of (b:bs) -> do - let currentBn = barNumber (barTimestamp b) (fromIntegral . unBarTimeframe $ bsTimeframe series) + let timeframeInSeconds = fromIntegral . unBarTimeframe $ bsTimeframe series + let currentBn = barNumber (barTimestamp b) timeframeInSeconds case datatype tick of LastTradePrice -> if volume tick > 0 then - if currentBn == barNumber (timestamp tick) (fromIntegral . unBarTimeframe $ bsTimeframe series) + if currentBn == barNumber (timestamp tick) timeframeInSeconds then do lBars %= M.insert (security tick) series { bsBars = updateBar b tick : bs } return Nothing else do - lBars %= M.insert (security tick) series { bsBars = barFromTick tick : b : bs } - return . Just $ b + let barEndTimestamp = barEndTime b timeframeInSeconds + let resultingBar = b { barTimestamp = barEndTimestamp } + lBars %= M.insert (security tick) series { bsBars = barFromTick tick : resultingBar : bs } + return . Just $ resultingBar else return Nothing _ -> @@ -140,15 +143,16 @@ handleTick tick = runState $ do updateTime :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator) updateTime tick = runState $ do lLastTicks %= M.insert (security tick, datatype tick) tick - tws <- gets tickTimeWindows + timeWindows <- gets tickTimeWindows mybars <- gets bars - if (any (isInTimeInterval tick) tws) + if any (isInTimeInterval tick) timeWindows then case M.lookup (security tick) mybars of Just series -> case bsBars series of (b:bs) -> do - let currentBn = barNumber (barTimestamp b) (fromIntegral . unBarTimeframe $ bsTimeframe series) - let thisBn = barNumber (timestamp tick) (fromIntegral . unBarTimeframe $ bsTimeframe series) + let timeframeInSeconds = fromIntegral . unBarTimeframe $ bsTimeframe series + let currentBn = barNumber (barTimestamp b) timeframeInSeconds + let thisBn = barNumber (timestamp tick) timeframeInSeconds if | currentBn == thisBn -> do lBars %= M.insert (security tick) series { bsBars = updateBarTimestamp b tick : bs } diff --git a/test/Test/BarAggregator.hs b/test/Test/BarAggregator.hs index f6a7294..4f152af 100644 --- a/test/Test/BarAggregator.hs +++ b/test/Test/BarAggregator.hs @@ -10,6 +10,8 @@ import ATrade.BarAggregator import ATrade.RoboCom.Types import ATrade.Types import Data.List +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as M import qualified Data.Text as T import Data.Time.Calendar @@ -34,10 +36,37 @@ unitTests = testGroup "BarAggregator" [ properties = testGroup "BarAggregator" [ prop_allTicksInOneBar + , prop_threeBars ] secParams = InstrumentParameters "TEST_TICKER" 1 0.01 +genTick :: T.Text -> UTCTime -> Int -> Gen Tick +genTick tickerId baseTime timeframe = do + ts <- generateTimestampInsideBar baseTime timeframe + val <- fromIntegral <$> Gen.int (Range.linear 1 1000000) + vol <- Gen.integral (Range.linear 1 1000000) + return $ Tick tickerId LastTradePrice ts (fromDouble $ val / 1000) vol + where + generateTimestampInsideBar base timeframe = + flip addUTCTime base . + fromRational . + toRational . + picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * fromIntegral timeframe)) + +mkAggregator :: TickerId -> Int -> BarAggregator +mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (BarTimeframe tf) [] secParams)) [(0, 86400)] + +assertBarCorrespondence :: (MonadTest m) => Bar -> NE.NonEmpty Tick -> m () +assertBarCorrespondence bar ticks = do + barHigh bar === maximum (value <$> sortedTicks) + barLow bar === minimum (value <$> sortedTicks) + barOpen bar === value (NE.head sortedTicks) + barClose bar === value (NE.last sortedTicks) + barVolume bar === sum (volume <$> sortedTicks) + where + sortedTicks = NE.fromList . sortOn timestamp . NE.toList $ ticks + testUnknownBarSeries :: TestTree testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do let agg = BarAggregator M.empty M.empty [(0, 86400)] @@ -95,11 +124,13 @@ testTwoTicksInDifferentBars = testCase "Two ticks - different bar" $ do let (mbar, newagg) = handleTick (tick testTimestamp1 12.00) agg mbar @?= Nothing let (mbar', newagg') = handleTick (tick testTimestamp2 14.00) newagg - mbar' @?= Just (Bar "TEST_TICKER" testTimestamp1 12.00 12.00 12.00 12.00 1) - (bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just [Bar "TEST_TICKER" testTimestamp2 14.00 14.00 14.00 14.00 1, Bar "TEST_TICKER" testTimestamp1 12.00 12.00 12.00 12.00 1] + mbar' @?= Just (Bar "TEST_TICKER" barEndTime 12.00 12.00 12.00 12.00 1) + + (bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just [Bar "TEST_TICKER" testTimestamp2 14.00 14.00 14.00 14.00 1, Bar "TEST_TICKER" barEndTime 12.00 12.00 12.00 12.00 1] where - testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 58) - testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 61) + testTimestamp1 = UTCTime (fromGregorian 1970 1 1) 58 + barEndTime = UTCTime (fromGregorian 1970 1 1) 60 + testTimestamp2 = UTCTime (fromGregorian 1970 1 1) 61 tick ts val = Tick { security = "TEST_TICKER", datatype = LastTradePrice, @@ -107,29 +138,42 @@ testTwoTicksInDifferentBars = testCase "Two ticks - different bar" $ do value = fromDouble val, volume = 1 } - prop_allTicksInOneBar :: TestTree prop_allTicksInOneBar = testProperty "All ticks in one bar" $ property $ do tf <- forAll $ Gen.integral (Range.constant 1 86400) ticks <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" baseTime tf) let ticks' = sortOn timestamp ticks let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" tf) - (barHigh <$> currentBar "TEST_TICKER" agg) === Just (maximum $ value <$> ticks) - (barLow <$> currentBar "TEST_TICKER" agg) === Just (minimum $ value <$> ticks) - (barOpen <$> currentBar "TEST_TICKER" agg) === (value <$> headMay ticks') - (barClose <$> currentBar "TEST_TICKER" agg) === (value <$> lastMay ticks') - (barVolume <$> currentBar "TEST_TICKER" agg) === Just (sum $ volume <$> ticks) + let (Just lastBar) = currentBar "TEST_TICKER" agg HH.assert $ null newbars - + assertBarCorrespondence lastBar $ NE.fromList ticks where - genTick :: T.Text -> UTCTime -> Int -> Gen Tick - genTick tickerId base tf = do - difftime <- fromRational . toRational . picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * fromIntegral tf)) - val <- fromIntegral <$> Gen.int (Range.linear 1 1000000) - vol <- Gen.integral (Range.linear 1 1000000) - return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) (fromDouble $ val / 1000) vol - mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (BarTimeframe tf) [] secParams)) [(0, 86400)] - currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg)) baseTime = UTCTime (fromGregorian 1970 1 1) 0 +prop_threeBars :: TestTree +prop_threeBars = testProperty "Three bars" $ property $ do + tf <- forAll $ Gen.integral (Range.constant 1 86400) + + ticks1 <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" baseTime tf) + + let secondBarBaseTime = addUTCTime (fromIntegral tf) baseTime + ticks2 <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" secondBarBaseTime tf) + + let thirdBarBaseTime = addUTCTime (fromIntegral $ 2 * tf) baseTime + ticks3 <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" thirdBarBaseTime tf) + + let ticks' = sortOn timestamp $ ticks1 <> ticks2 <> ticks3 + let ([secondBar, firstBar], agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" tf) + + assertBarCorrespondence firstBar (NE.fromList ticks1) + assertBarCorrespondence secondBar (NE.fromList ticks2) + + barTimestamp firstBar === secondBarBaseTime + barTimestamp secondBar === thirdBarBaseTime + + let (Just lastBar) = currentBar "TEST_TICKER" agg + assertBarCorrespondence lastBar (NE.fromList ticks3) + where + currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg)) + baseTime = UTCTime (fromGregorian 1970 1 1) 0