diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +## 0 + +- initial version +- compatible with `tdigest-0.1` + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016 Futurice Oy + +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 Oleg Grenrus 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# tdigest-Chart + +A [`Chart`](http://hackage.haskell.org/package/Chart) plotting of [`tdigest`](http://hackage.haskell.org/package/tdigest) + +## Examples + +These are outputs of the test-suite + +```sh +inkscape --export-png=example1.png --export-dpi=80 --export-background-opacity=0 --without-gui example1.svg +inkscape --export-png=example2.png --export-dpi=80 --export-background-opacity=0 --without-gui example2.svg +``` + +### Standard normal distribution + +```haskell +Chart.layout_title Chart..= "Normal distribution" +Chart.plot $ do + p <- Chart.tdigestPlot "tdigest" td + return $ Chart.tdigestToPlot $ p + & Chart.plot_tdigest_normalize .~ True + & Chart.plot_tdigest_deviations .~ Just 3 +``` + +![Example 1](https://raw.githubusercontent.com/futurice/haskell-tdigest/master/tdigest-Chart/example1.png) + +### Chi-squared distribution, k = 5 + +```haskell +Chart.layout_title Chart..= "Chi-squared distribution, k = 5" +Chart.plot $ do + p <- Chart.tdigestPlot "tdigest" td + return $ Chart.tdigestToPlot $ p + & Chart.plot_tdigest_normalize .~ True + & Chart.plot_tdigest_quantiles .~ [0.5, 0.9, 0.999] +``` + +![Example 2](https://raw.githubusercontent.com/futurice/haskell-tdigest/master/tdigest-Chart/example2.png) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/example/Examples.hs b/example/Examples.hs new file mode 100644 --- /dev/null +++ b/example/Examples.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DataKinds #-} +module Main (main) where + +import Prelude () +import Prelude.Compat +import Control.Lens ((&), (.~)) +import Control.Monad (replicateM) +import Data.TDigest + +import Statistics.Distribution (ContGen (..)) +import Statistics.Distribution.ChiSquared (chiSquared) +import Statistics.Distribution.Normal (standard) + +import qualified Graphics.Rendering.Chart.Backend.Diagrams as Chart +import qualified Graphics.Rendering.Chart.Easy as Chart +import qualified Graphics.Rendering.Chart.Plot.TDigest as Chart +import qualified System.Random.MWC as MWC + +example1 :: IO () +example1 = do + xs <- randomStream standard + let td = tdigest xs :: TDigest 10 + Chart.toFile Chart.def "example1.svg" $ do + Chart.layout_title Chart..= "Normal distribution" + Chart.plot $ do + p <- Chart.tdigestPlot "tdigest" td + return $ Chart.tdigestToPlot $ p + & Chart.plot_tdigest_normalize .~ True + & Chart.plot_tdigest_deviations .~ Just 3 + +example2 :: IO () +example2 = do + xs <- randomStream $ chiSquared 5 + let td = tdigest xs :: TDigest 10 + Chart.toFile Chart.def "example2.svg" $ do + Chart.layout_title Chart..= "Chi-squared distribution, k = 5" + Chart.plot $ do + p <- Chart.tdigestPlot "tdigest" td + return $ Chart.tdigestToPlot $ p + & Chart.plot_tdigest_normalize .~ True + & Chart.plot_tdigest_quantiles .~ [0.5, 0.9, 0.999] + +main :: IO () +main = do + example1 + example2 + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +randomStream :: ContGen d => d -> IO [Double] +randomStream d = do + g <- MWC.create + replicateM 100000 (genContVar d g) diff --git a/src/Graphics/Rendering/Chart/Plot/TDigest.hs b/src/Graphics/Rendering/Chart/Plot/TDigest.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/Chart/Plot/TDigest.hs @@ -0,0 +1,178 @@ +module Graphics.Rendering.Chart.Plot.TDigest where + +import Prelude () +import Prelude.Compat +import Control.Lens +import Data.Colour (opaque, black) +import Data.Foldable (toList, for_) +import Data.Semigroup (Max (..)) +import Data.Semigroup.Foldable (foldMap1) +import Data.TDigest +import Data.TDigest.Postprocess +import Numeric (showFFloat) + +import Graphics.Rendering.Chart.Drawing +import Graphics.Rendering.Chart.Geometry +import Graphics.Rendering.Chart.Plot.Types +import Graphics.Rendering.Chart.Layout +import Graphics.Rendering.Chart.State + +data PlotTDigest comp = PlotTDigest + { _plot_tdigest_data :: TDigest comp -- ^ Plot tdigest, i.e .data + , _plot_tdigest_normalize :: Bool -- ^ Normalize histogram so total weight is 1. + , _plot_tdigest_title :: String -- ^ Plot tile + , _plot_tdigest_fill_style :: FillStyle -- ^ Fill style of the bins + , _plot_tdigest_line_style :: LineStyle -- ^ Line style of the bin outlines + , _plot_tdigest_quantiles :: [Double] -- ^ Which quantile lines to plot + , _plot_tdigest_q_line_style :: LineStyle -- ^ Line style of quantile lines + , _plot_tdigest_deviations :: Maybe Int -- ^ Which stddev lines to plot + , _plot_tdigest_d_line_style :: LineStyle -- ^ Line style of deviation lines + } + +-- | Construct a bar chart with the given title and tdigest, using the next available colors +tdigestPlot :: String -> TDigest comp -> EC l (PlotTDigest comp) +tdigestPlot title td = do + color <- takeColor + pure $ PlotTDigest + { _plot_tdigest_data = td + , _plot_tdigest_normalize = False + , _plot_tdigest_title = title + , _plot_tdigest_fill_style = solidFillStyle color + , _plot_tdigest_line_style = solidLine 1.0 $ opaque black + , _plot_tdigest_quantiles = [] + , _plot_tdigest_q_line_style = dashedLine 1.0 [1,1] $ opaque black + , _plot_tdigest_deviations = Nothing + , _plot_tdigest_d_line_style = dashedLine 1.0 [5,5] $ opaque black + } + +tdigestPlot' :: String -> TDigest comp -> EC (Layout Double Double) () +tdigestPlot' title td = plot (fmap tdigestToPlot (tdigestPlot title td)) + +tdigestToPlot :: PlotTDigest comp -> Plot Double Double +tdigestToPlot ptd = Plot + { _plot_render = renderHistogram + , _plot_legend = + [(_plot_tdigest_title ptd, renderLegend)] ++ + [(quantileTitle q, renderQuantileLegend) | q <- _plot_tdigest_quantiles ptd] ++ + maybe [] deviationLegend (_plot_tdigest_deviations ptd) + , _plot_all_points = unzip allPoints + } + where + td = _plot_tdigest_data ptd + hist' = histogram td + hist = foldMap toList hist' + lineStyle = _plot_tdigest_line_style ptd + fillStyle = _plot_tdigest_fill_style ptd + qLineStyle = _plot_tdigest_q_line_style ptd + dLineStyle = _plot_tdigest_d_line_style ptd + + showFFloat' = showFFloat (Just 6) + + tw' = totalWeight td + tw | _plot_tdigest_normalize ptd = tw' + | otherwise = 1.0 + + maxy = maxy' * 1.1 + maxy' = maybe 1.0 (getMax . foldMap1 (Max . f)) hist' + where + f (HistBin mi ma _ w _) = w / (ma - mi) / tw + + somex = 0 + + sigma = maybe 0 (sqrt . variance') hist' + mu = maybe 9 mean' hist' + + + allPoints = ((somex, maxy) :) $ flip map hist $ \(HistBin mi ma x w _) -> + let d = ma - mi + y = w / d / tw + in (x, y) + + -- Mean & Variance + + deviationLegend _ = [ (t, renderDeviationLegend) ] + where + t = showString "mean = " + . showFFloat' mu + . showString ", stddev = " + . showFFloat' sigma + $ "" + + renderDeviationLegend (Rect p1 p2) = withLineStyle dLineStyle $ do + let y = (p_y p1 + p_y p2) / 2 + strokePath $ moveTo' (p_x p1) y `mappend` lineTo' (p_x p2) y + + renderDeviation pmap d = withLineStyle dLineStyle $ do + let x = mu + fromIntegral d * sigma + let path = moveTo (mapXY pmap (x, 0)) `mappend` lineTo (mapXY pmap (x, maxy)) + alignStrokePath path >>= strokePath + + -- Quantiles + + quantileTitle q + = showFFloat' q + . showString "q = " + . showFFloat' (maybe 0 (quantile' q tw') hist') + $ "" + + renderQuantileLegend (Rect p1 p2) = withLineStyle qLineStyle $ do + let y = (p_y p1 + p_y p2) / 2 + strokePath $ moveTo' (p_x p1) y `mappend` lineTo' (p_x p2) y + + renderQuantile pmap q = withLineStyle qLineStyle $ do + let x = maybe 0 (quantile' q tw') hist' + let path = moveTo (mapXY pmap (x, 0)) `mappend` lineTo (mapXY pmap (x, maxy)) + alignStrokePath path >>= strokePath + + -- Histogram + + renderLegend r = withLineStyle lineStyle $ withFillStyle fillStyle $ do + let path = rectPath r + fillPath path + strokePath path + + renderHistogram pmap = do + withLineStyle lineStyle $ withFillStyle fillStyle $ do + for_ hist $ \(HistBin mi ma _ w _) -> do + let d = ma - mi + y = w / d / tw + path = rectPath $ Rect + (mapXY pmap (mi,0)) + (mapXY pmap (ma,y)) + alignFillPath path >>= fillPath + alignStrokePath path >>= strokePath + + for_ (_plot_tdigest_quantiles ptd) $ renderQuantile pmap + for_ (_plot_tdigest_deviations ptd) $ \maxd -> + for_ [-maxd .. maxd] $ renderDeviation pmap + +------------------------------------------------------------------------------- +-- Lenses +------------------------------------------------------------------------------- + +plot_tdigest_title :: Lens' (PlotTDigest comp) String +plot_tdigest_title = lens _plot_tdigest_title $ \s x -> s { _plot_tdigest_title = x } + +plot_tdigest_quantiles :: Lens' (PlotTDigest comp) [Double] +plot_tdigest_quantiles = lens _plot_tdigest_quantiles $ \s x -> s { _plot_tdigest_quantiles = x } + +plot_tdigest_q_line_style :: Lens' (PlotTDigest comp) LineStyle +plot_tdigest_q_line_style = lens _plot_tdigest_q_line_style $ \s x -> s { _plot_tdigest_q_line_style = x } + +plot_tdigest_normalize :: Lens' (PlotTDigest comp) Bool +plot_tdigest_normalize = lens _plot_tdigest_normalize $ \s x -> s { _plot_tdigest_normalize = x } + +plot_tdigest_line_style :: Lens' (PlotTDigest comp) LineStyle +plot_tdigest_line_style = lens _plot_tdigest_line_style $ \s x -> s { _plot_tdigest_line_style = x } + +plot_tdigest_fill_style :: Lens' (PlotTDigest comp) FillStyle +plot_tdigest_fill_style = lens _plot_tdigest_fill_style $ \s x -> s { _plot_tdigest_fill_style = x } + +plot_tdigest_deviations :: Lens' (PlotTDigest comp) (Maybe Int) +plot_tdigest_deviations = lens _plot_tdigest_deviations $ \s x -> s { _plot_tdigest_deviations = x } + +plot_tdigest_data :: Lens (PlotTDigest comp) (PlotTDigest comp') (TDigest comp) (TDigest comp') +plot_tdigest_data = lens _plot_tdigest_data $ \s x -> s { _plot_tdigest_data = x } + +plot_tdigest_d_line_style :: Lens' (PlotTDigest comp) LineStyle +plot_tdigest_d_line_style = lens _plot_tdigest_d_line_style $ \s x -> s { _plot_tdigest_d_line_style = x } diff --git a/tdigest-Chart.cabal b/tdigest-Chart.cabal new file mode 100644 --- /dev/null +++ b/tdigest-Chart.cabal @@ -0,0 +1,63 @@ +name: tdigest-Chart +version: 0 +synopsis: Chart generation from tdigest +description: + Chart generation from tdigest. + . + @ + ... + @ +category: Numeric, Graphics +homepage: https://github.com/futurice/haskell-tdigest#readme +bug-reports: https://github.com/futurice/haskell-tdigest/issues +author: Oleg Grenrus +maintainer: Oleg Grenrus +license: BSD3 +license-file: LICENSE +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.0.2 +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/futurice/haskell-tdigest + +library + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >=4.7 && <4.10 + , base-compat >=0.9.1 && <0.10 + , colour >=2.3.3 && <2.4 + , semigroups >=0.18.2 && <0.19 + , semigroupoids >=5.1 && <5.2 + , tdigest >=0.1 && <0.2 + , lens >=4 && <4.16 + , Chart >=1.8.1 && <1.9 + exposed-modules: + Graphics.Rendering.Chart.Plot.TDigest + default-language: Haskell2010 + +test-suite tdigest-chart-examples + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Examples.hs + ghc-options: -Wall -threaded + hs-source-dirs: example + + build-depends: + base, + base-compat, + Chart, + lens, + tdigest, + tdigest-Chart, + vector, + Chart-diagrams >=1.8.1 && <1.9, + mwc-random >=0.13.4.0 && <0.14, + statistics >=0.13.3.0 && <0.14