module Progression.Plot (plotMulti) where
import Control.Applicative (Applicative(..), (<$>))
import Control.Monad (ap, forM, liftM)
import Data.List (findIndex, intercalate)
import qualified Data.Map as Map
import Database.TxtSushi.FlatFile (csvFormat, formatTable, parseTable)
import System.Cmd (rawSystem)
import System.Exit (ExitCode(..))
import System.FilePath (dropExtension, takeExtension, (<.>))
import System.IO (hPutStrLn, stderr)
import Progression.Files
data BoundedMean = BoundedMean { _meanLB :: String, _mean :: String, _meanUB :: String }
plotFile :: FilePath -> (Integer, FilePath) -> [String] -> IO ()
plotFile destFile (numBench, csvFile) names = check =<< rawSystem "gnuplot" ("-e" :
[concat
["set terminal " ++ terminalType ++ " size 1024,768;"
,"set output '", destFile, "';"
,"set xtics rotate;"
,"set xrange [-" ++ show (makeOffset 1) ++ ":"
++ show (fromInteger (numBench 1) + makeOffset (toInteger $ length names)) ++ "];"
,"set bmargin 20;"
,"set datafile separator ',';"
,"plot " ++ intercalate ","
[let indices = map show [i*3 + 2, i*3 + 3, i*3 + 4]
in "'" ++ csvFile ++ "' using ($0+" ++ show (makeOffset i) ++ "):" ++ intercalate ":" indices ++ ":xtic(1) with errorlines title '" ++ n ++ "'"
| (i, n) <- zip [0..] names]
]
])
where
terminalType = case takeExtension destFile of
"" -> "png"
(_:ext) -> ext
check ExitSuccess = return ()
check (ExitFailure _) = hPutStrLn stderr "Error executing gnuplot; have you got gnuplot installed on your system and in your path?"
makeOffset :: Integer -> Double
makeOffset i = (fromInteger i :: Double) / 8
plotMulti :: FilePath -> [String] -> IO ()
plotMulti destFile names
= do count <- joinMulti csvFile (map makeFileName names)
plotFile destFile (count, csvFile) names
where
csvFile = dropExtension destFile <.> "csv"
data FailM a = Fail String | Fine a
instance Monad FailM where
fail = Fail
return = Fine
(Fail s) >>= _ = Fail s
(Fine x) >>= f = f x
instance Functor FailM where
fmap = liftM
instance Applicative FailM where
pure = return
(<*>) = ap
joinMulti :: FilePath -> [FilePath] -> IO Integer
joinMulti _ [] = return 0
joinMulti dest allFiles
= do allData <- sequence [parseTable csvFormat <$> readFile path | path <- allFiles]
case mapM tableToMap allData of
Fail err -> hPutStrLn stderr err >> return 0
Fine ms -> let m = foldl1 (Map.intersectionWith (++)) $
map (Map.map (:[])) ms
in do writeFile dest $ formatTable csvFormat (mapToTable m)
return (toInteger $ Map.size m)
where
headTail :: [a] -> FailM (a, [a])
headTail [] = Fail "Empty file"
headTail (x:xs) = return (x, xs)
find' :: String -> [String] -> FailM Int
find' s ss = case findIndex (== s) ss of
Nothing -> Fail $ "Could not find row titled: " ++ s
Just i -> return i
(!) :: [a] -> Int -> FailM a
(!) xs n | n >= length xs = Fail "Missing data in file"
| otherwise = return $ xs !! n
tableToMap :: [[String]] -> FailM (Map.Map String BoundedMean)
tableToMap tbl = do (header, body) <- headTail tbl
nameIndex <- find' "Name" header
meanIndex <- find' "Mean" header
meanLBIndex <- find' "MeanLB" header
meanUBIndex <- find' "MeanUB" header
Map.fromList <$> forM body (\r ->
(,) <$> (r ! nameIndex) <*>
(BoundedMean <$>
(r ! meanLBIndex) <*> (r ! meanIndex) <*> (r ! meanUBIndex))
)
mapToTable :: Map.Map String [BoundedMean] -> [[String]]
mapToTable = map itemToRow . Map.toList
where
itemToRow :: (String, [BoundedMean]) -> [String]
itemToRow (n, ms) = n : concatMap meanToStr ms
meanToStr :: BoundedMean -> [String]
meanToStr (BoundedMean lb m ub) = [m, lb, ub]