Bar aggregator tests

robocom-zero.cabal

@@ -27,6 +27,7 @@ library
                      , ATrade.Quotes.QTIS
                      , ATrade.Driver.Real
                      , ATrade.Driver.Backtest
+                     , ATrade.BarAggregator
   build-depends:       base >= 4.7 && < 5
                      , libatrade == 0.8.0.0
                      , text
@@ -64,8 +65,7 @@ library
                      , hedis
 
   default-language:    Haskell2010
-  other-modules:       ATrade.BarAggregator
-                     , ATrade.Exceptions
+  other-modules:       ATrade.Exceptions
                      , ATrade.Driver.Real.BrokerClientThread
                      , ATrade.Driver.Real.QuoteSourceThread
                      , ATrade.Driver.Real.Types
@@ -93,6 +93,7 @@ test-suite robots-test
   other-modules:     Test.RoboCom.Indicators
                    , Test.RoboCom.Positions
                    , Test.RoboCom.Utils
+                   , Test.BarAggregator
 
 source-repository head
   type:     git

src/ATrade/BarAggregator.hs

@@ -28,6 +28,7 @@ import           Control.Lens
 import           Control.Monad.State
 import qualified Data.Map.Strict      as M
 import           Data.Time.Clock
+import           Debug.Trace
 
 -- | Bar aggregator state
 data BarAggregator = BarAggregator {
@@ -84,6 +85,14 @@ handleTick tick = runState $ do
                     return Nothing
                   else
                     return Nothing
+          _ -> case datatype tick of
+            LastTradePrice -> do
+              if volume tick > 0
+                then do
+                  lBars %= M.insert (security tick) series { bsBars = barFromTick tick : [] }
+                  return Nothing
+                else
+                  return Nothing
             _ -> return Nothing
         _ -> return Nothing
     else

src/ATrade/Driver/Backtest.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE QuasiQuotes        #-}
 
 module ATrade.Driver.Backtest (
   backtestMain
@@ -17,7 +18,8 @@ import           ATrade.Quotes.Finam      as QF
 import           ATrade.RoboCom.Monad     (Event (..), EventCallback,
                                            StrategyAction (..),
                                            StrategyEnvironment (..),
-                                           runStrategyElement)
+                                           runStrategyElement, st,
+                                           appendToLog)
 import           ATrade.RoboCom.Positions
 import           ATrade.RoboCom.Types     (BarSeries (..), Ticker (..),
                                            Timeframe (..))
@@ -208,8 +210,8 @@ backtestMain dataDownloadDelta defaultState initCallback callback = do
 
     isExecutable bar order = case orderPrice order of
       Limit price -> if orderOperation order == Buy
-                        then price <= barLow bar
-                        else price >= barHigh bar
+                        then price >= barLow bar
+                        else price <= barHigh bar
       _ -> True
 
     priceForLimitOrder order bar = case orderPrice order of
@@ -267,8 +269,11 @@ backtestMain dataDownloadDelta defaultState initCallback callback = do
     updateBars barMap newbar = M.alter (\case
       Nothing -> Just BarSeries { bsTickerId = barSecurity newbar,
         bsTimeframe = Timeframe 60,
-        bsBars = [newbar] }
-      Just bs -> Just bs { bsBars = newbar : bsBars bs }) (barSecurity newbar) barMap
+        bsBars = [newbar, newbar] }
+      Just bs -> Just bs { bsBars = updateBarList newbar (bsBars bs) }) (barSecurity newbar) barMap
+
+    updateBarList newbar (_:bs) = newbar:newbar:bs
+    updateBarList newbar _ = newbar:[newbar]
 
     fireTimers ts = do
       (firedTimers, otherTimers) <- partition (< ts) <$> gets pendingTimers

src/ATrade/Driver/Real.hs

@@ -131,7 +131,7 @@ storeState params stateRef timersRef = do
       now <- getPOSIXTime
       res <- runRedis conn $ mset [(encodeUtf8 $ T.pack $ instanceId params, BL.toStrict $ encode currentStrategyState),
           (encodeUtf8 $ T.pack $ instanceId params ++ ":last_store", encodeUtf8 $ T.pack $ show now),
-          (encodeUtf8 $ T.pack $ instanceId params ++ ":timers", encodeUtf8 $ T.pack $ show now) ]
+          (encodeUtf8 $ T.pack $ instanceId params ++ ":timers", BL.toStrict $ encode currentTimersState) ]
 
       case res of
         Left _ -> warningM "main" "Unable to save state"
