chart-histogram (empty) → 0.4.1
raw patch · 5 files changed
+285/−0 lines, 5 filesdep +Chartdep +basedep +coloursetup-changed
Dependencies added: Chart, base, colour, data-default, lens, vector
Files
- Graphics/Rendering/Chart/Plot/Histogram.hs +174/−0
- LICENSE +30/−0
- Numeric/Histogram.hs +51/−0
- Setup.hs +2/−0
- chart-histogram.cabal +28/−0
+ Graphics/Rendering/Chart/Plot/Histogram.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}++module Graphics.Rendering.Chart.Plot.Histogram+ ( -- * Histograms+ PlotHist (..)+ , histToPlot+ , defaultPlotHist+ , defaultFloatPlotHist+ , defaultNormedPlotHist+ -- * Accessors+ , plot_hist_title+ , plot_hist_bins+ , plot_hist_values+ , plot_hist_no_zeros+ , plot_hist_range+ , plot_hist_drop_lines+ , plot_hist_line_style+ , plot_hist_fill_style+ , plot_hist_norm_func+ ) where++import Control.Monad (when)+import Data.Monoid+import Data.List (transpose)+import Data.Maybe (fromMaybe)+import qualified Data.Foldable as F+import qualified Data.Vector as V++import Control.Lens hiding (moveTo)+import Graphics.Rendering.Chart+import Data.Default++import Data.Colour (opaque)+import Data.Colour.Names (black, blue)+import Data.Colour.SRGB (sRGB)++import Numeric.Histogram++data PlotHist x y = PlotHist+ { -- | Plot title+ _plot_hist_title :: String++ -- | Number of bins+ , _plot_hist_bins :: Int++ -- | Values to histogram+ , _plot_hist_values :: V.Vector x++ -- | Don't attempt to plot bins with zero counts. Useful when+ -- the y-axis is logarithmically scaled.+ , _plot_hist_no_zeros :: Bool++ -- | Override the range of the histogram. If @Nothing@ the+ -- range of @_plot_hist_values@ is used+ , _plot_hist_range :: Maybe (x,x)++ -- | Plot vertical lines between bins+ , _plot_hist_drop_lines :: Bool++ -- | Fill style of the bins+ , _plot_hist_fill_style :: FillStyle++ -- | Line style of the bin outlines+ , _plot_hist_line_style :: LineStyle++ -- | Normalization function+ , _plot_hist_norm_func :: Double -> Int -> y+ }++instance Default (PlotHist x Int) where+ def = defaultPlotHist++-- | The default style is an unnormalized histogram of 20 bins.+defaultPlotHist :: PlotHist x Int+defaultPlotHist = PlotHist { _plot_hist_bins = 20+ , _plot_hist_title = ""+ , _plot_hist_values = V.empty+ , _plot_hist_no_zeros = False+ , _plot_hist_range = Nothing+ , _plot_hist_drop_lines = False+ , _plot_hist_line_style = defaultLineStyle+ , _plot_hist_fill_style = defaultFillStyle+ , _plot_hist_norm_func = const id+ }++-- | @defaultPlotHist@ but with real counts+defaultFloatPlotHist :: PlotHist x Double+defaultFloatPlotHist = defaultPlotHist { _plot_hist_norm_func = const realToFrac }++-- | @defaultPlotHist@ but normalized such that the integral of the+-- histogram is one.+defaultNormedPlotHist :: PlotHist x Double+defaultNormedPlotHist = defaultPlotHist { _plot_hist_norm_func = \n y->realToFrac y / n }++defaultFillStyle :: FillStyle+defaultFillStyle = solidFillStyle (opaque $ sRGB 0.5 0.5 1.0)++defaultLineStyle :: LineStyle+defaultLineStyle = (solidLine 1 $ opaque blue)+ { _line_cap = LineCapButt+ , _line_join = LineJoinMiter+ }++-- | Convert a @PlotHist@ to a @Plot@+histToPlot :: (RealFrac x, Num y, Ord y) => PlotHist x y -> Plot x y+histToPlot p = Plot {+ _plot_render = renderPlotHist p,+ _plot_legend = [(_plot_hist_title p, renderPlotLegendHist p)],+ _plot_all_points = unzip+ $ concatMap (\((x1,x2), y)->[(x1,y), (x2,y)])+ $ histToBins p+ }++buildHistPath :: (RealFrac x, Num y)+ => PointMapFn x y -> [((x,x), y)] -> Path+buildHistPath _ [] = End+buildHistPath pmap bins = MoveTo (pt x0 0) (go bins)+ where go [((x1,x2),y)] = LineTo (pt x1 y)+ $ LineTo (pt x2 y)+ $ LineTo (pt x2 0)+ $ End+ go (((x1,x2),y):rest) = LineTo (pt x1 y)+ $ LineTo (pt x2 y)+ $ go rest+ ((x0,_),_) = head bins+ pt x y = pmap (LValue x, LValue y)++renderPlotHist :: (RealFrac x, Num y, Ord y)+ => PlotHist x y -> PointMapFn x y -> ChartBackend ()+renderPlotHist p pmap+ | null bins = return ()+ | otherwise = do+ withFillStyle (_plot_hist_fill_style p) $+ alignFillPath (buildHistPath pmap bins) >>= fillPath+ withLineStyle (_plot_hist_line_style p) $ do+ when (_plot_hist_drop_lines p) $+ alignStrokePath dropLinesPath >>= strokePath+ alignStrokePath (buildHistPath pmap bins) >>= strokePath+ where bins = histToBins p+ pt x y = pmap (LValue x, LValue y)+ dropLinesPath = F.foldMap (\((x1,_), y)->moveTo (pt x1 0)+ <> lineTo (pt x1 y)+ ) $ tail bins++renderPlotLegendHist :: PlotHist x y -> Rect -> ChartBackend ()+renderPlotLegendHist p r@(Rect p1 p2) =+ withLineStyle (_plot_hist_line_style p) $+ let y = (p_y p1 + p_y p2) / 2+ in strokePath $ moveTo' (p_x p1) y <> lineTo' (p_x p2) y++histToBins :: (RealFrac x, Num y, Ord y) => PlotHist x y -> [((x,x), y)]+histToBins hist =+ filter_zeros $ zip bounds $ counts+ where n = _plot_hist_bins hist+ (a,b) = realHistRange hist+ dx = realToFrac (b-a) / realToFrac n+ bounds = binBounds a b n+ values = _plot_hist_values hist+ filter_zeros | _plot_hist_no_zeros hist = filter (\(b,c)->c > 0)+ | otherwise = id+ norm = dx * realToFrac (V.length values)+ normalize = _plot_hist_norm_func hist norm+ counts = V.toList $ V.map (normalize . snd)+ $ histWithBins (V.fromList bounds) (zip (repeat 1) $ V.toList values)++-- TODO: Determine more aesthetically pleasing range+realHistRange :: (RealFrac x) => PlotHist x y -> (x,x)+realHistRange hist = fromMaybe range $ _plot_hist_range hist+ where values = _plot_hist_values hist+ range = if V.null values+ then (0,0)+ else (V.minimum values, V.maximum values)++$( makeLenses ''PlotHist )
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Ben Gamari++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Ben Gamari nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Numeric/Histogram.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE PatternGuards #-} ++module Numeric.Histogram ( Range+ , binBounds+ , histValues+ , histWeightedValues+ , histWithBins+ ) where++import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV+import Control.Monad.ST++type Range a = (a,a)++-- | 'binBounds a b n' generates bounds for 'n' bins spaced linearly between+-- 'a' and 'b'+binBounds :: RealFrac a => a -> a -> Int -> [Range a]+binBounds a b n = map (\i->(lbound i, lbound (i+1))) [0..n]+ where lbound i = a + (b-a) * realToFrac i / realToFrac n++-- | 'histValues a b n vs' returns the bins for the histogram of+-- 'vs' on the range from 'a' to 'b' with 'n' bins+histValues :: RealFrac a => a -> a -> Int -> [a] -> V.Vector (Range a, Int)+histValues a b n = histWithBins (V.fromList $ binBounds a b n) . zip (repeat 1)++-- | 'histValues a b n vs' returns the bins for the weighted histogram of+-- 'vs' on the range from 'a' to 'b' with 'n' bins+histWeightedValues :: RealFrac a => a -> a -> Int -> [(Double,a)] -> V.Vector (Range a, Double)+histWeightedValues a b n = histWithBins (V.fromList $ binBounds a b n)++-- | 'histWithBins bins xs' is the histogram of weighted values 'xs' with 'bins'+histWithBins :: (Num w, RealFrac a) => V.Vector (Range a) -> [(w, a)] -> V.Vector (Range a, w)+histWithBins bins xs =+ let testBin :: RealFrac a => a -> Range a -> Bool+ testBin x (a,b) = x >= a && x < b++ f :: (RealFrac a, Num w)+ => V.Vector (Range a) -> MV.STVector s w -> (w, a)+ -> ST s ()+ f bins bs (w,x) =+ case V.dropWhile (not . testBin x . snd) $ V.indexed bins of+ v | V.null v -> return ()+ v | (idx,bounds) <- V.head v -> do+ n <- MV.read bs idx+ MV.write bs idx $! n+w++ counts = runST $ do b <- MV.replicate (V.length bins) 0+ mapM_ (f bins b) xs+ V.freeze b+ in V.zip bins counts
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ chart-histogram.cabal view
@@ -0,0 +1,28 @@+Name: chart-histogram+Version: 0.4.1+Synopsis: Easily render histograms with Chart+Description: A library for rendering histograms with the Chart library+License: BSD3+License-file: LICENSE+Author: Ben Gamari+Maintainer: bgamari.foss@gmail.com+Copyright: Ben Gamari 2013+Category: Graphics+Build-type: Simple+Cabal-version: >=1.6++Source-repository head+ Location: git@github.com:bgamari/chart-histogram+ Type: git++Library+ Exposed-modules: Numeric.Histogram,+ Graphics.Rendering.Chart.Plot.Histogram++ Build-depends: base >=4.6 && <4.9,+ vector >=0.9 && <0.11,+ lens >=4.2 && <4.5,+ data-default >=0.5 && <0.6,+ colour >=2.3 && <2.4,+ Chart >=1.0 && <1.4+