progression-0.1: Progression/Plot.hs

-- Progression.
-- Copyright (c) 2010, Neil Brown.
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--  * Redistributions of source code must retain the above copyright
--    notice, this list of conditions and the following disclaimer.
--  * Redistributions in binary form must reproduce the above copyright
--    notice, this list of conditions and the following disclaimer in the
--    documentation and/or other materials provided with the distribution.
--  * The name of Neil Brown may not be used to endorse or promote products derived from
--    this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | A helper module for plotting.
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 }

-- | Plots to the given destination file (using its extension as the terminal type),
-- from the given CSV file, using the given list as labels.
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

-- | Plots to the given destination file (using its extension as the terminal type),
-- the given list of labels.
plotMulti :: FilePath -> [String] -> IO ()
plotMulti destFile names
  = do count <- joinMulti csvFile (map makeFileName names)
       plotFile destFile (count, csvFile) names
  where
    csvFile = dropExtension destFile <.> "csv"

-- I know this is really Either String; long story
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

-- | Joins all the result files in the list into the given destination file ready
-- to be fed to plotFile.  If the list is empty, nothing is done.
--
-- It returns the number of benchmarks that are in the resulting file
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
         -- ms must be non-empty, because "allFiles" was non-empty:
         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))
                          )

    -- No header at the moment:
    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]