diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,9 @@ [![Haddock](https://rawgit.com/cchalmers/plots/gh-pages/haddock.svg)](https://cchalmers.github.io/plots/) [![Travis](https://api.travis-ci.org/cchalmers/plots.svg?branch=master)](https://travis-ci.org/cchalmers/plots) +[![Hackage](https://img.shields.io/hackage/v/plots.svg)](https://hackage.haskell.org/package/plots) + `plots` is a plotting library based on [diagrams](http://projects.haskell.org/diagrams). Some sample plots: @@ -25,7 +27,8 @@ the examples, first ensure that you have `stack` installed, and that you have a `stack.yaml` file in this directory that contains the lines: -```yaml packages: +```yaml +packages: - '.' - 'test' ``` @@ -41,3 +44,9 @@ file (`examples_output/X.png`) does not exist, or if the source file (`examples/X.hs`) has been modified since the last time the script was run. + +**Note 2:** If the `RunExamples` script fails with errors such as + `Failed to load interface for ...` then you will need to `stack + install` the required packages. In my case (with a freshly installed + stack), I needed to run the following `stack install wreq cassava + diagrams-rasterific`. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/diagrams/src_Plots_Types_Scatter_bubbleExample.svg b/diagrams/src_Plots_Types_Scatter_bubbleExample.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Plots_Types_Scatter_bubbleExample.svg @@ -0,0 +1,1 @@ +6.05.04.03.02.03.53.02.52.01.51.0data 9data 8data 7 diff --git a/plots.cabal b/plots.cabal --- a/plots.cabal +++ b/plots.cabal @@ -1,5 +1,5 @@ name: plots -version: 0.1.0.2 +version: 0.1.1.0 synopsis: Diagrams based plotting library. homepage: http://github.com/cchalmers/plots license: BSD3 @@ -10,7 +10,7 @@ stability: Experimental category: Graphics build-type: Simple -cabal-version: >=1.10 +cabal-version: >=1.18 extra-source-files: README.md diagrams/*.svg extra-doc-files: diagrams/*.svg description: Diagrams based plotting library. @@ -47,7 +47,7 @@ Diagrams.Coordinates.Polar hs-source-dirs: src build-depends: - base >= 4.3 && < 5.0, + base >= 4.7 && < 5.0, adjunctions, colour, containers >= 0.3 && < 0.6, diff --git a/src/Diagrams/Coordinates/Polar.hs b/src/Diagrams/Coordinates/Polar.hs --- a/src/Diagrams/Coordinates/Polar.hs +++ b/src/Diagrams/Coordinates/Polar.hs @@ -136,9 +136,9 @@ etheta = eθ -- | Coordinate with at least one dimension where the x coordinate can be --- retreived numerically. Note this differs slightly from 'R1' which requires +-- retrieved numerically. Note this differs slightly from 'R1' which requires -- a lens for all values. This allows instances for different coordinates --- such as 'Polar', where the x coordinate can only be retreived numerically. +-- such as 'Polar', where the x coordinate can only be retrieved numerically. class HasX t where x_ :: RealFloat n => Lens' (t n) n diff --git a/src/Plots.hs b/src/Plots.hs --- a/src/Plots.hs +++ b/src/Plots.hs @@ -49,10 +49,10 @@ -- ** Histogram plot - -- | Histogram. API for histogram. + -- | Histogram. API for histograms. , module Plots.Types.Histogram - -- | Wedge and annular wedge. API for wedge, annular wegde and pie. + -- | Wedge and annular wedge. API for wedge, annular wedge and pie. , module Plots.Types.Pie -------------------------------------------------------------------- @@ -60,7 +60,7 @@ -------------------------------------------------------------------- -- | Definitions of bounds, axis scale, orientation, legend, generic - -- plot ,plot spec and so on. + -- plot, plot spec and so on. , module Plots.Types -- | Grid lines and styles. @@ -69,7 +69,7 @@ -- | Grid lines and styles. , module Plots.Axis.Grid - -- | Axis labels and tick labels . + -- | Axis labels and tick labels. , module Plots.Axis.Labels -- | Rendering system for polar and r2 axis. @@ -87,7 +87,7 @@ -- | Colour bars. , module Plots.Axis.ColourBar - -- | Polar coordinates + -- | Polar coordinates. , module Diagrams.Coordinates.Polar , (&=), (&~~) diff --git a/src/Plots/Axis.hs b/src/Plots/Axis.hs --- a/src/Plots/Axis.hs +++ b/src/Plots/Axis.hs @@ -14,7 +14,7 @@ -- Portability : non-portable -- -- The 'Axis' is the main data type for "plots". It holds all the --- nessesary infomation to be rendered into a 'Diagram'. +-- necessary infomation to be rendered into a 'Diagram'. -- ---------------------------------------------------------------------------- module Plots.Axis @@ -100,7 +100,7 @@ -- Single axis --------------------------------------------------------- --- | Render infomation for a single axis line. +-- | Render information for a single axis line. data SingleAxis b v n = SingleAxis -- note the the v is only present for Style v n { saLabel :: AxisLabel b v n @@ -183,7 +183,7 @@ -- Axis data type ------------------------------------------------------ --- | Axis is the data type that holds all the nessessary information to render +-- | Axis is the data type that holds all the necessary information to render -- a plot. Common 'LensLike's used for the axis (see haddock's -- instances for a more comprehensive list): -- @@ -211,7 +211,7 @@ -- * 'axisScaling' - customise the 'AxisScaling' -- -- Plots are usually added to the axis using specific functions for --- that plots ('Plots.Types.Line.linePlot, 'Plots.Types.Bar.barPlot'). +-- those plots ('Plots.Types.Line.linePlot, 'Plots.Types.Bar.barPlot'). -- These functions use 'addPlotable' to add the plot to the axis. data Axis b c n = Axis { _axisStyle :: AxisStyle b (BaseSpace c) n @@ -322,7 +322,7 @@ axisSize :: (HasLinearMap c, Num n, Ord n) => Lens' (Axis b c n) (SizeSpec c n) axisSize = axes . column renderSize . iso mkSizeSpec getSpec -- column axisScaling . asSizeSpec -- iso mkSizeSpec getSpec --- | The range used for the colour bar limits. This is automaticlaly set +-- | The range used for the colour bar limits. This is automatically set -- when using 'heatMap' or 'heatMap'' colourBarRange :: Lens' (Axis b v n) (n,n) colourBarRange = lens _colourBarR (\a r -> a {_colourBarR = r}) @@ -368,7 +368,7 @@ -> m () -- ^ add plot to the 'Axis' addPlot p = axisPlots <>= [DynamicPlot p] --- | Add something 'Plotable' to the 'Axis' with a statefull modification +-- | Add something 'Plotable' to the 'Axis' with a stateful modification -- of the 'Plot'. addPlotable :: (InSpace (BaseSpace c) n p, MonadState (Axis b c n) m, Plotable p b) diff --git a/src/Plots/Axis/ColourBar.hs b/src/Plots/Axis/ColourBar.hs --- a/src/Plots/Axis/ColourBar.hs +++ b/src/Plots/Axis/ColourBar.hs @@ -57,6 +57,7 @@ { cbPlacement :: Placement , cbVisible :: Bool , cbTicks :: MajorTicks V2 n + , cbMinorTicks :: MinorTicks V2 n , cbGridLines :: MajorGridLines V2 n , cbTickLabels :: TickLabels b V2 n , cbDraw :: ColourMap -> QDiagram b V2 n Any @@ -76,6 +77,7 @@ { cbPlacement = rightMid , cbVisible = False , cbTicks = def + , cbMinorTicks = def & hidden .~ True , cbGridLines = def , cbTickLabels = def , cbDraw = gradientColourBar @@ -187,6 +189,12 @@ instance Functor f => HasMajorTicks f (ColourBar b n) where majorTicks = lens cbTicks (\c a -> c {cbTicks = a}) +instance Functor f => HasMinorTicks f (ColourBar b n) where + minorTicks = lens cbMinorTicks (\c a -> c {cbMinorTicks = a}) + +instance Functor f => HasMajorGridLines f (ColourBar b n) where + majorGridLines = lens cbGridLines (\c a -> c {cbGridLines = a}) + instance Functor f => HasTickLabels f (ColourBar b n) b where tickLabel = lens cbTickLabels (\c a -> c {cbTickLabels = a}) @@ -247,7 +255,7 @@ f x = (x - (ub + lb)/2) / (ub - lb) * l inRange x = x >= lb && x <= ub - bar = outline <> tks <> gLines <> colours + bar = outline <> tks <> minorTks <> gLines <> colours -- the outline outline = rect l w # applyStyle (cbStyle & _fillTexture .~ _AC ## transparent) @@ -261,8 +269,17 @@ tks | cbTicks ^. hidden = mempty | otherwise = F.foldMap (\x -> aTick # translate (V2 (f x) (-w/2))) tickXs' + # applyStyle (cbTicks ^. majorTicksStyle) aTick = someTick (cbTicks ^. majorTicksAlignment) (cbTicks ^. majorTicksLength) + minorTickXs = view minorTicksFunction cbMinorTicks tickXs bnds + minorTickXs' = filter inRange minorTickXs + minorTks + | cbMinorTicks ^. hidden = mempty + | otherwise = F.foldMap (\x -> aMinorTick # translate (V2 (f x) (-w/2))) minorTickXs' + # applyStyle (cbMinorTicks ^. minorTicksStyle) + aMinorTick = someTick (cbTicks ^. majorTicksAlignment) (cbTicks ^. majorTicksLength) + someTick tType d = case tType of TickSpec (fromRational -> aa) (fromRational -> bb) -> mkP2 0 (-d*bb) ~~ mkP2 0 (d*aa) @@ -324,7 +341,7 @@ where mkR i x = rect d' 1 # alignR - # fcA (cm ^. ixColour (x - 1/(2*fromIntegral n))) + # fc (cm ^. ixColourR (x - 1/(2*fromIntegral n))) # translateX (fromRational x) # lw none where diff --git a/src/Plots/Axis/Grid.hs b/src/Plots/Axis/Grid.hs --- a/src/Plots/Axis/Grid.hs +++ b/src/Plots/Axis/Grid.hs @@ -14,7 +14,7 @@ -- Stability : experimental -- Portability : non-portable -- --- Lines that go along the axis. Supports major and minor gird lines +-- Lines that go along the axis. Supports major and minor grid lines -- separately for each axis. -- ---------------------------------------------------------------------------- @@ -193,7 +193,7 @@ -- Both grid lines ------------------------------------------------------------------------ --- | Type holding infomation about both major and minor grid lines. +-- | Type holding information about both major and minor grid lines. data GridLines v n = GridLines { majGrid :: MajorGridLines v n , minGrid :: MinorGridLines v n @@ -228,7 +228,7 @@ -- @ -- 'hideGridLines' :: 'Axis' b c n -> 'Axis' b c n -- 'hideGridLines' :: 'SingleAxis' b c n -> 'SingleAxis' b c n --- 'hideGridLines' :: 'GridLines' b c n -> 'GirdLines' b c n +-- 'hideGridLines' :: 'GridLines' b c n -> 'GridLines' b c n -- @ hideGridLines :: (HasGridLines Identity a, MonadState a m) => m () hideGridLines = do @@ -240,14 +240,14 @@ -- @ -- 'showGridLines' :: 'Axis' b c n -> 'Axis' b c n -- 'showGridLines' :: 'SingleAxis' b c n -> 'SingleAxis' b c n --- 'showGridLines' :: 'GridLines' b c n -> 'GirdLines' b c n +-- 'showGridLines' :: 'GridLines' b c n -> 'GridLines' b c n -- @ showGridLines :: (HasGridLines Identity a, MonadState a m) => m () showGridLines = do minorGridLines . visible .= True majorGridLines . visible .= True --- | Traversal over both the major and minor grid styles. This can be used at seversal levels in the Axis: +-- | Traversal over both the major and minor grid styles. This can be used at several levels in the axis: gridLinesStyle :: (HasGridLines f a, Applicative f) => LensLike' f a (Style (V a) (N a)) gridLinesStyle = gridLines . styles where styles :: Traversal' (GridLines v n) (Style v n) diff --git a/src/Plots/Axis/Labels.hs b/src/Plots/Axis/Labels.hs --- a/src/Plots/Axis/Labels.hs +++ b/src/Plots/Axis/Labels.hs @@ -8,13 +8,15 @@ ----------------------------------------------------------------------------- -- | -- Module : Plots.Axis.Labels --- Copyright : (C) 2015 Christopher Chalmers +-- Copyright : (C) 2015-2017 Christopher Chalmers -- License : BSD-style (see the file LICENSE) -- Maintainer : Christopher Chalmers -- Stability : experimental -- Portability : non-portable -- --- Low level module defining types for axis labels and tick labels. +-- There are two kinds of labels this module deals with: The 'AxisLabel' +-- labels are placed next to an axis line. The 'TickLabels' are the +-- numbers (usually) next to each major tick on an axis line. -- ---------------------------------------------------------------------------- module Plots.Axis.Labels @@ -56,11 +58,22 @@ | LowerAxisLabel | UpperAxisLabel --- | Whether the 'AxisLabel' should be inside or ouside the axis. +-- | Whether the 'AxisLabel' should be inside or outside the axis. data AxisLabelPlacement = InsideAxisLabel | OutsideAxisLabel +-- | 'AxisLabel' describes the label next to each axis line. They are +-- normally set with the 'Plots.Axis.xLabel' and 'Plots.Axis.yLabel' +-- helper function: +-- +-- @ +-- myAxis = r2Axis &~ do +-- 'Plots.Axis.xLabel' .= "time (s)" +-- 'Plots.Axis.yLabel' .= "height (m)" +-- @ +-- +-- See 'HasAxisLabel' for more advanced settings. data AxisLabel b v n = AxisLabel { alFun :: TextFunction b v n , alText :: String @@ -102,7 +115,7 @@ axisLabelStyle :: Functor f => LensLike' f a (Style (V a) (N a)) axisLabelStyle = axisLabel . lens alStyle (\al sty -> al {alStyle = sty}) - -- | The position the label will be placed parallel the axis. + -- | The position the label will be placed parallel to the axis. axisLabelPosition :: Functor f => LensLike' f a AxisLabelPosition axisLabelPosition = axisLabel . lens alPos (\al sty -> al {alPos = sty}) @@ -140,8 +153,8 @@ -- Tick labels ------------------------------------------------------------------------ --- Labels that are placed next to the ticks of an axis. - +-- | 'TickLabels' describes how to draw the labels next to ticks. See +-- 'HasTickLabels' for more options. data TickLabels b v n = TickLabels { tlFun :: [n] -> (n,n) -> [(n, String)] , tlTextFun :: TextFunction b v n @@ -170,7 +183,7 @@ tickLabelTextFunction :: Functor f => LensLike' f a (TextFunction b (V a) (N a)) tickLabelTextFunction = tickLabel . lens tlTextFun (\tl f -> tl {tlTextFun = f}) - -- | Tick labels functions are used to draw the tick labels. They has + -- | Tick labels functions are used to draw the tick labels. They have -- access to the major ticks and the current bounds. Returns the -- position of the tick and label to use at that position. -- @@ -211,9 +224,18 @@ visible = lens tlVisible (\tl b -> tl {tlVisible = b}) -- | Setter over the final positions the major ticks. This is not as --- general as 'minorTicksFunction' because you don't have access to --- the bounds but it can be useful when you know exactly what ticks --- you want to add or modify existing tick positions. +-- general as 'tickLabelFunction' because you don't have access to the +-- bounds but it can be useful when you know exactly what ticks you +-- want to add or modify existing tick positions or to add an extra +-- value: +-- +-- @ +-- xAxis . tickLabelPositions .= [(1, "apples"), (2, "oranges"), (3, "bananas"] +-- yAxis . tickLabelPositions <>= [(1.5, "critial mass")] +-- @ +-- +-- If you want to change or add normal ticks see 'majorTicksFunction'. +-- tickLabelPositions :: (HasTickLabels f a b, Settable f) => LensLike' f a [(N a, String)] diff --git a/src/Plots/Axis/Render.hs b/src/Plots/Axis/Render.hs --- a/src/Plots/Axis/Render.hs +++ b/src/Plots/Axis/Render.hs @@ -301,8 +301,8 @@ | otherwise = foldMap mkline (map snd ys) -- merge with ticks? # transform t # stroke - -- # applyStyle (a ^. axisLine e . axisArrowOpts . _Just . shaftStyle) # lineCap LineCapSquare + # applyStyle (a^.axisLineStyle) where -- TODO: Arrow for R3 mkline y = pathFromVertices @@ -544,7 +544,7 @@ -- Angular axis ---------------------------------------------------------------------- - -- The angular axis is a circular line around the perimieter of the + -- The angular axis is a circular line around the perimeter of the -- polar plot. The Ticks and tick labels are placed around this -- perimeter. The Grid lines go from the perimeter to the center. thetaAx @@ -614,7 +614,7 @@ -- grid lines go from the centre of the axis to the perimeter thetaAxGridLines - -- - | thetaA ^. girdLines . hidden = mempty + -- - | thetaA ^. gridLines . hidden = mempty | otherwise = thetaMajorGridLines <> thetaMinorGridLines majorGridThetas = view majorGridLinesFunction thetaA majorTickThetas (0,theta) diff --git a/src/Plots/Axis/Title.hs b/src/Plots/Axis/Title.hs --- a/src/Plots/Axis/Title.hs +++ b/src/Plots/Axis/Title.hs @@ -36,6 +36,7 @@ , tTxtFun :: TextAlignment n -> String -> QDiagram b v n Any , tStyle :: Style v n , tPlacement :: Placement + , tAlignment :: TextAlignment n , tGap :: n } deriving Typeable @@ -47,6 +48,7 @@ , tTxtFun = mkText , tStyle = mempty # fontSize (output 11) , tPlacement = midAbove + , tAlignment = BoxAlignedText 0.5 0 , tGap = 20 } @@ -84,6 +86,19 @@ titlePlacement :: Lens' a Placement titlePlacement = title . lens tPlacement (\t s -> t {tPlacement = s}) + -- | The function used to draw the title text. + -- + -- Default is 'mkText'. + titleTextFunction :: Lens' a (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any) + titleTextFunction = title . lens tTxtFun (\t s -> t {tTxtFun = s}) + + -- | The 'TextAlignment' used for the title text. This is given to the + -- 'titleTextFunction'. + -- + -- Default is @'BoxAlignedText' 0.5 0@. + titleAlignment :: Lens' a (TextAlignment (N a)) + titleAlignment = title . lens tAlignment (\t s -> t {tAlignment = s}) + -- | The gap between the axis and the title. -- -- Default is 'mempty'. @@ -107,6 +122,6 @@ (t ^. titleGap) tDia where - tDia = tTxtFun t (BoxAlignedText 0.5 0) (tTxt t) + tDia = tTxtFun t (t ^. titleAlignment) (tTxt t) # applyStyle (tStyle t) diff --git a/src/Plots/Legend.hs b/src/Plots/Legend.hs --- a/src/Plots/Legend.hs +++ b/src/Plots/Legend.hs @@ -137,14 +137,20 @@ # orient (l ^. legendOrientation) hcat vcat # alignTL - back = rect (w + h + 5) (h * fromIntegral (length entries)) - # fcA transparent + back = backRect # applyStyle (l ^. legendStyle) # alignTL - # translate (V2 (-5) 0) -- (-3)) + backRect = orient (l ^. legendOrientation) + (rect (nEntries * entryWidth) h ) + (rect entryWidth (h * nEntries)) + nEntries = fromIntegral (length entries) - -- mkLabels :: (QDiagram b V2 n Any, String) -> QDiagram b V2 n Any - mkLabels (pic, txt) = pic' ||| strutX 5 ||| label where + -- Each legend picture has a width equal to the height of each + -- legend entry. The picture also has a 5 unit buffer either side of + -- it. + entryWidth = w + 10 + h + + mkLabels (pic, txt) = strutX 5 ||| pic' ||| strutX 5 ||| label where pic' = pic # withEnvelope (fromCorners (pure (-h/2)) (pure (h/2))) label = view legendTextFunction l txt # applyStyle (l ^. legendTextStyle) diff --git a/src/Plots/Style.hs b/src/Plots/Style.hs --- a/src/Plots/Style.hs +++ b/src/Plots/Style.hs @@ -26,7 +26,6 @@ ( -- * The axis style AxisStyle , HasAxisStyle (..) - -- , axisStyles -- ** Predefined styles , fadedColours @@ -58,12 +57,15 @@ -- * Colour maps , ColourMap , ixColour + , ixColourR , cmTraverse , colourMap - , alphaColourMap , colourList , toStops + , NanColours + , HasNanColours (..) + -- ** Sample maps , viridis , magma @@ -73,7 +75,6 @@ ) where --- import Control.Lens hiding (transform, ( # ), at, none) import qualified Control.Lens as Lens import Data.Colour.SRGB import qualified Data.Map as M @@ -273,7 +274,7 @@ ------------------------------------------------------------------------ -- | The 'AxisStyle' determines the 'Style's of the plots in an axis. --- There are various predifined styles to change the look of the plot. +-- There are various predefined styles to change the look of the plot. data AxisStyle b v n = AxisStyle ColourMap [PlotStyle b v n] type instance V (AxisStyle b v n) = v @@ -459,52 +460,101 @@ -- Colour maps ------------------------------------------------------------------------ --- type ColourMap = [(Double, AlphaColour Double)] +-- | Colours to use when representing @NaN@, @Infinity@ and @-Infinity@. +data NanColours = NanColours + { _nanColour :: Colour Double + , _infColour :: Colour Double + , _negInfColour :: Colour Double + } deriving Show +class HasNanColours a where + -- | Colours to use when displaying @NaN@, @Infinity@ and @-Infinity@. + nanColours :: Lens' a NanColours + + -- | Colour to use when displaying @NaN@. + -- + -- Default is 'white. + nanColour :: Lens' a (Colour Double) + nanColour = nanColours . lens _nanColour (\n c -> n {_nanColour = c}) + + -- | Colour to use when displaying @Infinity@. + -- + -- Default is 'lime'. + infColour :: Lens' a (Colour Double) + infColour = nanColours . lens _infColour (\n c -> n {_infColour = c}) + + -- | Colour to use when displaying @-Infinity@. + -- + -- Default is 'magenta'. + negInfColour :: Lens' a (Colour Double) + negInfColour = nanColours . lens _negInfColour (\n c -> n {_negInfColour = c}) + +instance HasNanColours NanColours where + nanColours = id + +instance Default NanColours where + def = NanColours + { _nanColour = magenta + , _infColour = white + , _negInfColour = black + } + +-- type ColourMap = [(Double, Colour Double)] + -- | A map from a number (usually between 0 and 1) to a colour. Colour -- maps are part of the 'AxisStyle', which is used for plots like -- 'Plots.Types.HeatMap'. -newtype ColourMap = ColourMap (M.Map Rational (AlphaColour Double)) +data ColourMap = ColourMap NanColours (M.Map Rational (Colour Double)) deriving Show - type instance V ColourMap = V1 type instance N ColourMap = Rational --- makeWrapped ''ColourMap --- manually write instance to avoid template haskell splitting the --- module up -instance Rewrapped ColourMap ColourMap -instance Wrapped ColourMap where - type Unwrapped ColourMap = M.Map Rational (AlphaColour Double) - _Wrapped' = iso (\(ColourMap a) -> a) ColourMap - {-# INLINE _Wrapped' #-} +cmap :: Lens' ColourMap (M.Map Rational (Colour Double)) +cmap f (ColourMap ncs cs) = f cs <&> \cs' -> ColourMap ncs cs' +instance HasNanColours ColourMap where + nanColours f (ColourMap ncs cs) = f ncs <&> \ncs' -> ColourMap ncs' cs + p1apply :: Num a => Transformation V1 a -> a -> a p1apply t a = papply t (P (V1 a)) ^. _x instance Transformable ColourMap where - transform t = over (_Wrapped' . _Wrapped' . mapped . _1) (p1apply t) + transform t = over (cmap . _Wrapped' . mapped . _1) (p1apply t) type instance Index ColourMap = Rational -type instance IxValue ColourMap = AlphaColour Double - -instance AsEmpty ColourMap where - _Empty = nearly (ColourMap M.empty) (allOf each (==transparent)) +type instance IxValue ColourMap = Colour Double -instance Each ColourMap ColourMap (AlphaColour Double) (AlphaColour Double) where - each = _Wrapped' . each +instance Each ColourMap ColourMap (Colour Double) (Colour Double) where + each = cmap . each instance Ixed ColourMap where - ix = ixColour + ix = ixColourR -- | 'Nothing' == 'transparent' instance At ColourMap where - at x = ixColour x . from (non transparent) + at x = ixColourR x . from (non black) -ixColour :: Rational -> Lens' ColourMap (AlphaColour Double) -ixColour x f (ColourMap cm) = f c <&> \c' -> ColourMap (M.insert x c' cm) +ixColour :: Double -> Lens' ColourMap (Colour Double) +ixColour x f cM@(ColourMap ncs cm) + | isNaN x = nanColour f cM + | isInfinite x = if x < 0 then negInfColour f cM else infColour f cM + | otherwise = f c <&> \c' -> ColourMap ncs (M.insert r c' cm) where + r = toRational x + c = case (M.lookupLE r cm, M.lookupGE r cm) of + (Just (i,c1), Just (j,c2)) + | i == j -> c1 + | otherwise -> + let a = fromRational $ (r - i) / (j - i) + in blend a c2 c1 + (Just (_,c1), Nothing) -> c1 + (Nothing, Just (_,c2)) -> c2 + _ -> black + +ixColourR :: Rational -> Lens' ColourMap (Colour Double) +ixColourR x f (ColourMap ncs cm) = f c <&> \c' -> ColourMap ncs (M.insert x c' cm) + where c = case (M.lookupLE x cm, M.lookupGE x cm) of (Just (i,c1), Just (j,c2)) | i == j -> c1 @@ -513,28 +563,25 @@ in blend a c2 c1 (Just (_,c1), Nothing) -> c1 (Nothing, Just (_,c2)) -> c2 - _ -> transparent + _ -> black -- | Indexed traversal over the colours indexed and ordered by their -- position in the map. -cmTraverse :: IndexedTraversal' Rational ColourMap (AlphaColour Double) -cmTraverse = _Wrapped' . itraversed +cmTraverse :: IndexedTraversal' Rational ColourMap (Colour Double) +cmTraverse = cmap . itraversed -- | Return the list of colours in the [0,1] range in order. This always -- includes colours 0 and 1. -colourList :: ColourMap -> [(Rational, AlphaColour Double)] +colourList :: ColourMap -> [(Rational, Colour Double)] colourList = itoListOf (cmTraverse . ifiltered (\i _ -> i >= 0 && i <= 1)) - . (ixColour 0 %~ id) . (ixColour 1 %~ id) + . (ixColourR 0 %~ id) . (ixColourR 1 %~ id) -- touch colours at 0 and 1 so they're in the list colourMap :: [(Rational, Colour Double)] -> ColourMap -colourMap = alphaColourMap . over (mapped . _2) opaque - -alphaColourMap :: [(Rational, AlphaColour Double)] -> ColourMap -alphaColourMap [] = ColourMap M.empty -alphaColourMap cs - | a == b = ColourMap (M.singleton 0.5 c) - | otherwise = ColourMap (M.mapKeysMonotonic normalise cm) +colourMap [] = ColourMap def M.empty +colourMap cs + | a == b = ColourMap def (M.singleton 0.5 c) + | otherwise = ColourMap def (M.mapKeysMonotonic normalise cm) where cm = M.fromList cs (a,c) = M.findMin cm diff --git a/src/Plots/Types.hs b/src/Plots/Types.hs --- a/src/Plots/Types.hs +++ b/src/Plots/Types.hs @@ -302,8 +302,8 @@ legendText :: Lens' (LegendEntry b v n) String legendText = lens lText (\l txt -> l {lText = txt}) --- | The order in which the legend entries are rendered. If precedence --- are equal, they entries are put in the order they are added to the +-- | The order in which the legend entries are rendered. If precedences +-- are equal, the entries are put in the order they are added to the -- axis. -- -- Default is @0@. @@ -635,7 +635,7 @@ _DynamicPlot :: (Plotable p b, Typeable b) => Prism' (DynamicPlot b (V p) (N p)) (Plot p b) _DynamicPlot = prism' DynamicPlot (\(DynamicPlot p) -> cast p) --- | Traversal over the dynamic plot without the Plotable constraint +-- | Traversal over the dynamic plot without the 'Plotable' constraint -- '_DynamicPlot' has. dynamicPlot :: forall p b. (Typeable p, Typeable b) => Traversal' (DynamicPlot b (V p) (N p)) (Plot p b) @@ -692,7 +692,7 @@ f sty <&> StyledPlot p opts -- | Traversal over a raw plot of a styled plot. The type of the plot --- must match for the traversal to be succesful. +-- must match for the traversal to be successful. styledPlot :: forall p b. Typeable p => Traversal' (StyledPlot b (V p) (N p)) p styledPlot f s@(StyledPlot p opts sty) = case eq p of diff --git a/src/Plots/Types/Bar.hs b/src/Plots/Types/Bar.hs --- a/src/Plots/Types/Bar.hs +++ b/src/Plots/Types/Bar.hs @@ -22,6 +22,8 @@ -- -- <> -- +-- (see 'multiBars' example for code to make this plot) +-- ---------------------------------------------------------------------------- module Plots.Types.Bar ( diff --git a/src/Plots/Types/HeatMap.hs b/src/Plots/Types/HeatMap.hs --- a/src/Plots/Types/HeatMap.hs +++ b/src/Plots/Types/HeatMap.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -23,6 +24,8 @@ -- -- <> -- +-- (see 'heatMapIndexed' example for code to make this plot) +-- ---------------------------------------------------------------------------- module Plots.Types.HeatMap @@ -55,7 +58,6 @@ ) where import Control.Lens hiding (transform, ( # )) -import qualified Data.Colour as C import Control.Monad.ST import Control.Monad.State @@ -65,7 +67,6 @@ import qualified Data.Vector.Storable as S import qualified Data.Vector.Unboxed as V import Data.Word (Word8) -import Statistics.Function (minMax) import Codec.Picture import Diagrams.Coordinates.Isomorphic @@ -104,6 +105,32 @@ go 0 (1/0) (-1/0) 0 0 {-# INLINE mkHeatMatrix #-} +min' :: Double -> Double -> Double +min' !a !b + | isNaN b = a + | isInfinite b = a + | otherwise = min a b +{-# INLINE min' #-} + +max' :: Double -> Double -> Double +max' !a !b + | isNaN b = a + | isInfinite b = a + | otherwise = max a b +{-# INLINE max' #-} + +data MM = MM {-# UNPACK #-} !Double {-# UNPACK #-} !Double + +-- | Compute the minimum and maximum of a vector in one pass. This +-- ignores any @Infinity@ or @NaN@ values (since these make no sense +-- for colour bar ranges). +minMax :: V.Vector Double -> (Double, Double) +minMax = fini . V.foldl' go (MM (1/0) (-1/0)) + where + go (MM lo hi) k = MM (min' lo k) (max' hi k) + fini (MM lo hi) = (lo, hi) +{-# INLINE minMax #-} + -- | Construct a heat matrix from a foldable of foldables. -- -- @ @@ -207,7 +234,7 @@ V2 x y = hmSize hm -- | Scale an image so each pixel takes (n*n) pixels. This can be --- usefull for using 'heatImage' on small heat matrixes to give a +-- useful for using 'heatImage' on small heat matrices to give a -- sharper image. scaleImage :: Int -> Image PixelRGB8 -> Image PixelRGB8 scaleImage n img | n == 1 = img @@ -234,30 +261,36 @@ -- | Create an image of 'PixelsRGB8' using the heat matrix. heatImage :: HeatMatrix -> ColourMap -> Image PixelRGB8 -heatImage (HeatMatrix (V2 x y) dv a b) cm = Image x y v' where +heatImage (HeatMatrix (V2 x y) dv a b) cm = Image x y v where !cv = mkColourVector cm - -- PixelRGB8 doesn't have an unboxed instance so we have to write each - -- component manually. - v' = S.create $ do + v :: S.Vector Word8 + v = S.create $ do mv <- M.new (3 * x * y) let !m = 256 / (b - a) - go s i q - | s == x-1 = do -- return mv - let !d = V.unsafeIndex dv s + writeColour q (toSRGB24 -> RGB rr gg bb) = do + M.unsafeWrite mv q rr + M.unsafeWrite mv (q+1) gg + M.unsafeWrite mv (q+2) bb + + colourValue !q !d + | isNaN d = writeColour q (cm^.nanColour) + | isInfinite d = writeColour q (if d < 0 then cm^.negInfColour else cm^.infColour) + | otherwise = do let !o = 3 * (min 255 . max 0 . round $ (d - a) * m) M.unsafeWrite mv q (V.unsafeIndex cv o ) M.unsafeWrite mv (q+1) (V.unsafeIndex cv (o+1)) M.unsafeWrite mv (q+2) (V.unsafeIndex cv (o+2)) + + go s i q + | s == x-1 = do + let d = V.unsafeIndex dv s + colourValue q d return mv - -- go (s+1) (i+1) (q+3) | i == x = go (s - 2*x) 0 q | otherwise = do - let !d = V.unsafeIndex dv s - let !o = 3 * (min 255 . max 0 . round $ (d - a) * m) - M.unsafeWrite mv q (V.unsafeIndex cv o ) - M.unsafeWrite mv (q+1) (V.unsafeIndex cv (o+1)) - M.unsafeWrite mv (q+2) (V.unsafeIndex cv (o+2)) + let d = V.unsafeIndex dv s + colourValue q d go (s+1) (i+1) (q+3) go (x * (y-1)) 0 0 @@ -268,8 +301,8 @@ let go i | i == 3*256 = return mv | otherwise = do - let PixelRGB8 r g b = cm ^. ixColour (fromIntegral i / (3*256)) - . to colourToPixel + let x = fromIntegral i / (3*256) + RGB r g b = cm ^. ixColourR x . to toSRGB24 M.unsafeWrite mv i r M.unsafeWrite mv (i+1) g M.unsafeWrite mv (i+2) b @@ -277,10 +310,6 @@ go 0 -colourToPixel :: AlphaColour Double -> PixelRGB8 -colourToPixel c = PixelRGB8 r g b - where RGB r g b = toSRGB24 (c `C.over` black) - -- | Render the heat map as a collection squares made up of 'Trail's. -- This method is compatible with all backends and should always look -- sharp. However it can become slow and large for large heat maps. @@ -306,12 +335,12 @@ -> QDiagram b V2 n Any pathHeatRender hm@(HeatMatrix _ _ a b) cm = ifoldMapOf hmPoints mk hm # lwO 0 where - normalise d = toRational $ (d - a) / (b - a) + normalise d = (d - a) / (b - a) mk v@(V2 i j) d = rect w h # alignTR # translate (fromIntegral <$> v ^+^ 1) - # fcA (cm ^. ixColour (normalise d)) + # fc (cm ^. ixColour (normalise d)) where -- Squares that are not on the top left edge are slightly -- bigger to remove phantom gaps @@ -363,7 +392,7 @@ heatMapSize :: Functor f => LensLike' f a (V2 (N a)) heatMapSize = heatMapOptions . lens hSize (\s b -> (s {hSize = b})) - -- | The size of the full extend of the heat map. + -- | The size of the full extent of the heat map. -- -- Default is extent of the heat matrix. heatMapExtent :: (Functor f, Fractional (N a)) => LensLike' f a (V2 (N a)) diff --git a/src/Plots/Types/Histogram.hs b/src/Plots/Types/Histogram.hs --- a/src/Plots/Types/Histogram.hs +++ b/src/Plots/Types/Histogram.hs @@ -74,7 +74,7 @@ import Plots.Util --- | Construct a rectangle of size v with the bottom left at point p. +-- | Construct a rectangle of size $v$ with the bottom left at point $p$. rectBL :: (InSpace V2 n t, TrailLike t) => Point V2 n -> V2 n -> t rectBL p (V2 x y) = trailLike $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p @@ -96,7 +96,7 @@ instance OrderedField n => Enveloped (HistogramPlot n) where getEnvelope HistogramPlot {..} = - -- don't like this reduntent code + -- don't like this redundant code getEnvelope . orient hOrient _reflectXY id . (id :: Path v n -> Path v n) $ ifoldMap drawBar hValues where diff --git a/src/Plots/Types/Line.hs b/src/Plots/Types/Line.hs --- a/src/Plots/Types/Line.hs +++ b/src/Plots/Types/Line.hs @@ -159,7 +159,7 @@ -- Trail and path ------------------------------------------------------------------------ --- | Construct a localed trail from a list of folable of points. +-- | Construct a localed trail from a list of foldable of points. mkTrail :: (PointLike v n p, OrderedField n, F.Foldable f) => f p -> Located (Trail v n) mkTrail = mkTrailOf folded diff --git a/src/Plots/Types/Pie.hs b/src/Plots/Types/Pie.hs --- a/src/Plots/Types/Pie.hs +++ b/src/Plots/Types/Pie.hs @@ -27,6 +27,8 @@ -- -- <> -- +-- (see 'piePlot' example for code to make this plot) +-- ---------------------------------------------------------------------------- module Plots.Types.Pie @@ -64,7 +66,7 @@ ------------------------------------------------------------------------ -- | Contains information to draw a single wedge of a pie. It is not --- intended to be draw directly. Instead use 'piePlot. +-- intended to be drawn directly. Instead use 'piePlot'. data Wedge n = Wedge { sEndR :: n , sStartR :: n diff --git a/src/Plots/Types/Scatter.hs b/src/Plots/Types/Scatter.hs --- a/src/Plots/Types/Scatter.hs +++ b/src/Plots/Types/Scatter.hs @@ -25,6 +25,8 @@ -- -- <> -- +-- (see 'scatterPlot' example for code to make this plot) +-- ---------------------------------------------------------------------------- module Plots.Types.Scatter ( -- * Scatter plot @@ -273,8 +275,9 @@ -- | Add a 'ScatterPlot' to the 'AxisState' from a data set. -- -- @ --- myaxis = r2Axis ~& --- scatterPlot data1 +-- 'scatterPlot' :: [('Double', 'Double')] -> 'State' ('Plot' ('ScatterOptions' 'V2' 'Double' ('P2' 'Double')) b) () -> 'State' ('Axis' b 'V2' 'Double') () +-- 'scatterPlot' :: ['V2' 'Double'] -> 'State' ('Plot' ('ScatterOptions' 'V2' 'Double' ('P2' 'Double')) b) () -> 'State' ('Axis' b 'V2' 'Double') () +-- 'scatterPlot' :: ['P2' 'Double'] -> 'State' ('Plot' ('ScatterOptions' 'V2' 'Double' ('P2' 'Double')) b) () -> 'State' ('Axis' b 'V2' 'Double') () -- @ -- -- === __Example__ @@ -309,6 +312,12 @@ -- | Version of 'scatterPlot' without any changes to the -- 'ScatterOptions'. -- +-- @ +-- 'scatterPlot'' :: [('Double', 'Double')] -> 'State' ('Axis' b 'V2' 'Double') () +-- 'scatterPlot'' :: ['V2' 'Double'] -> 'State' ('Axis' b 'V2' 'Double') () +-- 'scatterPlot'' :: ['P2' 'Double'] -> 'State' ('Axis' b 'V2' 'Double') () +-- @ +-- -- === __Example__ -- -- <> @@ -371,6 +380,30 @@ -- | Scatter plots with extra numeric parameter. By default the extra -- parameter is the scale of the marker but this can be changed. +-- +-- @ +-- 'bubblePlot' :: [('Double', ('Double', 'Double'))] -> 'State' ('Plot' ('BubbleOptions' v n) b) () -> 'State' ('Axis' b 'V2' 'Double') () +-- 'bubblePlot' :: [('Double', 'V2' 'Double')] -> 'State' ('Plot' ('BubbleOptions' v n) b) () -> 'State' ('Axis' b 'V2' 'Double') () +-- 'bubblePlot' :: [('Double', 'P2' 'Double')] -> 'State' ('Plot' ('BubbleOptions' v n) b) () -> 'State' ('Axis' b 'V2' 'Double') () +-- @ +-- +-- === __Example__ +-- +-- <> +-- +-- > import Plots +-- > myweights = [2, 1.3, 1.8, 0.7] +-- > mydata7 = zip myweights [(1,3), (2,5.5), (3.2, 6), (3.5, 6.1)] +-- > mydata8 = mydata7 & each._2._2 *~ 0.5 & each._1 *~ 0.5 +-- > mydata9 = [(1, V2 1.2 2.7), (3, V2 2 5.1), (0.9, V2 3.2 2.6), (2, V2 3.5 5)] +-- +-- > bubbleAxis :: Axis B V2 Double +-- > bubbleAxis = r2Axis &~ do +-- > bubblePlot mydata7 $ key "data 7" +-- > bubblePlot mydata8 $ key "data 8" +-- > bubblePlot mydata9 $ key "data 9" +-- +-- > bubbleExample = renderAxis bubbleAxis bubblePlot :: (BaseSpace c ~ v, PointLike v n p, @@ -387,6 +420,12 @@ s -- | Simple version of 'bubblePlot' without any changes to the 'Plot'. +-- +-- @ +-- 'bubblePlot'' :: [('Double', ('Double', 'Double'))] -> 'State' ('Axis' b 'V2' 'Double') () +-- 'bubblePlot'' :: [('Double', 'V2' 'Double')] -> 'State' ('Axis' b 'V2' 'Double') () +-- @ +-- bubblePlot' :: (v ~ BaseSpace c, PointLike v n p,