From 91de243a70c7a01d4f6e8491b3191b7e20062051 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sun, 1 Sep 2019 11:09:46 +0700 Subject: [PATCH 1/5] More debug in QuoteSourceThread --- src/ATrade/Driver/Real/QuoteSourceThread.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ATrade/Driver/Real/QuoteSourceThread.hs b/src/ATrade/Driver/Real/QuoteSourceThread.hs index e5d3b1a..cd23dbb 100644 --- a/src/ATrade/Driver/Real/QuoteSourceThread.hs +++ b/src/ATrade/Driver/Real/QuoteSourceThread.hs @@ -31,7 +31,7 @@ startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter maybeSourceTim bracket (startQuoteSourceClient tickChan tickersList ctx qsEp defaultClientSecurityParams) (\qs -> do stopQuoteSourceClient qs - debugM "Strategy" "Quotesource client: stop") + debugM "QSThread" "Quotesource client: stop") (\_ -> forever $ do qdata <- readChan tickChan case qdata of @@ -46,6 +46,7 @@ startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter maybeSourceTim Just _ -> return () QDBar (incomingTf, bar) -> do aggValue <- readIORef agg + debugM "QSThread" $ "Incoming bar: " ++ show incomingTf ++ ": " ++ show bar case maybeSourceTimeframe of Just tf -> when (tf == unBarTimeframe incomingTf) $ case handleBar bar aggValue of From 2e0802a2fdad2ab7cbdb1760d45a2cc663afa388 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sat, 7 Sep 2019 11:49:23 +0700 Subject: [PATCH 2/5] BarAggregator: increased max time --- src/ATrade/Driver/Real.hs | 2 +- src/ATrade/Driver/Real/QuoteSourceThread.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ATrade/Driver/Real.hs b/src/ATrade/Driver/Real.hs index 8877cdc..2653176 100644 --- a/src/ATrade/Driver/Real.hs +++ b/src/ATrade/Driver/Real.hs @@ -311,7 +311,7 @@ barStrategyDriver mbSourceTimeframe tickFilter strategy stateRef timersRef shutd M.fromList <$> mapM (loadTickerFromHAP ctx ((strategyHistoryProvider . strategyInstanceParams) strategy)) (tickers . strategyInstanceParams $ strategy) | otherwise -> M.fromList <$> mapM (loadTickerFromQHP ctx ((strategyHistoryProvider . strategyInstanceParams) strategy)) (tickers . strategyInstanceParams $ strategy) - agg <- newIORef $ mkAggregatorFromBars historyBars [(hmsToDiffTime 6 50 0, hmsToDiffTime 21 0 0)] + agg <- newIORef $ mkAggregatorFromBars historyBars [(hmsToDiffTime 6 50 0, hmsToDiffTime 21 10 0)] bracket (startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter mbSourceTimeframe) killThread (\_ -> do debugM "Strategy" "QuoteSource thread forked" bracket (startBrokerClientThread (strategyInstanceId . strategyInstanceParams $ strategy) ctx brEp ordersChan eventChan shutdownVar) killThread (\_ -> do diff --git a/src/ATrade/Driver/Real/QuoteSourceThread.hs b/src/ATrade/Driver/Real/QuoteSourceThread.hs index cd23dbb..7cad432 100644 --- a/src/ATrade/Driver/Real/QuoteSourceThread.hs +++ b/src/ATrade/Driver/Real/QuoteSourceThread.hs @@ -46,7 +46,7 @@ startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter maybeSourceTim Just _ -> return () QDBar (incomingTf, bar) -> do aggValue <- readIORef agg - debugM "QSThread" $ "Incoming bar: " ++ show incomingTf ++ ": " ++ show bar + -- debugM "QSThread" $ "Incoming bar: " ++ show incomingTf ++ ": " ++ show bar case maybeSourceTimeframe of Just tf -> when (tf == unBarTimeframe incomingTf) $ case handleBar bar aggValue of From 07a16fec1e7b7798bca289acab2c0451b06c2449 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Wed, 11 Sep 2019 20:03:39 +0700 Subject: [PATCH 3/5] Baraggregator bugfix --- src/ATrade/BarAggregator.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/ATrade/BarAggregator.hs b/src/ATrade/BarAggregator.hs index 55c54c0..0829274 100644 --- a/src/ATrade/BarAggregator.hs +++ b/src/ATrade/BarAggregator.hs @@ -204,8 +204,13 @@ handleBar bar = runState $ do lBars %= M.insert (barSecurity bar) series { bsBars = emptyBarFrom bar : (updateBar b bar : bs) } return . Just $ updateBar b bar else do - lBars %= M.insert (barSecurity bar) series { bsBars = bar : b : bs } - return . Just $ b + if barVolume b > 0 + then do + lBars %= M.insert (barSecurity bar) series { bsBars = emptyBarFrom bar : bar : b : bs } + return . Just $ bar + else do + lBars %= M.insert (barSecurity bar) series { bsBars = emptyBarFrom bar : bar : bs } + return . Just $ bar | otherwise -> return Nothing _ -> do lBars %= M.insert (barSecurity bar) series { bsBars = [bar] } From 7f12ce1e644a9f6c22cf9a55206430c7a8f36176 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sun, 29 Sep 2019 17:19:53 +0700 Subject: [PATCH 4/5] Bar aggregator: use incoming bars as is --- src/ATrade/BarAggregator.hs | 60 ++++++------------------------------- 1 file changed, 9 insertions(+), 51 deletions(-) diff --git a/src/ATrade/BarAggregator.hs b/src/ATrade/BarAggregator.hs index 0829274..7389745 100644 --- a/src/ATrade/BarAggregator.hs +++ b/src/ATrade/BarAggregator.hs @@ -186,56 +186,14 @@ updateTime tick = runState $ do handleBar :: Bar -> BarAggregator -> (Maybe Bar, BarAggregator) handleBar bar = runState $ do - tws <- gets tickTimeWindows mybars <- gets bars - if (any (isInTimeInterval bar) tws) - then - case M.lookup (barSecurity bar) mybars of - Just series -> case bsBars series of - (b:bs) -> do - let currentBn = barNumber (barTimestamp b) (tfSeconds $ bsTimeframe series) - if - | currentBn == barNumber (barTimestamp bar) (tfSeconds $ bsTimeframe series) -> do - lBars %= M.insert (barSecurity bar) series { bsBars = updateBar b bar : bs } - return Nothing - | currentBn < barNumber (barTimestamp bar) (tfSeconds $ bsTimeframe series) -> do - if barEndTime b (tfSeconds $ bsTimeframe series) == barTimestamp bar - then do - lBars %= M.insert (barSecurity bar) series { bsBars = emptyBarFrom bar : (updateBar b bar : bs) } - return . Just $ updateBar b bar - else do - if barVolume b > 0 - then do - lBars %= M.insert (barSecurity bar) series { bsBars = emptyBarFrom bar : bar : b : bs } - return . Just $ bar - else do - lBars %= M.insert (barSecurity bar) series { bsBars = emptyBarFrom bar : bar : bs } - return . Just $ bar - | otherwise -> return Nothing - _ -> do - lBars %= M.insert (barSecurity bar) series { bsBars = [bar] } - return Nothing - _ -> return Nothing - else - return Nothing - where - isInTimeInterval bar' (a, b) = (utctDayTime . barTimestamp) bar' >= a && (utctDayTime . barTimestamp) bar' <= b - updateBar !bar' newbar = - let newHigh = max (barHigh bar') (barHigh newbar) - newLow = min (barLow bar') (barLow newbar) in - bar' { - barTimestamp = barTimestamp newbar, - barHigh = newHigh, - barLow = newLow, - barClose = barClose newbar, - barVolume = barVolume bar' + (abs . barVolume $ newbar) } - - emptyBarFrom bar' = Bar { - barSecurity = barSecurity bar', - barTimestamp = 0.000001 `addUTCTime` barTimestamp bar', - barOpen = barClose bar', - barHigh = barClose bar', - barLow = barClose bar', - barClose = barClose bar', - barVolume = 0 } + case M.lookup (barSecurity bar) mybars of + Just series -> case bsBars series of + (b:bs) -> do + lBars %= M.insert (barSecurity bar) series { bsBars = bar : b : bs } + return . Just $ b + _ -> do + lBars %= M.insert (barSecurity bar) series { bsBars = [bar] } + return Nothing + _ -> return Nothing From daeb7b0cb2f9d7f1cde462083f265e749d4f33de Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sat, 5 Oct 2019 14:45:00 +0700 Subject: [PATCH 5/5] BarAggregator: return correct bar --- src/ATrade/BarAggregator.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ATrade/BarAggregator.hs b/src/ATrade/BarAggregator.hs index 7389745..12a1329 100644 --- a/src/ATrade/BarAggregator.hs +++ b/src/ATrade/BarAggregator.hs @@ -191,7 +191,7 @@ handleBar bar = runState $ do Just series -> case bsBars series of (b:bs) -> do lBars %= M.insert (barSecurity bar) series { bsBars = bar : b : bs } - return . Just $ b + return . Just $ bar _ -> do lBars %= M.insert (barSecurity bar) series { bsBars = [bar] } return Nothing