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

79
test/Test/BarAggregator.hs
Unescape View File

@ -10,18 +10,19 @@ import ATrade.BarAggregator @@ -10,18 +10,19 @@ import ATrade.BarAggregator
import ATrade.RoboCom.Types
import ATrade.Types
import Data.List
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
import Safe
import Hedgehog as HH
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty
import Test.Tasty.Hedgehog
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import ArbitraryInstances
unitTests = testGroup "BarAggregator" [
@ -36,7 +37,8 @@ unitTests = testGroup "BarAggregator" [ @@ -36,7 +37,8 @@ unitTests = testGroup "BarAggregator" [
]
properties = testGroup "BarAggregator" [
prop_allTicksInOneBar
prop_allTicksInOneBar,
prop_ticksInTwoBars
]
testUnknownBarSeries :: TestTree
@ -193,26 +195,61 @@ testNextBarAfterBarClose = testCase "Three bars (smaller timeframe) - next bar a @@ -193,26 +195,61 @@ testNextBarAfterBarClose = testCase "Three bars (smaller timeframe) - next bar a
barVolume = v }
prop_allTicksInOneBar :: TestTree
prop_allTicksInOneBar = QC.testProperty "All ticks in one bar" $ QC.forAll (QC.choose (1, 86400)) $ \timeframe ->
QC.forAll (QC.listOf1 (genTick "TEST_TICKER" baseTime timeframe)) $ \ticks ->
let ticks' = sortOn timestamp ticks in
let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" timeframe) in
null newbars &&
((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))
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)
HH.assert $ null newbars
where
genTick :: T.Text -> UTCTime -> Integer -> Gen Tick
genTick tickerId base tf = do
difftime <- fromRational . toRational . picosecondsToDiffTime <$> choose (0, truncate 1e12 * tf)
val <- arbitrary
vol <- arbitrary `suchThat` (> 0)
return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) val vol
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 = 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 @@ -7,8 +7,6 @@ module Test.RoboCom.Indicators
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import ATrade.Types
import qualified Data.Text as T

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

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

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

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

Write Preview
Loading…
Cancel
Save