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
Split 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 @@ -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 @@ -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 }

82
test/Test/BarAggregator.hs
Unescape View File

@ -10,6 +10,8 @@ import ATrade.BarAggregator @@ -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" [ @@ -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 @@ -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 @@ -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

Write Preview
Loading…
Cancel
Save