amby 0.3.1 → 0.3.2

raw patch · 16 files changed

+1670/−113 lines, 16 filesdep +bytestringdep +cassavadep +containersdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, cassava, containers, datasets, extra, foldl, text

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• amby.cabal +32/−9
• bench/Bench.hs +7/−0
• data/seaborn_tips.csv +245/−0
• src/Amby.hs +5/−1
• src/Amby/BoxPlot.hs +276/−0
• src/Amby/Categorical.hs +186/−0
• src/Amby/Compatibility/HistogramPlot.hs +4/−0
• src/Amby/Display.hs +4/−2
• src/Amby/FactorPlot.hs +185/−0
• src/Amby/Numeric.hs +7/−26
• src/Amby/Plot.hs +83/−51
• src/Amby/Style.hs +18/−2
• src/Amby/Theme.hs +161/−7
• src/Amby/Types.hs +248/−15
• src/Amby/Util.hs +207/−0
• test/Spec.hs +2/−0

@@ -1,5 +1,5 @@ name:                amby-version:             0.3.1+version:             0.3.2 synopsis:            Statistical data visualization description:         <<https://travis-ci.org/jsermeno/amby.svg?branch=master>>                      <<https://img.shields.io/badge/language-Haskell-blue.svg>>@@ -28,26 +28,35 @@ category:            Graphics build-type:          Simple cabal-version:       >=1.10-tested-with:         GHC==8.0.1, GHC==7.10.3, GHC==7.10.2+tested-with:         GHC==8.0.1, GHC==7.10.3+Data-files:          data/seaborn_tips.csv  library   hs-source-dirs:      src   exposed-modules:     Amby-  other-modules:       Amby.Types-                     , Amby.Style-                     , Amby.Theme-                     , Amby.Numeric-                     , Amby.Plot-                     , Amby.Display+  other-modules:       Amby.BoxPlot+                     , Amby.Categorical                      , Amby.Compatibility.HistogramPlot                      , Amby.Compatibility.HistogramNumeric+                     , Amby.Display+                     , Amby.FactorPlot+                     , Amby.Numeric+                     , Amby.Plot+                     , Amby.Style+                     , Amby.Theme+                     , Amby.Types+                     , Amby.Util+                     , Paths_amby   build-depends:       base >= 4.7 && < 5                      , data-default-class                      , Chart-cairo                      , Chart-diagrams                      , Chart+                     , text                      , vector                      , vector-algorithms+                     , containers+                     , extra                      , statistics                      , colour                      , scientific@@ -58,9 +67,14 @@                      , process                      , exceptions                      , data-default+                     , mwc-random+                     , foldl+                     , datasets+                     , cassava+                     , bytestring+                      -- 'Lens' package used as dependency of 'Chart'                      , lens-                     , mwc-random   ghc-options:         -Wall -fno-warn-orphans   default-language:    Haskell2010 @@ -75,6 +89,15 @@                      , tasty-hunit                      , vector   ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++benchmark amby-bench+  type:                exitcode-stdio-1.0+  hs-source-dirs:      bench+  main-is:             Bench.hs+  build-depends:       base+                     , amby+                     , statistics   default-language:    Haskell2010  source-repository head

@@ -0,0 +1,7 @@+import qualified Statistics.Distribution.Normal as Stats+import qualified Amby as Am++main :: IO ()+main = do+  z <- Am.random Stats.standard 10000+  Am.save $ Am.rugPlot' z

@@ -0,0 +1,245 @@+"total_bill","tip","sex","smoker","day","time","size"+16.99,1.01,"Female","No","Sun","Dinner",2+10.34,1.66,"Male","No","Sun","Dinner",3+21.01,3.5,"Male","No","Sun","Dinner",3+23.68,3.31,"Male","No","Sun","Dinner",2+24.59,3.61,"Female","No","Sun","Dinner",4+25.29,4.71,"Male","No","Sun","Dinner",4+8.77,2,"Male","No","Sun","Dinner",2+26.88,3.12,"Male","No","Sun","Dinner",4+15.04,1.96,"Male","No","Sun","Dinner",2+14.78,3.23,"Male","No","Sun","Dinner",2+10.27,1.71,"Male","No","Sun","Dinner",2+35.26,5,"Female","No","Sun","Dinner",4+15.42,1.57,"Male","No","Sun","Dinner",2+18.43,3,"Male","No","Sun","Dinner",4+14.83,3.02,"Female","No","Sun","Dinner",2+21.58,3.92,"Male","No","Sun","Dinner",2+10.33,1.67,"Female","No","Sun","Dinner",3+16.29,3.71,"Male","No","Sun","Dinner",3+16.97,3.5,"Female","No","Sun","Dinner",3+20.65,3.35,"Male","No","Sat","Dinner",3+17.92,4.08,"Male","No","Sat","Dinner",2+20.29,2.75,"Female","No","Sat","Dinner",2+15.77,2.23,"Female","No","Sat","Dinner",2+39.42,7.58,"Male","No","Sat","Dinner",4+19.82,3.18,"Male","No","Sat","Dinner",2+17.81,2.34,"Male","No","Sat","Dinner",4+13.37,2,"Male","No","Sat","Dinner",2+12.69,2,"Male","No","Sat","Dinner",2+21.7,4.3,"Male","No","Sat","Dinner",2+19.65,3,"Female","No","Sat","Dinner",2+9.55,1.45,"Male","No","Sat","Dinner",2+18.35,2.5,"Male","No","Sat","Dinner",4+15.06,3,"Female","No","Sat","Dinner",2+20.69,2.45,"Female","No","Sat","Dinner",4+17.78,3.27,"Male","No","Sat","Dinner",2+24.06,3.6,"Male","No","Sat","Dinner",3+16.31,2,"Male","No","Sat","Dinner",3+16.93,3.07,"Female","No","Sat","Dinner",3+18.69,2.31,"Male","No","Sat","Dinner",3+31.27,5,"Male","No","Sat","Dinner",3+16.04,2.24,"Male","No","Sat","Dinner",3+17.46,2.54,"Male","No","Sun","Dinner",2+13.94,3.06,"Male","No","Sun","Dinner",2+9.68,1.32,"Male","No","Sun","Dinner",2+30.4,5.6,"Male","No","Sun","Dinner",4+18.29,3,"Male","No","Sun","Dinner",2+22.23,5,"Male","No","Sun","Dinner",2+32.4,6,"Male","No","Sun","Dinner",4+28.55,2.05,"Male","No","Sun","Dinner",3+18.04,3,"Male","No","Sun","Dinner",2+12.54,2.5,"Male","No","Sun","Dinner",2+10.29,2.6,"Female","No","Sun","Dinner",2+34.81,5.2,"Female","No","Sun","Dinner",4+9.94,1.56,"Male","No","Sun","Dinner",2+25.56,4.34,"Male","No","Sun","Dinner",4+19.49,3.51,"Male","No","Sun","Dinner",2+38.01,3,"Male","Yes","Sat","Dinner",4+26.41,1.5,"Female","No","Sat","Dinner",2+11.24,1.76,"Male","Yes","Sat","Dinner",2+48.27,6.73,"Male","No","Sat","Dinner",4+20.29,3.21,"Male","Yes","Sat","Dinner",2+13.81,2,"Male","Yes","Sat","Dinner",2+11.02,1.98,"Male","Yes","Sat","Dinner",2+18.29,3.76,"Male","Yes","Sat","Dinner",4+17.59,2.64,"Male","No","Sat","Dinner",3+20.08,3.15,"Male","No","Sat","Dinner",3+16.45,2.47,"Female","No","Sat","Dinner",2+3.07,1,"Female","Yes","Sat","Dinner",1+20.23,2.01,"Male","No","Sat","Dinner",2+15.01,2.09,"Male","Yes","Sat","Dinner",2+12.02,1.97,"Male","No","Sat","Dinner",2+17.07,3,"Female","No","Sat","Dinner",3+26.86,3.14,"Female","Yes","Sat","Dinner",2+25.28,5,"Female","Yes","Sat","Dinner",2+14.73,2.2,"Female","No","Sat","Dinner",2+10.51,1.25,"Male","No","Sat","Dinner",2+17.92,3.08,"Male","Yes","Sat","Dinner",2+27.2,4,"Male","No","Thur","Lunch",4+22.76,3,"Male","No","Thur","Lunch",2+17.29,2.71,"Male","No","Thur","Lunch",2+19.44,3,"Male","Yes","Thur","Lunch",2+16.66,3.4,"Male","No","Thur","Lunch",2+10.07,1.83,"Female","No","Thur","Lunch",1+32.68,5,"Male","Yes","Thur","Lunch",2+15.98,2.03,"Male","No","Thur","Lunch",2+34.83,5.17,"Female","No","Thur","Lunch",4+13.03,2,"Male","No","Thur","Lunch",2+18.28,4,"Male","No","Thur","Lunch",2+24.71,5.85,"Male","No","Thur","Lunch",2+21.16,3,"Male","No","Thur","Lunch",2+28.97,3,"Male","Yes","Fri","Dinner",2+22.49,3.5,"Male","No","Fri","Dinner",2+5.75,1,"Female","Yes","Fri","Dinner",2+16.32,4.3,"Female","Yes","Fri","Dinner",2+22.75,3.25,"Female","No","Fri","Dinner",2+40.17,4.73,"Male","Yes","Fri","Dinner",4+27.28,4,"Male","Yes","Fri","Dinner",2+12.03,1.5,"Male","Yes","Fri","Dinner",2+21.01,3,"Male","Yes","Fri","Dinner",2+12.46,1.5,"Male","No","Fri","Dinner",2+11.35,2.5,"Female","Yes","Fri","Dinner",2+15.38,3,"Female","Yes","Fri","Dinner",2+44.3,2.5,"Female","Yes","Sat","Dinner",3+22.42,3.48,"Female","Yes","Sat","Dinner",2+20.92,4.08,"Female","No","Sat","Dinner",2+15.36,1.64,"Male","Yes","Sat","Dinner",2+20.49,4.06,"Male","Yes","Sat","Dinner",2+25.21,4.29,"Male","Yes","Sat","Dinner",2+18.24,3.76,"Male","No","Sat","Dinner",2+14.31,4,"Female","Yes","Sat","Dinner",2+14,3,"Male","No","Sat","Dinner",2+7.25,1,"Female","No","Sat","Dinner",1+38.07,4,"Male","No","Sun","Dinner",3+23.95,2.55,"Male","No","Sun","Dinner",2+25.71,4,"Female","No","Sun","Dinner",3+17.31,3.5,"Female","No","Sun","Dinner",2+29.93,5.07,"Male","No","Sun","Dinner",4+10.65,1.5,"Female","No","Thur","Lunch",2+12.43,1.8,"Female","No","Thur","Lunch",2+24.08,2.92,"Female","No","Thur","Lunch",4+11.69,2.31,"Male","No","Thur","Lunch",2+13.42,1.68,"Female","No","Thur","Lunch",2+14.26,2.5,"Male","No","Thur","Lunch",2+15.95,2,"Male","No","Thur","Lunch",2+12.48,2.52,"Female","No","Thur","Lunch",2+29.8,4.2,"Female","No","Thur","Lunch",6+8.52,1.48,"Male","No","Thur","Lunch",2+14.52,2,"Female","No","Thur","Lunch",2+11.38,2,"Female","No","Thur","Lunch",2+22.82,2.18,"Male","No","Thur","Lunch",3+19.08,1.5,"Male","No","Thur","Lunch",2+20.27,2.83,"Female","No","Thur","Lunch",2+11.17,1.5,"Female","No","Thur","Lunch",2+12.26,2,"Female","No","Thur","Lunch",2+18.26,3.25,"Female","No","Thur","Lunch",2+8.51,1.25,"Female","No","Thur","Lunch",2+10.33,2,"Female","No","Thur","Lunch",2+14.15,2,"Female","No","Thur","Lunch",2+16,2,"Male","Yes","Thur","Lunch",2+13.16,2.75,"Female","No","Thur","Lunch",2+17.47,3.5,"Female","No","Thur","Lunch",2+34.3,6.7,"Male","No","Thur","Lunch",6+41.19,5,"Male","No","Thur","Lunch",5+27.05,5,"Female","No","Thur","Lunch",6+16.43,2.3,"Female","No","Thur","Lunch",2+8.35,1.5,"Female","No","Thur","Lunch",2+18.64,1.36,"Female","No","Thur","Lunch",3+11.87,1.63,"Female","No","Thur","Lunch",2+9.78,1.73,"Male","No","Thur","Lunch",2+7.51,2,"Male","No","Thur","Lunch",2+14.07,2.5,"Male","No","Sun","Dinner",2+13.13,2,"Male","No","Sun","Dinner",2+17.26,2.74,"Male","No","Sun","Dinner",3+24.55,2,"Male","No","Sun","Dinner",4+19.77,2,"Male","No","Sun","Dinner",4+29.85,5.14,"Female","No","Sun","Dinner",5+48.17,5,"Male","No","Sun","Dinner",6+25,3.75,"Female","No","Sun","Dinner",4+13.39,2.61,"Female","No","Sun","Dinner",2+16.49,2,"Male","No","Sun","Dinner",4+21.5,3.5,"Male","No","Sun","Dinner",4+12.66,2.5,"Male","No","Sun","Dinner",2+16.21,2,"Female","No","Sun","Dinner",3+13.81,2,"Male","No","Sun","Dinner",2+17.51,3,"Female","Yes","Sun","Dinner",2+24.52,3.48,"Male","No","Sun","Dinner",3+20.76,2.24,"Male","No","Sun","Dinner",2+31.71,4.5,"Male","No","Sun","Dinner",4+10.59,1.61,"Female","Yes","Sat","Dinner",2+10.63,2,"Female","Yes","Sat","Dinner",2+50.81,10,"Male","Yes","Sat","Dinner",3+15.81,3.16,"Male","Yes","Sat","Dinner",2+7.25,5.15,"Male","Yes","Sun","Dinner",2+31.85,3.18,"Male","Yes","Sun","Dinner",2+16.82,4,"Male","Yes","Sun","Dinner",2+32.9,3.11,"Male","Yes","Sun","Dinner",2+17.89,2,"Male","Yes","Sun","Dinner",2+14.48,2,"Male","Yes","Sun","Dinner",2+9.6,4,"Female","Yes","Sun","Dinner",2+34.63,3.55,"Male","Yes","Sun","Dinner",2+34.65,3.68,"Male","Yes","Sun","Dinner",4+23.33,5.65,"Male","Yes","Sun","Dinner",2+45.35,3.5,"Male","Yes","Sun","Dinner",3+23.17,6.5,"Male","Yes","Sun","Dinner",4+40.55,3,"Male","Yes","Sun","Dinner",2+20.69,5,"Male","No","Sun","Dinner",5+20.9,3.5,"Female","Yes","Sun","Dinner",3+30.46,2,"Male","Yes","Sun","Dinner",5+18.15,3.5,"Female","Yes","Sun","Dinner",3+23.1,4,"Male","Yes","Sun","Dinner",3+15.69,1.5,"Male","Yes","Sun","Dinner",2+19.81,4.19,"Female","Yes","Thur","Lunch",2+28.44,2.56,"Male","Yes","Thur","Lunch",2+15.48,2.02,"Male","Yes","Thur","Lunch",2+16.58,4,"Male","Yes","Thur","Lunch",2+7.56,1.44,"Male","No","Thur","Lunch",2+10.34,2,"Male","Yes","Thur","Lunch",2+43.11,5,"Female","Yes","Thur","Lunch",4+13,2,"Female","Yes","Thur","Lunch",2+13.51,2,"Male","Yes","Thur","Lunch",2+18.71,4,"Male","Yes","Thur","Lunch",3+12.74,2.01,"Female","Yes","Thur","Lunch",2+13,2,"Female","Yes","Thur","Lunch",2+16.4,2.5,"Female","Yes","Thur","Lunch",2+20.53,4,"Male","Yes","Thur","Lunch",4+16.47,3.23,"Female","Yes","Thur","Lunch",3+26.59,3.41,"Male","Yes","Sat","Dinner",3+38.73,3,"Male","Yes","Sat","Dinner",4+24.27,2.03,"Male","Yes","Sat","Dinner",2+12.76,2.23,"Female","Yes","Sat","Dinner",2+30.06,2,"Male","Yes","Sat","Dinner",3+25.89,5.16,"Male","Yes","Sat","Dinner",4+48.33,9,"Male","No","Sat","Dinner",4+13.27,2.5,"Female","Yes","Sat","Dinner",2+28.17,6.5,"Female","Yes","Sat","Dinner",3+12.9,1.1,"Female","Yes","Sat","Dinner",2+28.15,3,"Male","Yes","Sat","Dinner",5+11.59,1.5,"Male","Yes","Sat","Dinner",2+7.74,1.44,"Male","Yes","Sat","Dinner",2+30.14,3.09,"Female","Yes","Sat","Dinner",4+12.16,2.2,"Male","Yes","Fri","Lunch",2+13.42,3.48,"Female","Yes","Fri","Lunch",2+8.58,1.92,"Male","Yes","Fri","Lunch",1+15.98,3,"Female","No","Fri","Lunch",3+13.42,1.58,"Male","Yes","Fri","Lunch",2+16.27,2.5,"Female","Yes","Fri","Lunch",2+10.09,2,"Female","Yes","Fri","Lunch",2+20.45,3,"Male","No","Sat","Dinner",4+13.28,2.72,"Male","No","Sat","Dinner",2+22.12,2.88,"Female","Yes","Sat","Dinner",2+24.01,2,"Male","Yes","Sat","Dinner",4+15.69,3,"Male","Yes","Sat","Dinner",3+11.61,3.39,"Male","No","Sat","Dinner",2+10.77,1.47,"Male","No","Sat","Dinner",2+15.53,3,"Male","Yes","Sat","Dinner",2+10.07,1.25,"Male","No","Sat","Dinner",2+12.6,1,"Male","Yes","Sat","Dinner",2+32.83,1.17,"Male","Yes","Sat","Dinner",2+35.83,4.67,"Female","No","Sat","Dinner",3+29.03,5.92,"Male","No","Sat","Dinner",3+27.18,2,"Female","Yes","Sat","Dinner",2+22.67,2,"Male","Yes","Sat","Dinner",2+17.82,1.75,"Male","No","Sat","Dinner",2+18.78,3,"Female","No","Thur","Dinner",2

