asakul
/
robocom-zero
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

BarAggregator: update bar timestamp on close

master
Denis Tereshkin 3 years ago
parent
bcb7d91805
commit
3e78fa99dd
2 changed files with 77 additions and 29 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 24
      src/ATrade/BarAggregator.hs
  2. 82
      test/Test/BarAggregator.hs

24
src/ATrade/BarAggregator.hs
Unescape View File

@ -72,25 +72,28 @@ handleTicks ticks aggregator = foldl f ([], aggregator) ticks
handleTick :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator) handleTick :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator)
handleTick tick = runState $ do handleTick tick = runState $ do
lLastTicks %= M.insert (security tick, datatype tick) tick lLastTicks %= M.insert (security tick, datatype tick) tick
tws <- gets tickTimeWindows timeWindows <- gets tickTimeWindows
mybars <- gets bars mybars <- gets bars
if (any (isInTimeInterval tick) tws) if any (isInTimeInterval tick) timeWindows
then then
case M.lookup (security tick) mybars of case M.lookup (security tick) mybars of
Just series -> case bsBars series of Just series -> case bsBars series of
(b:bs) -> do (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 case datatype tick of
LastTradePrice -> LastTradePrice ->
if volume tick > 0 if volume tick > 0
then then
if currentBn == barNumber (timestamp tick) (fromIntegral . unBarTimeframe $ bsTimeframe series) if currentBn == barNumber (timestamp tick) timeframeInSeconds
then do then do
lBars %= M.insert (security tick) series { bsBars = updateBar b tick : bs } lBars %= M.insert (security tick) series { bsBars = updateBar b tick : bs }
return Nothing return Nothing
else do else do
lBars %= M.insert (security tick) series { bsBars = barFromTick tick : b : bs } let barEndTimestamp = barEndTime b timeframeInSeconds
return . Just $ b let resultingBar = b { barTimestamp = barEndTimestamp }
lBars %= M.insert (security tick) series { bsBars = barFromTick tick : resultingBar : bs }
return . Just $ resultingBar
else else
return Nothing return Nothing
_ -> _ ->
@ -140,15 +143,16 @@ handleTick tick = runState $ do
updateTime :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator) updateTime :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator)
updateTime tick = runState $ do updateTime tick = runState $ do
lLastTicks %= M.insert (security tick, datatype tick) tick lLastTicks %= M.insert (security tick, datatype tick) tick
tws <- gets tickTimeWindows timeWindows <- gets tickTimeWindows
mybars <- gets bars mybars <- gets bars
if (any (isInTimeInterval tick) tws) if any (isInTimeInterval tick) timeWindows
then then
case M.lookup (security tick) mybars of case M.lookup (security tick) mybars of
Just series -> case bsBars series of Just series -> case bsBars series of
(b:bs) -> do (b:bs) -> do
let currentBn = barNumber (barTimestamp b) (fromIntegral . unBarTimeframe $ bsTimeframe series) let timeframeInSeconds = fromIntegral . unBarTimeframe $ bsTimeframe series
let thisBn = barNumber (timestamp tick) (fromIntegral . unBarTimeframe $ bsTimeframe series) let currentBn = barNumber (barTimestamp b) timeframeInSeconds
let thisBn = barNumber (timestamp tick) timeframeInSeconds
if if
| currentBn == thisBn -> do | currentBn == thisBn -> do
lBars %= M.insert (security tick) series { bsBars = updateBarTimestamp b tick : bs } lBars %= M.insert (security tick) series { bsBars = updateBarTimestamp b tick : bs }

82
test/Test/BarAggregator.hs
Unescape View File

@ -10,6 +10,8 @@ import ATrade.BarAggregator
import ATrade.RoboCom.Types import ATrade.RoboCom.Types
import ATrade.Types import ATrade.Types
import Data.List 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.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
@ -34,10 +36,37 @@ unitTests = testGroup "BarAggregator" [
properties = testGroup "BarAggregator" [ properties = testGroup "BarAggregator" [
prop_allTicksInOneBar prop_allTicksInOneBar
, prop_threeBars
] ]
secParams = InstrumentParameters "TEST_TICKER" 1 0.01 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 :: TestTree
testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do
let agg = BarAggregator M.empty M.empty [(0, 86400)] 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 let (mbar, newagg) = handleTick (tick testTimestamp1 12.00) agg
mbar @?= Nothing mbar @?= Nothing
let (mbar', newagg') = handleTick (tick testTimestamp2 14.00) newagg let (mbar', newagg') = handleTick (tick testTimestamp2 14.00) newagg
mbar' @?= Just (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" 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" barEndTime 12.00 12.00 12.00 12.00 1]
where where
testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 58) testTimestamp1 = UTCTime (fromGregorian 1970 1 1) 58
testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 61) barEndTime = UTCTime (fromGregorian 1970 1 1) 60
testTimestamp2 = UTCTime (fromGregorian 1970 1 1) 61
tick ts val = Tick { tick ts val = Tick {
security = "TEST_TICKER", security = "TEST_TICKER",
datatype = LastTradePrice, datatype = LastTradePrice,
@ -107,29 +138,42 @@ testTwoTicksInDifferentBars = testCase "Two ticks - different bar" $ do
value = fromDouble val, value = fromDouble val,
volume = 1 } volume = 1 }
prop_allTicksInOneBar :: TestTree prop_allTicksInOneBar :: TestTree
prop_allTicksInOneBar = testProperty "All ticks in one bar" $ property $ do prop_allTicksInOneBar = testProperty "All ticks in one bar" $ property $ do
tf <- forAll $ Gen.integral (Range.constant 1 86400) tf <- forAll $ Gen.integral (Range.constant 1 86400)
ticks <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" baseTime tf) ticks <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" baseTime tf)
let ticks' = sortOn timestamp ticks let ticks' = sortOn timestamp ticks
let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" tf) let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" tf)
(barHigh <$> currentBar "TEST_TICKER" agg) === Just (maximum $ value <$> ticks) let (Just lastBar) = currentBar "TEST_TICKER" agg
(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)
HH.assert $ null newbars HH.assert $ null newbars
assertBarCorrespondence lastBar $ NE.fromList ticks
where 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)) currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg))
baseTime = UTCTime (fromGregorian 1970 1 1) 0 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

Write Preview
Loading…
Cancel
Save