diff --git a/approx-rand-test.cabal b/approx-rand-test.cabal --- a/approx-rand-test.cabal +++ b/approx-rand-test.cabal @@ -1,19 +1,27 @@ Name: approx-rand-test -Version: 0.1.1 +Version: 0.2.0 License: OtherLicense License-file: LICENSE -Copyright: Copyright 2012 Daniël de Kok +Copyright: Copyright 2012-2013 Daniël de Kok Author: Daniël de Kok Maintainer: Daniël de Kok Homepage: http://github.com/danieldk/approx-rand-test Category: Statistics Synopsis: Approximate randomization test -Description: Utility to perform approximate randomization tests. +Description: + . + Functions and utilities to perform paired and unpaired approximate + randomization tests (Noreen, 1989). + . + The utilities can also draw histograms of the applications of the test + statistic to the randomized samples. For support for more file formats, + install the package with the @-withCairo@ flag. + . Cabal-Version: >= 1.8 Build-Type: Simple Extra-Source-Files: - utils/cairo/CairoHistogram.hs - utils/nocairo/CairoHistogram.hs + utils/cairo/ChartBackend.hs + utils/diagrams/ChartBackend.hs Source-Repository head Type: git @@ -25,7 +33,7 @@ Tag: 0.1.1 Flag withCairo - Description: Enable non-terminal histogram output, requiring Cairo. + Description: Use Cairo for drawing charts, supports more output formats. Default: False Library @@ -41,43 +49,48 @@ Executable approx_rand_test Main-Is: approx-rand-test.hs - Other-Modules: Histogram, SampleIO, TextHistogram + Other-Modules: ChartBackend, ChartHistogram, Histogram, SampleIO, + TextHistogram HS-Source-Dirs: utils Ghc-Options: -O2 -Wall Build-Depends: base >= 4 && < 5, approx-rand-test, - conduit >= 0.4 && < 1.1, text >= 0.11.1 && < 0.11.3, - containers == 0.4.*, vector >= 0.9 && < 0.11, + Chart == 1.0, colour == 2.3.*, conduit >= 0.4 && < 1.1, + containers >= 0.4 && < 0.6, data-default-class == 0.0.*, + filepath >= 1.3 && < 1.5, lens == 3.9.*, mersenne-random-pure64 == 0.2.0.*, - monad-mersenne-random == 0.1, - statistics == 0.10.* + monad-mersenne-random == 0.1, mtl >= 2.0.1 && < 2.2, + text >= 0.11.1 && < 0.11.4, vector >= 0.9 && < 0.11, + statistics == 0.10.*, vector-algorithms == 0.5.* + if flag(withCairo) Hs-Source-Dirs: utils/cairo - Build-Depends: Chart >= 0.15 && < 0.17, colour == 2.3.*, - data-accessor == 0.2.2.*, filepath >= 1.3 && < 1.5, - vector-algorithms == 0.5.* + Build-Depends: Chart-cairo == 1.0 else - Hs-Source-Dirs: utils/nocairo + Hs-Source-Dirs: utils/diagrams + Build-Depends: Chart-diagrams == 1.0 Executable approx_rand_test_paired Main-Is: approx-rand-test-paired.hs - Other-Modules: Histogram, SampleIO, TextHistogram + Other-Modules: ChartBackend, ChartHistogram, Histogram, SampleIO, + TextHistogram HS-Source-Dirs: utils Ghc-Options: -O2 -Wall Build-Depends: base >= 4 && < 5, approx-rand-test, - conduit >= 0.4 && < 1.1, text >= 0.11.1 && < 0.11.3, - containers == 0.4.*, vector >= 0.9 && < 0.11, + Chart == 1.0, colour == 2.3.*, conduit >= 0.4 && < 1.1, + containers >= 0.4 && < 0.6, data-default-class == 0.0.*, + filepath >= 1.3 && < 1.5, lens == 3.9.*, mersenne-random-pure64 == 0.2.0.*, - monad-mersenne-random == 0.1, - mtl >= 2.0.1 && < 2.2, statistics == 0.10.* + monad-mersenne-random == 0.1, mtl >= 2.0.1 && < 2.2, + text >= 0.11.1 && < 0.11.4, vector >= 0.9 && < 0.11, + statistics == 0.10.*, vector-algorithms == 0.5.* + if flag(withCairo) Hs-Source-Dirs: utils/cairo - Build-Depends: Chart >= 0.15 && < 0.17, colour == 2.3.*, - data-accessor == 0.2.2.*, filepath >= 1.3 && < 1.5, - vector-algorithms == 0.5.* - + Build-Depends: Chart-cairo == 1.0 else - Hs-Source-Dirs: utils/nocairo + Hs-Source-Dirs: utils/diagrams + Build-Depends: Chart-diagrams == 1.0 Test-Suite tests Type: exitcode-stdio-1.0 @@ -90,5 +103,5 @@ mersenne-random-pure64 == 0.2.0.*, monad-mersenne-random == 0.1, HUnit >= 1.2.4 && < 1.2.6, - test-framework == 0.6.*, - test-framework-hunit == 0.2.* + test-framework >= 0.6 && < 0.9, + test-framework-hunit >= 0.2 && < 0.4 diff --git a/src/Statistics/Test/ApproxRand.hs b/src/Statistics/Test/ApproxRand.hs --- a/src/Statistics/Test/ApproxRand.hs +++ b/src/Statistics/Test/ApproxRand.hs @@ -148,7 +148,7 @@ approxRandPairTest (TestOptions testType stat n pTest) s1 s2 = do stats <- approxRandPairStats stat n s1 s2 let tOrig = stat s1 s2 - let sig = significance testType pTest n $ countExtremes tOrig $ stats + let sig = significance testType pTest n $ countExtremes tOrig stats return $ TestResult sig tOrig stats -- | @@ -261,7 +261,7 @@ permute val1 val2 coin = if coin then val1 else val2 -randomVector :: (VG.Vector v Bool) => Int -> Rand (v Bool) +randomVector :: VG.Vector v Bool => Int -> Rand (v Bool) randomVector len = VG.replicateM len getBool diff --git a/utils/ChartHistogram.hs b/utils/ChartHistogram.hs new file mode 100644 --- /dev/null +++ b/utils/ChartHistogram.hs @@ -0,0 +1,98 @@ +module ChartHistogram ( + backendFormats, + writeHistogram +) where + +import Control.Lens.Setter ((.~)) +import Control.Monad.ST (runST) +import qualified Data.Colour as Colour +import qualified Data.Colour.Names as ColourNames +import Data.Default.Class +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 System.IO (hPutStrLn, stderr) + +import Histogram +import ChartBackend + +writeHistogram :: TestOptions -> Int -> TestResult -> FilePath -> IO () +writeHistogram testOptions bins result path = + case histogram bins result of + Left err -> hPutStrLn stderr err + Right h -> + writeWithBackend (createHistogram testOptions result h) path + +-- 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 + $ def + 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 + $ def + 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.LineStyle -> [a] -> Chart.Plot a b +vlinesPlot t ls xs = Chart.toPlot vlines + where + vlines = + Chart.plot_lines_title .~ t + $ Chart.plot_lines_style .~ ls + $ Chart.plot_lines_limit_values .~ minMax + $ def + minMax = + [[(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 diff --git a/utils/approx-rand-test-paired.hs b/utils/approx-rand-test-paired.hs --- a/utils/approx-rand-test-paired.hs +++ b/utils/approx-rand-test-paired.hs @@ -14,6 +14,7 @@ import Control.Monad (liftM, when) import Control.Monad.Error (runErrorT) import Control.Monad.Mersenne.Random (evalRandom) +import Data.List (intersperse) import qualified Data.Vector.Generic as VG import qualified Data.Vector.Unboxed as V import Data.Word (Word64) @@ -26,7 +27,7 @@ import System.Random.Mersenne.Pure64 (PureMT, newPureMT, pureMT) import Text.Printf (printf) -import CairoHistogram +import ChartHistogram import SampleIO import TextHistogram @@ -136,10 +137,7 @@ options :: [OptDescr (Options -> Options)] options = - if hasCairoHistograms then - cairoHistogramOption : mandatoryOptions - else - mandatoryOptions + chartHistogramOption backendFormats : mandatoryOptions -- Options that are always available, regardless of the compilation flags. mandatoryOptions :: [OptDescr (Options -> Options)] @@ -170,11 +168,13 @@ "test statistic (mean_diff, var_ratio)" ] -cairoHistogramOption :: OptDescr (Options -> Options) -cairoHistogramOption = - Option ['w'] ["write-histogram"] - (ReqArg (\arg opt -> opt { optWriteHistogram = Just arg}) "FILENAME") - "write a histogram (supported file extensions: pdf, png, ps, and svg)" +chartHistogramOption :: [String] -> OptDescr (Options -> Options) +chartHistogramOption formats = + Option ['w'] ["write-histogram"] + (ReqArg (\arg opt -> opt { optWriteHistogram = Just arg}) "FILENAME") + $ printf "write a histogram (supported file extensions: %s)" formatStr + where + formatStr = concat $ intersperse ", " formats getOptions :: IO (Options, [String]) getOptions = do diff --git a/utils/approx-rand-test.hs b/utils/approx-rand-test.hs --- a/utils/approx-rand-test.hs +++ b/utils/approx-rand-test.hs @@ -13,6 +13,7 @@ import Control.Monad (liftM, when) import Control.Monad.Mersenne.Random (evalRandom) +import Data.List (intersperse) import qualified Data.Vector.Generic as VG import qualified Data.Vector.Unboxed as V import Data.Word (Word64) @@ -25,7 +26,7 @@ import System.Random.Mersenne.Pure64 (PureMT, newPureMT, pureMT) import Text.Printf (printf) -import CairoHistogram +import ChartHistogram import SampleIO import TextHistogram @@ -127,10 +128,7 @@ options :: [OptDescr (Options -> Options)] options = - if hasCairoHistograms then - cairoHistogramOption : mandatoryOptions - else - mandatoryOptions + chartHistogramOption backendFormats : mandatoryOptions mandatoryOptions :: [OptDescr (Options -> Options)] mandatoryOptions = @@ -160,11 +158,13 @@ "test statistic (mean_diff, var_ratio)" ] -cairoHistogramOption :: OptDescr (Options -> Options) -cairoHistogramOption = - Option ['w'] ["write-histogram"] - (ReqArg (\arg opt -> opt { optWriteHistogram = Just arg}) "FILENAME") - "write a histogram (supported file extensions: pdf, png, ps, and svg)" +chartHistogramOption :: [String] -> OptDescr (Options -> Options) +chartHistogramOption formats = + Option ['w'] ["write-histogram"] + (ReqArg (\arg opt -> opt { optWriteHistogram = Just arg}) "FILENAME") + $ printf "write a histogram (supported file extensions: %s)" formatStr + where + formatStr = concat $ intersperse ", " formats getOptions :: IO (Options, [String]) getOptions = do diff --git a/utils/cairo/CairoHistogram.hs b/utils/cairo/CairoHistogram.hs deleted file mode 100644 --- a/utils/cairo/CairoHistogram.hs +++ /dev/null @@ -1,104 +0,0 @@ -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 diff --git a/utils/cairo/ChartBackend.hs b/utils/cairo/ChartBackend.hs new file mode 100644 --- /dev/null +++ b/utils/cairo/ChartBackend.hs @@ -0,0 +1,23 @@ +module ChartBackend ( + backendFormats, + writeWithBackend +) where + +import Control.Monad (void) +import qualified Graphics.Rendering.Chart as Chart +import qualified Graphics.Rendering.Chart.Backend.Cairo as CairoChart +import qualified System.FilePath.Posix as FP +import System.IO (hPutStrLn, stderr) + +backendFormats :: [String] +backendFormats = ["pdf", "png", "ps", "svg"] + +writeWithBackend :: Chart.Renderable () -> FP.FilePath -> IO () +writeWithBackend renderable path = + case snd $ FP.splitExtension path of + ".pdf" -> CairoChart.renderableToPDFFile renderable 800 600 path + ".png" -> void $ CairoChart.renderableToPNGFile renderable 800 600 path + ".ps" -> CairoChart.renderableToPSFile renderable 800 600 path + ".svg" -> CairoChart.renderableToSVGFile renderable 800 600 path + _ -> hPutStrLn stderr "Unknown output format!" + diff --git a/utils/diagrams/ChartBackend.hs b/utils/diagrams/ChartBackend.hs new file mode 100644 --- /dev/null +++ b/utils/diagrams/ChartBackend.hs @@ -0,0 +1,30 @@ +module ChartBackend ( + backendFormats, + writeWithBackend +) where + +import Control.Monad (void) +import qualified Graphics.Rendering.Chart as Chart +import qualified Graphics.Rendering.Chart.Backend.Diagrams as DiagramsChart +import qualified System.FilePath.Posix as FP +import System.IO (hPutStrLn, stderr) + +backendFormats :: [String] +backendFormats = ["eps", "svg"] + +type RenderFunction a = Chart.Renderable a -> Double -> Double -> FilePath -> + IO (Chart.PickFn a) + +renderFunctions :: [(String, RenderFunction a)] +renderFunctions = + [ (".eps", DiagramsChart.renderableToEPSFile), + (".svg", DiagramsChart.renderableToSVGFile) ] + + +writeWithBackend :: Chart.Renderable () -> FP.FilePath -> IO () +writeWithBackend renderable path = + case lookup (snd $ FP.splitExtension path) renderFunctions of + Just f -> void $ f renderable 800 600 path + Nothing -> + hPutStrLn stderr "Unknown output format!" + diff --git a/utils/nocairo/CairoHistogram.hs b/utils/nocairo/CairoHistogram.hs deleted file mode 100644 --- a/utils/nocairo/CairoHistogram.hs +++ /dev/null @@ -1,15 +0,0 @@ -module CairoHistogram ( - hasCairoHistograms, - writeHistogram -) where - -import System.IO (hPutStrLn, stderr) - -hasCairoHistograms :: Bool -hasCairoHistograms = False - --- Stub function, for when we did not compile with Cairo support. -writeHistogram :: a -> Int -> b -> c -> IO () -writeHistogram _ _ _ _ = do - hPutStrLn stderr "This program was built without Cairo support, cannot make a histogram." -