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
module Analytics.Trading.Advice.Backtesting where

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

import Analytics.Trading.Data.Advice    -- 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)

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

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

placeOrder :: Monad m => Recommendation -> Day -> Symbol -> USD 
           -> Shares -> WriterDL m Shares
placeOrder rec day sym open sh@(Sh x) =
   let ans@(Sh y) = min (Sh 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 run it

theStrat :: [Advice] -> TradeCalendar -> WriterS ()
theStrat [] _ = return ()
theStrat (Infallible 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 >>= \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

-- this back test is very limited in scope; we'll improve as we expand
-- our system.

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)

{-- *Main> backtest 1000000
PlaceOrder 2015-03-24 "AAPL" Buy 100.00 shares $127.23 $12723.00
PlaceOrder 2015-03-25 "AAPL" Sell 100.00 shares $126.54 $12654.00
PlaceOrder 2015-03-27 "AAPL" Buy 100.00 shares $124.56 $12456.99
PlaceOrder 2015-03-30 "AAPL" Sell 100.00 shares $124.04 $12404.99
PlaceOrder 2015-03-31 "AAPL" Buy 100.00 shares $126.09 $12609.00
PlaceOrder 2015-04-01 "AAPL" Sell 100.00 shares $124.81 $12481.99
PlaceOrder 2015-04-02 "AAPL" Buy 100.00 shares $125.03 $12503.00
PlaceOrder 2015-04-08 "AAPL" Sell 100.00 shares $125.84 $12584.99
PlaceOrder 2015-04-10 "AAPL" Buy 100.00 shares $125.95 $12595.00
PlaceOrder 2015-04-14 "AAPL" Sell 100.00 shares $127.00 $12700.00
PlaceOrder 2015-04-16 "AAPL" Buy 100.00 shares $126.28 $12628.00
PlaceOrder 2015-04-17 "AAPL" Sell 100.00 shares $125.54 $12554.99
PlaceOrder 2015-04-21 "AAPL" Buy 100.00 shares $128.10 $12810.00
PlaceOrder 2015-04-29 "AAPL" Sell 100.00 shares $130.15 $13015.99
PlaceOrder 2015-05-04 "AAPL" Buy 100.00 shares $129.50 $12950.00
PlaceOrder 2015-05-06 "AAPL" Sell 100.00 shares $126.56 $12656.00
PlaceOrder 2015-05-08 "AAPL" Buy 100.00 shares $126.68 $12668.00
PlaceOrder 2015-05-12 "AAPL" Sell 100.00 shares $125.59 $12559.99
PlaceOrder 2015-05-15 "AAPL" Buy 100.00 shares $129.07 $12907.00
(-1.94%,Stat $986572.99 (fromList [("AAPL",($13427.00,100.00 shares))]))

URGH! The truth bears out in the log! --}

{-- Standard disclaimer: I'm not an investment guru, so if you lose your shirt,
that's your problem, not mine, as these are educational exercises for your
edification and supreme enlightenment. Your financial well-being is your (sole)
responsibility, and blah-di-blah and more legal mumbo jumbo that nobody reads
anyway, except lawyers on their days off to poke fun at the gaping loopholes
in all these boilerplate disclaimers, anyway, so there it is. --}