module Progression.Plot (plotMulti) where
import Control.Applicative (Applicative(..), (<$>))
import Control.Arrow ((***), (&&&))
import Control.Monad (ap, forM, liftM, when)
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.Config
import Progression.Files
plotFile :: GraphSettings Definite -> (([String], [String]), FilePath) -> IO ()
plotFile settings ((rowNames, colNames), csvFile) = check =<< rawSystem "gnuplot" ("-e" : [concat cmd])
where
cmd =
["set terminal " ++ terminalType ++ " size " ++ sizeX ++ "," ++ sizeY ++ ";"
,"set output '" ++ get graphFilename ++ "';"
,"set xtics rotate;"
,"set xrange [-" ++ show (makeOffset 1) ++ ":"
++ show (fromIntegral (length rowNames 1) + makeOffset (toInteger $ length colNames)) ++ "];"
,"set bmargin " ++ show ((maximum (map length rowNames) * 2) `div` 3) ++ ";"
,if get graphLogY then "set logscale y;" else ""
,"set datafile separator ',';"
,"set style data " ++ style ++ ";" ++ otherStyle
,"plot " ++ intercalate ","
[let indices = map show [i*3 + 2, i*3 + 3, i*3 + 4]
indicesAndExtra = case get graphType of
GraphTypeLines -> indices
GraphTypeBars -> indices ++ ["(" ++ show (makeOffset 1) ++ ")"]
in "'" ++ csvFile ++ "' using ($0+" ++ show (makeOffset i) ++ "):" ++ intercalate ":" indicesAndExtra ++ ":xtic(1) title '" ++ n ++ "'"
| (i, n) <- zip [0..] colNames]
]
terminalType = case takeExtension $ get graphFilename of
"" -> "png"
(_:ext) -> ext
check ExitSuccess = do hPutStrLn stderr "Executed gnuplot commands: "
mapM_ (hPutStrLn stderr . (" " ++)) cmd
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) / (max 8 (fromIntegral $ length colNames + 1))
(sizeX, sizeY) = show *** show $ get graphSize
get f = definite (f settings)
style = case get graphType of
GraphTypeLines -> "errorlines"
GraphTypeBars -> "boxerrorbars"
otherStyle = case get graphType of
GraphTypeLines -> ""
GraphTypeBars -> "set style fill pattern;"
plotMulti :: String -> GraphSettings Definite -> IO ()
plotMulti orig settings
= do rowColumns <- joinMulti (get graphGroup $ orig) csvFile (map (id &&& makeFileName) $ get graphCompareTo)
when (uncurry (&&) . ((not . null) *** (not . null)) $ rowColumns) $
plotFile settings (rowColumns, csvFile)
where
csvFile = dropExtension (get graphFilename) <.> "csv"
get f = definite (f settings)
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 :: (Map.Map String (Map.Map String BoundedMean)
-> GraphData)
-> FilePath -> [(String, FilePath)] -> IO ([String], [String])
joinMulti _ _ [] = return ([], [])
joinMulti groupFunc dest allFiles
= do allData <- sequence [parseTable csvFormat <$> readFile path | (_, path) <- allFiles]
case mapM tableToMap allData of
Fail err -> hPutStrLn stderr err >> return ([], [])
Fine ms -> let gd = groupFunc $ Map.fromList $ zip (map fst allFiles) ms
in do writeFile dest $ formatTable csvFormat (mapToTable gd)
return ((map groupName . groupLabels) &&& (map subGroupName . subGroupLabels) $ gd)
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 <$>
(read <$> r ! meanLBIndex) <*> (read <$> r ! meanIndex) <*> (read <$> r ! meanUBIndex))
)
mapToTable :: GraphData -> [[String]]
mapToTable gd = [ groupName x : concatMap (meanToStr . graphData gd x) (subGroupLabels gd)
| x <- groupLabels gd]
where
meanToStr :: BoundedMean -> [String]
meanToStr (BoundedMean lb m ub) = map show [m, lb, ub]