Topic: Analysis of the recent MtGox moves: few very big orders (Read 3874 times)

{-# LANGUAGE TemplateHaskell #-}

import Control.Applicative
import Data.List
import Data.List.Utils
import Data.Maybe
import Data.Time
import HFlags
import Text.Printf

defineFlag "bigs_only" True "Show only big orders."

data Trade = Trade { _time :: !Int
                   , _price :: !Double
                   , _amount :: !Double
                   } deriving (Eq,Show)

readCSVFile :: FilePath -> IO [Trade]
readCSVFile file = do
  ls <- lines <$> readFile file
  return $ map (\[t,p,a] -> Trade (read t) (read p) (read a)) $
    map (split ",") $ ls

aggPrice :: [Trade] -> (Double,Double)
aggPrice l = (avgPrice, totAmount)
  where
    totAmount = sum $ map _amount l
    avgPrice = (/totAmount) $ sum $ map wprice l
    wprice (Trade _ p a) = p * a

showTime :: Int -> String
showTime s = show $ addUTCTime (fromIntegral s) epoch
  where
    epoch = UTCTime (fromGregorian 1970 01 01) 0

data GTag = LEV | BUY | SELL  deriving (Eq,Show)
data TGroup = Single Trade | Group GTag [Trade]  deriving (Show)

groupTrades :: [Trade] -> [TGroup]
groupTrades [] = []
groupTrades [t] = [Single t]
groupTrades (t1:t2:ts) | withinSecond t1 t2 = go (tag t1 t2) t2 ts [t1]
                       | otherwise = Single t1 : groupTrades (t2:ts)
  where
    withinSecond (Trade t1 _ _) (Trade t2 _ _) = abs (t2 - t1) <= 1
    go t x [] res = [Group t (reverse (x:res))]
    go t x (y:ys) res | withinSecond x y,
                        Just t' <- fitsTag t x y = go t' y ys (x:res)
                      | otherwise = (Group t (reverse (x:res))) : groupTrades (y:ys)

    fitsTag LEV (Trade _ p1 _) (Trade _ p2 _) | p1 == p2 = Just LEV
                                              | p1 < p2  = Just BUY
                                              | otherwise = Just SELL
    fitsTag BUY (Trade _ p1 _) (Trade _ p2 _) | p1 <= p2 = Just BUY
    fitsTag SELL (Trade _ p1 _) (Trade _ p2 _) | p1 >= p2 = Just SELL
    fitsTag _ _ _ = Nothing

    tag t1 t2 = fromJust $ fitsTag LEV t1 t2

combinedTransactions :: [Trade] -> IO ()
combinedTransactions trades = do
  let cts = groupTrades trades


      output :: TGroup -> IO ()
      output (Single (Trade t p a)) = if flags_bigs_only && a < 400
                                      then return ()
                                      else printf "%s: %.2f @ %.2f\n" (showTime t) a p
      output (Group tag ts) = if amount > 400 || not flags_bigs_only
                              then printf "%s:      (%d ts in %ds) %.2f @ %.2f %s (min: %.2f, max: %.2f) big ts: %s\n" stTime count duration amount avgPrice tag minPrice maxPrice bigs
                              else return ()
        where
          ta = head ts
          tz = last ts
          count = length ts
          prices = map _price ts
          stTime = showTime $ _time ta
          duration = _time tz - _time ta
          (avgPrice,amount) = aggPrice ts
          minPrice = minimum prices
          maxPrice = maximum prices
          bigs :: [String]
          bigs = map (printf "%.2f") $ take 4 $ reverse $ sort $ map _amount ts
  mapM_ output cts

main :: IO ()
main = do
  $initHFlags "Analyze bitcoin trades"
  mtgox <- readCSVFile "mtgox.csv"
  combinedTransactions mtgox