@@ -156,6 +156,7 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
 
   (tickerList, config) <- loadStrategyConfig params
   stratState <- loadStrategyState params
+  timersState <- loadStrategyTimers params
 
   let instanceParams = StrategyInstanceParams {
     strategyInstanceId = T.pack . instanceId $ params,
@@ -174,7 +175,7 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
 
   let strategy = mkBarStrategy instanceParams dataDownloadDelta updatedConfig stratState callback
   stateRef <- newIORef stratState
-  timersRef <- newIORef []
+  timersRef <- newIORef timersState
   shutdownMv <- newEmptyMVar
   installHandler sigINT (gracefulShutdown params stateRef timersRef shutdownMv)
   installHandler sigTERM (gracefulShutdown params stateRef timersRef shutdownMv)
@@ -220,6 +221,27 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
         Right conf -> return (confTickers conf, strategyConfig conf)
         Left errmsg -> throw $ UnableToLoadConfig $ (T.pack . show) errmsg)
 
+    loadStrategyTimers :: Params -> IO [UTCTime]
+    loadStrategyTimers params = case redisSocket params of
+      Nothing -> return []
+      Just sock -> do
+        conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock }
+        res <- runRedis conn $ get (encodeUtf8 $ T.pack $ instanceId params ++ "timers")
+        case res of
+          Left _ -> do
+            warningM "main" "Unable to load state"
+            return []
+          Right mv -> case mv of
+            Just v -> case eitherDecode $ BL.fromStrict v of
+              Left _ -> do
+                warningM "main" "Unable to load state"
+                return []
+              Right s -> return s
+            Nothing -> do
+              warningM "main" "Unable to load state"
+              return []
+        
+
     loadStrategyState params = case redisSocket params of
       Nothing -> loadStateFromFile (strategyStateFile params)
       Just sock -> do

src/ATrade/RoboCom/Positions.hs

@@ -170,7 +170,7 @@ orderCorrespondsTo o1 o2 =
 orderDeadline :: Maybe UTCTime -> UTCTime -> Bool
 orderDeadline maybeDeadline lastTs =
   case maybeDeadline of
-    Just deadline -> lastTs >= deadline
+    Just deadline -> lastTs > deadline
     Nothing       -> False
 
 
@@ -203,7 +203,7 @@ dispatchPosition event pos = case posState pos of
       case posCurrentOrder pos of
         Just order -> if orderDeadline (posExecutionDeadline pos) lastTs
           then do -- TODO call TimeoutHandler
-            appendToLog "In PositionWaitingOpen: execution timeout"
+            appendToLog $ [st|"In PositionWaitingOpen: execution timeout: %?/%?"|] (posExecutionDeadline pos) lastTs
             cancelOrder $ orderId order
             return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled }
           else case event of

test/Spec.hs

@@ -1,3 +1,4 @@
+import qualified Test.BarAggregator
 import qualified Test.RoboCom.Indicators
 import qualified Test.RoboCom.Positions
 import qualified Test.RoboCom.Utils
@@ -11,4 +12,5 @@ unitTests :: TestTree
 unitTests = testGroup "Unit Tests"
   [Test.RoboCom.Indicators.unitTests,
    Test.RoboCom.Positions.unitTests,
-   Test.RoboCom.Utils.unitTests]
+   Test.RoboCom.Utils.unitTests,
+   Test.BarAggregator.unitTests ]

