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

Switched from quickcheck to hedgehog

master
Denis Tereshkin 7 years ago
parent
a1322161a5
commit
32a75e8c47
5 changed files with 71 additions and 41 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. 5
      robocom-zero.cabal
  2. 79
      test/Test/BarAggregator.hs
  3. 2
      test/Test/RoboCom/Indicators.hs
  4. 22
      test/Test/RoboCom/Positions.hs
  5. 4
      test/Test/RoboCom/Utils.hs

5
robocom-zero.cabal
Unescape View File

@ -79,11 +79,11 @@ test-suite robots-test
, libatrade , libatrade
, time , time
, text , text
, hedgehog
, tasty , tasty
, tasty-hunit , tasty-hunit
, tasty-golden , tasty-golden
, tasty-smallcheck , tasty-hedgehog
, tasty-quickcheck
, tasty-hspec , tasty-hspec
, quickcheck-text , quickcheck-text
, quickcheck-instances , quickcheck-instances
@ -95,7 +95,6 @@ test-suite robots-test
, Test.RoboCom.Positions , Test.RoboCom.Positions
, Test.RoboCom.Utils , Test.RoboCom.Utils
, Test.BarAggregator , Test.BarAggregator
, ArbitraryInstances
source-repository head source-repository head
type: git type: git

79
test/Test/BarAggregator.hs
Unescape View File

