Take the Monoid and Run(State-WriterT)!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
module Analytics.Trading.Advice.Backtesting where

-- http://lpaste.net/109687

import Prelude hiding (log)
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
import Data.List (sortBy)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Ord (comparing)
import Data.Time.Calendar

import Analytics.Math.Statistics.StandardDeviation
                                        -- http://lpaste.net/8056787266321776640
import Analytics.Trading.Data.Advice hiding (Approach)
                                        -- http://lpaste.net/7565330848883408896
import Analytics.Trading.Data.Calendar  -- http://lpaste.net/729791673181143040
import Analytics.Trading.Data.Order     -- http://lpaste.net/3384997230741028864
import Analytics.Trading.Data.Portfolio hiding (value)
                                        -- http://lpaste.net/2376647211535564800
import Analytics.Trading.Data.Row       -- http://lpaste.net/109658
import Control.Comonad                  -- http://lpaste.net/107661
import Control.DList                    -- http://lpaste.net/107607
import Data.Monetary.USD                -- http://lpaste.net/109653

-- a combined solution to the problem http://lpaste.net/8301304912738779136

log :: Monad m => a -> WriterT (DList a) m ()
log = tell . DL . cons

type WriterDL = WriterT (DList Order)
type WriterS = WriterDL (State Portfolio)

-- filter out advices by standard deviation:

topN :: Int -> [Advice] -> [Advice]
topN n = sortBy (comparing day) . take n . sortBy (flip (comparing sig))

-- added missing types to the signature to construct logged order

tomorrowsOrder :: Monad m => Recommendation -> Day -> Symbol -> USD -> USD 
               -> Shares -> Rational -> WriterDL m Shares
tomorrowsOrder Sell day sym cash op sh@(Sh 0) mult =
   log (NoShortSelling day sym) >> return sh
tomorrowsOrder Hold _ _ _ _ _ _ = return (Sh 0) -- we don't log holds
tomorrowsOrder Buy day sym cash open shareReserve mult =
   placeOrder Buy day sym open (Sh (value (cash / open))) mult
tomorrowsOrder Sell day sym cash open shareReserve mult =
   placeOrder Sell day sym open shareReserve mult

placeOrder :: Monad m => Recommendation -> Day -> Symbol -> USD 
           -> Shares -> Rational -> WriterDL m Shares
placeOrder rec day sym open sh@(Sh x) mult =
   let ans@(Sh y) = min (Sh $ mult * 100) sh in
   log (PlaceOrder day sym rec ans open (USD y * open)) >> return ans
   -- n.b.: commission is NOT recorded here!
   -- also note placeOrder is very contextual around (day, sym, cash, open)
   -- a meta-info comonad?

-- So, with that, we just tie that into the theStrat and runIt

theStrat :: [Advice] -> TradeCalendar -> WriterS ()
theStrat [] _ = return ()
theStrat (Trade dt sym _ rec:advices) (TC today table) =
   lift get >>= \stat@(Stat mny portfolio) ->
   let secur = snd (fromMaybe (USD 0, Sh 0) (Map.lookup sym portfolio))
       tomorrow = nextD dt today
       day = extract tomorrow
       price = open (table Map.! day)
   in  tomorrowsOrder rec day sym mny price secur 1 >>= \ordr ->
       lift (order rec ordr sym price (USD 10)) >>
       theStrat advices (TC tomorrow table) 

results :: USD -> Portfolio -> Listings -> Percentage
results seedmoney portfolio = snd . performance seedmoney portfolio

backtest :: USD -> [Row] -> [Advice] -> (Percentage, Portfolio, [Order])
backtest monay rows adv =
   -- readAdvice "seer/aapl-advice.csv" >>= \adv ->
   -- readRows "seer/aapl-2mos.csv" >>= \rows ->
   let cal = tc rows
       (log, portfolio) =
          runState (execWriterT (theStrat adv cal)) (Stat monay Map.empty)
       listing = Map.singleton "AAPL" (head rows) -- head rows is today
   in  -- mapM_ (putStrLn . show) (dlToList log) >> 
       (results monay portfolio listing, portfolio, dlToList log)

-- the above backtests without integrating the strength of the advice given
-- because there is no 'strength of advice' indicator. The below takes an
-- additional factor: the standard deviation of the indicator run to give us
-- a measure of variance from the mean so that we can determine how emphatic
-- the advice given is

type Approach = StandardDeviation -> Rational

enhStrat :: Monad m => [Advice] -> TradeCalendar -> Approach
         -> Portfolio -> WriterDL m Portfolio
enhStrat [] calendar force portfolio = return portfolio
enhStrat (Trade dt sym stddev rec:advices) (TC today tab)
         force port@(Stat mny portfolio) =
   let secur = snd (fromMaybe (USD 0, Sh 0) (Map.lookup sym portfolio))
       tomorrow = nextD dt today
       day = extract tomorrow
       price = open (tab Map.! day)
   in  tomorrowsOrder rec day sym mny price secur (force stddev) >>= \ordr ->
       enhStrat advices (TC tomorrow tab) force 
                (recFn rec ordr sym price (USD 10) port)

-- *Main> saveTo "seer/aapl-enhadv.csv" (adviceHdr ++ ",stddev,mag") top5

backtestWithStdDev :: USD -> [Row] -> [Advice] -> Approach
                   -> (Percentage, Portfolio, [Order])
backtestWithStdDev infusion rows advices force =
   let cal = tc rows
       port = Stat infusion Map.empty
       (portfolio, log) = runWriter (enhStrat advices cal force port)
       listing = Map.singleton "AAPL" (head rows)
   in  (results infusion portfolio listing, portfolio, dlToList log)
69:8: Warning: Reduce duplication
Found:
secur = snd (fromMaybe (USD 0, Sh 0) (Map.lookup sym portfolio))
tomorrow = nextD dt today
day = extract tomorrow
Why not:
Combine with /tmp/1715274131156500480.hs:104:8