test/Test/BarAggregator.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.BarAggregator
+(
+  unitTests
+) where
+
+import           ATrade.BarAggregator
+import           ATrade.RoboCom.Types
+import           ATrade.Types
+import qualified Data.Map.Strict       as M
+import qualified Data.Text             as T
+import           Data.Time.Calendar
+import           Data.Time.Clock
+
+import           Test.Tasty
+import           Test.Tasty.HUnit
+import           Test.Tasty.QuickCheck as QC
+import           Test.Tasty.SmallCheck as SC
+
+unitTests = testGroup "BarAggregator" [
+    testUnknownBarSeries
+  , testOneTick
+  , testTwoTicksInSameBar
+  , testTwoTicksInDifferentBars
+  ]
+
+testUnknownBarSeries :: TestTree
+testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do
+  let agg = BarAggregator M.empty M.empty [(0, 86400)]
+  let (mbar, newagg) = handleTick tick agg
+  mbar @?= Nothing
+  (bars newagg) @?= M.empty
+  where
+    testTimestamp = (UTCTime (fromGregorian 1970 1 1) 100)
+    tick = Tick {
+            security = "TEST_TICKER",
+            datatype = LastTradePrice,
+            timestamp = testTimestamp,
+            value = fromDouble 12.00,
+            volume = 1 }
+
+testOneTick :: TestTree
+testOneTick = testCase "One tick" $ do
+  let series = BarSeries "TEST_TICKER" (Timeframe 60) []
+  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
+  let (mbar, newagg) = handleTick tick agg
+  mbar @?= Nothing
+  (bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg)) @?= Just [Bar "TEST_TICKER" testTimestamp 12.00 12.00 12.00 12.00 1]
+  where
+    testTimestamp = (UTCTime (fromGregorian 1970 1 1) 60)
+    tick = Tick {
+            security = "TEST_TICKER",
+            datatype = LastTradePrice,
+            timestamp = testTimestamp,
+            value = fromDouble 12.00,
+            volume = 1 }
+
+testTwoTicksInSameBar :: TestTree
+testTwoTicksInSameBar = testCase "Two ticks - same bar" $ do
+  let series = BarSeries "TEST_TICKER" (Timeframe 60) []
+  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
+  let (mbar, newagg) = handleTick (tick testTimestamp1 12.00) agg
+  mbar @?= Nothing
+  let (mbar', newagg') = handleTick (tick testTimestamp2 14.00) newagg
+  mbar' @?= Nothing
+  (bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just [Bar "TEST_TICKER" testTimestamp2 12.00 14.00 12.00 14.00 2]
+  where
+    testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 58)
+    testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 59)
+    tick ts val = Tick {
+            security = "TEST_TICKER",
+            datatype = LastTradePrice,
+            timestamp = ts,
+            value = fromDouble val,
+            volume = 1 }
+
+testTwoTicksInDifferentBars :: TestTree
+testTwoTicksInDifferentBars = testCase "Two ticks - different bar" $ do
+  let series = BarSeries "TEST_TICKER" (Timeframe 60) []
+  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
+  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]
+  where
+    testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 58)
+    testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 61)
+    tick ts val = Tick {
+            security = "TEST_TICKER",
+            datatype = LastTradePrice,
+            timestamp = ts,
+            value = fromDouble val,
+            volume = 1 }

test/Test/RoboCom/Indicators.hs

@@ -22,6 +22,7 @@ unitTests = testGroup "RoboCom.Indicators" [
   testRsi,
   testRsi2,
   testAtr,
+  testAtr2,
   testCci,
   testBbandUpper,
   testPercentRank
@@ -77,6 +78,114 @@ testAtr = testCase "ATR calculation" $ assertEqualWithEpsilon 0.01 (atr 14 bars)
       bar 48.79 47.73 47.85 ]
     bar h l c = Bar { barSecurity = "", barTimestamp = UTCTime (fromGregorian 1970 1 1) 0, barOpen = 0, barHigh = h, barLow = l, barClose = c, barVolume = 0}
 
