Programming performance/TimN Haskell

< Programming performance

• Language: Haskell
• Skill: Intermediate. I'm self taught in Haskell and use it as a hobbyist but haven't used it much for serious work.
• Time: Approx 45 - 90 minutes. I did not keep track of time well and this is just an estimate.
• Notes: I had previously written similar code in python. I feel overall this was a bit harder for me to write than the python code and it took me a bit longer. My resulting haskell code is definitely on the imperative side and is longer and more complex than my python code. The dprint function can be altered to give more or less output.

Code

#!/usr/bin/env runhaskell
module Main where
import Control.Monad
import Control.Monad.State
import Data.List
import Text.Printf
 
io = lift
 
dprint :: String -> StateT Owned IO ()
dprint = io . putStrLn
--dprint x = io $ return ()
 
type Data = [(String,Float)]        -- list of date, closing price
 
-- | Parse data from raw file bytes.  Columns as:
-- Date Open High Low Close Volume Adj Close
parseData :: String -> Data
parseData = map (mkData.words).filter ((/= '#').head).lines
    where mkData [d,o,h,l,c,a,c2] = (d, read c2)
          mkData xs = error (show xs)
 
readData :: IO Data
readData = return.parseData =<< readFile "gspc"
 
data Owned = Owned {
        cash :: Float,
        stocks :: Float,
        queue :: [(Float, Float)]     -- quant and price
    } deriving(Show)
newOwnings = Owned 10000 0 []
 
type DeltaData = [(String,Float,Float)]  -- list of date, close, delta
 
delta c1 c2 = (c2-c1)/c1
 
mkDelta :: Data -> DeltaData
mkDelta dat = zipWith f dat (drop 1 dat) where
    f (d1,c1) (d2,c2) = (d1, c2, delta c1 c2)
 
buy :: String -> Float -> Float -> StateT Owned IO ()
buy date p n = do
    if n > 0 
        then dprint $ printf "%s buy %.2f at $%.2f" date n p
        else dprint $ printf "%s sell %.2f at $%.2f" date (negate n) p
    c <- gets cash
    s <- gets stocks
    modify $ \o -> o {cash = c-n*p, stocks = s+n}
 
remember p n = do
    q <- gets queue
    modify $ \s -> s {queue = (p, n) : q}
 
pop :: StateT Owned IO (Float,Float)
pop = do
    q <- gets queue
    modify $ \s -> s {queue = tail q}
    return $ head q
 
buyAndRemember date c p = do
    let n = c / p
    buy date p n
    remember p n
 
processQueue :: String -> Float -> StateT Owned IO ()
processQueue date price = processQueue' where
    processQueue' = do
        q <- gets queue
        when ((not.null) q) (do
            let (p,n) = head q
            when (delta p price > 0.06) (do
                buy date price (negate n)
                modify $ \s -> s {queue = tail q}
                processQueue'
             )
         )
 
buyTrigger = -0.03
sellTrigger = 0.06
 
strategy :: Data -> StateT Owned IO ()
strategy dat = do
    forM_ (mkDelta dat) (\(date,price,delta) -> do
        c <- gets ((* 0.10).cash)
        when (delta < buyTrigger) (buyAndRemember date c price)
        processQueue date price
     )
    when ((not.null) dat) (do
        let (date,price) = last dat
        n <- gets stocks
        buy date price (negate n)
     )
 
runStrategy dat = do
    owned <- execStateT (strategy dat) newOwnings
    return $ cash owned
 
main = do
    dat <- liftM reverse readData
    res <- runStrategy dat
    print res

Recent content is available under a simple permissive license.