CairoHistogram.hs

module CairoHistogram (
  hasCairoHistograms,
  writeHistogram
) where

import           Control.Monad.ST (runST)
import           Data.Accessor ((^=), (^:))
import qualified Data.Colour as Colour
import qualified Data.Colour.Names as ColourNames
import qualified Data.Vector.Algorithms.Intro as VI
import qualified Data.Vector.Generic as VG
import           Data.Vector.Unboxed ((!))
import qualified Graphics.Rendering.Chart as Chart
import           Statistics.Test.ApproxRand
import           Statistics.Test.Types (TestType(..))
import qualified System.FilePath.Posix as FP
import           System.IO (hPutStrLn, stderr)

import           Histogram

hasCairoHistograms :: Bool
hasCairoHistograms = True

writeHistogram :: TestOptions -> Int -> TestResult -> FP.FilePath -> IO ()
writeHistogram testOptions bins result path =
  case histogram bins result of
    Left err -> hPutStrLn stderr err
    Right  h ->
      let r = createHistogram testOptions result h in
        case snd $ FP.splitExtension path of
          ".pdf" -> Chart.renderableToPDFFile r 800 600 path
          ".png" -> do
            _ <- Chart.renderableToPNGFile r 800 600 path
            return ()
          ".ps"  -> Chart.renderableToPSFile  r 800 600 path
          ".svg" -> Chart.renderableToSVGFile r 800 600 path
          _      -> hPutStrLn stderr "Unknown output format!"

-- Creates a histogram. The histogram is stacked, but the second bar
-- is always empty, except for the bin of the original statistic (if any).
-- There, the first bar is empty and the second bar has the frequency.
-- Yes, this is cheating ;).
createHistogram :: TestOptions -> TestResult -> [(Double, Int)] ->
  Chart.Renderable ()
createHistogram testOptions result his =
  Chart.toRenderable layout
  where
    layout =
        Chart.layout1_background  ^= Chart.solidFillStyle opaqueWhite
      $ Chart.layout1_left_axis   ^: Chart.laxis_override ^= Chart.axisTicksHide
      $ Chart.layout1_right_axis  ^: Chart.laxis_title    ^= "Frequency"
      $ Chart.layout1_bottom_axis ^: Chart.laxis_title    ^= "Statistic"
      $ Chart.layout1_plots       ^= [ Right (Chart.plotBars randomizationBars),
                                       Right statisticLine, Right sigLines ]
      $ Chart.setLayout1Foreground   opaqueBlack
      $ Chart.defaultLayout1
    randomizationBars =
        Chart.plot_bars_style       ^= Chart.BarsStacked
      $ Chart.plot_bars_spacing     ^= Chart.BarsFixGap 6 2
      -- $ Chart.plot_bars_spacing     ^= Chart.BarsFixGap 0 0
      $ Chart.plot_bars_item_styles ^= [
          (Chart.solidFillStyle $ opaqueGreen, Nothing) ]
      $ Chart.plot_bars_values      ^= map (\(b, f) -> (b, [f])) his
      $ Chart.defaultPlotBars
    statisticLine =
      Chart.vlinePlot "Statistic for samples" (Chart.solidLine 2 (opaqueRed)) $ trStat result
    sigLines      =
      vlinesPlot "Significance" (Chart.dashedLine 2 [8, 4] opaqueBlack) $
        sigBounds testOptions result

-- Plot vertical lines, adapted from Chart.vlinePlot.
vlinesPlot :: String -> Chart.CairoLineStyle -> [a] -> Chart.Plot a b
vlinesPlot t ls xs = Chart.toPlot Chart.defaultPlotLines {
    Chart.plot_lines_title_        = t,
    Chart.plot_lines_style_        = ls,
    Chart.plot_lines_limit_values_ =
      [[(Chart.LValue v, Chart.LMin),(Chart.LValue v, Chart.LMax)] | v <- xs]
    }

-- Calculate the bounds of significance.
sigBounds :: TestOptions -> TestResult -> [Double]
sigBounds (TestOptions testType _ n pTest) (TestResult _ _ stats) =
  case testType of
    TwoTailed -> [sorted ! (nExtreme - 1), sorted ! (n - nExtreme)]
    OneTailed -> [sorted ! (n - nExtreme)]
  where
    sorted           = sortVector stats
    nExtreme         = floor $ (pVal testType pTest) * (fromIntegral n + 1) - 1
    pVal OneTailed p = p
    pVal TwoTailed p = p / 2
    -- XXX: Fix extreme cases: p-value of 0, small n.

sortVector :: (Ord a, VG.Vector v a) => v a -> v a
sortVector v = runST $ do
  s <- VG.thaw v
  VI.sort s
  VG.freeze s

-- Convenience...
opaqueBlack, opaqueGreen, opaqueRed, opaqueWhite :: Colour.AlphaColour Double
opaqueBlack = Colour.opaque ColourNames.black
opaqueGreen = Colour.opaque ColourNames.green
opaqueRed   = Colour.opaque ColourNames.red
opaqueWhite = Colour.opaque ColourNames.white