+testAtr2 = testCase "ATR calculation - case 2" $ assertEqualWithEpsilon 1 (atr 18 bars) 230.8
+  where
+    bars = reverse [
+        bar 122870.0000000 122900.0000000 122350.0000000 122480.0000000,
+        bar 122470.0000000 122590.0000000 122420.0000000 122540.0000000,
+        bar 122540.0000000 122680.0000000 122490.0000000 122680.0000000,
+        bar 122680.0000000 122760.0000000 122630.0000000 122650.0000000,
+        bar 122640.0000000 122720.0000000 122570.0000000 122610.0000000,
+        bar 122610.0000000 122660.0000000 122450.0000000 122500.0000000,
+        bar 122510.0000000 122640.0000000 122490.0000000 122580.0000000,
+        bar 122580.0000000 122730.0000000 122490.0000000 122700.0000000,
+        bar 122690.0000000 122840.0000000 122690.0000000 122780.0000000,
+        bar 122780.0000000 122800.0000000 122620.0000000 122670.0000000,
+        bar 122670.0000000 122800.0000000 122640.0000000 122700.0000000,
+        bar 122700.0000000 122810.0000000 122700.0000000 122710.0000000,
+        bar 122720.0000000 122800.0000000 122650.0000000 122730.0000000,
+        bar 122710.0000000 122990.0000000 122680.0000000 122920.0000000,
+        bar 122940.0000000 123190.0000000 122940.0000000 122960.0000000,
+        bar 122960.0000000 123100.0000000 122930.0000000 123090.0000000,
+        bar 123090.0000000 123130.0000000 122940.0000000 122950.0000000,
+        bar 122950.0000000 123010.0000000 122870.0000000 122970.0000000,
+        bar 122960.0000000 122970.0000000 122700.0000000 122730.0000000,
+        bar 122720.0000000 122790.0000000 122550.0000000 122560.0000000,
+        bar 122570.0000000 122680.0000000 122460.0000000 122540.0000000,
+        bar 122540.0000000 122700.0000000 122510.0000000 122620.0000000,
+        bar 122620.0000000 122870.0000000 122600.0000000 122860.0000000,
+        bar 122860.0000000 123170.0000000 122830.0000000 123050.0000000,
+        bar 123050.0000000 123080.0000000 122910.0000000 122920.0000000,
+        bar 122920.0000000 123100.0000000 122850.0000000 123020.0000000,
+        bar 123010.0000000 123280.0000000 122960.0000000 123230.0000000,
+        bar 123240.0000000 123240.0000000 123090.0000000 123220.0000000,
+        bar 123220.0000000 123230.0000000 123140.0000000 123200.0000000,
+        bar 123200.0000000 123290.0000000 123180.0000000 123190.0000000,
+        bar 123200.0000000 123530.0000000 123200.0000000 123470.0000000,
+        bar 123470.0000000 123510.0000000 123340.0000000 123390.0000000,
+        bar 123390.0000000 123430.0000000 123330.0000000 123430.0000000,
+        bar 123430.0000000 123450.0000000 123320.0000000 123340.0000000,
+        bar 123340.0000000 123360.0000000 123280.0000000 123350.0000000,
+        bar 123340.0000000 123370.0000000 123220.0000000 123260.0000000,
+        bar 123250.0000000 123350.0000000 123230.0000000 123250.0000000,
+        bar 123240.0000000 123280.0000000 123160.0000000 123170.0000000,
+        bar 123170.0000000 123260.0000000 123150.0000000 123210.0000000,
+        bar 123210.0000000 123330.0000000 123200.0000000 123300.0000000,
+        bar 123300.0000000 123310.0000000 123220.0000000 123250.0000000,
+        bar 123240.0000000 123280.0000000 123220.0000000 123270.0000000,
+        bar 123270.0000000 123350.0000000 123230.0000000 123260.0000000,
+        bar 123260.0000000 123260.0000000 123180.0000000 123190.0000000,
+        bar 123190.0000000 123190.0000000 123160.0000000 123180.0000000,
+        bar 123170.0000000 123180.0000000 123040.0000000 123060.0000000,
+        bar 123070.0000000 123210.0000000 123020.0000000 123200.0000000,
+        bar 123090.0000000 123300.0000000 122310.0000000 122440.0000000,
+        bar 122440.0000000 122620.0000000 122400.0000000 122550.0000000,
+        bar 122540.0000000 122720.0000000 122460.0000000 122710.0000000,
+        bar 122720.0000000 122730.0000000 122530.0000000 122570.0000000,
+        bar 122570.0000000 122680.0000000 122490.0000000 122590.0000000,
+        bar 122580.0000000 122750.0000000 122550.0000000 122640.0000000,
+        bar 122650.0000000 122660.0000000 122510.0000000 122620.0000000,
+        bar 122620.0000000 122680.0000000 122500.0000000 122560.0000000,
+        bar 122570.0000000 122670.0000000 122520.0000000 122610.0000000,
+        bar 122610.0000000 122790.0000000 122590.0000000 122690.0000000,
+        bar 122690.0000000 122830.0000000 122680.0000000 122800.0000000,
+        bar 122810.0000000 122810.0000000 122560.0000000 122620.0000000,
+        bar 122620.0000000 122700.0000000 122570.0000000 122640.0000000,
+        bar 122640.0000000 122730.0000000 122620.0000000 122670.0000000,
+        bar 122680.0000000 122830.0000000 122630.0000000 122780.0000000,
+        bar 122770.0000000 123090.0000000 122740.0000000 122980.0000000,
+        bar 123000.0000000 123090.0000000 122940.0000000 122960.0000000,
+        bar 122960.0000000 122980.0000000 122850.0000000 122920.0000000,
+        bar 122930.0000000 123030.0000000 122920.0000000 122950.0000000,
+        bar 122940.0000000 122990.0000000 122880.0000000 122970.0000000,
+        bar 122980.0000000 123080.0000000 122860.0000000 122880.0000000,
+        bar 122880.0000000 122980.0000000 122870.0000000 122980.0000000,
+        bar 122980.0000000 123130.0000000 122780.0000000 122950.0000000,
+        bar 122960.0000000 123020.0000000 122860.0000000 122870.0000000,
+        bar 122870.0000000 122890.0000000 122570.0000000 122650.0000000,
+        bar 122640.0000000 122710.0000000 122500.0000000 122580.0000000,
+        bar 122580.0000000 122690.0000000 122400.0000000 122430.0000000,
+        bar 122430.0000000 122700.0000000 122410.0000000 122690.0000000,
+        bar 122690.0000000 122720.0000000 122320.0000000 122480.0000000,
+        bar 122480.0000000 122560.0000000 122380.0000000 122540.0000000,
+        bar 122540.0000000 122650.0000000 122450.0000000 122480.0000000,
+        bar 122480.0000000 122540.0000000 122400.0000000 122430.0000000,
+        bar 122440.0000000 122450.0000000 122110.0000000 122200.0000000,
+        bar 122190.0000000 122350.0000000 122110.0000000 122320.0000000,
+        bar 122330.0000000 122480.0000000 122200.0000000 122430.0000000,
+        bar 122380.0000000 122570.0000000 121870.0000000 122210.0000000,
+        bar 122210.0000000 122300.0000000 122170.0000000 122230.0000000,
+        bar 122220.0000000 122340.0000000 122210.0000000 122320.0000000,
+        bar 122310.0000000 122320.0000000 122190.0000000 122290.0000000,
+        bar 122300.0000000 122440.0000000 122300.0000000 122410.0000000,
+        bar 122400.0000000 122490.0000000 122370.0000000 122450.0000000,
+        bar 122460.0000000 122770.0000000 122450.0000000 122760.0000000,
+        bar 122760.0000000 122850.0000000 122720.0000000 122810.0000000,
+        bar 122820.0000000 122890.0000000 122760.0000000 122830.0000000,
+        bar 122830.0000000 122950.0000000 122780.0000000 122780.0000000,
+        bar 122790.0000000 122790.0000000 122670.0000000 122740.0000000,
+        bar 122750.0000000 122770.0000000 122670.0000000 122720.0000000,
+        bar 122720.0000000 122880.0000000 122700.0000000 122750.0000000,
+        bar 122750.0000000 122760.0000000 122650.0000000 122680.0000000,
+        bar 122670.0000000 122770.0000000 122670.0000000 122740.0000000,
+        bar 122740.0000000 122820.0000000 122690.0000000 122750.0000000,
+        bar 122750.0000000 122790.0000000 122690.0000000 122740.0000000,
+        bar 122740.0000000 122770.0000000 122610.0000000 122680.0000000,
+        bar 122670.0000000 122800.0000000 122670.0000000 122770.0000000,
+        bar 122770.0000000 122910.0000000 122710.0000000 122790.0000000,
+        bar 122700.0000000 122730.0000000 121680.0000000 121780.0000000 ]
+    bar o h l c = Bar { barSecurity = "", barTimestamp = UTCTime (fromGregorian 1970 1 1) 0, barOpen = o, barHigh = h, barLow = l, barClose = c, barVolume = 0}
+
 testCci = testCase "CCI calculation" $ do
   assertEqualWithEpsilon 0.1 (cci 12 bars) 212.39
   where