@@ -7,10 +7,12 @@ module Amby   (   -- * Modules-    module Amby.Theme+    module Amby.Categorical+  , module Amby.Theme   , module Amby.Numeric   , module Amby.Types   , module Amby.Plot+  , module Amby.Util    -- * Lens operators   , (.=)@@ -18,8 +20,10 @@  import Graphics.Rendering.Chart.Easy ((.=)) +import Amby.Categorical import Amby.Types import Amby.Numeric import Amby.Theme import Amby.Plot import Amby.Display ()+import Amby.Util

@@ -0,0 +1,276 @@+{-# LANGUAGE FlexibleContexts #-}+module Amby.BoxPlot+  ( boxPlotVec+  , boxPlotVec'+  ) where++import Control.Arrow ((***))+import Control.Monad+import Control.Monad.State+import qualified Data.List as L+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U++import Control.Lens+import Data.Colour (transparent, opaque)+import qualified Data.Colour as Colour+import Data.Colour.SRGB (sRGB)+import Graphics.Rendering.Chart.Easy (Layout, EC)+import Graphics.Rendering.Chart.Easy as Chart++import Amby.Categorical+import Amby.Types+import Amby.Theme+import Amby.Style (categoricalAxisData, scaledAxisCustom)+import Amby.Numeric++boxPlotVec :: (G.Vector v Double, G.Vector v (Double, Double))+           => v Double -> State BoxPlotOpts () -> AmbyChart ()+boxPlotVec xs optsState = do+    layout <- takeLayout+    putLayout $ do+      layout+      palette <- Chart.liftCState $ do+        cs <- use Chart.colors+        return cs+      drawBoxPlot palette xs opts+  where+    opts = execState optsState def++boxPlotVec' :: (G.Vector v Double, G.Vector v (Double, Double))+            => v Double -> AmbyChart ()+boxPlotVec' xs = boxPlotVec xs $ return ()++drawBoxPlot :: (G.Vector v Double, G.Vector v (Double, Double))+            => Palette -> v Double -> BoxPlotOpts+            -> EC (Layout Double Double) ()+drawBoxPlot palette xs opts+  -- Boxplot for univariate distribution+  | opts ^. facL == DefaultCategory = do+    drawUnivariate (head catPalette) lineGray startPos barHeight xs "" opts++    -- Axis changes+    -- TODO: Replace manual axis ranges with better automatic scaling+    axisGetter . Chart.laxis_generate .= scaledAxisCustom def+      ( mkAxisTuple+        (startPos - (barHeight / 2) - (1/8) * barHeight)+        (startPos + (barHeight / 2) + (1/8) * barHeight)+      )+    axisGetter . Chart.laxis_override .= categoricalAxisData []+    axisGetter . Chart.laxis_title .= (opts ^. facLabel)+    datAxisGetter . Chart.laxis_title .= (opts ^. datLabel)+    -- TODO: Chart does not give a way to add a title to a legend, or+    -- to change positon of legend++  -- Boxplot against categorical data+  | opts ^. hueL == DefaultCategory = do+    -- group data+    let groups = groupByCategory (G.toList xs) (opts ^. facL)++    -- draw data+    forM_ (zip3 groups catPalette [0..]) $ \(g, c, i) ->+      drawUnivariate c lineGray (facMidPos i) barHeight (U.fromList g) "" opts++    -- Axis changes+    axisGetter . Chart.laxis_generate .= scaledAxisCustom def+      ( mkAxisTuple+        (facMidPos (nFacs - 1) - facMargin - (barHeight / 2))+        (startPos + (barHeight / 2) + facMargin)+      )+    axisGetter . Chart.laxis_override .= categoricalAxisData facLabelPos+    axisGetter . Chart.laxis_title .= (opts ^. facLabel)+    datAxisGetter . Chart.laxis_title .= (opts ^. datLabel)++  -- Boxplot against two categories+  | otherwise = do+    -- group data+    let groups = groupByCategory (G.toList xs) facs+        hueGroups = groupByCategory (getCategoryList hues) facs++    -- draw data+    forM_ (zip3 groups hueGroups [0..]) $ \(facData, hueData, i) ->+      forM_ (zip3 (getCategoryOrder hues) catPalette [0..]) $ \(hueVal, c, j) -> do+        let hueMask = map (== hueVal) hueData+            drawData = U.fromList $ filterMask facData hueMask+            l = if i == 0 && (opts ^. hueLegend)+              then getCategoryLabelFromVal hues hueVal+              else ""+        drawUnivariate c lineGray (hueMidPos i j) barHeight drawData l opts++    -- Axis changes+    axisGetter . Chart.laxis_generate .= scaledAxisCustom def+      ( mkAxisTuple+        (hueMidPos (nFacs - 1) (nHues - 1) - (barHeight / 2) - hueMargin)+        (startPos + (barHeight / 2) + hueMargin)+      )+    axisGetter . Chart.laxis_override .= categoricalAxisData hueLabelPos+    axisGetter . Chart.laxis_title .= (opts ^. facLabel)+    datAxisGetter . Chart.laxis_title .= (opts ^. datLabel)+  where+    facs = opts ^. facL+    hues = opts ^. hueL+    facLabels = getCategoryLabels facs+    nFacs = catSize facs+    nHues = catSize hues+    cUser = opts ^. color+    sat = opts ^. saturation+    (catPalette, lineGray) = getCategoricalPalette palette cUser nFacs nHues sat++    mkAxisTuple x y = if opts ^. axis == XAxis+      then (x, y)+      else (abs y, abs x)+    mkLabelTuple x s = if opts ^. axis == XAxis+      then (x, s)+      else (abs x, s)++    barHeight = 1.0+    startPos = -1.0++    facMidSpacing = barHeight / 4.0+    facMidPos :: Int -> Double+    facMidPos i = startPos - (barHeight + facMidSpacing) * fromIntegral i+    facMargin = barHeight / 4.0+    facLabelPos = if opts ^. facLegend+      then zipWith (\i l -> mkLabelTuple (facMidPos i) l) [0..] facLabels+      else []++    hueMidSpacing = barHeight / 2.0+    hueMargin = barHeight / 2.0+    hueCatSize = fromIntegral nHues * barHeight+    hueSpan = (fromIntegral (nHues - 1) * barHeight) / 2+    hueMidPos :: Int -> Int -> Double+    hueMidPos i j =+        startPos+      - (fromIntegral j * barHeight)+      - (fromIntegral i * (hueCatSize + hueMidSpacing))+    hueLabelMidPos i = startPos - hueSpan - i * (hueCatSize + hueMidSpacing)+    hueLabelPos = if opts ^. facLegend+      then zipWith (\i l -> mkLabelTuple (hueLabelMidPos i) l) [0..] facLabels+      else []++    axisGetter = if (opts ^. axis) == XAxis+      then Chart.layout_y_axis+      else Chart.layout_x_axis+    datAxisGetter = if (opts ^. axis) == XAxis+      then Chart.layout_x_axis+      else Chart.layout_y_axis++drawUnivariate :: (G.Vector v Double, G.Vector v (Double, Double))+               => AlphaColour Double -> AlphaColour Double+               -> Double -> Double -> v Double -> String+               -> BoxPlotOpts -> EC (Layout Double Double) ()+drawUnivariate c lineGray midY yHeight xs l opts = do+    Chart.plot $ return $ Chart.Plot+      { _plot_render = if noData then const (return ()) else renderBoxPlot+      , _plot_legend = [(l, renderLabel)]+      , _plot_all_points = if noData then ([], []) else unzip allPoints+      }+    Chart.plot $ Chart.liftEC $ do+      Chart.plot_points_values .= outlierPts+      Chart.plot_points_style . Chart.point_radius .= 4+      Chart.plot_points_style . Chart.point_shape .= Chart.PointShapePolygon 4 True+      Chart.plot_points_style . Chart.point_color .= lineGray+  where+    noData = G.length xs == 0+    whiskLimit = interquartileRange xs * 1.5+    firstQuartile = scoreAtPercentile xs 25+    thirdQuartile = scoreAtPercentile xs 75+    median = scoreAtPercentile xs 50+    startWhiskFoldFn a b = if b < a && b >= firstQuartile - whiskLimit+      then b+      else a+    endWhiskFoldFn a b = if b > a && b <= thirdQuartile + whiskLimit+      then b+      else a+    startWhisk = G.foldl' startWhiskFoldFn firstQuartile xs+    endWhisk = G.foldl' endWhiskFoldFn thirdQuartile xs+    outliers = G.filter (\x -> x < startWhisk || x > endWhisk) xs+    pt x y = if opts ^. axis == XAxis then (x, y) else (-y, x)+    yt = midY + (yHeight / 2)+    yb = midY - (yHeight / 2)+    yt4 = midY + (yHeight / 4)+    yb4 = midY - (yHeight / 4)++    outlierPts = G.toList $ G.map (\x -> pt x midY) outliers++    allPoints =+      [ pt startWhisk yt4, pt startWhisk yb4, pt startWhisk midY+      , pt firstQuartile midY+      , pt firstQuartile yt, pt firstQuartile yb, pt median yt, pt median yb+      , pt thirdQuartile yt, pt thirdQuartile yb, pt thirdQuartile midY+      , pt endWhisk midY, pt endWhisk yt4, pt endWhisk yb4+      ] ++ outlierPts++    renderLabel r@(Rect _ _) = do+        Chart.withFillStyle fillStyle $ do+          Chart.alignFillPath (Chart.rectPath r) >>= Chart.fillPath+        Chart.withLineStyle lineStyle $ do+          Chart.alignStrokePath (Chart.rectPath r) >>= Chart.strokePath+      where+        lineStyle = def+          & Chart.line_width .~ (opts ^. linewidth) / 2+          & Chart.line_color .~ lineGray+        fillStyle = def & Chart.fill_color .~ c++    renderBoxPlot pmap = do+      Chart.withFillStyle fillStyle $ do+        Chart.alignFillPath (plotBox pmap) >>= Chart.fillPath+      Chart.withLineStyle lineStyle $ do+        Chart.alignStrokePath (plotWhiskers pmap) >>= Chart.strokePath+        Chart.alignStrokePath (plotBox pmap) >>= Chart.strokePath+      where+        lineStyle = def+          & Chart.line_width .~ (opts ^. linewidth)+          & Chart.line_color .~ lineGray+        fillStyle = def+          & Chart.fill_color .~ Colour.dissolve 0.8 c++    plotWhiskers pmap =+        Chart.MoveTo (ptr startWhisk yt4)+      $ Chart.LineTo (ptr startWhisk yb4)+      $ Chart.MoveTo (ptr startWhisk midY)+      $ Chart.LineTo (ptr firstQuartile midY)+      $ Chart.MoveTo (ptr thirdQuartile midY)+      $ Chart.LineTo (ptr endWhisk midY)+      $ Chart.MoveTo (ptr endWhisk yt4)+      $ Chart.LineTo (ptr endWhisk yb4)+      $ Chart.End+      where+        ptr x y = pmap $ join (***) Chart.LValue $ pt x y++    plotBox pmap = if firstQuartile == thirdQuartile+      then+          Chart.MoveTo (ptr firstQuartile yt)+        $ Chart.LineTo (ptr firstQuartile yb)+        $ Chart.End+      else+          Chart.MoveTo (ptr median yt)+        $ Chart.LineTo (ptr firstQuartile yt)+        $ Chart.LineTo (ptr firstQuartile yb)+        $ Chart.LineTo (ptr median yb)+        $ Chart.LineTo (ptr median yt)+        $ Chart.LineTo (ptr thirdQuartile yt)+        $ Chart.LineTo (ptr thirdQuartile yb)+        $ Chart.LineTo (ptr median yb)+        $ Chart.End+      where+        ptr x y = pmap $ join (***) Chart.LValue $ pt x y++getCategoricalPalette :: Palette -> AmbyColor -> Int -> Int -> Double+                      -> (Palette, AlphaColour Double)+getCategoricalPalette palette cUser n nHues sat = (desatColors, lineGray)+  where+    cUserAlpha = toColour cUser transparent+    effN = if nHues > 1 then nHues else n+    iniColors+      -- Passing specific color+      | cUser /= DefaultColor && nHues <= 1 = replicate effN cUserAlpha+      | cUser /= DefaultColor = lightPalette cUserAlpha nHues++      -- Using default colors+      | (length . L.nub . take effN) palette < effN =+        huslPalette n Nothing Nothing (Just 0.7)+      | otherwise = take effN palette+    desatColors = map (desaturate sat) iniColors+    l = (* 0.6) . minimum $ map ((^. _3) . alphaToHsl) desatColors+    lineGray = opaque $ sRGB l l l

@@ -0,0 +1,186 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+module Amby.Categorical+  (+  -- * Types+    Category(..)++  -- * Methods+  , toCat+  , toCatOrdered+  , changeOrder+  , getCategoryLabels+  , getCategoryLabelFromVal+  , getCategoryOrder+  , getCategoryList+  , catSize+  , catValsLength+  , filterMask+  , groupByCategory+  , groupCategoryBy+  , getGroupAt+  , getGroupWithFilterMask+  ) where++import qualified Data.Foldable as Foldable+import qualified Data.List.Extra as L+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Tuple (swap)++import Control.Lens+import Safe++data Category = Category+  { _categoryOrder :: [Int]+  , _categoryValues :: [Int]+  , _categoryTable :: Map Int String+  , _categoryGroups :: [[Int]]+  }+  | DefaultCategory+  deriving (Show, Eq)++-- | Get list of category labels in order.+getCategoryLabels :: Category -> [String]+getCategoryLabels c = map lookupLabel intOrder+  where+    labelMap = _categoryTable c+    intOrder = _categoryOrder c+    lookupLabel i = case Map.lookup i labelMap of+      Just a -> a+      Nothing -> modErr "getCategoryLabels" "Value does not exist in category"++getCategoryLabelFromVal :: Category -> Int -> String+getCategoryLabelFromVal c i = case Map.lookup i (_categoryTable c) of+  Just a -> a+  Nothing -> modErr "getCategoryLabelFromVal" "Value does not exist in category"++getCategoryList :: Category -> [Int]+getCategoryList = _categoryValues++getCategoryOrder :: Category -> [Int]+getCategoryOrder = _categoryOrder++-- | Group by category.+--+-- Examples:+--+-- >>> groupByCategory [1..5] (toCat [1, 1, 3, 2, 4])+-- [[1,2],[3],[4],[5]]+groupByCategory :: [a] -> Category -> [[a]]+groupByCategory xs cat+  | length xs /= length (getCategoryList cat) =+    modErr "groupByCategory" "Can only group data with equivalent sized category"+  | otherwise =+      map (map fst)+    $ L.groupSortOn snd+    $ zip xs (_categoryValues cat)++-- | Group category internally+groupCategoryBy :: Category -> Category -> Category+groupCategoryBy cat grouper = cat+    { _categoryGroups = groupByCategory dat grouper+    }+  where+    dat = _categoryValues cat++getGroupAt :: Category -> Int -> Category+getGroupAt cat i = cat+    { _categoryValues = groupValues+    }+  where+    groupValues = getGroupValues cat i++getGroupWithFilterMask :: Category -> Int -> [Bool] -> Category+getGroupWithFilterMask cat i mask = cat+    { _categoryValues = filterMask groupValues mask+    }+  where+    groupValues = getGroupValues cat i++getGroupValues :: Category -> Int -> [Int]+getGroupValues cat i = groupValues+  where+    dat = _categoryGroups cat+    groupValues = case dat `atMay` i of+      Just a -> a+      Nothing -> modErr "getGroupAt" ("No group at index: " ++ show i)++-- | Filter list based on another equal sized list of bools.+--+-- Examples:+--+-- >>>  filterMask [1..5] [True, False, True, False, False]+-- [1,3]+filterMask :: [a] -> [Bool] -> [a]+filterMask xs ts+  | length xs /= length ts =+    modErr "filterMask" "mask length must match data length."+  | otherwise = (map fst . filter snd . zip xs) ts++-- | Find number of distinct elements in a category.+--+-- Examples:+--+-- >>> catSize $ toCat ["dog", "cat", "dog"]+-- 2+catSize :: Category -> Int+catSize DefaultCategory = 1+catSize cat = Map.size (_categoryTable cat)++-- | Find the number of elements in a category.+catValsLength :: Category -> Int+catValsLength c = length $ getCategoryList c++-- | Convert 'Foldable' into a 'Category'.+toCat :: (Foldable f, Eq a, Show a) => f a -> Category+toCat f = listToCat list order+  where+    list = Foldable.toList f+    order = L.nub list++toCatOrdered :: (Foldable f, Eq a, Show a) => f a -> f a -> Category+toCatOrdered f order = listToCat (Foldable.toList f) (Foldable.toList order)++changeOrder :: (Foldable f, Show a) => Category -> f a -> Category+changeOrder cat order = cat+  { _categoryOrder = newOrder+  }+  where+    currOrder = _categoryOrder cat+    intMap = _categoryTable cat+    nameMap  = (`map` currOrder) $ \i -> case Map.lookup i intMap of+      Nothing -> modErr "changeOrder" "Invalid map key"+      Just a -> (a, i)+    newOrder = (`map` Foldable.toList order) $ \s ->+      case lookup (mkDisplayString s) nameMap of+        Nothing -> modErr "changeOrder" "Invalid string key"+        Just a -> a++listToCat :: (Eq a, Show a) => [a] -> [a] -> Category+listToCat xs order+  | L.length (L.nub order) /= L.length order =+    modErr "listToCat" "Order cannot contain duplicates"+  | otherwise = Category+    { _categoryOrder = map snd orderedPairs+    , _categoryValues = map replaceWithIdx xs+    , _categoryTable = map swap orderedPairs+      & mapped . _2 %~ mkDisplayString+      & Map.fromList+    , _categoryGroups = []+    }+  where+    orderedPairs = zip order [0..]+    replaceWithIdx x = case lookup x orderedPairs of+      Just a -> a+      Nothing -> modErr "listToCat" "No idx created for category value"++mkDisplayString :: Show a => a -> String+mkDisplayString = filter (/= '"') . show++modErr :: String -> String -> a+modErr f err = error+  $ showString "Amby.Container."+  $ showString f+  $ showString ": " err

@@ -1,9 +1,13 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-}+--------------------------------------------+-- TODO: Replace HistogramPlot and HistogramNumeric with optimized versions.+-------------------------------------------- module Amby.Compatibility.HistogramPlot   ( -- * Histograms     PlotHist (..)+  , BackendProgram   , histToPlot   , defaultPlotHist   , defaultFloatPlotHist

@@ -24,7 +24,10 @@ instance {-# OVERLAPPING #-} Display (EC (Layout Double Double) ()) where   display a = saveAndDisplayEC a -saveAndDisplay :: AmbyChart () -> DisplayText+instance {-# OVERLAPPING #-} Display (AmbyGrid ()) where+  display a = saveAndDisplay a++saveAndDisplay :: Saveable s => s -> DisplayText saveAndDisplay chart = saveAndDisplayIO $ do   Plot.save chart @@ -47,4 +50,3 @@         return $ mkDt "Could not find imgcat executable."       | otherwise =         return $ mkDt "Unknown display error."-

@@ -0,0 +1,185 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiWayIf #-}+module Amby.FactorPlot+  ( factorPlotVec+  ) where++import Control.Lens+import Control.Monad.State+import Data.Default (def)+import qualified Data.Vector as V++import qualified Graphics.Rendering.Chart.Grid as Chart+import Safe++import Amby.BoxPlot+import Amby.Categorical+import Amby.Theme+import Amby.Types++factorPlotVec :: V.Vector Double -> State FactorPlotOpts () -> AmbyGrid ()+factorPlotVec xs optsState+  -- Single plot+  | rows == DefaultCategory && cols == DefaultCategory = do+    activeTheme <- takeGridTheme+    ambyChart <- case opts ^. kind of+      Box -> return $ do+        theme activeTheme+        boxPlotVec xs $ do+          facL .= (opts ^. facL)+          hueL .= (opts ^. hueL)+          color .= opts ^. color+          saturation .= opts ^. saturation+          axis .= opts ^. axis+          facLabel .= opts ^. facLabel+          datLabel .= opts ^. datLabel+    setGrid $ chartToGrid ambyChart++  -- Row chart+  | rows /= DefaultCategory && cols == DefaultCategory =+    drawThirdFactor xs rows Chart.aboveN (catSize rows) 1 (opts ^. rowLabel) opts++  -- Col chart+  | rows == DefaultCategory && cols /= DefaultCategory = do+    drawThirdFactor xs cols Chart.besideN 1 (catSize cols) (opts ^. colLabel) opts++  -- Row and col chart+  | otherwise =+    drawFourthFactor xs rows cols opts+  where+    cols = opts ^. colL+    rows = opts ^. rowL+    opts = execState optsState def++drawThirdFactor :: V.Vector Double -> Category+                -> ([ChartGrid] -> ChartGrid) -> Int -> Int -> String+                -> FactorPlotOpts -> AmbyGrid ()+drawThirdFactor xs grouper gridGrouper nRows nCols gLabel opts = do+  let cats = opts ^. facL+      hues = opts ^. hueL+      datGroups = groupByCategory (V.toList xs) grouper+      catGroups = cats `groupCategoryBy` grouper+      hueGroups = hues `groupCategoryBy` grouper+      factorOrder = getCategoryOrder grouper+      plotKind = opts ^. kind+      drawAxis = opts ^. axis+  activeTheme <- takeGridTheme+  setGrid+    $ gridGrouper+    $ (`map` zip factorOrder [0..])+    $ \(factorVal, i) -> do+      let datGroup = case datGroups `atMay` i of+            Just a -> V.fromList a+            Nothing -> modErr "drawThirdFactor" $ "No group at index: " ++ show i+      case plotKind of+        Box -> chartToGrid $ do+          theme activeTheme+          boxPlotVec datGroup $ do+            facL .= catGroups `getGroupAt` i+            hueL .= hueGroups `getGroupAt` i+            facLegend .= if nCols > 1+              then i == 0 || drawAxis == YAxis+              else i == nRows - 1 || drawAxis == XAxis+            hueLegend .= if nCols > 1+              then i == 0+              else i == nRows - 1+            color .= opts ^. color+            saturation .= opts ^. saturation+            axis .= opts ^. axis+            facLabel .=+              if   (drawAxis == XAxis && nCols > 1 && i == 0)+                || (drawAxis == XAxis && nRows > 1)+                || (drawAxis == YAxis && nCols > 1)+                || (drawAxis == YAxis && nRows > 1 && i == nRows - 1)+                then opts ^. facLabel+                else ""+            datLabel .=+              if   (drawAxis == XAxis && nCols > 1)+                || (drawAxis == XAxis && nRows > 1 && i == nRows - 1)+                || (drawAxis == YAxis && nCols > 1 && i == 0)+                || (drawAxis == YAxis && nRows > 1)+                then opts ^. datLabel+                else ""+          title+            $ mkGridLabel gLabel+            ++ getCategoryLabelFromVal grouper factorVal+  gridScale (fromIntegral nCols, fromIntegral nRows)++drawFourthFactor :: V.Vector Double -> Category -> Category -> FactorPlotOpts+                 -> AmbyGrid ()+drawFourthFactor xs rows cols opts = do+    activeTheme <- takeGridTheme+    setGrid+      $ Chart.aboveN+      $ (`map` zip rowOrder [0..])+      $ \rowIdx ->+          Chart.besideN+        $ (`map` zip colOrder [0..]) $ \colIdx ->+          drawGridCell rowIdx colIdx activeTheme+    gridScale (fromIntegral nCols, fromIntegral nRows)+  where+    cats = opts ^. facL+    hues = opts ^. hueL+    datGroups = groupByCategory (V.toList xs) rows+    catGroups = cats `groupCategoryBy` rows+    hueGroups = hues `groupCategoryBy` rows+    colGroups = cols `groupCategoryBy` rows+    rowOrder = getCategoryOrder rows+    colOrder = getCategoryOrder cols+    nRows = length rowOrder+    nCols = length colOrder+    plotKind = opts ^. kind+    rLabel = opts ^. rowLabel+    cLabel = opts ^. colLabel+    drawAxis = opts ^. axis++    drawGridCell :: (Int, Int) -> (Int, Int) -> Theme -> ChartGrid+    drawGridCell (rowVal, i) (colVal, j) activeTheme = do+      let rowColGroup = colGroups `getGroupAt` i+          colMask = map (== colVal) (getCategoryList rowColGroup)+      let rowDatGroup = case datGroups `atMay` i of+            Nothing -> modErr "drawFourthFactor" $ "No group at index: " ++ show i+            Just a -> V.fromList $ filterMask a colMask+          rowCatGroup = getGroupWithFilterMask catGroups i colMask+          rowHueGroup = getGroupWithFilterMask hueGroups i colMask++      case plotKind of+        Box -> chartToGrid $ do+          theme activeTheme+          boxPlotVec rowDatGroup $ do+            facL .= rowCatGroup+            hueL .= rowHueGroup+            facLegend .= if drawAxis == XAxis+              then j == 0+              else i == nRows - 1+            hueLegend .= (j == 0 && i == nRows - 1)+            color .= opts ^. color+            saturation .= opts ^. saturation+            axis .= opts ^. axis+            facLabel .=+              if   (j == 0 && drawAxis == XAxis)+                || (i == nRows - 1 && drawAxis == YAxis)+                then opts ^. facLabel+                else ""+            datLabel .=+              if   (i == nRows - 1 && drawAxis == XAxis)+                || (j == 0 && drawAxis == YAxis)+                then opts ^. datLabel+                else ""+          title+            $ mkGridLabel rLabel+            ++ getCategoryLabelFromVal rows rowVal+            ++ " | "+            ++ mkGridLabel cLabel+            ++ getCategoryLabelFromVal cols colVal++mkGridLabel :: String -> String+mkGridLabel s = if null s+  then s+  else s ++ " = "++modErr :: String -> String -> a+modErr f err = error+  $ showString "Amby.FactorPlot."+  $ showString f+  $ showString ": " err

@@ -23,13 +23,12 @@    ) where -import Data.Vector.Generic ((!)) import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector as V-import qualified Data.Vector.Algorithms.Intro as V  import Statistics.Distribution+import qualified Statistics.Quantile as Stats import System.Random.MWC (withSystemRandom, asGenST)  -- $setup@@ -86,30 +85,11 @@ -- -- >>> scoreAtPercentile a 50 -- 49.5-scoreAtPercentile :: (G.Vector v Double) => v Double -> Double -> Double+scoreAtPercentile :: (G.Vector v Double) => v Double -> Int -> Double scoreAtPercentile xs p-  | n == 0 = modErr "scoreAtPercentile" "Percentile sample size is 0"-  | p < 0 || p > 100 = modErr "scoreAtPercentile" "Percentile must be in [0, 100]"-  | otherwise = (getScore . G.modify V.sort) xs-  where-    n = G.length xs-    idx = (p / 100) * fromIntegral (n - 1)-    i = floor idx-    j = ceiling idx--    isInt :: Double -> Bool-    isInt a = fromIntegral (round a :: Int) == a--    interop :: (G.Vector v Double) => v Double -> Double-    interop vec =-      (vec ! i) * (fromIntegral j - idx) +-      (vec ! j) * (idx - fromIntegral i)--    getScore vec = if isInt idx-      then vec ! i-      else interop vec-{-# SPECIALIZE scoreAtPercentile :: U.Vector Double -> Double -> Double #-}-{-# SPECIALIZE scoreAtPercentile :: V.Vector Double -> Double -> Double #-}+  | G.length xs == 0 =+    modErr "scoreAtPercentile" "Cannot find percentile of empyt list"+  | otherwise = Stats.weightedAvg p 100 xs  -- | Calculate the interquartile range. --@@ -140,4 +120,5 @@ modErr :: String -> String -> a modErr f err = error   $ showString "Amby.Numeric."-  $ showString f err+  $ showString f+  $ showString ": " err

@@ -8,6 +8,7 @@ {-# OPTIONS_GHC -fno-warn-deprecations #-} module Amby.Plot   ( getEC+  , getRenderable   , save   , saveSvg @@ -28,7 +29,7 @@ import Control.Lens import Data.Colour as Colour import Data.Default.Class-import Graphics.Rendering.Chart.Easy (Layout, EC)+import Graphics.Rendering.Chart.Easy (Layout, EC, Renderable, LayoutPick) import qualified Graphics.Rendering.Chart.Easy as Chart import qualified Graphics.Rendering.Chart.Backend.Cairo as Cairo import qualified Graphics.Rendering.Chart.Backend.Diagrams as Diagrams@@ -36,7 +37,9 @@ import qualified Statistics.Sample.KernelDensity.Simple as Stats import qualified Statistics.Sample as Stats +import Amby.BoxPlot import Amby.Compatibility.HistogramPlot+import Amby.FactorPlot import Amby.Numeric import Amby.Theme (toColour) import Amby.Types@@ -47,6 +50,7 @@  instance AmbyContainer (V.Vector Double) where   type Value (V.Vector Double) = Double+   plot = plotVec   plot' = plotVec'   plotEq = plotEqVec@@ -57,9 +61,13 @@   kdePlot' = kdePlotVec'   rugPlot = rugPlotVec   rugPlot' = rugPlotVec'+  boxPlot = boxPlotVec+  boxPlot' = boxPlotVec'+  factorPlot = factorPlotVec  instance AmbyContainer (U.Vector Double) where   type Value (U.Vector Double) = Double+   plot = plotVec   plot' = plotVec'   plotEq = plotEqVec@@ -70,53 +78,46 @@   kdePlot' = kdePlotVec'   rugPlot = rugPlotVec   rugPlot' = rugPlotVec'+  boxPlot = boxPlotVec+  boxPlot' = boxPlotVec'+  factorPlot v = factorPlotVec (G.convert v)  instance (Real a) => AmbyContainer [a] where   type Value [a] = a -  plot :: [a] -> [a] -> State PlotOpts () -> AmbyChart ()   plot x y optsState = plotList vals opts     where       opts = execState optsState def-      vals = L.zipWith (\a b -> (realToFrac a, realToFrac b)) x y--  plot' :: [a] -> [a] -> AmbyChart ()+      vals = L.zipWith realToTuple x y   plot' x y = plot x y $ return () -  plotEq :: [a] -> (a -> a) -> State PlotEqOpts () -> AmbyChart ()   plotEq x fn optsState = plotList vals $ def       & color .~ (opts ^. color)     where       opts = execState optsState def-      vals = L.zipWith (\a b -> (realToFrac a, realToFrac b)) x $ map fn x--  plotEq' :: [a] -> (a -> a) -> AmbyChart ()+      vals = L.zipWith realToTuple x $ map fn x   plotEq' x fn = plotEq x fn $ return () -  distPlot :: [a] -> State DistPlotOpts () -> AmbyChart ()-  distPlot xs optsState = distPlotVec valsVec optsState-    where-      valsVec = (V.map realToFrac . V.fromList) xs--  distPlot' :: [a] -> AmbyChart ()+  distPlot xs optsState = distPlotVec (realToVec xs) optsState   distPlot' xs = distPlot xs $ return () -  kdePlot :: [a] -> State KdePlotOpts () -> AmbyChart ()-  kdePlot xs optsState = kdePlotVec valsVec optsState-    where-      valsVec = (V.map realToFrac . V.fromList) xs--  kdePlot' :: [a] -> AmbyChart ()+  kdePlot xs optsState = kdePlotVec (realToVec xs) optsState   kdePlot' xs = kdePlot xs $ return () -  rugPlot :: [a] -> State RugPlotOpts () -> AmbyChart ()-  rugPlot xs optsState = rugPlotVec valsVec optsState-    where-      valsVec = (V.map realToFrac . V.fromList) xs--  rugPlot' :: [a] -> AmbyChart ()+  rugPlot xs optsState = rugPlotVec (realToVec xs) optsState   rugPlot' xs = rugPlot xs $ return () +  boxPlot xs optsState = boxPlotVec (realToVec xs) optsState+  boxPlot' xs = boxPlot xs $ return ()++  factorPlot xs optsState = factorPlotVec (realToVec xs) optsState++realToVec :: (Real a) => [a] -> V.Vector Double+realToVec = V.map realToFrac . V.fromList++realToTuple :: Real a => a -> a -> (Double, Double)+realToTuple a b = (realToFrac a, realToFrac b)+ -------------------------- -- Generic vec plotters --------------------------@@ -145,11 +146,13 @@            => v Double -> (Double -> Double) -> AmbyChart () plotEqVec' x fn = plotEqVec x fn $ return () -distPlotVec :: (G.Vector v Double) => v Double -> State DistPlotOpts ()+distPlotVec :: (G.Vector v Double, G.Vector v (Double, Double))+            => v Double -> State DistPlotOpts ()             -> AmbyChart () distPlotVec xs optsState = plotDistribution xs $ execState optsState def -distPlotVec' :: (G.Vector v Double) => v Double -> AmbyChart ()+distPlotVec' :: (G.Vector v Double, G.Vector v (Double, Double))+             => v Double -> AmbyChart () distPlotVec' xs = distPlotVec xs $ return ()  kdePlotVec :: (G.Vector v Double) => v Double -> State KdePlotOpts ()@@ -166,7 +169,7 @@ kdePlotVec' :: (G.Vector v Double) => v Double -> AmbyChart () kdePlotVec' xs = kdePlotVec xs $ return () -rugPlotVec :: (G.Vector v Double)+rugPlotVec :: (G.Vector v Double, G.Vector v (Double, Double))            => v Double -> State RugPlotOpts ()            -> AmbyChart () rugPlotVec xs optsState = do@@ -178,7 +181,7 @@   where     opts = execState optsState def -rugPlotVec' :: (G.Vector v Double)+rugPlotVec' :: (G.Vector v Double, G.Vector v (Double, Double))             => v Double -> AmbyChart () rugPlotVec' xs = rugPlotVec xs $ return () @@ -186,7 +189,8 @@ -- Generic plotters -------------------------- -plotDistribution :: (G.Vector v Double) => v Double -> DistPlotOpts -> AmbyChart ()+plotDistribution :: (G.Vector v Double, G.Vector v (Double, Double))+                 => v Double -> DistPlotOpts -> AmbyChart () plotDistribution xs opts = do     layout <- takeLayout     putLayout $ do@@ -233,13 +237,19 @@     plot_hist_fill_style . Chart.fill_color .= Colour.dissolve 0.4 c     plot_hist_vertical .= (opts ^. axis == YAxis) -plotRug :: (G.Vector v Double)+plotRug :: forall v. (G.Vector v Double, G.Vector v (Double, Double))         => AlphaColour Double -> v Double -> RugPlotOpts         -> EC (Layout Double Double) () plotRug c xs opts = do       maxMay <- getPlotMaxHeightMay       h <- calcRugHeight maxMay-      G.foldM (plotSingleLine h) () xs+      Chart.plot $ return $ Chart.Plot+        { Chart._plot_render = renderPlotRug h+        , Chart._plot_legend = [("", const $ return ())]+        , Chart._plot_all_points = join (***) G.toList+          $ G.unzip+          $ G.concatMap (toPoints h) xs+        }       updatePlotHeight maxMay     where       getPlotMaxHeightMay :: EC (Layout Double Double) (Maybe Double)@@ -250,15 +260,34 @@           & maximumMay           & return +      toPoints :: Double -> Double -> v (Double, Double)+      toPoints h x = if opts ^. axis == XAxis+        then G.fromList [(x, 0), (x, h)]+        else G.fromList [(0, x), (h, x)]+       calcRugHeight :: (Maybe Double) -> EC (Layout Double Double) Double       calcRugHeight maxMay =         return $ (Maybe.fromMaybe 1.0 maxMay) * (opts ^. height) -      plotSingleLine :: Double -> () -> Double -> EC (Layout Double Double) ()-      plotSingleLine h _ x = if opts ^. axis == XAxis-        then plotLine c (opts ^. linewidth) [(x, 0), (x, h)]-        else plotLine c (opts ^. linewidth)  [(0, x), (h, x)]+      renderPlotRug :: Double -> Chart.PointMapFn Double Double+                    -> BackendProgram ()+      renderPlotRug h pmap =+        Chart.withLineStyle lineStyle $ do+          Chart.alignStrokePath (plotPath h pmap) >>= Chart.strokePath+        where+          lineStyle = def+            & Chart.line_width .~ (opts ^. linewidth)+            & Chart.line_color .~ c +      plotPath :: Double -> Chart.PointMapFn Double Double -> Chart.Path+      plotPath h pmap =+          go (G.toList xs)+        where+          go [] = Chart.End+          go [b] = Chart.MoveTo (pt b 0) $ Chart.LineTo (pt b h) $ Chart.End+          go (b:rest) = Chart.MoveTo (pt b 0) $ Chart.LineTo (pt b h) $ go rest+          pt x y = pmap (Chart.LValue x, Chart.LValue y)+       updatePlotHeight :: (Maybe Double)                        -> EC (Layout Double Double) ()       updatePlotHeight maxMay = do@@ -316,35 +345,38 @@ -- Rendering -------------------------- +-- | Default save filename for Cairo. cairoDefSave :: FilePath cairoDefSave = ".__amby.png" +-- | Default save filename for Diagrams. diagramsDefSave :: FilePath diagramsDefSave = ".__amby.svg" +-- | Convert 'AmbyChart' into Chart's 'EC (Layout Double Double) ()'. getEC :: AmbyChart () -> EC (Layout Double Double) () getEC compute = getLayout $ execState compute def -getState :: AmbyChart () -> AmbyState-getState compute = execState compute def+-- | Convert 'AmbyGrid' into Chart's 'Renderable a'.+getRenderable :: AmbyChart () -> Renderable (LayoutPick Double Double Double)+getRenderable ch = getSaveObjectRenderable (toSaveObject ch) --- | Quick render. -- Short-hand to render to png file using Cairo backend.-save :: AmbyChart () -> IO ()-save chart = Cairo.toFile+save :: Saveable s => s -> IO ()+save chart = void $ Cairo.renderableToFile     def { Cairo._fo_size = newSize }     cairoDefSave-    (getLayout st)+    (getSaveObjectRenderable so)   where-    st = getState chart-    newSize = getSize st+    so = toSaveObject chart+    newSize = getSize so  -- | Short-hand to render to svg using Cairo backend-saveSvg :: AmbyChart () -> IO ()-saveSvg chart = Diagrams.toFile+saveSvg :: Saveable s => s -> IO ()+saveSvg chart = void $ Diagrams.renderableToFile     def { Diagrams._fo_size = join (***) fromIntegral newSize }     diagramsDefSave-    (getLayout st)+    (getSaveObjectRenderable so)   where-    st = getState chart-    newSize = getSize st+    so = toSaveObject chart+    newSize = getSize so

@@ -6,7 +6,9 @@ {-# LANGUAGE CPP #-} module Amby.Style   ( setThemeStyles+  , setDefaultThemeStyles   , scaledAxisCustom+  , categoricalAxisData   )   where @@ -42,9 +44,15 @@   Chart.layout_axes_styles . Chart.axis_grid_style . Chart.line_width .= 1.5   Chart.layout_axes_styles . Chart.axis_grid_style . Chart.line_dashes .= []   Chart.layout_axes_styles . Chart.axis_label_gap .= 8+  Chart.layout_margin .= 10+  -- TODO: Chart does not give a way to specify space between axis+  -- tick labels and axis label++setDefaultThemeStyles :: Theme -> EC (Layout x y) ()+setDefaultThemeStyles theme = do+  setThemeStyles theme   Chart.layout_x_axis . Chart.laxis_override .= roundAxisData   Chart.layout_y_axis . Chart.laxis_override .= roundAxisData-  Chart.layout_margin .= 10  --- | Equalizes precision for all labels. --- For example the labels [0, 0.2] become [0.0, 0.2].@@ -60,11 +68,19 @@       where         precision = maximum $ map (countAfterDecimal . snd) xs +categoricalAxisData :: [(x, String)] -> Chart.AxisData x -> Chart.AxisData x+categoricalAxisData labels axisData = axisData+  & Chart.axis_grid .~ []+  & Chart.axis_labels .~ [labels]+  & Chart.axis_ticks .~ []+ ------------------------ -- Scaling ------------------------ --- | Take from the 'Chart' package with minor modifications.+-- | Taken from the 'Chart' package with minor modifications.+-- Needed to enforce 'xlim' and 'ylim' maximum and minimum limits.+-- Default version snaps to next available grid position. scaledAxisCustom :: RealFloat a => Chart.LinearAxisParams a -> (a, a)                  -> Chart.AxisFn a scaledAxisCustom lap rs@(minV,maxV) ps0 = makeAxisCustom'

@@ -5,11 +5,15 @@ module Amby.Theme   ( Theme(..)   , AmbyColor(..)+  , Palette    -- * Themes   , mutedTheme   , deepTheme   , cleanTheme+  , plainTheme+  , easterTheme+  , springTheme    -- * Lenses   , bgColor@@ -23,14 +27,32 @@   , hexToRgb   , hexToRgba   , toColour+  , huslPalette+  , lightPalette+  , desaturate+  , alphaToHsl+  , hslToAlpha   )   where  import Control.Lens-import Data.Colour-import Data.Colour.SRGB import Data.Default+import Data.Fixed (mod')+import qualified Data.Maybe as Maybe+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector as V +import Data.Colour (AlphaColour, opaque)+import qualified Data.Colour as Colour+import Data.Colour.SRGB (sRGB, toSRGB, sRGB24read)+import Data.Colour.RGBSpace (uncurryRGB)+import Data.Colour.RGBSpace.HSL (hsl, hslView)++import Amby.Numeric++type Palette = [AlphaColour Double]+ -- | Used to style a chart. data Theme = Theme   { _themeBgColor :: AlphaColour Double@@ -38,12 +60,12 @@   , _themeGridLineColor :: AlphaColour Double   , _themeFontFamily :: String   , _themeFontSize :: Double-  , _themeColorCycle :: [AlphaColour Double]-  }+  , _themeColorCycle :: Palette+  } deriving (Show) makeFields ''Theme  instance Default Theme where-  def = deepTheme+  def = plainTheme  -- | Api facing color selection. data AmbyColor =@@ -52,6 +74,23 @@   | CustomColor (AlphaColour Double)   deriving (Show, Eq) +plainTheme :: Theme+plainTheme = Theme+  { _themeBgColor = opaque (sRGB24read "#FFFFFF")+  , _themePlotBgColor = opaque (sRGB24read "#EAEAF2")+  , _themeGridLineColor = opaque (sRGB24read "#FFFFFF")+  , _themeFontFamily = "Verdana"+  , _themeFontSize = 14+  , _themeColorCycle =+    [ opaque (sRGB24read "#4A70B2")+    , opaque (sRGB24read "#52A966")+    , opaque (sRGB24read "#C64D4F")+    , opaque (sRGB24read "#8170B4")+    , opaque (sRGB24read "#CDBA70")+    , opaque (sRGB24read "#60B5CF")+    ]+  }+ mutedTheme :: Theme mutedTheme = Theme   { _themeBgColor = opaque (sRGB24read "#FFFFFF")@@ -86,11 +125,51 @@     ]   } +easterTheme :: Theme+easterTheme = Theme+  { _themeBgColor = opaque (sRGB24read "#FFFFFF")+  , _themePlotBgColor = opaque (sRGB24read "#EAEAF2")+  , _themeGridLineColor = opaque (sRGB24read "#FFFFFF")+  , _themeFontFamily = "Verdana"+  , _themeFontSize = 14+  , _themeColorCycle =+    [ opaque (sRGB24read "#8BD3C7")+    , opaque (sRGB24read "#FEFFAF")+    , opaque (sRGB24read "#BFBADA")+    , opaque (sRGB24read "#FB8071")+    , opaque (sRGB24read "#7FB0D3")+    , opaque (sRGB24read "#FEB55A")+    , opaque (sRGB24read "#B2DF60")+    , opaque (sRGB24read "#FCCCE3")+    , opaque (sRGB24read "#D8D6D8")+    , opaque (sRGB24read "#BD7FBE")+    ]+  }++springTheme :: Theme+springTheme = Theme+  { _themeBgColor = opaque (sRGB24read "#FFFFFF")+  , _themePlotBgColor = opaque (sRGB24read "#EAEAF2")+  , _themeGridLineColor = opaque (sRGB24read "#FFFFFF")+  , _themeFontFamily = "Verdana"+  , _themeFontSize = 14+  , _themeColorCycle =+    [ opaque (sRGB24read "#62C3A5")+    , opaque (sRGB24read "#FC8D5C")+    , opaque (sRGB24read "#8C9ECC")+    , opaque (sRGB24read "#E888C4")+    , opaque (sRGB24read "#A5DA48")+    , opaque (sRGB24read "#FFDA00")+    ]+  }+ cleanTheme :: Theme-cleanTheme = def+cleanTheme = Theme   { _themeBgColor = opaque (sRGB24read "#FFFFFF")   , _themePlotBgColor = opaque (sRGB24read "#FFFFFF")   , _themeGridLineColor = opaque (sRGB24read "#EEEEEE")+  , _themeFontFamily = "Verdana"+  , _themeFontSize = 14   , _themeColorCycle =     [ opaque (sRGB24read "#1776B6")     , opaque (sRGB24read "#FF962A")@@ -108,7 +187,7 @@ hexToRgb s = CustomColor $ opaque (sRGB24read s)  hexToRgba :: String -> Double -> AmbyColor-hexToRgba s a = CustomColor $ withOpacity (sRGB24read s) a+hexToRgba s a = CustomColor $ Colour.withOpacity (sRGB24read s) a  -- | Conversion from Amby Api 'Color' to  underlying 'Colour' type. toColour :: AmbyColor -> AlphaColour Double -> AlphaColour Double@@ -122,3 +201,78 @@ toColour C _ = opaque (sRGB24read "#77BEDB") toColour K _ = opaque (sRGB24read "#000000") toColour W _ = opaque (sRGB24read "#FFFFFF")++-- | Get a set of evenly spaced colors in the HUSL space.+huslPalette :: Int -> Maybe Double -> Maybe Double -> Maybe Double -> Palette+huslPalette n hMay sMay lMay = V.toList huesBoxed+  where+    h = Maybe.fromMaybe 0.01 hMay+    s = Maybe.fromMaybe 0.90 sMay+    l = Maybe.fromMaybe 0.65 lMay+    hues = U.init $ linspace 0 1 (n + 1)+    hues' = (`U.map` hues) $+        (* 359)+      . (`mod'` 1)+      . (+ h)+    huesBoxed = (`V.map` G.convert hues') $+        opaque+      . uncurryRGB sRGB+      . (\hi -> hsl hi s l)++-- | Get sequential palette of colors from light to dark+lightPalette :: AlphaColour Double -> Int -> Palette+lightPalette c n = blendPalette lightColor c n+  where+    (h, s, _) = alphaToHsl c+    lightColor = hslToAlpha h s 0.95++blendPalette :: AlphaColour Double -> AlphaColour Double -> Int -> Palette+blendPalette s e n+  | n < 2 = modErr "blendPalette" "Need at least two colors to blend"+  | n == 2 = [s, e]+  | otherwise =+      V.toList+    $ (`V.snoc` e)+    $ V.cons s+    $ V.map (\x -> Colour.blend x s e)+    $ G.convert+    $ U.tail+    $ U.init+    $ linspace 0 1 n++-- | Desaturate color by a proporation.+desaturate :: Double -> AlphaColour Double -> AlphaColour Double+desaturate p c+  | p < 0 || p > 1 =+    modErr "setSaturation" "Saturation proportion must be between [0, 1]"+  | otherwise = hslToAlpha h (s * p) l+  where+    (h, s, l) = alphaToHsl c++-- | Converts 'AlphaColour Double' to triplet of 'Double's in hsl encoding.+--+-- Examples:+--+-- >>> import qualified Data.Colour.Names as Colour+-- >>> alphaToHsl (opaque Colour.black)+-- (0.0,0.0,0.0)+--+-- >>> alphaToHsl (opaque Colour.blue)+-- (240.0,1.0,0.5)+alphaToHsl :: AlphaColour Double -> (Double, Double, Double)+alphaToHsl c = hslView . toSRGB . (c `Colour.over`) $ Colour.black++-- | Converts hsl triplet of 'Double's to 'AlphaColour Double'.+hslToAlpha :: Double -> Double -> Double -> AlphaColour Double+hslToAlpha h s l+  | h < 0   || s < 0 || l < 0 = modErr+    "hslToAlpha" "hsl accepts values in ([0, 365], [0,1], [0,1])"+  | h > 365 || s > 1 || l > 1 = modErr+    "hslToAlpha" "hsl accepts values in ([0, 365], [0,1], [0,1])"+  | otherwise = opaque . uncurryRGB sRGB $ hsl h s l++modErr :: String -> String -> a+modErr f err = error+  $ showString "Amby.Theme."+  $ showString f+  $ showString ": " err

@@ -4,10 +4,15 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTSyntax #-} module Amby.Types   ( AmbyContainer(..)   , AmbyState   , AmbyChart+  , AmbyGrid+  , ChartGrid+  , Saveable(..)    -- * General accessors   , takeTheme@@ -15,23 +20,32 @@   , xlim   , ylim   , size+  , title   , takeLayout   , getLayout   , getSize   , putLayout-  , linewidth-  , histLinewidth-  , kdeLinewidth-  , rugLinewidth+  , getSaveObjectRenderable +  -- * Grid+  , gridTheme+  , takeGridTheme+  , gridSize+  , gridScale+  , setGrid+  , chartToGrid+   -- * Plot options   , PlotOpts   , PlotEqOpts   , DistPlotOpts   , KdePlotOpts   , RugPlotOpts+  , BoxPlotOpts(..)+  , FactorPlotOpts(..)   , Bandwidth(..)   , Axis(..)+  , PlotKind(..)   , bins   , hist   , rug@@ -44,6 +58,28 @@   , gridsize   , bw   , color+  , linewidth+  , histLinewidth+  , kdeLinewidth+  , rugLinewidth+  , kind+  , hueLegend+  , facLegend++  -- * Categorical options+  , fac+  , hue+  , row+  , col+  , saturation+  , facL+  , hueL+  , rowL+  , colL+  , datLabel+  , facLabel+  , rowLabel+  , colLabel   )   where @@ -51,13 +87,16 @@  import Control.Lens import Data.Default.Class-import Graphics.Rendering.Chart.Easy (EC, Layout)+import Graphics.Rendering.Chart.Easy (EC, Layout, LayoutPick, Renderable) import qualified Graphics.Rendering.Chart.Easy as Chart+import Graphics.Rendering.Chart.Grid (Grid)+import qualified Graphics.Rendering.Chart.Grid as Chart import Graphics.Rendering.Chart.Backend.Cairo (FileOptions(..))  import Amby.Compatibility.HistogramPlot import Amby.Theme import Amby.Style+import Amby.Categorical  ----------------------------------- -- Parameter option types@@ -65,6 +104,7 @@  data Axis = XAxis | YAxis deriving (Show, Eq) data Bandwidth = Scott | BwScalar Double deriving (Show, Eq)+data PlotKind = Box deriving (Show, Eq)  data PlotOpts = PlotOpts   { _plotOptsColor :: AmbyColor@@ -118,9 +158,84 @@   , _rugPlotOptsAxis :: Axis   , _rugPlotOptsColor :: AmbyColor   , _rugPlotOptsLinewidth :: Double-  }+  } deriving (Show) makeFields ''RugPlotOpts +data BoxPlotOpts = BoxPlotOpts+  { _boxPlotOptsFacL :: Category+  , _boxPlotOptsHueL :: Category+  , _boxPlotOptsColor :: AmbyColor+  , _boxPlotOptsSaturation :: Double+  , _boxPlotOptsAxis :: Axis+  , _boxPlotOptsLinewidth :: Double+  , _boxPlotOptsHueLegend :: Bool+  , _boxPlotOptsFacLegend :: Bool+  , _boxPlotOptsDatLabel :: String+  , _boxPlotOptsFacLabel :: String+  } deriving (Show)+makeFields ''BoxPlotOpts++data FactorPlotOpts = FactorPlotOpts+  { _factorPlotOptsFacL :: Category+  , _factorPlotOptsHueL :: Category+  , _factorPlotOptsColL :: Category+  , _factorPlotOptsRowL :: Category+  , _factorPlotOptsColor :: AmbyColor+  , _factorPlotOptsSaturation :: Double+  , _factorPlotOptsAxis :: Axis+  , _factorPlotOptsKind :: PlotKind+  , _factorPlotOptsDatLabel :: String+  , _factorPlotOptsFacLabel :: String+  , _factorPlotOptsRowLabel :: String+  , _factorPlotOptsColLabel :: String+  -- TODO: Polymorphic setters for labels?+  } deriving (Show)+makeFields ''FactorPlotOpts++class HasFac s a b | s -> a where+  fac :: Setter s s a b+instance (Foldable f, Ord a, Show a) => HasFac BoxPlotOpts Category (f a) where+  fac = sets (\a b -> b { _boxPlotOptsFacL = (toCat . a) (_boxPlotOptsFacL b) })+instance HasFac BoxPlotOpts Category Category where+  fac = sets (\a b -> b { _boxPlotOptsFacL = a (_boxPlotOptsFacL b) })+instance (Foldable f, Ord a, Show a) => HasFac FactorPlotOpts Category (f a) where+  fac = sets (\a b -> b+    { _factorPlotOptsFacL = (toCat . a) (_factorPlotOptsFacL b)+    })+instance HasFac FactorPlotOpts Category Category where+  fac = sets (\a b -> b { _factorPlotOptsFacL = a (_factorPlotOptsFacL b) })++class HasHue s a b | s -> a where+  hue :: Setter s s a b+instance (Foldable f, Ord a, Show a) => HasHue BoxPlotOpts Category (f a) where+  hue = sets (\a b -> b { _boxPlotOptsHueL = (toCat . a) (_boxPlotOptsHueL b) })+instance HasHue BoxPlotOpts Category Category where+  hue = sets (\a b -> b { _boxPlotOptsHueL = a (_boxPlotOptsHueL b) })+instance (Foldable f, Ord a, Show a) => HasHue FactorPlotOpts Category (f a) where+  hue = sets (\a b -> b+    { _factorPlotOptsHueL = (toCat . a) (_factorPlotOptsHueL b)+    })+instance HasHue FactorPlotOpts Category Category where+  hue = sets (\a b -> b { _factorPlotOptsHueL = a (_factorPlotOptsHueL b) })++class HasCol s a b | s -> a where+  col :: Setter s s a b+instance (Foldable f, Ord a, Show a) => HasCol FactorPlotOpts Category (f a) where+  col = sets (\a b -> b+    { _factorPlotOptsColL = (toCat . a) (_factorPlotOptsColL b)+    })+instance HasCol FactorPlotOpts Category Category where+  col = sets (\a b -> b { _factorPlotOptsColL = a (_factorPlotOptsColL b) })++class HasRow s a b | s -> a where+  row :: Setter s s a b+instance (Foldable f, Ord a, Show a) => HasRow FactorPlotOpts Category (f a) where+  row = sets (\a b -> b+    { _factorPlotOptsRowL = (toCat . a) (_factorPlotOptsRowL b)+    })+instance HasRow FactorPlotOpts Category Category where+  row = sets (\a b -> b { _factorPlotOptsRowL = a (_factorPlotOptsRowL b) })+ ----------------------------------- -- Main types -----------------------------------@@ -132,10 +247,53 @@   } makeLenses ''AmbyState +data AmbyGridState = AmbyGridState+  { _agsThemeState :: Theme+  , _agsGrid :: Grid (Renderable (LayoutPick Double Double Double))+  , _agsSize :: (Int, Int)+  }+makeLenses ''AmbyGridState+ type AmbyChart a = State AmbyState a+type AmbyGrid a = State AmbyGridState a+type ChartGrid = Grid (Renderable (LayoutPick Double Double Double)) +data SaveObject = SaveObject+  { _soSize :: (Int, Int)+  , _soRenderable :: Renderable (LayoutPick Double Double Double)+  }+makeLenses ''SaveObject++class Saveable a where+  toSaveObject :: a -> SaveObject++instance Saveable (AmbyChart ()) where+  toSaveObject ch = SaveObject+      { _soSize = st ^. asSize+      , _soRenderable =+        ( Chart.layoutToRenderable+        . Chart.execEC+        . (^. asLayoutState)+        ) st+      }+    where+      st = execState ch def++instance Saveable (AmbyGrid ()) where+  toSaveObject ch = SaveObject+      { _soSize = st ^. agsSize+      , _soRenderable =+        ( Chart.fillBackground def+        . Chart.gridToRenderable+        . (^. agsGrid)+        ) st+      }+    where+      st = execState ch def+ class AmbyContainer c where   type Value c :: *+   plot :: c -> c -> State PlotOpts () -> AmbyChart ()   plot' :: c -> c -> AmbyChart ()   plotEq :: c -> (Value c -> Value c) -> State PlotEqOpts () -> AmbyChart ()@@ -146,26 +304,35 @@   kdePlot' :: c -> AmbyChart ()   rugPlot :: c -> State RugPlotOpts () -> AmbyChart()   rugPlot' :: c -> AmbyChart ()+  boxPlot :: c -> State BoxPlotOpts () -> AmbyChart ()+  boxPlot' :: c -> AmbyChart ()+  factorPlot :: c -> State FactorPlotOpts () -> AmbyGrid ()  ----------------------------------- -- General options ----------------------------------- +chartToGrid :: AmbyChart () -> Grid (Renderable (LayoutPick Double Double Double))+chartToGrid ch =+    Chart.layoutToGrid+  $ Chart.execEC+  $ getLayout+  $ execState ch def+ getLayout :: AmbyState -> EC (Layout Double Double) () getLayout s = s ^. asLayoutState -getSize :: AmbyState -> (Int, Int)-getSize s = s ^. asSize+getSize :: SaveObject -> (Int, Int)+getSize s = s ^. soSize +getSaveObjectRenderable :: SaveObject -> Renderable (LayoutPick Double Double Double)+getSaveObjectRenderable so = so ^. soRenderable+ takeTheme :: AmbyChart Theme-takeTheme = do-  t <- use asThemeState-  return t+takeTheme = use asThemeState  takeLayout :: AmbyChart (EC (Layout Double Double) ())-takeLayout = do-  l <- use asLayoutState-  return l+takeLayout = use asLayoutState  putLayout :: EC (Layout Double Double) () -> AmbyChart () putLayout l = do@@ -180,6 +347,14 @@     setThemeStyles t   asThemeState .= t +gridTheme :: Theme -> AmbyGrid ()+gridTheme t = do+  agsThemeState .= t++takeGridTheme :: AmbyGrid Theme+takeGridTheme = do+  use agsThemeState+ xlim :: (Double, Double) -> AmbyChart () xlim rs = do   l <- use asLayoutState@@ -197,6 +372,27 @@ size :: (Int, Int) -> AmbyChart () size rs = asSize .= rs +title :: String -> AmbyChart ()+title t = do+  layout <- takeLayout+  putLayout $ do+    layout+    Chart.layout_title .= t+    Chart.layout_title_style . Chart.font_weight .= Chart.FontWeightNormal++gridSize :: (Int, Int) -> AmbyGrid ()+gridSize rs = agsSize .= rs++-- | Scale current grid size by percentage. Scaling will snap to+-- nearest integer point.+gridScale :: (Double, Double) -> AmbyGrid ()+gridScale (sx, sy) = do+  (x, y) <- use agsSize+  agsSize .= (round (fromIntegral x * sx), round (fromIntegral y * sy))++setGrid :: Grid (Renderable (LayoutPick Double Double Double)) -> AmbyGrid ()+setGrid g = agsGrid .= g+ -------------------- -- Default instances --------------------@@ -206,10 +402,17 @@     { _asThemeState = def     , _asLayoutState = do       Chart.setColors $ (def :: Theme) ^. colorCycle-      setThemeStyles def+      setDefaultThemeStyles def     , _asSize = _fo_size def     } +instance Default AmbyGridState where+  def = AmbyGridState+    { _agsThemeState = def+    , _agsGrid = Chart.empty+    , _agsSize = _fo_size def+    }+ instance Default (PlotHist x Double) where   def = PlotHist     { _plot_hist_bins = 20@@ -273,4 +476,34 @@     , _rugPlotOptsAxis = XAxis     , _rugPlotOptsColor = DefaultColor     , _rugPlotOptsLinewidth = 1.2+    }++instance Default BoxPlotOpts where+  def = BoxPlotOpts+    { _boxPlotOptsFacL = DefaultCategory+    , _boxPlotOptsHueL = DefaultCategory+    , _boxPlotOptsColor = DefaultColor+    , _boxPlotOptsSaturation = 0.8+    , _boxPlotOptsAxis = XAxis+    , _boxPlotOptsLinewidth = 2+    , _boxPlotOptsFacLegend = True+    , _boxPlotOptsHueLegend = True+    , _boxPlotOptsDatLabel = ""+    , _boxPlotOptsFacLabel = ""+    }++instance Default FactorPlotOpts where+  def = FactorPlotOpts+    { _factorPlotOptsFacL = DefaultCategory+    , _factorPlotOptsHueL = DefaultCategory+    , _factorPlotOptsColL = DefaultCategory+    , _factorPlotOptsRowL = DefaultCategory+    , _factorPlotOptsColor = DefaultColor+    , _factorPlotOptsSaturation = 0.8+    , _factorPlotOptsAxis = XAxis+    , _factorPlotOptsKind = Box+    , _factorPlotOptsDatLabel = ""+    , _factorPlotOptsFacLabel = ""+    , _factorPlotOptsRowLabel = ""+    , _factorPlotOptsColLabel = ""     }

@@ -0,0 +1,207 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}+module Amby.Util+  ( loadDataset+  , getCol++  -- * Datasets+  , Tip(..)+  , Iris(..)+  , tips+  , getTipColumns+  , iris+  , getIrisColumns++  -- * Tip lenses+  , totalBill+  , tip+  , sex+  , day+  , smoker+  , time+  , tipSize++  -- * Iris lenses+  , sepalLength+  , sepalWidth+  , petalLength+  , petalWidth+  , irisClass+  ) where++import Control.Lens+import qualified Data.ByteString.Lazy as BL+import Data.Csv ((.:))+import qualified Data.Csv as Csv+import qualified Data.Vector as V+import GHC.Generics+import Paths_amby (getDataFileName)++import Numeric.Datasets (Dataset, getDataset)+import qualified Numeric.Datasets.Iris as Iris++import Amby.Categorical++loadDataset :: Dataset a -> IO [a]+loadDataset ds = do+  getDataset ds++data Tip = Tip+  { _tipTotalBill :: !Double+  , _tipTip :: !Double+  , _tipSex :: !String+  , _tipSmoker :: !String+  , _tipDay :: !String+  , _tipTime :: !String+  , _tipTipSize :: !Int+  } deriving (Generic)+makeFields ''Tip++instance Show Tip where+  show t =+      showString "Tip "+    $ showString "{totalBill = "+    $ showString (show (_tipTotalBill t))+    $ showString ", tip = "+    $ showString (show (_tipTip t))+    $ showString ", sex = "+    $ showString (show (_tipSex t))+    $ showString ", smoker = "+    $ showString (show (_tipSmoker t))+    $ showString ", day = "+    $ showString (show (_tipDay t))+    $ showString ", time = "+    $ showString (show (_tipTime t))+    $ showString ", tipSize = "+    $ showString (show (_tipTipSize t)) "}"++data TipColumns = TipColumns+  { _tipColumnsTotalBill :: [Double]+  , _tipColumnsTip :: [Double]+  , _tipColumnsSex :: Category+  , _tipColumnsSmoker :: Category+  , _tipColumnsDay :: Category+  , _tipColumnsTime :: Category+  , _tipColumnsTipSize :: [Int]+  }+makeFields ''TipColumns++data Iris = Iris+  { _irisSepalLength :: Double+  , _irisSepalWidth :: Double+  , _irisPetalLength :: Double+  , _irisPetalWidth :: Double+  , _irisIrisClass :: Iris.IrisClass+  } deriving (Show)+makeFields ''Iris++data IrisColumns = IrisColumns+  { _irisColumnsSepalLength :: [Double]+  , _irisColumnsSepalWidth :: [Double]+  , _irisColumnsPetalLength :: [Double]+  , _irisColumnsPetalWidth :: [Double]+  , _irisColumnsIrisClass :: Category+  }+makeFields ''IrisColumns++class Loader a where+  type RowValue a :: *+  getCol ::  Lens (RowValue a) (RowValue a) b b -> a -> b++instance Loader [Tip] where+  type RowValue [Tip] = TipColumns+  getCol gtr ds = TipColumns+    { _tipColumnsTotalBill = map (^. totalBill) ds+    , _tipColumnsTip = map (^. tip) ds+    , _tipColumnsSex = toCatOrdered (map (^. sex) ds) ["Male", "Female"]+    , _tipColumnsSmoker = toCatOrdered (map (^. smoker) ds) ["Yes", "No"]+    , _tipColumnsDay = toCatOrdered (map (^. day) ds) ["Thur", "Fri", "Sat", "Sun"]+    , _tipColumnsTime = toCatOrdered (map (^. time) ds) ["Lunch", "Dinner"]+    , _tipColumnsTipSize = map (^. tipSize) ds+    } ^. gtr++instance Loader [Iris] where+  type RowValue [Iris] = IrisColumns+  getCol gtr ds = IrisColumns+    { _irisColumnsSepalLength = map (^. sepalLength) ds+    , _irisColumnsSepalWidth = map (^. sepalWidth) ds+    , _irisColumnsPetalLength = map (^. petalLength) ds+    , _irisColumnsPetalWidth = map (^. petalWidth) ds+    , _irisColumnsIrisClass = toCat (map (^. irisClass) ds)+    } ^. gtr++------------------------+-- Tips dataset+------------------------++instance Csv.FromNamedRecord Tip where+  parseNamedRecord m = Tip+    <$> m .: "total_bill"+    <*> m .: "tip"+    <*> m .: "sex"+    <*> m .: "smoker"+    <*> m .: "day"+    <*> m .: "time"+    <*> m .: "size"+instance Csv.ToNamedRecord Tip+instance Csv.DefaultOrdered Tip++tips :: Dataset Tip+tips _ = do+  csvPath <- getDataFileName "data/seaborn_tips.csv"+  dat <- BL.readFile csvPath+  case Csv.decodeByName dat of+    Left e -> error $ "Unable to parse csv file: " ++ e+    Right (_hs, ds) -> return $ V.toList ds++getTipColumns :: [Tip]+              -> IO ( [Double]+                    , [Double]+                    , Category+                    , Category+                    , Category+                    , Category+                    , [Int]+                    )+getTipColumns ts = return+  ( getCol totalBill ts+  , getCol tip ts+  , getCol sex ts+  , getCol smoker ts+  , getCol day ts+  , getCol time ts+  , getCol tipSize ts+  )++iris :: Dataset Iris+iris f = Iris.iris f >>= mapM dsIrisToIris++dsIrisToIris :: Iris.Iris -> IO Iris+dsIrisToIris oIris = return $ Iris+  { _irisSepalLength = Iris.sepalLength oIris+  , _irisSepalWidth = Iris.sepalWidth oIris+  , _irisPetalLength = Iris.petalLength oIris+  , _irisPetalWidth = Iris.petalWidth oIris+  , _irisIrisClass = Iris.irisClass oIris+  }++getIrisColumns :: [Iris]+               -> IO ( [Double]+                     , [Double]+                     , [Double]+                     , [Double]+                     , Category+                     )+getIrisColumns is = return+  ( getCol sepalLength is+  , getCol sepalWidth is+  , getCol petalLength is+  , getCol petalWidth is+  , getCol irisClass is+  )

@@ -10,6 +10,8 @@ main = do   doctest     [ "src/Amby/Numeric.hs"+    , "src/Amby/Categorical.hs"+    , "src/Amby/Theme.hs"     ]   defaultMain tests