analysis: the prefix
:r
:set -Wno-type-defaults
:set -Wno-name-shadowing
:set -XOverloadedLabels
:set -XOverloadedStrings
:set -XRebindableSyntax
:set -XTupleSections
import Anal
import Anal.Returns
import Control.Monad
import qualified FlatParse.Basic as FP
import Data.Time
import Data.Time.Calendar
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Data.Mealy
import Data.Profunctor
import Data.Maybe
import Data.Bifunctor
import NumHask.Prelude hiding (fold)
import qualified Data.Map as Map
import qualified Data.Text as Text
import Prettychart
import Chart
import qualified Prelude as P
import GHC.OverloadedLabels
import Optics.Core
import Control.Category ((>>>))
import Control.Applicative
import Chart.Compound
import Faker.Lorem
print "imports loaded"
r <- getReturns
length r
(display, quit) <- serve
disp x = display $ x & set (#markupOptions % #markupHeight) (Just 250) & set (#hudOptions % #frames % ix 1 % _2 % #buffer) 0.1
space1 (fst <$> r) :: Maybe (Range Day)
accret = scan (second' (dipure (+))) r
decay = 0.01
rs = snd <$> r
xma = scan (ma decay) rs
xstd = scan (std decay) rs
disp $ dayChart ["accumulated return"] (fmap (second (:[])) (taker 200 accret))mvq = (second' ((\a b -> a:(b!!1-a):b) <$> ma 0.99 <*> Data.Mealy.Quantiles.quantiles 0.99 [0.4,0.5,0.6]))
c = dayChart ["mean", "skew", "40th", "median", "60th"] (drop 1000 $ scan mvq (taker 2000 r))
disp c
writeChartOptions "other/mvq.svg" c
mvm = second' ((\a b -> b - a) <$> ma 0.99 <*> median 0.99)
mvmChart = dayChart ["median - mean"] (drop 1000 $ fmap (second (:[])) $ scan mvm (taker 2000 r))
disp mvmChart
writeChartOptions "other/mvm.svg" mvmChart
qs = [0.2,0.4,0.6,0.8]
mvmd = ((-) <$> median 0.99 <*> ma 0.99) >>> digitize 0.996 qs
d = drop 1000 $ scan (second' mvmd) (taker 2000 r)
mvmdChart = digitChart ((\x -> UTCTime x (P.fromInteger 0)) . fst <$> d) (fromIntegral . snd <$> d) (quantileNames qs)
disp mvmdChart
writeChartOptions "other/mvmd.svg" mvmdChart
(Today’s return, Yesterday’s signal)
n = 2000
pren = 1000
mvmRaw = (\a b -> a-b) <$> median 0.99 <*> ma 0.99
qs = [0.1,0.4,0.5,0.6,0.9]
d = scanRet (sigRet mvmRaw qs 0.996) n pren r
take 10 dData.Mealy.fold countM (snd . snd <$> d)cumulative return for each bucket
n = 1000
ndrop = 0
mvmRaw = (\a b -> a-b) <$> median 0.99 <*> ma 0.99
qs = [0.1,0.4,0.5,0.6,0.9]
c = dayChart (qRangeLabel qs) (scanRet (fmap (ardList 6) (sigRet mvmRaw qs 0.996 >>> accRetDigits)) n ndrop r)
c = c & #markupOptions % renderStyle .~ Indented 4
writeChartOptions "other/arc.svg" c
disp c
It looks like the market goes up when sd is declining.
What is the gradient of a moving statistic?
accret = scan (second' (dipure (+))) r
rebase xs = zip (fst <$> xs) (fmap (/head (snd <$> xs)) (snd <$> xs))
accChart = dayChart ["accumulated return"] (fmap (second (:[])) (rebase $ drop dropN $ taker (n+dropN) accret)) & set (#hudOptions % #legends) []
accChart' = accChart & over (#hudOptions % #axes) (fmap (second (set ( #ticks % #ltick ) Nothing))) & over (#charts % charts') (fmap (colourChart (const (palette1 2)))) & set (#hudOptions % #legends) []
sdChart = dayChart ["std"] $ second (:[]) <$> scanRet (std decay) n dropN r
sdChart' = sdChart & #hudOptions .~ (mempty & #axes .~ (view (#hudOptions % #axes) sdChart & (\x -> (List.!!) x 1) & second (set #place PlaceRight) & (:[]))) & over (#hudOptions % #axes) (fmap (second (set ( #ticks % #ltick ) Nothing)))
compChart = compoundMerge [accChart', sdChart']
compChart' = compChart & set (#hudOptions % #legends) [(Priority 20,defaultLegendOptions & set #legendCharts (zipWith (\t co -> (t, foldOf (#charts % charts') co)) ["return", "sd"] [accChart', sdChart']))]
writeChartOptions "other/sd.svg" compChart'
disp compChart'
stdBeta = dayChart ["std"] $ second (:[]) <$> scanRet (second' (std decayStd) >>> beta1 (ma decayBeta1)) n dropN (zip (fst <$> r) (zip [0..] (snd <$> r)))
stdBeta' = stdBeta & over (#hudOptions % #axes) (fmap (second (set ( #ticks % #ltick ) Nothing))) & over (#charts % charts') (fmap (colourChart (const (palette1 2)))) & set (#hudOptions % #legends) []
betaSdChart = compoundMerge [sdChart', stdBeta']
betaSdChart' = betaSdChart & set (#hudOptions % #legends) [(Priority 20,defaultLegendOptions & set #legendCharts (zipWith (\t co -> (t, foldOf (#charts % charts') co)) ["beta of sd", "sd"] [stdBeta', sdChart']))]
disp betaSdChart'qs = [0.2,0.4,0.6,0.8]
qBeta = (second' (std d) >>> beta1 (ma 0.95)) >>> digitize 0.996 qs
:t qBeta
d = drop dropN $ scan (second' qBeta) (taker (n+dropN) $ (zip (fst <$> r) (zip [0..] (snd <$> r))))
betaSdDigitChart = digitChart ((\x -> UTCTime x (P.fromInteger 0)) . fst <$> d) (fromIntegral . snd <$> d) (quantileNames qs)
disp betaSdDigitChart:t dSkew away from upper quantiles
Data.Mealy.fold countM (snd <$> d)acc = dayChartRhs (fmap (second (:[])) (rebase $ drop dropN $ taker (n+dropN) accret))
acc' = acc & over (#hudOptions % #axes) (fmap (second (set ( #ticks % #ltick ) Nothing))) & over (#charts % charts') (fmap (colourChart (const (palette1 4))))
c = dayChart (qRangeLabel qs) (scanRet (fmap (ardList 6) (sigRet mvmRaw qs 0.996 >>> accRetDigits)) n ndrop r)
disp $ compoundMerge [c, acc']:t dn = 2000
dropN = 100
qs = [0.1, 0.9] :: [Double]
decayStd = 0.95
decayBeta1 = 0.95
decayQ = 0.95
qBeta' = (first snd) <$> ((,) <$> id <*> (second' (std decayStd) >>> beta1 (ma decayBeta1) >>> digitize decayQ qs >>> delay1 0))
buckets = fmap (ardList ((length qs :: Int) + 1)) (qBeta' >>> accRetDigits)
xs = (drop dropN $ scan (second' buckets) (taker (n+dropN) $ (zip (fst <$> r) (zip [0..] (snd <$> r)))))
bucketChart = dayChart (qRangeLabel qs) xs
disp bucketChart:t stack 2 0.1
:t c
:t stack 2 0.1 [(\c -> addHud (view #hudOptions c) (view #charts c)) c]qBeta = (second' (std decayStd) >>> beta1 (ma decayBeta1)) >>> digitize decayQ qs
d = drop dropN $ scan (second' qBeta) (taker (n+dropN) $ (zip (fst <$> r) (zip [0..] (snd <$> r))))
betaSdDigitChart = digitChart ((\x -> UTCTime x (P.fromInteger 0)) . fst <$> d) (fromIntegral . snd <$> d) (quantileNames qs)
disp betaSdDigitCharttoCT co = addHud (view #hudOptions co) (view #charts co)disp $ mempty & #charts .~ stack 2 0.1 [toCT bucketChart, toCT compChart', toCT betaSdDigitChart, toCT betaSdChart', toCT decayChart]ts = pack <$> ["std decay = " <> show decayStd, "beta1 decay = " <> show decayBeta1, "quantile decay = " <> show decayQ]
s = defaultTextStyle & #anchor .~ AnchorStart
ts' = [TextChart s (zipWith (\t x -> (t, Point 0 x)) ts [0..])]
decayChart = mempty & #charts .~ unnamed (ts' <> [padChart 0.2 ts']) :: ChartOptionsstyleBoxes ts'- [ ] try and predict future stats
- [ ] calculate ma std etc
- [ ] chart of expected future distribution
- [ ] track a p&l
- [ ] random p&l streams
- [X] smaller text chart
- [X] bar chart labels too close and a bit too small
- [X] ticks not scaling and fuzzy
- function to scale hud along with the chart (can only do this once I assume, but maybe the chart section of HudChart can help)
- [X] combine digit chart with digit accumulation
- [X] better order of stack
-- parameters
n = 2000
dropN = 100
qs = [0.1, 0.5, 0.8] :: [Double]
decayStd = 0.95
decayBeta1 = 0.99
decayQ = 0.996
ri = zip [0..] (snd <$> r)
days = reindex n dropN id (fst <$> r)
accChart = lchart Nothing (palette1 0) (rebase n dropN (scan (dipure (+)) (snd <$> r)))
finishHud = #axes %~ (<> [dayAxis days]) >>> #frames %~ (<> [(Priority 30, defaultFrameOptions & #buffer .~ 0.1)]) :: HudOptions -> HudOptions
sdChart = lchart (Just PlaceLeft) (palette1 1) (reindex n dropN (scan (std decayStd)) (snd <$> r))
betaChart = lchart (Just PlaceRight) (palette1 2) (reindex n dropN (scan (second' (std decayStd) >>> beta1 (ma decayBeta1))) ri)
sdCharts = compoundMerge [sdChart,betaChart, accChart & #hudOptions %~ finishHud]
qBeta = (second' (std decayStd) >>> beta1 (ma decayBeta1)) >>> digitize decayQ qs
rDigit = reindex n dropN (scan qBeta) ri
cs = Data.Mealy.fold countM (rDigit)
qCountChart = barChart defaultBarOptions (BarData [fromIntegral <$> toList cs] (qRangeLabel qs) []) & #hudOptions % #frames %~ (<> [(Priority 30, defaultFrameOptions & #buffer .~ 0.2)]) & #hudOptions % #titles %~ (<> [(Priority 10, defaultTitle "quantile counts" & #buffer .~ 0.2 & #style % #color .~ palette1a 1 1)])
qBetaChart = digitChart ((\x -> UTCTime x (P.fromInteger 0)) <$> days) (fromIntegral <$> rDigit) (quantileNames qs) & #hudOptions % #axes .~ []
qBeta' = (first snd) <$> ((,) <$> id <*> (second' (std decayStd) >>> beta1 (ma decayBeta1) >>> digitize decayQ qs >>> delay1 0))
buckets = fmap (ardList ((length qs :: Int) + 1)) (qBeta' >>> accRetDigits)
xs = (drop dropN $ scan (second' buckets) (taker (n+dropN) $ (zip (fst <$> r) (zip [0..] (snd <$> r)))))
bucketChart = dayChart (qRangeLabel qs) xs
accBucketChart = compoundMerge [qBetaChart, bucketChart]
ts = pack <$> reverse ["std decay = " <> show decayStd, "beta1 decay = " <> show decayBeta1, "quantile decay = " <> show decayQ, "quantiles = " <> show qs]
s = defaultTextStyle & #anchor .~ AnchorStart & #hsize .~ 0.65
ts' = zipWith (\t x -> TextChart s [(t, Point 0 x)]) ts [0..]
decayChart = (mempty::ChartOptions) & (#hudOptions % #frames .~ [(Priority 30, FrameOptions (Just clear) 0.05)]) & (#charts .~ unnamed ts')
disp $ mempty & #charts .~ stack' 2 0.1 ([toCT sdCharts, toCT qCountChart, toCT accBucketChart, toCT decayChart])
-- parameters
n = 2000
dropN = 100
qs = [0.1, 0.5, 0.8] :: [Double]
decayStd = 0.95
decayBeta1 = 0.99
decayQ = 0.996
ri = zip [0..] (snd <$> r)
days = reindex n dropN id (fst <$> r)
accChart = lchart Nothing (palette1 0) (rebase n dropN (scan (dipure (+)) (snd <$> r)))
finishHud = #axes %~ (<> [dayAxis days]) >>> #frames %~ (<> [(Priority 30, defaultFrameOptions & #buffer .~ 0.1)]) :: HudOptions -> HudOptions
sdChart = lchart (Just PlaceLeft) (palette1 1) (reindex n dropN (scan (std decayStd)) (snd <$> r))
betaChart = lchart (Just PlaceRight) (palette1 2) (reindex n dropN (scan (second' (std decayStd) >>> beta1 (ma decayBeta1))) ri)
sdCharts = compoundMerge [sdChart,betaChart, accChart & #hudOptions %~ finishHud]
qBeta = (second' (std decayStd) >>> beta1 (ma decayBeta1)) >>> digitize decayQ qs
rDigit = reindex n dropN (scan qBeta) ri
cs = Data.Mealy.fold countM (rDigit)
qCountChart = barChart defaultBarOptions (BarData [fromIntegral <$> toList cs] (qRangeLabel qs) []) & #hudOptions % #frames %~ (<> [(Priority 30, defaultFrameOptions & #buffer .~ 0.2)]) & #hudOptions % #titles %~ (<> [(Priority 10, defaultTitle "quantile counts" & #buffer .~ 0.2 & #style % #color .~ palette1a 1 1)]) & #hudOptions % #axes %~ fmap (second (#bar .~ Nothing))
qBetaChart = digitChart ((\x -> UTCTime x (P.fromInteger 0)) <$> days) (fromIntegral <$> rDigit) (quantileNames qs) & #hudOptions % #axes .~ []
qBeta' = (first snd) <$> ((,) <$> id <*> (second' (std decayStd) >>> beta1 (ma decayBeta1) >>> digitize decayQ qs >>> delay1 0))
buckets = fmap (ardList ((length qs :: Int) + 1)) (qBeta' >>> accRetDigits)
xs = (drop dropN $ scan (second' buckets) (taker (n+dropN) $ (zip (fst <$> r) (zip [0..] (snd <$> r)))))
bucketChart = dayChart (qRangeLabel qs) xs
accBucketChart = compoundMerge [qBetaChart, bucketChart]
ts = pack <$> reverse ["std decay = " <> show decayStd, "beta1 decay = " <> show decayBeta1, "quantile decay = " <> show decayQ, "quantiles = " <> show qs]
s = defaultTextStyle & #anchor .~ AnchorStart & #hsize .~ 0.65
ts' = zipWith (\t x -> TextChart s [(t, Point 0 x)]) ts [0..]
decayChart = (mempty::ChartOptions) & (#hudOptions % #frames .~ [(Priority 30, FrameOptions (Just clear) 0.05)]) & (#charts .~ unnamed ts')
-- disp $ qCountChart & #hudOptions % #axes %~ fmap (second (#bar .~ Nothing))
disp $ mempty & #charts .~ stack' 2 0.1 ([toCT sdCharts, toCT qCountChart, toCT accBucketChart, toCT decayChart])