@ -10,18 +10,19 @@ import ATrade.BarAggregator
import ATrade.RoboCom.Types import ATrade.RoboCom.Types
import ATrade.Types import ATrade.Types
import Data.List import Data.List
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
import Data.Time.Clock import Data.Time.Clock
import Safe import Safe
import Hedgehog as HH
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty import Test.Tasty
import Test.Tasty.Hedgehog
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import ArbitraryInstances
unitTests = testGroup "BarAggregator" [ unitTests = testGroup "BarAggregator" [
@ -36,7 +37,8 @@ unitTests = testGroup "BarAggregator" [
] ]
properties = testGroup "BarAggregator" [ properties = testGroup "BarAggregator" [
prop_allTicksInOneBar prop_allTicksInOneBar,
prop_ticksInTwoBars
] ]
testUnknownBarSeries :: TestTree testUnknownBarSeries :: TestTree
@ -193,26 +195,61 @@ testNextBarAfterBarClose = testCase "Three bars (smaller timeframe) - next bar a
barVolume = v } barVolume = v }
prop_allTicksInOneBar :: TestTree prop_allTicksInOneBar :: TestTree
prop_allTicksInOneBar = QC.testProperty "All ticks in one bar" $ QC.forAll (QC.choose (1, 86400)) $ \timeframe -> prop_allTicksInOneBar = testProperty "All ticks in one bar" $ property $ do
QC.forAll (QC.listOf1 (genTick "TEST_TICKER" baseTime timeframe)) $ \ticks -> tf <- forAll $ Gen.integral (Range.constant 1 86400)
let ticks' = sortOn timestamp ticks in ticks <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" baseTime tf)
let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" timeframe) in let ticks' = sortOn timestamp ticks
null newbars && let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" tf)
((barHigh <$> currentBar "TEST_TICKER" agg) == Just (maximum $ value <$> ticks)) && (barHigh <$> currentBar "TEST_TICKER" agg) === Just (maximum $ value <$> ticks)
((barLow <$> currentBar "TEST_TICKER" agg) == Just (minimum $ value <$> ticks)) && (barLow <$> currentBar "TEST_TICKER" agg) === Just (minimum $ value <$> ticks)
((barOpen <$> currentBar "TEST_TICKER" agg) == (value <$> headMay ticks')) && (barOpen <$> currentBar "TEST_TICKER" agg) === (value <$> headMay ticks')
((barClose <$> currentBar "TEST_TICKER" agg) == (value <$> lastMay ticks')) && (barClose <$> currentBar "TEST_TICKER" agg) === (value <$> lastMay ticks')
((barVolume <$> currentBar "TEST_TICKER" agg) == Just (sum $ volume <$> ticks)) (barVolume <$> currentBar "TEST_TICKER" agg) === Just (sum $ volume <$> ticks)
HH.assert $ null newbars
where where
genTick :: T.Text -> UTCTime -> Integer -> Gen Tick genTick :: T.Text -> UTCTime -> Integer -> Gen Tick
genTick tickerId base tf = do genTick tickerId base tf = do
difftime <- fromRational . toRational . picosecondsToDiffTime <$> choose (0, truncate 1e12 * tf) difftime <- fromRational . toRational . picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * tf))
val <- arbitrary val <- fromDouble <$> Gen.double (Range.exponentialFloat 0.00001 100)
vol <- arbitrary `suchThat` (> 0) vol <- Gen.integral (Range.exponential 1 100)
return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) val vol return $ Tick tickerId LastTradePrice (difftime `addUTCTime` base) val vol
mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (Timeframe tf) [])) [(0, 86400)] mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (Timeframe tf) [])) [(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_ticksInTwoBars :: TestTree
prop_ticksInTwoBars = testProperty "Ticks in one bar, then in next bar" $ property $ do
tf <- forAll $ Gen.integral (Range.constant 1 86400)
ticks1 <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" (baseTime 0) tf)
ticks2 <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" (baseTime $ secondsToDiffTime tf) tf)
let ticks1' = sortOn timestamp ticks1
let ticks2' = sortOn timestamp ticks2
let (_, agg) = handleTicks ticks1' (mkAggregator "TEST_TICKER" tf)
let ([newbar], agg') = handleTicks ticks2' agg
barSecurity newbar === "TEST_TICKER"
(barHigh newbar) === (maximum $ value <$> ticks1)
(barLow newbar) === (minimum $ value <$> ticks1)
(barOpen newbar) === (value . head $ ticks1')
(barClose newbar) === (value . last $ ticks1')
(barVolume newbar) === (sum $ volume <$> ticks1)
(barHigh <$> currentBar "TEST_TICKER" agg') === Just (maximum $ value <$> ticks2)
(barLow <$> currentBar "TEST_TICKER" agg') === Just (minimum $ value <$> ticks2)
(barOpen <$> currentBar "TEST_TICKER" agg') === (value <$> headMay ticks2')
(barClose <$> currentBar "TEST_TICKER" agg') === (value <$> lastMay ticks2')
(barVolume <$> currentBar "TEST_TICKER" agg') === Just (sum $ volume <$> ticks2)
where
genTick :: T.Text -> UTCTime -> Integer -> Gen Tick
genTick tickerId base tf = do
difftime <- fromRational . toRational . picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * tf))
val <- fromDouble <$> Gen.double (Range.exponentialFloat 0.00001 100)
vol <- Gen.integral (Range.exponential 1 100)
return $ Tick tickerId LastTradePrice (difftime `addUTCTime` base) val vol
mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (Timeframe tf) [])) [(0, 86400)]
currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg))
baseTime offset = UTCTime (fromGregorian 1970 1 1) offset

2
test/Test/RoboCom/Indicators.hs
Unescape View File

@ -7,8 +7,6 @@ module Test.RoboCom.Indicators
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import ATrade.Types import ATrade.Types
import qualified Data.Text as T import qualified Data.Text as T

22
test/Test/RoboCom/Positions.hs
Unescape View File

@ -8,24 +8,22 @@ module Test.RoboCom.Positions
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import ATrade.Types import ATrade.Types
import qualified Data.Text as T import qualified Data.List as L
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Clock import Data.Time.Clock
import qualified Data.List as L
import ATrade.RoboCom.Monad import ATrade.RoboCom.Monad
import ATrade.RoboCom.Positions import ATrade.RoboCom.Positions
import ATrade.RoboCom.Types import ATrade.RoboCom.Types
data TestState = TestState data TestState = TestState
{ {
positions :: [Position], positions :: [Position],
testInt :: Int testInt :: Int
} }
defaultState = TestState { defaultState = TestState {
@ -56,7 +54,7 @@ unitTests = testGroup "RoboCom.Positions" [
testEnterAtMarketSendsAction, testEnterAtMarketSendsAction,
testDefaultHandlerSubmissionDeadline, testDefaultHandlerSubmissionDeadline,
testDefaultHandlerAfterSubmissionPositionIsWaitingOpen, testDefaultHandlerAfterSubmissionPositionIsWaitingOpen,
testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1
] ]
testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingOpenSubmission state" $ do testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingOpenSubmission state" $ do
@ -76,7 +74,7 @@ testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingO
element = enterAtMarket "long" Buy element = enterAtMarket "long" Buy
isPositionWaitingOpenSubmission (PositionWaitingOpenSubmission _) = True isPositionWaitingOpenSubmission (PositionWaitingOpenSubmission _) = True
isPositionWaitingOpenSubmission _ = False isPositionWaitingOpenSubmission _ = False
testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder" $ do testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder" $ do
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
@ -94,8 +92,8 @@ testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder"
element = enterAtMarket "long" Buy element = enterAtMarket "long" Buy
isActionOrder (ActionOrder _) = True isActionOrder (ActionOrder _) = True
isActionOrder _ = False isActionOrder _ = False
testDefaultHandlerSubmissionDeadline = testCase "defaultHandler after submission deadline marks position as cancelled" $ do testDefaultHandlerSubmissionDeadline = testCase "defaultHandler after submission deadline marks position as cancelled" $ do
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = afterDeadline } $ defaultHandler (NewTick tick) let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = afterDeadline } $ defaultHandler (NewTick tick)
@ -164,4 +162,4 @@ testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 = testCase "defaultHandl
tradeSignalId = SignalId "test_instance" "long" "" tradeSignalId = SignalId "test_instance" "long" ""
} }

4
test/Test/RoboCom/Utils.hs
Unescape View File

@ -7,11 +7,9 @@ module Test.RoboCom.Utils
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import ATrade.Types import ATrade.Types
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Clock import Data.Time.Clock

Write Preview
Loading…
Cancel
Save