anal

analysis: the prefix

Imports

: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

analysis

Accumulated return

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))

median versus average

mean versus 40th, 50th, 60th quantiles

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

medium minus mean

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

digitize median versus mean

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

trading signals

(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 d

Data.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

standard deviation

It looks like the market goes up when sd is declining.

What is the gradient of a moving statistic?

working

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'

gradient of sd

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'

digitize beta

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 d

Skew 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 d

n = 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

vert

: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 betaSdDigitChart

toCT 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']) :: ChartOptions

styleBoxes ts'

all in one

• [ ] 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])