├── .gitignore ├── examples ├── README.md ├── log-axis.hs ├── line.hs ├── polar.hs ├── pie.hs ├── histogram.hs ├── limits.hs ├── criterion.csv ├── criterion.hs └── stocks.hs ├── test ├── plots-test.cabal └── RunExamples.hs ├── diagrams ├── src_Plots_Types_HeatMap_pixelHeatRenderExample.svg ├── src_Plots_Types_HeatMap_pixelHeatRenderExample'.svg ├── src_Plots_Style_greysBar.svg ├── src_Plots_Axis_ColourBar_pathColourBarExample.svg ├── src_Plots_Types_Pie_pieExample'.svg ├── src_Plots_Style_blackAndWhitePic.svg ├── src_Plots_Style_fadedColourPic.svg ├── src_Plots_Style_vividColourPic.svg ├── src_Plots_Types_Pie_piePlotExample.svg ├── src_Plots_Types_HeatMap_pathHeatRenderExample.svg ├── src_Plots_Types_Bar_namedBarExample'.svg ├── src_Plots_Types_Bar_namedBarExample.svg ├── src_Plots_Types_Bar_multiBarExample.svg ├── src_Plots_Types_Bar_groupedBarsExample'.svg ├── src_Plots_Types_Bar_groupedBarsExample.svg ├── src_Plots_Types_Bar_stackedBarsExample.svg ├── src_Plots_Types_Bar_stackedEqualBarsExample.svg ├── src_Plots_Types_Bar_barExample.svg ├── src_Plots_Types_Bar_runningBarsExample.svg ├── src_Plots_Types_Bar_barExample'.svg ├── src_Plots_Types_Histogram_countDensityDia.svg ├── src_Plots_Types_Histogram_probabilityDia.svg └── src_Plots_Types_Histogram_cdfDia.svg ├── src ├── Plots │ ├── Name.hs │ ├── Util.hs │ ├── Axis │ │ ├── Line.hs │ │ └── Title.hs │ ├── Legend.hs │ └── Types │ │ └── Line.hs ├── Plots.hs └── Diagrams │ └── Coordinates │ ├── Isomorphic.hs │ └── Polar.hs ├── LICENSE ├── README.md ├── plots.cabal ├── unfinished ├── Surface.hs ├── Points.hs ├── Text.hs ├── Density.hs └── Boxplot.hs └── .travis.yml /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | examples_output 3 | .shake 4 | .DS_Store 5 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | ## Examples 2 | 3 | The haddock documentation contains many examples for simple cases and is 4 | a better place for getting started. The examples here are for more 5 | complicated or experimental plots. 6 | 7 | -------------------------------------------------------------------------------- /examples/log-axis.hs: -------------------------------------------------------------------------------- 1 | import Plots 2 | import Diagrams.Backend.Rasterific.CmdLine 3 | import Diagrams.Prelude 4 | 5 | logData = [V2 1 10, V2 2 100, V2 2.5 316, V2 3 1000] 6 | 7 | logAxis :: Axis B V2 Double 8 | logAxis = r2Axis &~ do 9 | scatterPlot' logData 10 | -- yMin ?= 200 11 | 12 | yAxis &= do 13 | logScale .= LogAxis 14 | majorTicksFunction .= logMajorTicks 5 -- <> pure [1] 15 | -- minorTicksFunction .= minorTicksHelper 5 16 | 17 | main = mainWith logAxis 18 | 19 | -------------------------------------------------------------------------------- /test/plots-test.cabal: -------------------------------------------------------------------------------- 1 | name: plots-test 2 | version: 0.1.0.0 3 | build-type: Simple 4 | cabal-version: >= 1.2 5 | 6 | executable RunExamples 7 | hs-source-dirs: . 8 | main-is: RunExamples.hs 9 | build-depends: base 10 | , plots 11 | , shake 12 | , filepath 13 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 14 | default-language: Haskell2010 15 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_HeatMap_pixelHeatRenderExample.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/line.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | import Plots 4 | import Diagrams.Prelude 5 | import Diagrams.Backend.Rasterific.CmdLine 6 | 7 | import Data.Typeable 8 | 9 | mydata1 = [(1,3), (2,5.5), (3.2, 6), (3.5, 6.1)] 10 | mydata2 = mydata1 & each . _1 *~ 0.5 11 | mydata3 = [V2 1.2 2.7, V2 2 5.1, V2 3.2 2.6, V2 3.5 5] 12 | 13 | myaxis :: Axis B V2 Double 14 | myaxis = r2Axis &~ do 15 | linePlot' mydata1 16 | linePlot mydata2 $ do 17 | key "data 2" 18 | plotColor .= black 19 | 20 | linePlot mydata3 $ key "data 3" 21 | 22 | main :: IO () 23 | main = r2AxisMain myaxis 24 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_HeatMap_pixelHeatRenderExample'.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/polar.hs: -------------------------------------------------------------------------------- 1 | import Plots 2 | import Diagrams.Prelude 3 | import Diagrams.Coordinates.Polar 4 | import Diagrams.Coordinates.Isomorphic 5 | import Diagrams.Backend.Rasterific.CmdLine 6 | import Plots.Legend 7 | 8 | ps :: [Polar Double] 9 | ps = [ mkPolar x theta | x <- [35], theta <- [20@@deg, 40@@deg .. fullTurn] ] 10 | 11 | myAxis :: Axis B Polar Double 12 | myAxis = polarAxis &~ do 13 | scatterPlot ps $ key "points" 14 | 15 | let ps' = map (_r *~ 0.6) ps 16 | scatterPlot ps' $ key "points'" 17 | 18 | legendPlacement .= rightTop 19 | rLabel .= "r-axis" 20 | thetaLabel .= "theta-axis" 21 | 22 | main :: IO () 23 | main = mainWith myAxis 24 | 25 | -------------------------------------------------------------------------------- /test/RunExamples.hs: -------------------------------------------------------------------------------- 1 | import Data.List (isInfixOf) 2 | import System.FilePath ((<.>), (), (-<.>), takeDirectory, takeBaseName) 3 | import Development.Shake 4 | 5 | main :: IO () 6 | main = shake shakeOptions $ do 7 | "examples_output/*.png" %> \out -> do 8 | let src = "examples" takeBaseName out -<.> "hs" 9 | need [src] 10 | command_ [] "stack" ["runghc", src, "--", "-o", out, "-w", "600"] 11 | 12 | action $ do 13 | sourceFiles <- getDirectoryFiles "" ["examples/*.hs"] 14 | -- let examplesToSkip = ["table"] 15 | -- isValid file = not $ any (`isInfixOf` file) examplesToSkip 16 | need ["examples_output" takeBaseName file -<.> "png" | file <- sourceFiles] 17 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Style_greysBar.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/pie.hs: -------------------------------------------------------------------------------- 1 | import Diagrams.Prelude 2 | import Plots 3 | import Diagrams.Coordinates.Polar 4 | import Diagrams.Backend.Rasterific.CmdLine 5 | import Control.Lens.Operators ((&~)) 6 | import Control.Monad (when) 7 | 8 | pieData :: [(String, Double)] 9 | pieData = [("red", 3), ("blue", 6), ("green", 9), ("purple", 4)] 10 | 11 | pieAxis :: Axis Rasterific Polar Double 12 | pieAxis = polarAxis &~ do 13 | piePlot pieData snd $ do 14 | wedgeKeys fst 15 | -- when (nm=="red") $ wedgeOffset .= 0.2 16 | -- wedgeWidth %= (^/ 2) 17 | -- wedgeInnerRadius .= 0.5 18 | 19 | -- scatterPlot' [zero, V2 1 1, V2 (-2) 0.5] 20 | 21 | -- connectingLine .= True 22 | 23 | main :: IO () 24 | -- main = r2AxisMain pieAxis -- renderPGF "examples_output/pie.pdf" (mkWidth 500) (renderAxis pieAxis) 25 | main = mainWith pieAxis 26 | -- main = renderRasterific "test.png" absolute (renderAxis pieAxis) 27 | 28 | -------------------------------------------------------------------------------- /examples/histogram.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | import Plots 4 | import Diagrams.Prelude 5 | import Diagrams.Backend.Rasterific.CmdLine 6 | 7 | myaxis :: Axis B V2 Double 8 | myaxis = r2Axis &~ do 9 | 10 | histogramPlot sampleData $ do 11 | key "sepal length" 12 | plotColor .= blue 13 | areaStyle . _opacity .= 0.5 14 | 15 | yMin .= Just 0 16 | 17 | main :: IO () 18 | main = r2AxisMain myaxis 19 | 20 | sampleData :: [Double] 21 | sampleData = 22 | [5.1,4.9,4.7,4.6,5.0,5.4,4.6,5.0,4.4,4.9 23 | ,5.4,4.8,4.8,4.3,5.8,5.7,5.4,5.1,5.7,5.1 24 | ,5.4,5.1,4.6,5.1,4.8,5.0,5.0,5.2,5.2,4.7 25 | ,4.8,5.4,5.2,5.5,4.9,5.0,5.5,4.9,4.4,5.1 26 | ,5.0,4.5,4.4,5.0,5.1,4.8,5.1,4.6,5.3,5.0 27 | ,7.0,6.4,6.9,5.5,6.5,5.7,6.3,4.9,6.6,5.2 28 | ,5.0,5.9,6.0,6.1,5.6,6.7,5.6,5.8,6.2,5.6 29 | ,5.9,6.1,6.3,6.1,6.4,6.6,6.8,6.7,6.0,5.7 30 | ,5.5,5.5,5.8,6.0,5.4,6.0,6.7,6.3,5.6,5.5 31 | ,5.5,6.1,5.8,5.0,5.6,5.7,5.7,6.2,5.1,5.7 32 | ,6.3,5.8,7.1,6.3,6.5,7.6,4.9,7.3,6.7,7.2 33 | ,6.5,6.4,6.8,5.7,5.8,6.4,6.5,7.7,7.7,6.0 34 | ,6.9,5.6,7.7,6.3,6.7,7.2,6.2,6.1,6.4,7.2 35 | ,7.4,7.9,6.4,6.3,6.1,7.7,6.3,6.4,6.0,6.9 36 | ,6.7,6.9,5.8,6.8,6.7,6.7,6.3,6.5,6.2,5.9 37 | ] 38 | 39 | -------------------------------------------------------------------------------- /examples/limits.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module Limits where 4 | 5 | import Plots 6 | import Diagrams.Prelude 7 | import Diagrams.Backend.Rasterific.CmdLine 8 | 9 | mydata1 = [(1,3), (2,5.5), (3.2, 6), (3.5, 6.1)] 10 | mydata2 = mydata1 & each . _1 *~ 0.5 11 | mydata3 = [V2 1.2 2.7, V2 2 5.1, V2 3.2 2.6, V2 3.5 5] 12 | 13 | myaxis :: Axis B V2 Double 14 | myaxis = r2Axis &~ do 15 | scatterPlot mydata1 $ key "data 1" 16 | scatterPlot mydata2 $ key "data 2" 17 | scatterPlot mydata3 $ key "data 3" 18 | 19 | -- The axis minimum and maximum are :: Maybe n. Where 'Nothing' uses 20 | -- the infered bounds from the axis data and 'Just a' uses a as the 21 | -- bound. To set the bound you can use the ?= operator or 22 | -- equivilantly, .= Just a 23 | xMin ?= 0 24 | xMax .= Just 10 25 | 26 | -- Coordinate labels are stored in the 'Axis' under axisLabels. 27 | -- Changing the label text is easy: 28 | xLabel .= "x-axis" 29 | yLabel .= "y-axis" 30 | 31 | -- More advanced things like changing text rendering or position of 32 | -- axis label can be changed by lenses onto the 'AxisLabel' for that 33 | -- axis. 34 | axisLabelStyle %= fc red 35 | xAxis . axisLabelPosition .= UpperAxisLabel 36 | yAxis . axisLabelStyle . _fontSize .= local 12 37 | 38 | main :: IO () 39 | main = r2AxisMain myaxis 40 | -------------------------------------------------------------------------------- /examples/criterion.csv: -------------------------------------------------------------------------------- 1 | Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB 2 | pcg-fast/Word32,2.5478246508587825e-9,2.5100051364491915e-9,2.6170439017856144e-9,1.6505345424172878e-10,1.0642244226637474e-10,2.394406353431119e-10 3 | pcg-fast/Word32B,7.617835087754578e-9,7.597534923252808e-9,7.642871459971822e-9,7.15470071646561e-11,5.896455365988448e-11,8.672712169530312e-11 4 | pcg-single/Word32,2.489457565765152e-9,2.472257927905715e-9,2.5085312572935768e-9,6.406599094283177e-11,5.6312712622471123e-11,7.456903823492487e-11 5 | pcg-unique/Word32,2.5287319035400075e-9,2.5207778596445076e-9,2.5373593841133952e-9,2.879831400146342e-11,2.310777084750716e-11,3.6945505450526605e-11 6 | mwc/Word64,9.031117576890663e-9,8.920935895149431e-9,9.185954452543549e-9,4.257797212927605e-10,2.762225406350874e-10,5.396230916215677e-10 7 | mwc/Word32R,1.5986489045645512e-8,1.596649726158263e-8,1.6008696128466056e-8,7.146542494639482e-11,5.823576058193966e-11,9.116445484981961e-11 8 | mwc/Double,8.92557813101465e-9,8.89604275108177e-9,8.956238450551614e-9,9.889988712385888e-11,8.447602633074688e-11,1.2211308127042596e-10 9 | mersenne/Word64,5.518793701316405e-9,5.49907127489714e-9,5.538664025180719e-9,6.443484170079774e-11,5.4615951833710774e-11,7.893961294721824e-11 10 | mersenne/Double,7.210547645393152e-9,7.18973723910596e-9,7.2352280916652536e-9,7.68988260390865e-11,6.616461428998667e-11,9.12376712577296e-11 11 | -------------------------------------------------------------------------------- /src/Plots/Name.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | module Plots.Name where 5 | 6 | import Control.Lens 7 | -- import Data.Map (Map) 8 | import Data.Ord (comparing) 9 | import Data.Function 10 | import Data.Typeable 11 | import Diagrams.Core.Names 12 | import Diagrams.Prelude hiding (view) 13 | 14 | data PlotName n = PlotName 15 | { _plotName :: String 16 | , _namedSize2D :: SizeSpec V2 n 17 | , _namedT2 :: T2 n 18 | } deriving Typeable 19 | 20 | makeLenses ''PlotName 21 | 22 | instance Show (PlotName n) where 23 | show pn = "Plot: " ++ view plotName pn 24 | 25 | -- equating :: Eq b => (a -> b) -> a -> a -> Bool 26 | -- equating = on (==) 27 | 28 | instance Eq (PlotName n) where 29 | (==) = on (==) (view plotName) 30 | 31 | instance Ord (PlotName n) where 32 | compare = comparing (view plotName) 33 | 34 | instance Typeable n => IsName (PlotName n) 35 | 36 | -- _AName :: IsName a => Prism' AName a 37 | -- _AName = prism' AName (\(AName a) -> cast a) 38 | 39 | -- _Names :: IsName a => Traversal' Name a 40 | -- _Names = _Wrapped' . traverse . _AName 41 | 42 | -- _NamedString :: Traversal' Name String 43 | -- _NamedString = _Names 44 | 45 | -- _NamedPlot :: Typeable n => Traversal' Name (PlotName n) 46 | -- _NamedPlot = _Names 47 | 48 | -- diaNames :: OrderedField n => QDiagram b V2 n Any -> Map Name [P2 n] 49 | -- diaNames = over (mapped . traversed) location . view (subMap . _Wrapped') 50 | 51 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2014: Christopher Chalmers 2 | 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ryan Yates nor the names of other 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Axis_ColourBar_pathColourBarExample.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # plots 2 | 3 | [![Haddock](https://rawgit.com/cchalmers/plots/gh-pages/haddock.svg)](https://cchalmers.github.io/plots/) 4 | [![Travis](https://api.travis-ci.org/cchalmers/plots.svg?branch=master)](https://travis-ci.org/cchalmers/plots) 5 | [![Hackage](https://img.shields.io/hackage/v/plots.svg)](https://hackage.haskell.org/package/plots) 6 | 7 | 8 | `plots` is a plotting library based on [diagrams](http://projects.haskell.org/diagrams). 9 | 10 | Some sample plots: 11 | 12 | #### Scatter plot 13 | ![scatter-plot](https://rawgit.com/cchalmers/plots/master/diagrams/src_Plots_Types_Scatter_scatterExample'.svg) 14 | 15 | #### Bar plot 16 | ![bar-plot](https://rawgit.com/cchalmers/plots/master/diagrams/src_Plots_Types_Bar_barExample'.svg) 17 | 18 | #### Heat map 19 | ![heat-map](https://rawgit.com/cchalmers/plots/master/diagrams/src_Plots_Types_HeatMap_heatMapIndexedExample'.svg) 20 | 21 | There are many more plots to be added. There are also plans to support 22 | 3D plots. Issues and pull requests welcome. 23 | 24 | ## Examples 25 | 26 | There are several example plots in the `examples/` directory. To build 27 | the examples, first ensure that you have `stack` installed, and that you 28 | have a `stack.yaml` file in this directory that contains the lines: 29 | 30 | ```yaml 31 | packages: 32 | - '.' 33 | - 'test' 34 | ``` 35 | 36 | (If you run the command `stack init`, stack will automatically generate 37 | the `stack.yaml` file with the appropriate packages.) 38 | 39 | You can then build the examples using ```sh stack build stack exec 40 | RunExamples ``` The `RunExamples` script will generate `png` files in 41 | the `examples_output` directory. 42 | 43 | **Note:** The `RunExamples` script re-builds an example if the output 44 | file (`examples_output/X.png`) does not exist, or if the source file 45 | (`examples/X.hs`) has been modified since the last time the script was 46 | run. 47 | 48 | **Note 2:** If the `RunExamples` script fails with errors such as 49 | `Failed to load interface for ...` then you will need to `stack 50 | install` the required packages. In my case (with a freshly installed 51 | stack), I needed to run the following `stack install wreq cassava 52 | diagrams-rasterific`. 53 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Pie_pieExample'.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /src/Plots/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-# LANGUAGE UndecidableInstances #-} 7 | 8 | module Plots.Util 9 | ( pathFromVertices 10 | , minMaxOf 11 | , enumFromToN 12 | , whenever 13 | 14 | -- * State helpers 15 | , (&=) 16 | , (&~~) 17 | ) where 18 | 19 | import Control.Lens 20 | import Control.Monad.State 21 | import Data.Bool 22 | 23 | import Diagrams.Prelude hiding (diff) 24 | 25 | -- | Similar to '(%=)' but takes a state modification instead of a 26 | -- function. 27 | (&=) :: MonadState s m => ASetter' s b -> State b a -> m () 28 | l &= s = l %= execState s 29 | infix 3 &= 30 | 31 | -- | Similar to '(&~)' but works with 'StateT' and returns it in @m@. 32 | (&~~) :: Monad m => s -> StateT s m a -> m s 33 | l &~~ s = execStateT s l 34 | infix 1 &~~ 35 | 36 | -- | @enumFromToN a b n@ calculates a list from @a@ to @b@ in @n@ steps. 37 | enumFromToN :: Fractional n => n -> n -> Int -> [n] 38 | enumFromToN a b n = go n a 39 | where 40 | go !i !x | i < 1 = [x] 41 | | otherwise = x : go (i - 1) (x + diff) 42 | diff = (b - a) / fromIntegral n 43 | 44 | -- | Apply a function if the predicate is true. 45 | whenever :: Bool -> (a -> a) -> a -> a 46 | whenever b f = bool id f b 47 | 48 | ------------------------------------------------------------------------ 49 | -- Diagrams 50 | ------------------------------------------------------------------------ 51 | 52 | -- | Type specialised version of 'fromVertices'. 53 | pathFromVertices :: (Metric v, OrderedField n) => [Point v n] -> Path v n 54 | pathFromVertices = fromVertices 55 | {-# INLINE pathFromVertices #-} 56 | 57 | -- | Minmax of a getter in the form @V2 min max@. Returns @(V2 58 | -- (-Infinity) Infinity)@ for empty folds. 59 | minMaxOf :: (Fractional a, Ord a) => Getting (Endo (Endo (V2 a))) s a -> s -> (a,a) 60 | minMaxOf l = foldlOf' l (\(V2 mn mx) a -> V2 (min mn a) (max mx a)) (V2 (1/0) (-1/0)) 61 | <&> \(V2 x y) -> (x,y) 62 | -- (\acc a -> acc <**> V2 min max ?? a) 63 | -- V2 is used instead of a tuple because V2 is strict. 64 | {-# INLINE minMaxOf #-} 65 | 66 | -------------------------------------------------------------------------------- /plots.cabal: -------------------------------------------------------------------------------- 1 | name: plots 2 | version: 0.1.1.5 3 | synopsis: Diagrams based plotting library 4 | homepage: http://github.com/cchalmers/plots 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Christopher Chalmers 8 | maintainer: c.chalmers@me.com 9 | bug-reports: http://github.com/cchalmers/plots 10 | stability: Experimental 11 | category: Graphics 12 | build-type: Simple 13 | cabal-version: 1.18 14 | extra-source-files: README.md diagrams/*.svg 15 | extra-doc-files: diagrams/*.svg 16 | description: Diagrams based plotting library. 17 | tested-with: GHC==9.2.1, GHC==8.8.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 18 | 19 | source-repository head 20 | type: git 21 | location: http://github.com/cchalmers/plots 22 | 23 | library 24 | exposed-modules: 25 | Plots 26 | Plots.Axis 27 | Plots.Axis.ColourBar 28 | Plots.Axis.Grid 29 | Plots.Axis.Labels 30 | Plots.Axis.Line 31 | Plots.Axis.Render 32 | Plots.Axis.Ticks 33 | Plots.Axis.Title 34 | Plots.Axis.Scale 35 | Plots.Legend 36 | Plots.Name 37 | Plots.Style 38 | Plots.Types 39 | Plots.Types.Bar 40 | Plots.Types.Histogram 41 | Plots.Types.HeatMap 42 | Plots.Types.Line 43 | Plots.Types.Pie 44 | Plots.Types.Scatter 45 | Plots.Util 46 | Diagrams.Coordinates.Isomorphic 47 | Diagrams.Coordinates.Polar 48 | hs-source-dirs: src 49 | build-depends: 50 | base >= 4.7 && < 5.0, 51 | adjunctions, 52 | colour, 53 | containers >= 0.3 && < 0.8, 54 | data-default >= 0.5 && < 0.9, 55 | diagrams-core >= 1.3 && < 1.6, 56 | diagrams-lib >= 1.3 && < 1.6, 57 | directory, 58 | distributive, 59 | transformers, 60 | filepath, 61 | fingertree, 62 | hashable >= 1.1 && < 1.6, 63 | lens >= 4.6 && < 5.4, 64 | linear >= 1.2 && < 2.0, 65 | monoid-extras >= 0.3 && < 0.7, 66 | mtl >= 1.0 && < 2.4, 67 | optparse-applicative, 68 | statistics, 69 | process, 70 | semigroupoids, 71 | semigroups, 72 | split >= 0.1.2 && < 0.5, 73 | time, 74 | vector, 75 | profunctors, 76 | JuicyPixels, 77 | intervals, 78 | base-orphans 79 | 80 | ghc-options: -Wall 81 | 82 | default-language: Haskell2010 83 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Style_blackAndWhitePic.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Style_fadedColourPic.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Style_vividColourPic.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Pie_piePlotExample.svg: -------------------------------------------------------------------------------- 1 | purplegreenbluered -------------------------------------------------------------------------------- /unfinished/Surface.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | {-# LANGUAGE UndecidableInstances #-} 8 | {-# LANGUAGE FunctionalDependencies #-} 9 | {-# LANGUAGE OverlappingInstances #-} 10 | {-# LANGUAGE ViewPatterns #-} 11 | {-# LANGUAGE TypeOperators #-} 12 | 13 | {-# OPTIONS_GHC -fno-warn-orphans #-} 14 | 15 | module Plots.Types.Surface where 16 | -- ( SurfaceType (..) 17 | -- , SurfacePlot 18 | -- , mkSurfacePlot 19 | -- ) where 20 | 21 | -- import Control.Lens hiding (transform, ( # ), lmap) 22 | -- import Diagrams.LinearMap 23 | -- import Data.Default 24 | -- import Data.Typeable 25 | -- import Diagrams.Prelude hiding (view) 26 | -- import Diagrams.Extra 27 | -- import Data.Foldable 28 | 29 | -- import Plots.Types 30 | 31 | -- import qualified Data.Vector as V 32 | -- import Data.Vector (Vector, (!)) 33 | 34 | -- data SurfaceType = Mesh 35 | -- | Faceted 36 | -- | Flat 37 | 38 | -- data SurfacePlot n = SurfacePlot 39 | -- { _surfaceFunction :: n -> n -> n 40 | -- } deriving Typeable 41 | 42 | -- makeLenses ''SurfacePlot 43 | 44 | -- type instance V (SurfacePlot n) = V3 45 | -- type instance N (SurfacePlot n) = n 46 | 47 | -- instance TypeableFloat n => Default (SurfacePlot n) where 48 | -- def = SurfacePlot 49 | -- { _surfaceFunction = \_ _ -> 0 50 | -- } 51 | 52 | -- -- could probably do something fancy with zippers but keep it simple for now. 53 | -- mkSquares :: OrderedField n => Vector (Vector (P3 n)) -> [(P3 n, Path V3 n)] 54 | -- mkSquares v = do 55 | -- let i = V.length v 56 | -- j = V.length $ V.head v 57 | 58 | -- x <- [0 .. i-2] 59 | -- y <- [0 .. j-2] 60 | 61 | -- let ps = [ v ! x ! y 62 | -- , v ! (x+1) ! y 63 | -- , v ! (x+1) ! (y+1) 64 | -- , v ! x ! (y+1) ] 65 | 66 | -- pure (centroid ps, closePath $ pathFromVertices ps) 67 | 68 | -- closePath :: Path v n -> Path v n 69 | -- closePath = over (_Wrapped' . mapped . located) closeTrail 70 | 71 | -- calcPoints :: (Fractional n, Enum n) => (n -> n -> n) -> Int -> V2 (n, n) -> Vector (Vector (P3 n)) 72 | -- calcPoints f n (V2 (xa,xb) (ya,yb)) = V.fromList $ map ylines ys 73 | -- where 74 | -- ylines y = V.fromList [ mkP3 x y (f x y) | x <- xs ] 75 | -- -- 76 | -- xs = [xa, xa + (xb - xa) / fromIntegral n .. xb] 77 | -- ys = [ya, ya + (xb - xa) / fromIntegral n .. yb] 78 | 79 | -- drawSquare :: (TypeableFloat n, Renderable (Path V2 n) b) 80 | -- => T3 n -> (V3 n -> V2 n) -> T2 n -> (P3 n, Path V3 n) -> QDiagram b V2 n Any 81 | -- drawSquare t3 l t2 (fromRational . toRational . view _z -> z, sq) 82 | -- = sq # transform t3 83 | -- # lmap l 84 | -- # transform t2 85 | -- # stroke 86 | -- # fc (blend z grey red) 87 | 88 | -- instance (TypeableFloat n, Enum n, Typeable b, Renderable (Path V2 n) b) => Plotable (SurfacePlot n) b where 89 | -- renderPlotable _ _ t3 l t2 sp = foldMap (drawSquare t3 l t2) sqs 90 | -- # lineJoin LineJoinBevel 91 | -- where sqs = mkSquares $ calcPoints f 20 bs 92 | -- f = sp ^. surfaceFunction 93 | -- bs = V2 (0,5) (0,5) 94 | 95 | -- mkSurfacePlot :: (TypeableFloat n) 96 | -- => (n -> n -> n) -> SurfacePlot n 97 | -- mkSurfacePlot f = def & surfaceFunction .~ f 98 | 99 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This Travis job script has been generated by a script via 2 | # 3 | # make_travis_yml_2.hs 'plots.cabal' 4 | # 5 | # For more information, see https://github.com/hvr/multi-ghc-travis 6 | # 7 | language: c 8 | sudo: false 9 | 10 | git: 11 | submodules: false # whether to recursively clone submodules 12 | 13 | cache: 14 | directories: 15 | - $HOME/.cabal/packages 16 | - $HOME/.cabal/store 17 | 18 | before_cache: 19 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log 20 | # remove files that are regenerated by 'cabal update' 21 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* 22 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json 23 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache 24 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar 25 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx 26 | 27 | matrix: 28 | include: 29 | - compiler: "ghc-7.8.4" 30 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 31 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}} 32 | - compiler: "ghc-7.10.3" 33 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 34 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}} 35 | - compiler: "ghc-8.0.2" 36 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 37 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} 38 | 39 | before_install: 40 | - HC=${CC} 41 | - unset CC 42 | - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH 43 | - PKGNAME='plots' 44 | 45 | install: 46 | - cabal --version 47 | - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" 48 | - BENCH=${BENCH---enable-benchmarks} 49 | - TEST=${TEST---enable-tests} 50 | - travis_retry cabal update -v 51 | - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config 52 | - rm -fv cabal.project.local 53 | - "echo 'packages: .' > cabal.project" 54 | - rm -f cabal.project.freeze 55 | - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 56 | - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 57 | 58 | # Here starts the actual work to be performed for the package under test; 59 | # any command which exits with a non-zero exit code causes the build to fail. 60 | script: 61 | - if [ -f configure.ac ]; then autoreconf -i; fi 62 | - rm -rf dist/ 63 | - cabal sdist # test that a source-distribution can be generated 64 | - cd dist/ 65 | - SRCTAR=(${PKGNAME}-*.tar.gz) 66 | - SRC_BASENAME="${SRCTAR/%.tar.gz}" 67 | - tar -xvf "./$SRC_BASENAME.tar.gz" 68 | - cd "$SRC_BASENAME/" 69 | ## from here on, CWD is inside the extracted source-tarball 70 | - rm -fv cabal.project.local 71 | - "echo 'packages: .' > cabal.project" 72 | # this builds all libraries and executables (without tests/benchmarks) 73 | - rm -f cabal.project.freeze 74 | - cabal new-build -w ${HC} --disable-tests --disable-benchmarks 75 | # this builds all libraries and executables (including tests/benchmarks) 76 | # - rm -rf ./dist-newstyle 77 | - cabal new-build -w ${HC} ${TEST} ${BENCH} 78 | 79 | # there's no 'cabal new-test' yet, so let's emulate for now 80 | - TESTS=( $(awk 'tolower($0) ~ /^test-suite / { print $2 }' *.cabal) ) 81 | - if [ "$TEST" != "--enable-tests" ]; then TESTS=(); fi 82 | - shopt -s globstar; 83 | RC=true; for T in ${TESTS[@]}; do echo "== $T =="; 84 | if dist-newstyle/build/**/$SRC_BASENAME/**/build/$T/$T; then echo "= $T OK ="; 85 | else echo "= $T FAILED ="; RC=false; fi; done; $RC 86 | 87 | # EOF 88 | -------------------------------------------------------------------------------- /src/Plots/Axis/Line.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | ----------------------------------------------------------------------------- 9 | -- | 10 | -- Module : Plots.Axis.Line 11 | -- Copyright : (C) 2015 Christopher Chalmers 12 | -- License : BSD-style (see the file LICENSE) 13 | -- Maintainer : Christopher Chalmers 14 | -- Stability : experimental 15 | -- Portability : non-portable 16 | -- 17 | -- The lines that make up an axis. 18 | -- 19 | ---------------------------------------------------------------------------- 20 | module Plots.Axis.Line 21 | ( -- * Grid lines 22 | AxisLine 23 | , HasAxisLine (..) 24 | 25 | -- * Axis line types 26 | , AxisLineType (..) 27 | 28 | ) where 29 | 30 | import Control.Lens hiding (( # )) 31 | import Data.Data 32 | import Data.Default 33 | 34 | import Diagrams.Prelude 35 | import Plots.Types 36 | 37 | -- | Where axis line for coordinate should be drawn. The 'Default' is 38 | -- 'BoxAxisLine'. 39 | data AxisLineType 40 | = BoxAxisLine 41 | | LeftAxisLine 42 | | MiddleAxisLine 43 | | RightAxisLine 44 | | NoAxisLine 45 | deriving (Show, Eq, Typeable) 46 | 47 | instance Default AxisLineType where 48 | def = BoxAxisLine 49 | 50 | -- | Information about position and style of axis lines. 51 | data AxisLine v n = AxisLine 52 | { alType :: AxisLineType 53 | , alArrowOpts :: Maybe (ArrowOpts n) 54 | , alVisible :: Bool 55 | , alStyle :: Style v n 56 | } deriving Typeable 57 | 58 | type instance V (AxisLine v n) = v 59 | type instance N (AxisLine v n) = n 60 | 61 | -- | Class of object that have an 'AxisLine'. 62 | class HasAxisLine f a where 63 | -- | Lens onto the 'AxisLine'. 64 | axisLine :: LensLike' f a (AxisLine (V a) (N a)) 65 | 66 | -- | The position of the axis line around the axis. 67 | -- 68 | -- 'Default' is 'BoxAxisLine'. 69 | axisLineType :: Functor f => LensLike' f a AxisLineType 70 | axisLineType = axisLine . lens alType (\al sty -> al {alType = sty}) 71 | 72 | -- | The options for if you want the axis line to have arrows at the 73 | -- end. 74 | -- 75 | -- 'Default' is 'Nothing'. 76 | -- 77 | -- XXX (feature not currently implimented) 78 | axisLineArrowOpts :: Functor f => LensLike' f a (Maybe (ArrowOpts (N a))) 79 | axisLineArrowOpts = axisLine . lens alArrowOpts (\al sty -> al {alArrowOpts = sty}) 80 | 81 | -- | The 'Style' applied to the axis line 82 | axisLineStyle :: Functor f => LensLike' f a (Style (V a) (N a)) 83 | axisLineStyle = axisLine . lens alStyle (\al sty -> al {alStyle = sty}) 84 | 85 | instance HasAxisLine f (AxisLine v n) where 86 | axisLine = id 87 | 88 | -- Note this is different from 'NoAxisLine'. Other parts that are 89 | -- tied to the axis line will still be present when 90 | -- 'axisLineVisible' is 'False'. But if 'NoAxisLine' is set, there 91 | -- never any line for those things to attach to, so they don't 92 | -- exist. 93 | instance HasVisibility (AxisLine v n) where 94 | visible = lens alVisible (\al b -> al {alVisible = b}) 95 | 96 | instance Typeable n => Default (AxisLine v n) where 97 | def = AxisLine 98 | { alType = def 99 | , alArrowOpts = def 100 | , alVisible = True 101 | , alStyle = mempty 102 | } 103 | 104 | -------------------------------------------------------------------------------- /src/Plots.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Plots 5 | -- Copyright : (C) 2015 Christopher Chalmers 6 | -- License : BSD-style (see the file LICENSE) 7 | -- Maintainer : Christopher Chalmers 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- This module defines types for axis labels and tick labels. 12 | -- 13 | ---------------------------------------------------------------------------- 14 | module Plots 15 | ( 16 | 17 | -- | Axis definition (r2Axis and polarAxis), aspect ratio and scaling. 18 | module Plots.Axis 19 | 20 | -- | 'AxisStyle's are used to provide default colours and shapes 21 | -- for the plots of an axis. 22 | , module Plots.Style 23 | 24 | -------------------------------------------------------------------- 25 | -- * Plot Types 26 | -------------------------------------------------------------------- 27 | 28 | -- ** Scatter plot 29 | -- | Scatter plots display data as a collection of points. A scatter 30 | -- plot can also be configured to have a different style / 31 | -- transform depending on the data. 32 | 33 | -- | Scatter and bubble. Scatter and bubble plot api. 34 | , module Plots.Types.Scatter 35 | 36 | -- | Bar plots, individual or grouped. 37 | , module Plots.Types.Bar 38 | 39 | -- ** Line plot 40 | 41 | -- | Line, trail and path. Line plot, steps plot api & api for trail 42 | -- and path. 43 | , module Plots.Types.Line 44 | 45 | -- ** Heat map plot 46 | 47 | -- | 2D mapping from 'Double's to colours. 48 | , module Plots.Types.HeatMap 49 | 50 | -- ** Histogram plot 51 | 52 | -- | Histogram. API for histograms. 53 | , module Plots.Types.Histogram 54 | 55 | -- | Wedge and annular wedge. API for wedge, annular wedge and pie. 56 | , module Plots.Types.Pie 57 | 58 | -------------------------------------------------------------------- 59 | -- * Low level 60 | -------------------------------------------------------------------- 61 | 62 | -- | Definitions of bounds, axis scale, orientation, legend, generic 63 | -- plot, plot spec and so on. 64 | , module Plots.Types 65 | 66 | -- | Grid lines and styles. 67 | , module Plots.Legend 68 | 69 | -- | Grid lines and styles. 70 | , module Plots.Axis.Grid 71 | 72 | -- | Axis labels and tick labels. 73 | , module Plots.Axis.Labels 74 | 75 | -- | Rendering system for polar and r2 axis. 76 | , module Plots.Axis.Render 77 | 78 | -- | The scaling/size options for an axis. 79 | , module Plots.Axis.Scale 80 | 81 | -- | Ticks properties and placement. 82 | , module Plots.Axis.Ticks 83 | 84 | -- | The plot title. 85 | , module Plots.Axis.Title 86 | 87 | -- | Colour bars. 88 | , module Plots.Axis.ColourBar 89 | 90 | -- | Polar coordinates. 91 | , module Diagrams.Coordinates.Polar 92 | 93 | , (&=), (&~~) 94 | 95 | ) where 96 | 97 | import Diagrams.Coordinates.Polar 98 | 99 | import Plots.Axis 100 | import Plots.Axis.ColourBar 101 | import Plots.Axis.Grid 102 | import Plots.Axis.Labels 103 | import Plots.Axis.Render 104 | import Plots.Axis.Scale 105 | import Plots.Axis.Title 106 | import Plots.Axis.Ticks 107 | 108 | import Plots.Legend 109 | import Plots.Style 110 | import Plots.Types 111 | import Plots.Util 112 | 113 | import Plots.Types.Bar 114 | import Plots.Types.HeatMap 115 | import Plots.Types.Histogram 116 | import Plots.Types.Line 117 | import Plots.Types.Pie 118 | import Plots.Types.Scatter 119 | 120 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_HeatMap_pathHeatRenderExample.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /src/Plots/Axis/Title.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | ----------------------------------------------------------------------------- 9 | -- | 10 | -- Module : Plots.Axis.Title 11 | -- Copyright : (C) 2016 Christopher Chalmers 12 | -- License : BSD-style (see the file LICENSE) 13 | -- Maintainer : Christopher Chalmers 14 | -- Stability : experimental 15 | -- Portability : non-portable 16 | -- 17 | -- The title used for a plot. 18 | -- 19 | ---------------------------------------------------------------------------- 20 | module Plots.Axis.Title 21 | ( Title 22 | , HasTitle (..) 23 | , drawTitle 24 | ) where 25 | 26 | import Data.Default 27 | import Data.Typeable 28 | 29 | import Diagrams.Prelude 30 | import Diagrams.TwoD.Text 31 | import Plots.Types 32 | 33 | data Title b v n = Title 34 | { tVisible :: Bool 35 | , tTxt :: String 36 | , tTxtFun :: TextAlignment n -> String -> QDiagram b v n Any 37 | , tStyle :: Style v n 38 | , tPlacement :: Placement 39 | , tAlignment :: TextAlignment n 40 | , tGap :: n 41 | } deriving Typeable 42 | 43 | instance (Renderable (Text n) b, TypeableFloat n) 44 | => Default (Title b V2 n) where 45 | def = Title 46 | { tVisible = True 47 | , tTxt = "" 48 | , tTxtFun = mkText 49 | , tStyle = mempty # fontSize (output 11) 50 | , tPlacement = midAbove 51 | , tAlignment = BoxAlignedText 0.5 0 52 | , tGap = 20 53 | } 54 | 55 | type instance V (Title b v n) = v 56 | type instance N (Title b v n) = n 57 | 58 | instance HasVisibility (Title b v n) where 59 | visible = lens tVisible (\t b -> t {tVisible = b}) 60 | 61 | instance HasGap (Title b v n) where 62 | gap = lens tGap (\t g -> t {tGap = g}) 63 | 64 | instance HasPlacement (Title b v n) where 65 | placement = titlePlacement 66 | 67 | class HasTitle a b | a -> b where 68 | title :: Lens' a (Title b (V a) (N a)) 69 | 70 | -- | The text used for the title. If the string is empty, no title is 71 | -- drawn. 72 | -- 73 | -- Default is @""@ 74 | titleText :: Lens' a String 75 | titleText = title . lens tTxt (\t s -> t {tTxt = s}) 76 | 77 | -- | The style applied to the title. 78 | -- 79 | -- Default is 'mempty'. 80 | titleStyle :: Lens' a (Style (V a) (N a)) 81 | titleStyle = title . lens tStyle (\t s -> t {tStyle = s}) 82 | 83 | -- | The placement of the title against the axis. 84 | -- 85 | -- Default is 'mempty'. 86 | titlePlacement :: Lens' a Placement 87 | titlePlacement = title . lens tPlacement (\t s -> t {tPlacement = s}) 88 | 89 | -- | The function used to draw the title text. 90 | -- 91 | -- Default is 'mkText'. 92 | titleTextFunction :: Lens' a (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any) 93 | titleTextFunction = title . lens tTxtFun (\t s -> t {tTxtFun = s}) 94 | 95 | -- | The 'TextAlignment' used for the title text. This is given to the 96 | -- 'titleTextFunction'. 97 | -- 98 | -- Default is @'BoxAlignedText' 0.5 0@. 99 | titleAlignment :: Lens' a (TextAlignment (N a)) 100 | titleAlignment = title . lens tAlignment (\t s -> t {tAlignment = s}) 101 | 102 | -- | The gap between the axis and the title. 103 | -- 104 | -- Default is 'mempty'. 105 | titleGap :: Lens' a (N a) 106 | titleGap = title . lens tGap (\t s -> t {tGap = s}) 107 | 108 | instance HasTitle (Title b v n) b where 109 | title = id 110 | 111 | -- | Render the title and place it around the bounding box. 112 | drawTitle 113 | :: TypeableFloat n 114 | => BoundingBox V2 n 115 | -> Title b V2 n 116 | -> QDiagram b V2 n Any 117 | drawTitle bb t 118 | | t ^. hidden || nullOf titleText t = mempty 119 | | otherwise = placeAgainst 120 | bb 121 | (t ^. titlePlacement) 122 | (t ^. titleGap) 123 | tDia 124 | where 125 | tDia = tTxtFun t (t ^. titleAlignment) (tTxt t) 126 | # applyStyle (tStyle t) 127 | 128 | -------------------------------------------------------------------------------- /examples/criterion.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE UndecidableInstances #-} 8 | {-# LANGUAGE RecordWildCards #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE FlexibleContexts #-} 11 | {-# LANGUAGE OverloadedStrings #-} 12 | {-# LANGUAGE TupleSections #-} 13 | 14 | -- | This example requires cassava for csv parsing. 15 | module Criterion where 16 | 17 | import Plots 18 | import Plots.Types.Bar 19 | import Diagrams.Prelude 20 | import Diagrams.Backend.Rasterific.CmdLine 21 | 22 | import Data.Csv hiding ((.=)) 23 | import qualified Data.ByteString.Lazy as BS 24 | import qualified Data.Vector as V 25 | import Control.Applicative (empty) 26 | import Data.Function (on) 27 | import Data.List (groupBy) 28 | import Control.Monad.State (execStateT, modify, MonadIO, liftIO) 29 | import qualified Data.Foldable as Foldable 30 | 31 | -- Misc stuff ---------------------------------------------------------- 32 | 33 | barAxis :: Axis B V2 Double 34 | barAxis = r2Axis &~ hideGridLines 35 | 36 | -- Criterion csv parsing ----------------------------------------------- 37 | 38 | data CResult = CResult 39 | { _name :: !String 40 | , _mean :: !Double 41 | , _meanLB :: !Double 42 | , _meanUB :: !Double 43 | , _stddev :: !Double 44 | , _stddevLB :: !Double 45 | , _stddevUB :: !Double 46 | } deriving Show 47 | 48 | makeLenses ''CResult 49 | 50 | instance FromNamedRecord CResult where 51 | parseNamedRecord m = 52 | CResult <$> m .: "Name" <*> m .: "Mean" <*> 53 | m .: "MeanLB" <*> m .: "MeanUB" <*> 54 | m .: "Stddev" <*> m .: "StddevUB" <*> 55 | m .: "StddevLB" 56 | 57 | instance FromRecord CResult where 58 | parseRecord v 59 | | V.length v == 7 = 60 | CResult <$> v .! 0 <*> v .! 1 <*> v .! 2 <*> 61 | v .! 3 <*> v .! 4 <*> v .! 5 <*> 62 | v .! 6 63 | | otherwise = empty 64 | 65 | -- | Read a @.csv@ file from criterion's output. 66 | readCriterion :: MonadIO m => FilePath -> m (V.Vector CResult) 67 | readCriterion path = liftIO $ do 68 | csv <- BS.readFile path 69 | let Right v = decode HasHeader csv 70 | return v 71 | 72 | -- | Group criterion results by name. 73 | groupCriterion :: [CResult] -> [(String, [CResult])] 74 | groupCriterion = map collate . groupBy ((==) `on` fst) . map splitName 75 | where 76 | splitName r = (a, r & name .~ tail b) 77 | where (a,b) = break (=='/') (r ^. name) 78 | collate [] = ("",[]) 79 | collate as@((n,_):_) = (n, map snd as) 80 | 81 | -- Making criterion plots ---------------------------------------------- 82 | 83 | -- => BarPlotOpts n -> [a] -> (a -> [n]) -> (a -> State (PlotProperties b V2 n) ()) -> m () 84 | 85 | -- | Given a filepath to a criterion @.csv@ file, make an axis. 86 | criterionAxis :: FilePath -> IO (Axis B V2 Double) 87 | criterionAxis path = execStateT ?? barAxis $ do 88 | results <- readCriterion path 89 | 90 | let rss = groupCriterion (Foldable.toList results) 91 | multiBars rss (map _mean . snd) $ do 92 | runningBars 93 | horizontal .= True 94 | labelBars (rss ^.. each . _2 . each . name) 95 | barWidth .= 0.6 96 | onBars $ \cresults -> key (fst cresults) 97 | 98 | minorTicks . visible .= False 99 | xAxis . axisLabelText .= "average time (s)" 100 | xAxis . majorGridLines . visible .= True 101 | 102 | -- instance HasOrientation p => HasOrientation (Plot p b) where 103 | -- orientation = rawPlot . orientation 104 | 105 | -- Groups bars --------------------------------------------------------- 106 | 107 | -- groupedData :: [(String, [Double])] 108 | -- groupedData = 109 | -- [ ( "green" 110 | -- , [ 7, 14, 3, 17 ] 111 | -- ) 112 | -- , ( "blue" 113 | -- , [ 12, 8, 12, 10 ] 114 | -- ) 115 | -- , ( "orange" 116 | -- , [ 20, 2, 19, 7 ] 117 | -- ) 118 | -- ] 119 | 120 | -- groupedAxis :: Axis B V2 Double 121 | -- groupedAxis = barAxis &~ do 122 | -- multiBars groupedData snd $ do 123 | -- groupedBars' 0.4 124 | -- labelBars ["fun", "professional", "bright", "cost"] 125 | -- barWidth *= 0.7 126 | -- horizontal .= True 127 | 128 | -- onBars $ \ (l,_) -> do 129 | -- key l 130 | -- areaStyle . mapped . _lw .= none 131 | -- case readColourName l of 132 | -- Just c -> plotColor .= c 133 | -- Nothing -> error l -- return () 134 | 135 | -- simpleBarAxis :: Axis B V2 Double 136 | -- simpleBarAxis = barAxis &~ do 137 | -- Plots.Types.Bar.barPlot [5,3,6,7,2] $ orientation .= Vertical 138 | 139 | main :: IO () 140 | main = do 141 | dia <- criterionAxis "examples/criterion.csv" 142 | r2AxisMain dia 143 | -------------------------------------------------------------------------------- /examples/stocks.hs: -------------------------------------------------------------------------------- 1 | -- stack --install-ghc runghc --package wreq --package cassava 2 | 3 | -- example usage 4 | -- ./stocks.hs -o stocks.png -w300 5 | -- ^ output file ^ width of output (use -h for height) 6 | 7 | {-# LANGUAGE FlexibleContexts #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE NoMonomorphismRestriction #-} 10 | import Plots 11 | import Diagrams 12 | import Network.Wreq 13 | import Control.Lens 14 | import Data.Csv hiding ((.=)) 15 | import Plots.Axis 16 | import qualified Data.Vector as V 17 | import Data.ByteString.Lazy (ByteString) 18 | import Control.Arrow 19 | import Control.Monad.State (MonadState, execStateT) 20 | import Data.Foldable 21 | import Control.Monad.IO.Class 22 | import Data.Time.Clock.POSIX 23 | import Diagrams.Backend.Rasterific.CmdLine 24 | import Data.Time 25 | import Control.Monad 26 | 27 | import Data.Maybe 28 | 29 | -- Incomplete example using mtl to perform IO in the axis do notation. 30 | -- The axis show dates but currently the tick positions and the start of 31 | -- the dates are not aligned properly. (the ticks might be 1.2 years 32 | -- apart but the labels will just show the year, which is misleading) 33 | 34 | parseStocks :: ByteString -> [(String, Double)] 35 | parseStocks bs = toListOf (each . to (view _1 &&& view _7)) v 36 | where 37 | Right v = decode HasHeader bs :: Either String (V.Vector (String, Double, Double, Double, Double, Double, Double)) 38 | 39 | filterStocks :: [(String, Double)] -> [(Double, Double)] 40 | filterStocks = mapMaybe f 41 | where 42 | f (s, d) = do 43 | date <- s ^? timeFormat "%F" 44 | start <- "2014" ^? timeFormat "%Y" 45 | guard $ date > start 46 | return $ (date ^. realUTC, d) 47 | 48 | stock :: MonadIO m => String -> m (Response ByteString) 49 | stock s = liftIO $ get ("http://ichart.yahoo.com/table.csv?s=" ++ s) 50 | 51 | myaxis :: IO (Axis B V2 Double) 52 | myaxis = execStateT ?? r2Axis $ do 53 | goog <- stock "GOOG" 54 | appl <- stock "AAPL" 55 | let stocks r = filterStocks . parseStocks $ r ^. responseBody 56 | linePlot (stocks goog) $ key "google" 57 | linePlot (stocks appl) $ key "apple" 58 | xAxis . tickLabelFunction .= autoTimeLabels 59 | 60 | xLabel .= "date" 61 | yLabel .= "closing (dollars)" 62 | 63 | yMin ?= 0 64 | 65 | main :: IO () 66 | main = mainWith myaxis 67 | 68 | -- make :: Diagram B -> IO () 69 | -- make = renderRasterific "examples/stocks.png" (mkWidth 600) . frame 30 70 | 71 | ------------------------------------------------------------------------ 72 | 73 | -- linePlotOf 74 | -- :: (PointLike V2 n p, TypeableFloat n, MonadState (Axis b V2 n) m, Renderable (Path V2 n) b) 75 | -- => Fold s p -- ^ Fold over data 76 | -- -> s -- ^ Data 77 | -- -> m () -- ^ Monad action on axis 78 | -- linePlotOf f s = addPlotable (Path [mkTrailOf f s]) 79 | 80 | ------------------------------------------------------------------------ 81 | -- Time 82 | ------------------------------------------------------------------------ 83 | 84 | -- | Same as 'timeFormat' but with the option of choosing the 85 | -- 'TimeLocale'. 86 | localeTimeFormat 87 | :: (ParseTime a, FormatTime a) 88 | => TimeLocale -> String -> Prism' String a 89 | localeTimeFormat tl s = prism' (formatTime tl s) (parseTimeM False tl s) 90 | {-# INLINE localeTimeFormat #-} 91 | 92 | -- | A prism between a parse-able format and its string representation 93 | -- from the given format string using the 'defaultTimeLocale'. See 94 | -- 'formatTime' for a description of the format string. 95 | -- 96 | -- @ 97 | -- >>> timeFormat "%F" # ModifiedJulianDay 91424 98 | -- "2109-03-10" 99 | -- 100 | -- >>> "2109-03-10" ^? timeFormat "%F" :: Maybe UTCTime 101 | -- Just 2109-03-10 00:00:00 UTC 102 | -- @ 103 | -- 104 | timeFormat 105 | :: (ParseTime a, FormatTime a) 106 | => String -> Prism' String a 107 | timeFormat = localeTimeFormat defaultTimeLocale 108 | {-# INLINE timeFormat #-} 109 | 110 | -- | Automatically choose a suitable time axis, based upon the time range 111 | -- of data. 112 | 113 | -- XXX: This is a terrible way to do it if the ticks aren't aligned 114 | -- properly. 115 | autoTimeLabels :: RealFloat n => [n] -> (n,n) -> [(n, String)] 116 | autoTimeLabels ts (t0, t1) 117 | | d < minute = fmt "%S%Q" 118 | | d < hour = fmt "%M:%S" 119 | | d < day = fmt "%H:%M" 120 | | d < month = fmt "%F %H" 121 | | d < year = fmt "%F" 122 | | d < 2*year = fmt "%F" 123 | | otherwise = fmt "%Y" 124 | where 125 | d = t1 - t0 126 | fmt a = map (\n -> (n, formatTime defaultTimeLocale a (realToUTC n))) ts 127 | 128 | minute = 60 129 | hour = 60 * minute 130 | day = 24 * hour 131 | month = 30 * day 132 | year = 365 * day 133 | 134 | realToUTC :: Real a => a -> UTCTime 135 | realToUTC = posixSecondsToUTCTime . realToFrac 136 | 137 | realUTC :: (Real a, Fractional a) => Iso' UTCTime a 138 | realUTC = iso (realToFrac . utcTimeToPOSIXSeconds) realToUTC 139 | -------------------------------------------------------------------------------- /src/Diagrams/Coordinates/Isomorphic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstrainedClassMethods #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | {-# LANGUAGE DefaultSignatures #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE FunctionalDependencies #-} 7 | {-# LANGUAGE KindSignatures #-} 8 | {-# LANGUAGE MultiParamTypeClasses #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE ViewPatterns #-} 11 | {-# LANGUAGE TypeOperators #-} 12 | ----------------------------------------------------------------------------- 13 | -- | 14 | -- Module : Diagrams.Coordinates.Isomorphic 15 | -- Copyright : (C) 2015 Christopher Chalmers 16 | -- License : BSD-style (see the file LICENSE) 17 | -- Maintainer : Christopher Chalmers 18 | -- Stability : experimental 19 | -- Portability : non-portable 20 | -- 21 | -- This module defines a class for coordinates that are (loosely) 22 | -- isomorphic to the standard spaces ('V2' and 'V3'). This allows plots 23 | -- to accept more data types for plot data. 24 | -- 25 | ---------------------------------------------------------------------------- 26 | module Diagrams.Coordinates.Isomorphic 27 | ( -- * Type constraints 28 | HasIndexedBasis, Euclidean 29 | 30 | -- * Vector like 31 | , VectorLike (..) 32 | , V2Like, V3Like 33 | 34 | -- * Point like 35 | , PointLike (..) 36 | , P2Like, P3Like 37 | ) 38 | where 39 | 40 | import Control.Lens 41 | import Data.Complex 42 | import Data.Kind 43 | import Data.Typeable 44 | 45 | import Diagrams.Prelude 46 | 47 | type HasIndexedBasis v = (HasBasis v, TraversableWithIndex (E v) v) 48 | 49 | -- | Umbrella class giving everything needed for working in the space. This is 50 | -- basically 'V2' or 'V3' from "linear". 51 | type Euclidean (v :: Type -> Type) = (HasLinearMap v, HasIndexedBasis v, Metric v) 52 | 53 | -- vector like --------------------------------------------------------- 54 | 55 | -- | Provides an 'Iso'' between @a@ and @v n@. This is normally used to 56 | -- convert between the data type you're already using, @a@, and diagram's 57 | -- native form, @v n@. 58 | class (Euclidean v, Typeable v) => VectorLike v n a | a -> v n where 59 | -- | Isomorphism from @Point v n@ to something 'PointLike' @a@. 60 | -- 61 | -- >>> V2 3 5 ^. vectorLike :: (Int, Int) 62 | -- (3,5) 63 | vectorLike :: Iso' (v n) a 64 | 65 | -- | Isomorphism from something 'PointLike' @a@ to @Point v n@. 66 | -- 67 | -- >>> ((3, 5) :: (Int, Int)) ^. unvectorLike 68 | -- V2 3 5 69 | unvectorLike :: Iso' a (v n) 70 | unvectorLike = from vectorLike 71 | {-# INLINE unvectorLike #-} 72 | 73 | instance VectorLike V2 n (V2 n) where 74 | vectorLike = id 75 | {-# INLINE vectorLike #-} 76 | 77 | type V2Like = VectorLike V2 78 | 79 | instance n ~ m => VectorLike V2 n (n, m) where 80 | vectorLike = iso unr2 r2 81 | {-# INLINE vectorLike #-} 82 | 83 | instance VectorLike V2 n (Complex n) where 84 | vectorLike = iso (\(V2 x y) -> x :+ y) 85 | (\(i :+ j) -> V2 i j) 86 | {-# INLINE vectorLike #-} 87 | 88 | type V3Like = VectorLike V3 89 | 90 | instance VectorLike V3 n (V3 n) where 91 | vectorLike = id 92 | {-# INLINE vectorLike #-} 93 | 94 | instance (n ~ m, m ~ o) => VectorLike V3 n (n, m, o) where 95 | vectorLike = iso unr3 r3 96 | {-# INLINE vectorLike #-} 97 | 98 | -- point like ---------------------------------------------------------- 99 | 100 | -- | Provides an 'Iso'' between @a@ and @'Point' v n@. This is normally used to 101 | -- convert between the data type you're already using, @a@, and diagram's 102 | -- native form, @'Point' v n@. 103 | class (Euclidean v, Typeable v) => PointLike v n a | a -> v n where 104 | -- | Isomorphism from @'Point' v n@ to something 'PointLike' @a@. 105 | -- 106 | -- >>> mkP2 3 5 ^. pointLike :: (Int, Int) 107 | -- (3,5) 108 | pointLike :: Iso' (Point v n) a 109 | 110 | -- | Isomorphism from something 'PointLike' @a@ to @Point v n@. 111 | -- 112 | -- >>> ((3, 5) :: (Int, Int)) ^. unpointLike 113 | -- P (V2 3 5) 114 | unpointLike :: Iso' a (Point v n) 115 | unpointLike = from pointLike 116 | {-# INLINE unpointLike #-} 117 | 118 | -- | Things that are isomorphic to points in R2. 119 | type P2Like = PointLike V2 120 | 121 | instance (Euclidean v, Typeable v) => PointLike v n (Point v n) where 122 | pointLike = id 123 | 124 | instance PointLike V2 n (V2 n) where 125 | pointLike = _Point 126 | {-# INLINE pointLike #-} 127 | 128 | instance n ~ m => PointLike V2 n (n, m) where 129 | pointLike = iso unp2 p2 130 | {-# INLINE pointLike #-} 131 | 132 | instance PointLike V2 n (Complex n) where 133 | pointLike = iso (\(unp2 -> (x,y)) -> x :+ y) 134 | (\(i :+ j) -> p2 (i,j)) 135 | {-# INLINE pointLike #-} 136 | 137 | type P3Like = PointLike V3 138 | 139 | instance (n ~ m, m ~ o) => PointLike V3 n (n, m, o) where 140 | pointLike = iso unp3 p3 141 | {-# INLINE pointLike #-} 142 | 143 | -------------------------------------------------------------------------------- /unfinished/Points.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE FunctionalDependencies #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE RankNTypes #-} 8 | {-# LANGUAGE RecordWildCards #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE UndecidableInstances #-} 11 | {-# LANGUAGE AllowAmbiguousTypes #-} 12 | 13 | {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} 14 | 15 | module Plots.Types.Points 16 | ( -- * Polar scatter plot 17 | GPointsPlot 18 | , mkPointsPlot 19 | 20 | -- * Lenses 21 | , doFill 22 | 23 | -- * Points plot 24 | , pointsPlot 25 | , pointsPlot' 26 | ) where 27 | 28 | import Control.Lens hiding (lmap, none, transform, 29 | ( # )) 30 | import Control.Monad.State.Lazy 31 | 32 | import Data.Typeable 33 | 34 | import Diagrams.Prelude 35 | import Diagrams.Coordinates.Isomorphic 36 | import Diagrams.Coordinates.Polar 37 | 38 | import Plots.Style 39 | import Plots.Types 40 | import Plots.Axis 41 | 42 | ------------------------------------------------------------------------ 43 | -- GPoints plot 44 | ------------------------------------------------------------------------ 45 | 46 | data GPointsPlot n = GPointsPlot 47 | { sPoints :: [(n, Angle n)] 48 | , sFill :: Bool 49 | } deriving Typeable 50 | 51 | -- options for style and transform. 52 | -- lenses for style and transform, 53 | -- scatter plot for example. 54 | 55 | type instance V (GPointsPlot n) = V2 56 | type instance N (GPointsPlot n) = n 57 | 58 | instance (OrderedField n) => Enveloped (GPointsPlot n) where 59 | getEnvelope GPointsPlot {..} = mempty 60 | 61 | instance (v ~ V2, TypeableFloat n, Renderable (Path v n) b) 62 | => Plotable (GPointsPlot n) b where 63 | renderPlotable _ sty GPointsPlot {..} = 64 | mconcat [marker # applyMarkerStyle sty # scale 0.1 # moveTo (p2 (r*(cosA theta),r*(sinA theta)))| (r,theta) <- sPoints] 65 | <> if sFill 66 | then doline <> doarea 67 | else mempty 68 | where 69 | marker = sty ^. plotMarker 70 | doline = fromVertices (map p2 [(r*(cosA theta),r*(sinA theta)) | (r,theta) <- sPoints]) # mapLoc closeLine # stroke # applyLineStyle sty 71 | doarea = fromVertices (map p2 [(r*(cosA theta),r*(sinA theta)) | (r,theta) <- sPoints]) # mapLoc closeLine # stroke # lw none # applyAreaStyle sty 72 | 73 | defLegendPic sty GPointsPlot {..} 74 | = sty ^. plotMarker 75 | & applyMarkerStyle sty 76 | 77 | ------------------------------------------------------------------------ 78 | -- Points plot 79 | ------------------------------------------------------------------------ 80 | 81 | -- | Plot a polar scatter plot given a list of radius and angle. 82 | mkPointsPlot :: [(n, Angle n)] -> GPointsPlot n 83 | mkPointsPlot ds = GPointsPlot 84 | { sPoints = ds 85 | , sFill = False 86 | } 87 | 88 | ------------------------------------------------------------------------ 89 | -- Points lenses 90 | ------------------------------------------------------------------------ 91 | 92 | class HasPoints a n | a -> n where 93 | pts :: Lens' a (GPointsPlot n) 94 | 95 | doFill :: Lens' a Bool 96 | doFill = pts . lens sFill (\s b -> (s {sFill = b})) 97 | 98 | instance HasPoints (GPointsPlot n) n where 99 | pts = id 100 | 101 | instance HasPoints (Plot (GPointsPlot n) b) n where 102 | pts = rawPlot 103 | 104 | ------------------------------------------------------------------------ 105 | -- Points plot 106 | ------------------------------------------------------------------------ 107 | 108 | -- $ points plot 109 | -- Points plot display data as scatter (dots) on polar co-ord. 110 | -- Points plots have the following lenses: 111 | -- 112 | -- @ 113 | -- * 'doFill' :: 'Lens'' ('BoxPlot' v n) 'Bool' - False 114 | -- @ 115 | -- 116 | -- | Add a 'PointsPlot' to the 'AxisState' from a data set. 117 | -- 118 | -- @ 119 | -- myaxis = polarAxis ~& 120 | -- pointsPlot data1 121 | -- @ 122 | -- 123 | -- === __Example__ 124 | -- 125 | -- <> 126 | -- 127 | -- > myaxis :: Axis B Polar Double 128 | -- > myaxis = polarAxis &~ do 129 | -- > pointsPlot mydata1 130 | -- > pointsPlot mydata2 131 | -- > pointsPlot mydata3 132 | 133 | pointsPlot 134 | :: (v ~ BaseSpace c, v ~ V2, 135 | PointLike v n (Polar n), 136 | MonadState (Axis b c n) m, 137 | Plotable (GPointsPlot n) b) 138 | => [(n,Angle n)] -> State (Plot (GPointsPlot n) b) () -> m () 139 | pointsPlot ds = addPlotable (mkPointsPlot ds) 140 | 141 | -- | Make a 'PointsPlot' and take a 'State' on the plot to alter it's 142 | -- options 143 | -- 144 | -- @ 145 | -- myaxis = polarAxis &~ do 146 | -- pointsPlot' pointData1 $ do 147 | -- addLegendEntry "data 1" 148 | -- doFill .= True 149 | -- @ 150 | 151 | pointsPlot' 152 | :: (v ~ BaseSpace c, v ~ V2, 153 | PointLike v n (Polar n), 154 | MonadState (Axis b c n) m, 155 | Plotable (GPointsPlot n) b) 156 | => [(n,Angle n)] -> m () 157 | pointsPlot' ds = addPlotable' (mkPointsPlot ds) 158 | -------------------------------------------------------------------------------- /unfinished/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE FunctionalDependencies #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE RankNTypes #-} 8 | {-# LANGUAGE RecordWildCards #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE TemplateHaskell #-} 11 | {-# LANGUAGE UndecidableInstances #-} 12 | 13 | module Plots.Types.Text 14 | ( -- * Text plot 15 | TextPlot 16 | , TextOptions 17 | , mkTextPlot 18 | 19 | -- * Text lenses 20 | , setOptions 21 | 22 | -- * Text plot 23 | , textPlot 24 | , textPlot' 25 | -- , textPlotL 26 | 27 | , tString 28 | , textPoint 29 | , textOptions 30 | 31 | , optalignment 32 | , optfontSize 33 | , optfontSlant 34 | , optfontWeight 35 | ) where 36 | 37 | import Control.Lens hiding (lmap, none, transform, 38 | ( # )) 39 | 40 | -- import qualified Data.Foldable as F 41 | import Data.Typeable 42 | 43 | import Diagrams.Prelude 44 | import Diagrams.TwoD.Text 45 | import Diagrams.Coordinates.Isomorphic 46 | 47 | import Plots.Style 48 | import Plots.Types 49 | import Plots.Axis 50 | import Control.Monad.State.Lazy 51 | 52 | ------------------------------------------------------------------------ 53 | -- Text data & options 54 | ------------------------------------------------------------------------ 55 | 56 | data TextPlot n = TextPlot 57 | { _tString :: String 58 | , _textPoint :: (n,n) 59 | , _textOptions :: TextOptions n 60 | } deriving Typeable 61 | 62 | -- | Text alignment, font size, slant and weight 63 | data TextOptions n = TextOptions 64 | { _optalignment :: (n, n) 65 | , _optfontSize :: n 66 | , _optfontSlant :: FontSlant 67 | , _optfontWeight :: FontWeight 68 | } 69 | 70 | -- need to implement an option for fonts 71 | 72 | instance (Fractional n) => Default (TextOptions n) where 73 | def = TextOptions 74 | { _optalignment = (0.0, 0.0) 75 | , _optfontSize = 0.4 76 | , _optfontSlant = FontSlantNormal 77 | , _optfontWeight = FontWeightNormal 78 | } 79 | 80 | makeLenses ''TextPlot 81 | makeLenses ''TextOptions 82 | 83 | type instance V (TextPlot n) = V2 84 | type instance N (TextPlot n) = n 85 | 86 | instance OrderedField n => Enveloped (TextPlot n) where 87 | getEnvelope = const mempty 88 | 89 | 90 | instance (TypeableFloat n, Renderable (Text n) b, Renderable (Path V2 n) b) 91 | => Plotable (TextPlot n) b where 92 | renderPlotable s sty v = alignedText a b str # fontSize (local fsze) 93 | # applyTextStyle sty 94 | # transform (s^.specTrans) 95 | 96 | where 97 | -- (x, y) = (v ^. textPoint) 98 | str = v ^. tString 99 | (a, b) = v ^. textOptions ^. optalignment 100 | fsze = v ^. textOptions ^. optfontSize 101 | 102 | -- # moveTo (p2 (x, y)) <> circle 1 # fc red 103 | -- fslant = v ^. textOptions ^. optfontSlant 104 | -- fwght = v ^. textOptions ^. optfontWeight 105 | -- need to find a method to move text string to 106 | -- a point in plot, translate and move doesnt work. 107 | -- Implement a font slant and font weight. 108 | 109 | defLegendPic sty TextPlot {..} 110 | = (p2 (-10,0) ~~ p2 (10,0)) 111 | # applyLineStyle sty 112 | 113 | ------------------------------------------------------------------------ 114 | -- Text plot 115 | ------------------------------------------------------------------------ 116 | 117 | -- | Draw a given string at a given point. 118 | mkTextPlot :: (TypeableFloat n) => (n,n) -> String -> TextPlot n 119 | mkTextPlot p1 f 120 | = TextPlot 121 | { _tString = f 122 | , _textPoint = p1 123 | , _textOptions = def 124 | } 125 | 126 | ------------------------------------------------------------------------ 127 | -- Text lenses 128 | ------------------------------------------------------------------------ 129 | 130 | class HasText a n | a -> n where 131 | txt :: Lens' a (TextPlot n) 132 | 133 | setOptions :: Lens' a (TextOptions n) 134 | setOptions = txt . lens _textOptions (\s b -> (s {_textOptions = b})) 135 | 136 | instance HasText (TextPlot n) n where 137 | txt = id 138 | 139 | instance HasText (Plot (TextPlot n) b) n where 140 | txt = rawPlot 141 | 142 | ------------------------------------------------------------------------ 143 | -- Textplot 144 | ------------------------------------------------------------------------ 145 | 146 | textPlot 147 | :: (v ~ BaseSpace c, 148 | RealFloat n, 149 | Typeable n, 150 | PointLike v n (V2 n), 151 | MonadState (Axis b c n) m, 152 | Plotable (TextPlot n) b, 153 | v ~ V2) 154 | => (n,n) -> String -> State (Plot (TextPlot n) b) () -> m () 155 | textPlot pt a = addPlotable (mkTextPlot pt a) 156 | 157 | textPlot' 158 | :: (v ~ BaseSpace c, 159 | RealFloat n, 160 | Typeable n, 161 | PointLike v n (V2 n), 162 | MonadState (Axis b c n) m, 163 | Plotable (TextPlot n) b, 164 | v ~ V2) 165 | => (n,n) -> String -> m () 166 | textPlot' pt a = addPlotable' (mkTextPlot pt a) 167 | 168 | -- textPlotL 169 | -- :: (v ~ BaseSpace c, 170 | -- RealFloat n, 171 | -- Typeable n, 172 | -- PointLike v n (V2 n), 173 | -- MonadState (Axis b c n) m, 174 | -- Plotable (TextPlot n) b, 175 | -- v ~ V2) 176 | -- => String -> (n,n) -> String -> m () 177 | -- textPlotL l pt a = addPlotableL l (mkTextPlot pt a) 178 | -------------------------------------------------------------------------------- /src/Diagrams/Coordinates/Polar.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DeriveTraversable #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE TemplateHaskell #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE TypeOperators #-} 11 | ----------------------------------------------------------------------------- 12 | -- | 13 | -- Module : Diagrams.Coordinates.Spherical 14 | -- Copyright : (C) 2015 Christopher Chalmers 15 | -- License : BSD-style (see the file LICENSE) 16 | -- Maintainer : Christopher Chalmers 17 | -- Stability : experimental 18 | -- Portability : non-portable 19 | -- 20 | -- This module defines a polar coordinate data type. This type can be 21 | -- used as an axis space for polar plots. 22 | -- 23 | ---------------------------------------------------------------------------- 24 | module Diagrams.Coordinates.Polar 25 | ( -- * Polar type 26 | Polar (..) 27 | , mkPolar, polar, unpolar, polarIso, polarV2 28 | 29 | -- * Polar functions 30 | , interpPolar 31 | 32 | -- * Classes 33 | , Radial (..), Circle (..) 34 | , HasX (..), HasY (..), HasR (..) 35 | 36 | -- * Basis elements 37 | , er, eθ, etheta, 38 | 39 | ) where 40 | 41 | import Control.Applicative 42 | import qualified Data.Foldable as F 43 | 44 | import Control.Lens 45 | import Control.Monad.Fix 46 | import Control.Monad.Zip 47 | import Data.Distributive 48 | import Data.Functor.Rep 49 | import Data.Typeable 50 | import GHC.Generics (Generic1) 51 | 52 | import Diagrams.Angle 53 | import Diagrams.TwoD.Types 54 | 55 | import Linear.Affine 56 | import Linear.Metric 57 | import Linear.V3 58 | import Linear.Vector 59 | 60 | import Diagrams.Coordinates.Isomorphic 61 | import Prelude 62 | 63 | 64 | newtype Polar a = Polar (V2 a) 65 | deriving (Monad, Functor, Typeable, MonadFix, Applicative, Traversable, 66 | Generic1, MonadZip, F.Foldable) 67 | 68 | makeWrapped ''Polar 69 | 70 | -- can't make reasonable Additive instance 71 | 72 | instance Distributive Polar where 73 | distribute f = Polar $ V2 (fmap (\(Polar (V2 x _)) -> x) f) 74 | (fmap (\(Polar (V2 _ y)) -> y) f) 75 | 76 | instance Representable Polar where 77 | type Rep Polar = E Polar 78 | tabulate f = Polar $ V2 (f er) (f eθ) 79 | index xs (E l) = view l xs 80 | 81 | instance Circle Polar where 82 | _azimuth = polarWrapper . _y . from rad 83 | _polar = id 84 | 85 | instance HasR Polar where 86 | _r = polarWrapper . _x 87 | 88 | -- | Construct a 'Polar' from a magnitude and an 'Angle'. 89 | mkPolar :: n -> Angle n -> Polar n 90 | mkPolar r θ = Polar $ V2 r (θ^.rad) 91 | 92 | -- | Construct a 'Polar' from a magnitude and 'Angle' tuple. 93 | polar :: (n, Angle n) -> Polar n 94 | polar = uncurry mkPolar 95 | 96 | -- | Turn a 'Polar' back into a magnitude and 'Angle' tuple. 97 | unpolar :: Polar n -> (n, Angle n) 98 | unpolar (Polar (V2 r θ)) = (r, θ @@ rad) 99 | 100 | -- | 'Iso'' between 'Polar' and its tuple form. 101 | polarIso :: Iso' (Polar n) (n, Angle n) 102 | polarIso = iso unpolar polar 103 | 104 | -- | Numerical 'Iso'' between 'Polar' and 'R2'. 105 | polarV2 :: RealFloat n => Iso' (Polar n) (V2 n) 106 | polarV2 = iso (\(Polar (V2 r θ)) -> V2 (r * cos θ) (r * sin θ)) 107 | (\v@(V2 x y) -> Polar $ V2 (norm v) (atan2 y x)) 108 | 109 | -- internal iso for instances 110 | polarWrapper :: Iso' (Polar a) (V2 a) 111 | polarWrapper = iso (\(Polar v) -> v) Polar 112 | 113 | -- | Polar interpolation between two polar coordinates. 114 | interpPolar :: Num n => n -> Polar n -> Polar n -> Polar n 115 | interpPolar t (Polar a) (Polar b) = Polar (lerp t a b) 116 | 117 | 118 | -- | Space which has a radial length basis. For Polar and Cylindrical this is 119 | -- the radius of the circle in the xy-plane. For Spherical this is the 120 | -- distance from the origin. 121 | class Radial t where 122 | _radial :: Lens' (t a) a 123 | 124 | instance Radial Polar where 125 | _radial = polarWrapper . _x 126 | 127 | -- | Space which has a radial and angular basis. 128 | class Radial t => Circle t where 129 | _azimuth :: Lens' (t a) (Angle a) 130 | _polar :: Lens' (t a) (Polar a) 131 | 132 | er :: Radial v => E v 133 | er = E _radial 134 | 135 | eθ, etheta :: Circle v => E v 136 | eθ = E (_polar . polarWrapper . _y) 137 | etheta = eθ 138 | 139 | -- | Coordinate with at least one dimension where the x coordinate can be 140 | -- retrieved numerically. Note this differs slightly from 'R1' which requires 141 | -- a lens for all values. This allows instances for different coordinates 142 | -- such as 'Polar', where the x coordinate can only be retrieved numerically. 143 | class HasX t where 144 | x_ :: RealFloat n => Lens' (t n) n 145 | 146 | instance HasX v => HasX (Point v) where 147 | x_ = _Point . x_ 148 | 149 | instance HasX V2 where x_ = _x 150 | instance HasX V3 where x_ = _x 151 | instance HasX Polar where x_ = polarV2 . _x 152 | 153 | -- | Coordinate with at least two dimensions where the x and y coordinates can be 154 | -- retreived numerically. 155 | class HasX t => HasY t where 156 | y_ :: RealFloat n => Lens' (t n) n 157 | y_ = xy_ . _y 158 | 159 | xy_ :: RealFloat n => Lens' (t n) (V2 n) 160 | 161 | instance HasY v => HasY (Point v) where 162 | xy_ = lensP . xy_ 163 | 164 | instance HasY V2 where xy_ = _xy 165 | instance HasY V3 where xy_ = _xy 166 | instance HasY Polar where xy_ = polarV2 167 | 168 | -- | Does not satify lens laws. 169 | instance RealFloat n => PointLike V2 n (Polar n) where 170 | pointLike = _Point . from polarV2 171 | {-# INLINE pointLike #-} 172 | 173 | -------------------------------------------------------------------------------- /src/Plots/Legend.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE TemplateHaskell #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE UndecidableInstances #-} 10 | module Plots.Legend 11 | ( 12 | -- * Legend 13 | Legend 14 | , HasLegend (..) 15 | 16 | -- * Drawing a legend 17 | , drawLegend 18 | 19 | ) where 20 | 21 | import Control.Lens hiding (none, ( # )) 22 | import Data.Default 23 | import Data.Typeable 24 | import Diagrams.TwoD.Text 25 | 26 | import Diagrams.BoundingBox 27 | import Diagrams.Prelude 28 | 29 | import Plots.Types 30 | 31 | -- | The data type to describe how to draw a legend. For legend entries 32 | -- see 'Plots.Types.LegendEntry'. 33 | data Legend b n = Legend 34 | { lPlacement :: Placement 35 | , lGap :: n 36 | , lStyle :: Style V2 n 37 | , lSpacing :: n 38 | , lTextWidth :: n 39 | , lTextF :: String -> QDiagram b V2 n Any 40 | , lTextStyle :: Style V2 n 41 | , lOrientation :: Orientation 42 | , lVisible :: Bool 43 | } deriving Typeable 44 | 45 | type instance V (Legend b n) = V2 46 | type instance N (Legend b n) = n 47 | 48 | class HasLegend a b | a -> b where 49 | -- | Lens onto the 'Legend' of something. 50 | legend :: Lens' a (Legend b (N a)) 51 | 52 | -- | The 'Placement' of the legend relative to the 'Plots.Axis.Axis'. 53 | legendPlacement :: Lens' a Placement 54 | legendPlacement = legend . lens lPlacement (\l a -> l {lPlacement = a}) 55 | 56 | -- | The gap between the legend and the axis. 57 | legendGap :: Lens' a (N a) 58 | legendGap = legend . lens lGap (\l a -> l {lGap = a}) 59 | 60 | -- | The style applied to the surronding box of the legend. 61 | legendStyle :: Lens' a (Style V2 (N a)) 62 | legendStyle = legend . lens lStyle (\l a -> l {lStyle = a}) 63 | 64 | -- | The spacing between entries in the legend. 65 | legendSpacing :: Lens' a (N a) 66 | legendSpacing = legend . lens lSpacing (\l a -> l {lSpacing = a}) 67 | 68 | -- | The space given for the text in the legend. 69 | legendTextWidth :: Lens' a (N a) 70 | legendTextWidth = legend . lens lTextWidth (\l a -> l {lTextWidth = a}) 71 | 72 | -- | The function to generate the legend text. 73 | legendTextFunction :: Lens' a (String -> QDiagram b V2 (N a) Any) 74 | legendTextFunction = legend . lens lTextF (\l a -> l {lTextF = a}) 75 | 76 | -- | The style applied to the legend text. 77 | legendTextStyle :: Lens' a (Style V2 (N a)) 78 | legendTextStyle = legend . lens lTextStyle (\l a -> l {lTextStyle = a}) 79 | 80 | -- | The way the legend entries are listed. (This will likely be 81 | -- replaced by a grid-like system) 82 | legendOrientation :: Lens' a Orientation 83 | legendOrientation = legend . lens lOrientation (\l a -> l {lOrientation = a}) 84 | 85 | instance HasLegend (Legend b n) b where 86 | legend = id 87 | 88 | instance HasGap (Legend b n) where 89 | gap = legendGap 90 | 91 | instance HasPlacement (Legend b n) where 92 | placement = legendPlacement 93 | 94 | instance (TypeableFloat n, Renderable (Text n) b) => Default (Legend b n) where 95 | def = Legend 96 | { lPlacement = rightTop 97 | , lGap = 20 98 | , lSpacing = 20 99 | , lTextWidth = 60 100 | , lStyle = mempty 101 | , lTextF = mkText (BoxAlignedText 0 0.5) 102 | , lTextStyle = mempty & fontSize (output 11) 103 | , lOrientation = Vertical 104 | , lVisible = True 105 | } 106 | 107 | instance HasVisibility (Legend b n) where 108 | visible = lens lVisible (\l a -> l {lVisible = a}) 109 | 110 | instance TypeableFloat n => HasStyle (Legend b n) where 111 | applyStyle sty = over legendStyle (applyStyle sty) 112 | 113 | instance HasOrientation (Legend b n) where 114 | orientation = legendOrientation 115 | 116 | -- | Draw a legend to the bounding box using the legend entries and 117 | -- legend options. 118 | drawLegend 119 | :: (TypeableFloat n, 120 | Renderable (Path V2 n) b) 121 | => BoundingBox V2 n -- ^ bounding box to place legend against 122 | -> [(QDiagram b V2 n Any, String)] -- ^ diagram pictures along with their key 123 | -> Legend b n -- ^ options for drawing the legend 124 | -> QDiagram b V2 n Any -- ^ rendered legend 125 | drawLegend bb entries l 126 | | l ^. hidden || null entries = mempty 127 | | otherwise = placeAgainst 128 | bb 129 | (l ^. legendPlacement) 130 | (l ^. legendGap) 131 | (ledge <> back) 132 | where 133 | w = l ^. legendTextWidth 134 | h = l ^. legendSpacing 135 | -- 136 | ledge = map mkLabels entries 137 | # orient (l ^. legendOrientation) hcat vcat 138 | # alignTL 139 | 140 | back = backRect 141 | # applyStyle (l ^. legendStyle) 142 | # alignTL 143 | backRect = orient (l ^. legendOrientation) 144 | (rect (nEntries * entryWidth) h ) 145 | (rect entryWidth (h * nEntries)) 146 | nEntries = fromIntegral (length entries) 147 | 148 | -- Each legend picture has a width equal to the height of each 149 | -- legend entry. The picture also has a 5 unit buffer either side of 150 | -- it. 151 | entryWidth = w + 10 + h 152 | 153 | mkLabels (pic, txt) = strutX 5 ||| pic' ||| strutX 5 ||| label where 154 | pic' = pic # withEnvelope (fromCorners (pure (-h/2)) (pure (h/2))) 155 | label = view legendTextFunction l txt 156 | # applyStyle (l ^. legendTextStyle) 157 | # withEnvelope (fromCorners origin (mkP2 w h) # moveTo (mkP2 0 (-h/2))) 158 | 159 | -- wrapPic :: RealFloat n => V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any 160 | -- wrapPic ((^/ 2) -> v) d 161 | -- = d # sizedAs (fromCorners (origin .-^ v) (origin .+^ v)) 162 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_namedBarExample'.svg: -------------------------------------------------------------------------------- 1 | beanssausagebaconeggs12.510.07.55.02.50.0 -------------------------------------------------------------------------------- /src/Plots/Types/Line.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-# LANGUAGE TypeOperators #-} 7 | {-# LANGUAGE FunctionalDependencies #-} 8 | ----------------------------------------------------------------------------- 9 | -- | 10 | -- Module : Plots.Types.Line 11 | -- Copyright : (C) 2016 Christopher Chalmers 12 | -- License : BSD-style (see the file LICENSE) 13 | -- Maintainer : Christopher Chalmers 14 | -- Stability : experimental 15 | -- Portability : non-portable 16 | -- 17 | -- A line plot is simply a 'Path' used as a plot. This module contains 18 | -- helpers adding path plots. For line plots with markers, see 19 | -- 'Plots.Types.Scatter'. 20 | -- 21 | ---------------------------------------------------------------------------- 22 | 23 | module Plots.Types.Line 24 | ( -- Plot trails/paths 25 | trailPlot 26 | , trailPlot' 27 | , pathPlot 28 | , pathPlot' 29 | 30 | -- * Line plots from points 31 | , linePlot 32 | , linePlot' 33 | , smoothLinePlot 34 | , smoothLinePlot' 35 | 36 | -- * Construction utilities 37 | 38 | -- ** Trails 39 | , mkTrail 40 | , mkTrailOf 41 | 42 | -- ** Paths 43 | , mkPath 44 | , mkPathOf 45 | 46 | 47 | ) where 48 | 49 | import Control.Monad.State.Lazy 50 | 51 | import qualified Data.Foldable as F 52 | 53 | import Diagrams.Coordinates.Isomorphic 54 | import Diagrams.Prelude 55 | 56 | import Plots.Axis 57 | import Plots.Types 58 | 59 | ------------------------------------------------------------------------ 60 | -- Trails and Paths 61 | ------------------------------------------------------------------------ 62 | 63 | -- | Add a 'Trail' as a 'Plot' to an 'Axis'. 64 | trailPlot 65 | :: (BaseSpace c ~ v, 66 | Plotable (Path v n) b, 67 | MonadState (Axis b c n) m) 68 | => Trail v n -- ^ trail to plot 69 | -> State (Plot (Path v n) b) () -- ^ changes to plot options 70 | -> m () -- ^ add plot to the 'Axis' 71 | trailPlot = pathPlot . toPath 72 | 73 | -- | Add a 'Trail' as a 'Plot' to an 'Axis' without changes to the plot 74 | -- options. 75 | trailPlot' 76 | :: (BaseSpace c ~ v, 77 | Plotable (Path v n) b, 78 | MonadState (Axis b c n) m) 79 | => Trail v n -- ^ trail to plot 80 | -> m () -- ^ add plot to the 'Axis' 81 | trailPlot' = pathPlot' . toPath 82 | 83 | -- | Add a 'Path' as a 'Plot' to an 'Axis'. 84 | pathPlot 85 | :: (BaseSpace c ~ v, 86 | Plotable (Path v n) b, 87 | MonadState (Axis b c n) m) 88 | => Path v n -- ^ path to plot 89 | -> State (Plot (Path v n) b) () -- ^ changes to plot options 90 | -> m () -- ^ add plot to the 'Axis' 91 | pathPlot = addPlotable 92 | 93 | -- | Add a 'Path' as a 'Plot' to an 'Axis' without changes to the plot 94 | -- options. 95 | pathPlot' 96 | :: (BaseSpace c ~ v, 97 | Plotable (Path v n) b, 98 | MonadState (Axis b c n) m) 99 | => Path v n -- ^ path to plot 100 | -> m () -- ^ add plot to the 'Axis' 101 | pathPlot' = addPlotable' 102 | 103 | ------------------------------------------------------------------------ 104 | -- From list of points 105 | ------------------------------------------------------------------------ 106 | 107 | -- | Add a 'Path' plot from a list of points. 108 | linePlot 109 | :: (BaseSpace c ~ v, 110 | Metric v, 111 | F.Foldable f, 112 | PointLike v n p, 113 | Plotable (Path v n) b, 114 | MonadState (Axis b c n) m) 115 | => f p -- ^ points to turn into trail 116 | -> State (Plot (Path v n) b) () -- ^ changes to plot options 117 | -> m () -- ^ add plot to the 'Axis' 118 | linePlot = addPlotable . toPath . mkTrail 119 | 120 | -- | Add a 'Path' plot from a list of points. 121 | linePlot' 122 | :: (BaseSpace c ~ v, 123 | Metric v, 124 | F.Foldable f, 125 | PointLike v n p, 126 | Plotable (Path v n) b, 127 | MonadState (Axis b c n) m) 128 | => f p -- ^ points to turn into trail 129 | -> m () -- ^ add plot to the 'Axis' 130 | linePlot' = addPlotable' . toPath . mkTrail 131 | 132 | -- | Add a smooth 'Path' plot from a list of points using 'cubicSpline'. 133 | smoothLinePlot 134 | :: (BaseSpace c ~ v, 135 | F.Foldable f, 136 | Metric v, 137 | PointLike v n p, 138 | Plotable (Path v n) b, 139 | Fractional (v n), -- needs fixing in diagrams-lib 140 | MonadState (Axis b c n) m) 141 | => f p -- ^ points to turn into trail 142 | -> State (Plot (Path v n) b) () -- ^ changes to plot options 143 | -> m () -- ^ add plot to the 'Axis' 144 | smoothLinePlot = addPlotable . cubicSpline False . toListOf (folded . unpointLike) 145 | 146 | -- | Add a smooth 'Path' plot from a list of points using 'cubicSpline' 147 | -- without changes to the plot options. 148 | smoothLinePlot' 149 | :: (BaseSpace c ~ v, 150 | F.Foldable f, 151 | PointLike v n p, 152 | Plotable (Path v n) b, 153 | Fractional (v n), -- needs fixing in diagrams-lib 154 | MonadState (Axis b c n) m) 155 | => f p -- ^ points to turn into trail 156 | -> m () -- ^ add plot to the 'Axis' 157 | smoothLinePlot' xs = smoothLinePlot xs (return ()) 158 | 159 | ------------------------------------------------------------------------ 160 | -- Trail and path 161 | ------------------------------------------------------------------------ 162 | 163 | -- | Construct a localed trail from a list of foldable of points. 164 | mkTrail :: (PointLike v n p, OrderedField n, F.Foldable f) => f p -> Located (Trail v n) 165 | mkTrail = mkTrailOf folded 166 | 167 | -- | Construct a localed trail from a fold over points. 168 | mkTrailOf :: (PointLike v n p, OrderedField n) => Fold s p -> s -> Located (Trail v n) 169 | mkTrailOf f ps = fromVertices $ toListOf (f . unpointLike) ps 170 | 171 | -- | Construct a localed trail from a fold over points. 172 | mkPath :: (PointLike v n p, OrderedField n, F.Foldable f, F.Foldable g) => g (f p) -> Path v n 173 | mkPath pss = toPath $ map mkTrail (F.toList pss) 174 | 175 | -- | Construct a localed trail from a fold over points. 176 | mkPathOf :: (PointLike v n p, OrderedField n) => Fold s t -> Fold t p -> s -> Path v n 177 | mkPathOf f1 f2 as = Path $ map (mkTrailOf f2) (toListOf f1 as) 178 | 179 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_namedBarExample.svg: -------------------------------------------------------------------------------- 1 | 12.510.07.55.02.50.0beanssausagebaconeggs -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_multiBarExample.svg: -------------------------------------------------------------------------------- 1 | 6420breakfast itembeanssausagebaconeggsboysgirls -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_groupedBarsExample'.svg: -------------------------------------------------------------------------------- 1 | 6420breakfast itembeanssausagebaconeggsboysgirls -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_groupedBarsExample.svg: -------------------------------------------------------------------------------- 1 | 6420breakfast itembeanssausagebaconeggsboysgirls -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_stackedBarsExample.svg: -------------------------------------------------------------------------------- 1 | 12108520breakfast itembeanssausagebaconeggsboysgirls -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_stackedEqualBarsExample.svg: -------------------------------------------------------------------------------- 1 | 1086420breakfast itembeanssausagebaconeggsboysgirls -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_barExample.svg: -------------------------------------------------------------------------------- 1 | 12.09.06.03.00.05.04.03.02.01.0 -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_runningBarsExample.svg: -------------------------------------------------------------------------------- 1 | 6420breakfast itembeanssausagebaconeggsbeanssausagebaconeggsboysgirls -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Bar_barExample'.svg: -------------------------------------------------------------------------------- 1 | 5.04.03.02.01.012.09.06.03.00.0 -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Histogram_countDensityDia.svg: -------------------------------------------------------------------------------- 1 | 80.060.040.020.00.08.07.06.05.04.0 -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Histogram_probabilityDia.svg: -------------------------------------------------------------------------------- 1 | 0.20.150.15.0e-20.08.07.06.05.04.0 -------------------------------------------------------------------------------- /unfinished/Density.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE RecordWildCards #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE FunctionalDependencies #-} 10 | 11 | {-# LANGUAGE StandaloneDeriving #-} 12 | {-# LANGUAGE AllowAmbiguousTypes #-} 13 | 14 | {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} 15 | 16 | module Plots.Types.Density 17 | ( -- * GDensitylot plot 18 | GDensityPlot 19 | -- , _DensityPlot 20 | 21 | -- * Density plot 22 | , DensityPlot 23 | , mkDensityPlotOf 24 | , mkDensityPlot 25 | 26 | -- * Helper funtions 27 | , densityY 28 | 29 | -- * Lenses 30 | , fillArea 31 | 32 | -- * Density plot 33 | , densityPlot 34 | , densityPlot' 35 | -- , densityPlotL 36 | 37 | -- * Fold variant density plot 38 | , densityPlotOf 39 | , densityPlotOf' 40 | -- , densityPlotOfL 41 | ) where 42 | 43 | import Control.Lens hiding (lmap, none, transform, 44 | ( # )) 45 | import Control.Monad.State.Lazy 46 | import qualified Data.Foldable as F 47 | import Data.Typeable 48 | import Data.List 49 | import Data.Function 50 | 51 | import Diagrams.Coordinates.Isomorphic 52 | import Diagrams.Prelude 53 | 54 | import Plots.Style 55 | import Plots.Types 56 | import Plots.Axis 57 | import Plots.Axis.Scale 58 | 59 | ------------------------------------------------------------------------ 60 | -- General density plot 61 | ------------------------------------------------------------------------ 62 | 63 | data GDensityPlot v n a = forall s. GDensityPlot 64 | { dData :: s 65 | , dFold :: Fold s a 66 | , dPos :: a -> Point v n 67 | , dFunc :: [P2 n] -> Located (Trail' Line V2 n) 68 | , dFill :: Bool 69 | } deriving Typeable 70 | 71 | type instance V (GDensityPlot v n a) = v 72 | type instance N (GDensityPlot v n a) = n 73 | 74 | instance (Metric v, OrderedField n) => Enveloped (GDensityPlot v n a) where 75 | getEnvelope GDensityPlot {..} = foldMapOf (dFold . to dPos) getEnvelope dData 76 | 77 | instance (Typeable a, TypeableFloat n, Renderable (Path V2 n) b) 78 | => Plotable (GDensityPlot V2 n a) b where 79 | renderPlotable s sty GDensityPlot {..} = 80 | dd # transform t 81 | # stroke 82 | <> if dFill 83 | then (fillDensity dd) # stroke 84 | # lw none 85 | # applyAreaStyle sty 86 | # transform t 87 | else mempty 88 | where 89 | ps = toListOf (dFold . to dPos . to (logPoint ls)) dData 90 | dd = dFunc ps 91 | t = s ^. specTrans 92 | ls = s ^. specScale 93 | 94 | -- having problems using applyLineStyle to dd. 95 | -- dd :: Located (Trail' Line V2 n) 96 | -- # applyLineStyle pp 97 | 98 | defLegendPic sty GDensityPlot {..} 99 | = (p2 (-10,0) ~~ p2 (10,0)) 100 | # applyLineStyle sty 101 | 102 | -- _DensityPlot :: (Plotable (DensityPlot v n) b, Typeable b) 103 | -- => Prism' (Plot b v n) (DensityPlot v n) 104 | -- _DensityPlot = _Plot 105 | 106 | ------------------------------------------------------------------------ 107 | -- Simple density plot 108 | ------------------------------------------------------------------------ 109 | 110 | type DensityPlot v n = GDensityPlot v n (Point v n) 111 | 112 | -- | Make a density plot. 113 | mkDensityPlot :: (PointLike v n p, F.Foldable f, Ord n, Floating n, Enum n) 114 | => f p -> DensityPlot v n 115 | mkDensityPlot = mkDensityPlotOf folded 116 | 117 | -- | Make a density plot using a given fold. 118 | mkDensityPlotOf :: (PointLike v n p, Ord n, Floating n, Enum n) 119 | => Fold s p -> s -> DensityPlot v n 120 | mkDensityPlotOf f a = GDensityPlot 121 | { dData = a 122 | , dFold = f . unpointLike 123 | , dPos = id 124 | , dFunc = densityY 125 | , dFill = False 126 | } 127 | 128 | ---------------------------------------------------------------------------- 129 | -- Helper functions 130 | ---------------------------------------------------------------------------- 131 | 132 | -- | Function used to create the density, takes the average of the xdata, bin y = 10. 133 | densityY :: (Ord n, Floating n, Enum n) => [P2 n] -> Located (Trail' Line V2 n) 134 | densityY xs = cubicSpline False (map p2 (zip xpts ypts)) 135 | where 136 | xmin = fst (maximumBy (compare `on` fst) (map unp2 xs)) 137 | xmax = fst (minimumBy (compare `on` fst) (map unp2 xs)) 138 | xpts = [xmin, (xmin + w) .. xmax] 139 | ypts = [bin1D xs (xpt, (xpt + w)) | xpt <- xpts] 140 | w = (xmax - xmin)/ 10.0 141 | 142 | bin1D as (a,b) = mean [y | (x,y) <- (map unp2 as), x > b, x < a] 143 | 144 | -- need to add more density functions 145 | 146 | mean :: Fractional a => [a] -> a 147 | mean [] = 0.0 148 | mean xs = (sum xs)/ fromIntegral (length xs) 149 | 150 | fillDensity :: Located (Trail' Line V2 n) -> Located (Trail' Loop V2 n) 151 | fillDensity dd = dd # mapLoc closeLine 152 | 153 | -- for better density fill, extend dd till xmin or zero 154 | -- dd :: Located (Trail' Line V2 n) 155 | 156 | ---------------------------------------------------------------------------- 157 | -- Density plot lenses 158 | ---------------------------------------------------------------------------- 159 | 160 | class HasDensity a v n d | a -> v n, a -> d where 161 | density :: Lens' a (GDensityPlot v n d) 162 | 163 | fillArea :: Lens' a Bool 164 | fillArea = density . lens dFill (\df fill -> df {dFill = fill}) 165 | 166 | instance HasDensity (GDensityPlot v n d) v n d where 167 | density = id 168 | 169 | instance HasDensity (Plot (GDensityPlot v n d) b) v n d where 170 | density = rawPlot 171 | 172 | ------------------------------------------------------------------------ 173 | -- Density Plot 174 | ------------------------------------------------------------------------ 175 | 176 | -- $ density plot 177 | -- Density plots display data as average x density of given points, 178 | -- Box plots have the following lenses: 179 | -- 180 | -- @ 181 | -- * 'fillArea' :: 'Lens'' ('DensityPlot' v n) 'Bool' - False 182 | -- @ 183 | 184 | -- | Add a 'DenistyPlot' to the 'AxisState' from a data set. 185 | -- 186 | -- === __Example__ 187 | -- 188 | -- <> 189 | -- 190 | -- > import Plots 191 | -- > import Plots.Types.Density 192 | -- > 193 | -- > mydata1 = [(1,3), (2,5.5), (3.2, 6), (3.5, 6.1)] 194 | -- > mydata2 = mydata1 & each . _1 *~ 0.5 195 | -- > mydata3 = [V2 1.2 2.7, V2 2 5.1, V2 3.2 2.6, V2 3.5 5] 196 | -- > 197 | -- > densityAxis :: Axis B V2 Double 198 | -- > densityAxis = r2Axis &~ do 199 | -- > densityPlot mydata1 $ key "data 1" 200 | -- > densityPlot mydata2 $ key "data 2" 201 | -- > densityPlot mydata3 $ key "data 3" 202 | -- 203 | -- > densityExample = renderAxis densityAxis 204 | densityPlot 205 | :: (v ~ BaseSpace c, 206 | PointLike v n p, 207 | MonadState (Axis b c n) m, 208 | Plotable (DensityPlot v n) b, 209 | F.Foldable f , 210 | Enum n) 211 | => f p -> State (Plot (DensityPlot v n) b) () -> m () 212 | densityPlot d = addPlotable (mkDensityPlot d) 213 | 214 | -- | Make a 'DensityPlot' and take a 'State' on the plot to alter it's 215 | -- options 216 | -- 217 | -- @ 218 | -- myaxis = r2Axis &~ do 219 | -- densityPlot' pointData1 $ do 220 | -- fillArea .= True 221 | -- addLegendEntry "data 1" 222 | -- @ 223 | 224 | densityPlot' 225 | :: (v ~ BaseSpace c, 226 | PointLike v n p, 227 | MonadState (Axis b c n) m, 228 | Plotable (DensityPlot v n) b, 229 | F.Foldable f , 230 | Enum n) 231 | => f p -> m () 232 | densityPlot' d = addPlotable' (mkDensityPlot d) 233 | 234 | -- | Add a 'DensityPlot' with the given name for the legend entry. 235 | -- 236 | -- @ 237 | -- myaxis = r2Axis &~ do 238 | -- densityPlotL "blue team" pointData1 239 | -- densityPlotL "red team" pointData2 240 | -- @ 241 | 242 | -- densityPlotL 243 | -- :: (v ~ BaseSpace c, 244 | -- PointLike v n p, 245 | -- MonadState (Axis b c n) m, 246 | -- Plotable (DensityPlot v n) b, 247 | -- F.Foldable f , 248 | -- Enum n, TypeableFloat n) 249 | -- => String -> f p -> m () 250 | -- densityPlotL l d = addPlotableL l (mkDensityPlot d) 251 | 252 | -- fold variant 253 | 254 | densityPlotOf 255 | :: (v ~ BaseSpace c, 256 | PointLike v n p, 257 | MonadState (Axis b c n) m, 258 | Plotable (DensityPlot v n) b, 259 | Enum n) 260 | => Fold s p -> s -> State (Plot (DensityPlot v n) b) () -> m () 261 | densityPlotOf f s = addPlotable (mkDensityPlotOf f s) 262 | 263 | densityPlotOf' 264 | :: (v ~ BaseSpace c, 265 | PointLike v n p, 266 | MonadState (Axis b c n) m, 267 | Plotable (DensityPlot v n) b, 268 | Enum n) 269 | => Fold s p -> s -> m () 270 | densityPlotOf' f s = addPlotable' (mkDensityPlotOf f s) 271 | 272 | -- densityPlotOfL 273 | -- :: (v ~ BaseSpace c, 274 | -- PointLike v n p, 275 | -- MonadState (Axis b c n) m, 276 | -- Plotable (DensityPlot v n) b, 277 | -- Enum n, TypeableFloat n) 278 | -- => String -> Fold s p -> s -> m () 279 | -- densityPlotOfL l f s = addPlotableL l (mkDensityPlotOf f s) 280 | 281 | 282 | -------------------------------------------------------------------------------- /unfinished/Boxplot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE FunctionalDependencies #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE RankNTypes #-} 8 | {-# LANGUAGE RecordWildCards #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | 11 | ----------------------------------------------------------------------------- 12 | -- | 13 | -- Module : Plots.Types.HeatMap 14 | -- Copyright : (C) 2016 Christopher Chalmers 15 | -- License : BSD-style (see the file LICENSE) 16 | -- Maintainer : Christopher Chalmers 17 | -- Stability : experimental 18 | -- Portability : non-portable 19 | -- 20 | -- A heat map is a graphical representation of data where the individual 21 | -- values contained in a matrix are represented as colours. 22 | -- 23 | -- <> 24 | -- 25 | ---------------------------------------------------------------------------- 26 | 27 | module Plots.Types.Boxplot 28 | ( -- * Adding box plots 29 | boxPlot 30 | , boxPlot' 31 | 32 | -- * Fold variant boxplot 33 | , boxPlotOf 34 | , boxPlotOf' 35 | 36 | -- * Boxplot type 37 | , GBoxPlot 38 | -- , _BoxPlot 39 | 40 | -- * Box plot 41 | , BoxPlot 42 | , mkBoxPlotOf 43 | , mkBoxPlot 44 | 45 | -- * Lenses 46 | , fillBox 47 | 48 | ) where 49 | 50 | import Control.Lens hiding (lmap, none, transform, 51 | ( # )) 52 | import Control.Monad.State.Lazy 53 | import qualified Data.Foldable as F 54 | import Data.Typeable 55 | import Data.List 56 | 57 | import Diagrams.Prelude 58 | import Diagrams.Coordinates.Isomorphic 59 | 60 | import Plots.Style 61 | import Plots.Types 62 | import Plots.Axis 63 | import Plots.Axis.Scale 64 | 65 | ------------------------------------------------------------------------ 66 | -- Boxplot data 67 | ------------------------------------------------------------------------ 68 | 69 | data BP = BP 70 | { bppoint :: (Double, Double) 71 | , bpw :: Double 72 | , bph1 :: Double 73 | , bph2 :: Double 74 | } 75 | 76 | -- need to change this part so that it have variable colour, 77 | -- width at each point, if done properly this can be a base for 78 | -- errorbar, crossbar, 2-boxplot and so on. 79 | 80 | ------------------------------------------------------------------------ 81 | -- General boxplot 82 | ------------------------------------------------------------------------ 83 | 84 | data GBoxPlot v n a = forall s. GBoxPlot 85 | { bData :: s 86 | , bFold :: Fold s a 87 | , bPos :: a -> Point v n 88 | , bBox :: [P2 Double] -> BP 89 | , bFill :: Bool 90 | } deriving Typeable 91 | 92 | type instance V (GBoxPlot v n a) = v 93 | type instance N (GBoxPlot v n a) = n 94 | 95 | instance (Metric v, OrderedField n) => Enveloped (GBoxPlot v n a) where 96 | getEnvelope GBoxPlot {..} = foldMapOf (bFold . to bPos) getEnvelope bData 97 | 98 | instance (Typeable a, TypeableFloat n, Renderable (Path V2 n) b, n ~ Double) 99 | => Plotable (GBoxPlot V2 n a) b where 100 | renderPlotable s sty GBoxPlot {..} = 101 | if bFill 102 | then mconcat ([ draw' d | d <- drawBoxPlot dd] ++ [foo]) 103 | else mconcat [ draw' d | d <- drawBoxPlot dd] 104 | where 105 | ps = toListOf (bFold . to bPos . to (logPoint ls)) bData 106 | dd = bBox ps 107 | foo = makeRect dd 108 | # mapLoc closeLine 109 | # stroke 110 | # lw none 111 | # applyAreaStyle sty 112 | # transform t 113 | t = s ^. specTrans 114 | ls = s ^. specScale 115 | draw' d = d # transform t 116 | # stroke 117 | 118 | defLegendPic sty GBoxPlot {..} 119 | = square 5 # applyAreaStyle sty 120 | 121 | -- _BoxPlot :: (Plotable (BoxPlot v n) b, Typeable b) 122 | -- => Prism' (Plot b v n) (BoxPlot v n) 123 | -- _BoxPlot = _Plot 124 | 125 | ------------------------------------------------------------------------ 126 | -- Boxplot 127 | ------------------------------------------------------------------------ 128 | 129 | type BoxPlot v n = GBoxPlot v n (Point v n) 130 | 131 | -- | Draw a boxplot with the given data. 132 | mkBoxPlot :: (PointLike v n p, F.Foldable f) 133 | => f p -> BoxPlot v n 134 | mkBoxPlot = mkBoxPlotOf folded 135 | 136 | -- | Create a boxplot using a fold and given data. 137 | mkBoxPlotOf :: PointLike v n p 138 | => Fold s p -> s -> BoxPlot v n 139 | mkBoxPlotOf f a = GBoxPlot 140 | { bData = a 141 | , bFold = f . unpointLike 142 | , bPos = id 143 | , bBox = boxplotstat 144 | , bFill = True 145 | } 146 | 147 | ------------------------------------------------------------------------ 148 | -- Helper functions 149 | ------------------------------------------------------------------------ 150 | 151 | boxplotstat :: (Floating n, n ~ Double) => [P2 n] -> BP 152 | boxplotstat ps = BP 153 | { bppoint = meanXY 154 | , bpw = maxX * 0.5 155 | , bph1 = maxY * 0.3 156 | , bph2 = maxY * 0.8 157 | } 158 | where 159 | xs = [fst (unp2 p) | p <- ps] 160 | ys = [snd (unp2 p) | p <- ps] 161 | meanXY = ((mean xs), (mean ys)) 162 | maxX = maximum xs - (mean xs) 163 | maxY = maximum ys - (mean ys) 164 | 165 | mean :: (Real a, Fractional b) => [a] -> b 166 | mean xs = realToFrac (sum xs)/ genericLength xs 167 | 168 | drawBoxPlot :: BP -> [Located (Trail' Line V2 Double)] 169 | drawBoxPlot (BP (x,y) w h1 h2) = [a, b ,c ,d ,e] 170 | where 171 | xmin = x - w/2 172 | xmax = x + w/2 173 | y1min = y - h1 174 | y2min = y - h2 175 | y1max = y + h1 176 | y2max = y + h2 177 | a = fromVertices (map p2 [(xmin,y1max),(xmax,y1max),(xmax,y1min),(xmin,y1min)]) 178 | b = fromVertices (map p2 [(xmin,y1max),(xmin,y1min)]) 179 | c = fromVertices (map p2 [(xmin,y),(xmax,y)]) 180 | d = fromVertices (map p2 [(x,y1min),(x,y2min)]) 181 | e = fromVertices (map p2 [(x,y1max),(x,y2max)]) 182 | 183 | makeRect :: BP -> Located (Trail' Line V2 Double) 184 | makeRect (BP (x,y) w h1 _h2) = 185 | fromVertices (map p2 [(xmin,y1max),(xmax,y1max),(xmax,y1min),(xmin,y1min)]) 186 | where 187 | xmin = x - w/2 188 | xmax = x + w/2 189 | y1min = y - h1 190 | y1max = y + h1 191 | 192 | ---------------------------------------------------------------------------- 193 | -- Box plot lenses 194 | ---------------------------------------------------------------------------- 195 | 196 | class HasBox a v n d | a -> v n, a -> d where 197 | box :: Lens' a (GBoxPlot v n d) 198 | 199 | fillBox :: Lens' a Bool 200 | fillBox = box . lens bFill (\df fill -> df {bFill = fill}) 201 | 202 | instance HasBox (GBoxPlot v n d) v n d where 203 | box = id 204 | 205 | instance HasBox (Plot (GBoxPlot v n d) b) v n d where 206 | box = rawPlot 207 | 208 | ------------------------------------------------------------------------ 209 | -- Boxplot 210 | ------------------------------------------------------------------------ 211 | 212 | -- $ boxplot 213 | -- Box plots display data as boxplot. There are several representations 214 | -- for boxplot plots for extra parameters. Box plots have the following 215 | -- lenses: 216 | -- 217 | -- @ 218 | -- * 'fillBox' :: 'Lens'' ('BoxPlot' v n) 'Bool' - False 219 | -- @ 220 | 221 | -- | Add a 'BoxPlot' to the 'AxisState' from a data set. 222 | -- 223 | -- @ 224 | -- myaxis = r2Axis &~ 225 | -- boxPlot data1 226 | -- @ 227 | -- 228 | -- === __Example__ 229 | -- 230 | -- <> 231 | -- 232 | -- > import Plots 233 | -- > import Plots.Types.Boxplot 234 | -- > mydata1 = [(1,3), (2,5.5), (3.2, 6), (3.5, 6.1)] 235 | -- > mydata2 = mydata1 & each . _1 *~ 0.5 236 | -- > mydata3 = [V2 1.2 2.7, V2 2 5.1, V2 3.2 2.6, V2 3.5 5] 237 | -- 238 | -- > boxPlotAxis :: Axis B V2 Double 239 | -- > boxPlotAxis = r2Axis &~ do 240 | -- > boxPlot mydata1 $ key "data 1" 241 | -- > boxPlot mydata2 $ key "data 2" 242 | -- > boxPlot mydata3 $ key "data 3" 243 | -- 244 | -- > boxPlotExample = renderAxis boxPlotAxis 245 | boxPlot 246 | :: (v ~ BaseSpace c, 247 | PointLike v n p, 248 | MonadState (Axis b c n) m, 249 | Plotable (BoxPlot v n) b, 250 | F.Foldable f) 251 | => f p -> State (Plot (BoxPlot v n) b) () -> m () 252 | boxPlot d = addPlotable (mkBoxPlot d) 253 | 254 | -- | Make a 'BoxPlot' and take a 'State' on the plot to alter its 255 | -- options 256 | -- 257 | -- === __Example__ 258 | -- 259 | -- <> 260 | -- 261 | -- > import Plots 262 | -- > import Plots.Types.Boxplot 263 | -- > boxPlotAxis' :: Axis B V2 Double 264 | -- > boxPlotAxis' = r2Axis &~ do 265 | -- > boxPlot' mydata1 266 | -- > boxPlot' mydata2 267 | -- > boxPlot' mydata3 268 | -- 269 | -- > boxPlotExample' = renderAxis boxPlotAxis' 270 | boxPlot' 271 | :: (v ~ BaseSpace c, 272 | PointLike v n p, 273 | MonadState (Axis b c n) m, 274 | Plotable (BoxPlot v n) b, 275 | F.Foldable f) 276 | => f p -> m () 277 | boxPlot' d = addPlotable' (mkBoxPlot d) 278 | 279 | boxPlotOf 280 | :: (v ~ BaseSpace c, 281 | PointLike v n p, 282 | MonadState (Axis b c n) m, 283 | Plotable (BoxPlot v n) b) 284 | => Fold s p -> s -> State (Plot (BoxPlot v n) b) () -> m () 285 | boxPlotOf f s = addPlotable (mkBoxPlotOf f s) 286 | 287 | boxPlotOf' 288 | :: (v ~ BaseSpace c, 289 | PointLike v n p, 290 | MonadState (Axis b c n) m, 291 | Plotable (BoxPlot v n) b) 292 | => Fold s p -> s -> m () 293 | boxPlotOf' f s = addPlotable' (mkBoxPlotOf f s) 294 | 295 | -------------------------------------------------------------------------------- /diagrams/src_Plots_Types_Histogram_cdfDia.svg: -------------------------------------------------------------------------------- 1 | 1.00.80.60.40.20.08.07.06.05.04.0 --------------------------------------------------------------------------------