plots 0.1.1.1 → 0.1.1.2
raw patch · 22 files changed
+1417/−1269 lines, 22 filesdep +diagrams-coredep +diagrams-libdep −diagramsdep −geometrydep ~hashabledep ~lensdep ~monoid-extras
Dependencies added: diagrams-core, diagrams-lib
Dependencies removed: diagrams, geometry
Dependency ranges changed: hashable, lens, monoid-extras, mtl
Files
- plots.cabal +4/−4
- src/Diagrams/Coordinates/Polar.hs +2/−2
- src/Plots.hs +2/−2
- src/Plots/Axis.hs +100/−121
- src/Plots/Axis/ColourBar.hs +58/−55
- src/Plots/Axis/Grid.hs +40/−42
- src/Plots/Axis/Labels.hs +46/−66
- src/Plots/Axis/Line.hs +13/−17
- src/Plots/Axis/Render.hs +71/−130
- src/Plots/Axis/Scale.hs +45/−39
- src/Plots/Axis/Ticks.hs +40/−47
- src/Plots/Axis/Title.hs +23/−32
- src/Plots/Legend.hs +33/−35
- src/Plots/Name.hs +32/−32
- src/Plots/Style.hs +63/−86
- src/Plots/Types.hs +137/−137
- src/Plots/Types/Bar.hs +102/−84
- src/Plots/Types/HeatMap.hs +71/−100
- src/Plots/Types/Histogram.hs +59/−53
- src/Plots/Types/Line.hs +54/−55
- src/Plots/Types/Pie.hs +308/−0
- src/Plots/Types/Scatter.hs +114/−130
plots.cabal view
@@ -1,5 +1,5 @@ name: plots-version: 0.1.1.1+version: 0.1.1.2 synopsis: Diagrams based plotting library. homepage: http://github.com/cchalmers/plots license: BSD3@@ -40,7 +40,7 @@ Plots.Types.Histogram Plots.Types.HeatMap Plots.Types.Line- -- Plots.Types.Pie+ Plots.Types.Pie Plots.Types.Scatter Plots.Util Diagrams.Coordinates.Isomorphic@@ -52,8 +52,8 @@ colour, containers >= 0.3 && < 0.7, data-default >= 0.5 && < 0.8,- diagrams >= 2.0 && < 2.1,- geometry,+ diagrams-core >= 1.3 && < 1.5,+ diagrams-lib >= 1.3 && < 1.5, directory, distributive, transformers,
src/Diagrams/Coordinates/Polar.hs view
@@ -48,8 +48,8 @@ import Data.Typeable import GHC.Generics (Generic1) -import Geometry.Angle-import Geometry.TwoD.Types+import Diagrams.Angle+import Diagrams.TwoD.Types import Linear.Affine import Linear.Metric
src/Plots.hs view
@@ -53,7 +53,7 @@ , module Plots.Types.Histogram -- | Wedge and annular wedge. API for wedge, annular wedge and pie.- -- , module Plots.Types.Pie+ , module Plots.Types.Pie -------------------------------------------------------------------- -- * Low level@@ -114,6 +114,6 @@ import Plots.Types.HeatMap import Plots.Types.Histogram import Plots.Types.Line--- import Plots.Types.Pie+import Plots.Types.Pie import Plots.Types.Scatter
src/Plots/Axis.hs view
@@ -30,7 +30,6 @@ -- * Predefined axes , r2Axis- , r3Axis , polarAxis -- ** Base space@@ -102,32 +101,22 @@ -- Single axis --------------------------------------------------------- -- | Render information for a single axis line.-data SingleAxis v = SingleAxis--- note the the v is only present for Style v- { saLabel :: AxisLabel v- , saLine :: AxisLine v- , saTickLabel :: TickLabels v- , saScaling :: AxisScaling- , saGridLines :: GridLines v- , saTicks :: Ticks v+data SingleAxis b v n = SingleAxis+-- note the the v is only present for Style v n+ { saLabel :: AxisLabel b v n+ , saLine :: AxisLine v n+ , saTickLabel :: TickLabels b v n+ , saScaling :: AxisScaling n+ , saGridLines :: GridLines v n+ , saTicks :: Ticks v n , saVisible :: Bool } -type instance V (SingleAxis v) = v-type instance N (SingleAxis v) = Double--instance Default (SingleAxis V2) where- def = SingleAxis- { saLabel = def- , saLine = def- , saTickLabel = def- , saGridLines = def- , saTicks = def- , saScaling = def- , saVisible = True- }+type instance V (SingleAxis b v n) = v+type instance N (SingleAxis b v n) = n -instance Default (SingleAxis V3) where+instance (TypeableFloat n, Renderable (Text n) b)+ => Default (SingleAxis b V2 n) where def = SingleAxis { saLabel = def , saLine = def@@ -138,43 +127,43 @@ , saVisible = True } -instance Functor f => HasTicks f (SingleAxis v) where+instance Functor f => HasTicks f (SingleAxis b v n) where bothTicks = lens saTicks (\sa ticks -> sa {saTicks = ticks}) -instance Functor f => HasMajorTicks f (SingleAxis v) where+instance Functor f => HasMajorTicks f (SingleAxis b v n) where majorTicks = bothTicks . majorTicks -instance Functor f => HasMinorTicks f (SingleAxis v) where+instance Functor f => HasMinorTicks f (SingleAxis b v n) where minorTicks = bothTicks . minorTicks -instance Functor f => HasAxisLabel f (SingleAxis v) where+instance Functor f => HasAxisLabel f (SingleAxis b v n) b where axisLabel = lens saLabel (\sa l -> sa {saLabel = l}) -instance Functor f => HasTickLabels f (SingleAxis v) where+instance Functor f => HasTickLabels f (SingleAxis b v n) b where tickLabel = lens saTickLabel (\sa tl -> sa {saTickLabel = tl}) -instance Functor f => HasAxisLine f (SingleAxis v) where+instance Functor f => HasAxisLine f (SingleAxis b v n) where axisLine = lens saLine (\sa l -> sa {saLine = l}) -instance Functor f => HasGridLines f (SingleAxis v) where+instance Functor f => HasGridLines f (SingleAxis b v n) where gridLines = lens saGridLines (\sa l -> sa {saGridLines = l}) -instance Functor f => HasMajorGridLines f (SingleAxis v) where+instance Functor f => HasMajorGridLines f (SingleAxis b v n) where majorGridLines = gridLines . majorGridLines -instance Functor f => HasMinorGridLines f (SingleAxis v) where+instance Functor f => HasMinorGridLines f (SingleAxis b v n) where minorGridLines = gridLines . minorGridLines -instance Functor f => HasAxisScaling f (SingleAxis v) where+instance Functor f => HasAxisScaling f (SingleAxis b v n) where axisScaling = lens saScaling (\sa s -> sa {saScaling = s}) -instance HasVisibility (SingleAxis v) where+instance HasVisibility (SingleAxis b v n) where visible = lens saVisible (\sa b -> sa {saVisible = b}) --- singleAxisScale :: Lens' (SingleAxis v) AxisScale+-- singleAxisScale :: Lens' (SingleAxis b v n) AxisScale -- singleAxisScale = lens saScale (\sa s -> sa {saScale = s}) --- singleAxisBound :: Lens' (SingleAxis v) (Bound n)+-- singleAxisBound :: Lens' (SingleAxis b v n) (Bound n) -- singleAxisBound = lens saBounds (\sa b -> sa {saBounds = b}) ------------------------------------------------------------------------@@ -224,36 +213,36 @@ -- Plots are usually added to the axis using specific functions for -- those plots ('Plots.Types.Line.linePlot, 'Plots.Types.Bar.barPlot'). -- These functions use 'addPlotable' to add the plot to the axis.-data Axis c = Axis- { _axisStyle :: AxisStyle (BaseSpace c)- , _colourBar :: ColourBar- , _colourBarR :: (Double,Double)- , _legend :: Legend- , _axisTitle :: Title (BaseSpace c)+data Axis b c n = Axis+ { _axisStyle :: AxisStyle b (BaseSpace c) n+ , _colourBar :: ColourBar b n+ , _colourBarR :: (n,n)+ , _legend :: Legend b n+ , _axisTitle :: Title b (BaseSpace c) n -- , _axisTitle :: AxisTitle - , _axisPlots :: [DynamicPlot (BaseSpace c)]- , _plotModifier :: Endo (StyledPlot (BaseSpace c))+ , _axisPlots :: [DynamicPlot b (BaseSpace c) n]+ , _plotModifier :: Endo (StyledPlot b (BaseSpace c) n) -- the v in each axis is only used for the style- , _axes :: c (SingleAxis (BaseSpace c))+ , _axes :: c (SingleAxis b (BaseSpace c) n) } deriving Typeable -- | Lens onto the separate axes of an axis. Allows changing the -- coordinate system as long as the 'BaseSpace' is the same. -- -- @--- 'axes' :: 'Lens'' ('Axis' c) (c ('SingleAxis' v))+-- 'axes' :: 'Lens'' ('Axis' b c n) (c ('SingleAxis' b v n)) -- @ axes :: (v ~ BaseSpace c, v ~ BaseSpace c')- => Lens (Axis c)- (Axis c')- (c (SingleAxis v))- (c' (SingleAxis v))+ => Lens (Axis b c n)+ (Axis b c' n)+ (c (SingleAxis b v n))+ (c' (SingleAxis b v n)) axes = lens _axes (\(Axis a1 a2 a3 a4 a5 a6 a7 _) a8 -> Axis a1 a2 a3 a4 a5 a6 a7 a8) -- | The list of plots currently in the axis.-axisPlots :: BaseSpace c ~ v => Lens' (Axis c) [DynamicPlot v]+axisPlots :: BaseSpace c ~ v => Lens' (Axis b c n) [DynamicPlot b v n] axisPlots = lens _axisPlots (\a ps -> a {_axisPlots = ps}) -- | Traversal over the current plots in the axis.@@ -264,7 +253,7 @@ -- @ -- 'finalPlots' . 'connectingLine' .= 'True' -- @-currentPlots :: BaseSpace c ~ v => Traversal' (Axis c) (DynamicPlot v)+currentPlots :: BaseSpace c ~ v => Traversal' (Axis b c n) (DynamicPlot b v n) currentPlots = axisPlots . traversed -- | Setter over the final plot before the axis is rendered.@@ -277,74 +266,71 @@ -- 'finalPlots' . 'connectingLine' .= 'True' -- @ ---finalPlots :: BaseSpace c ~ v => Setter' (Axis c) (StyledPlot v)+finalPlots :: BaseSpace c ~ v => Setter' (Axis b c n) (StyledPlot b v n) finalPlots = sets $ \f a -> a {_plotModifier = _plotModifier a <> Endo f} -- | Lens onto the modifier set by 'finalPlots'. This gets applied to -- all plots in the axis, just before they are rendered.-plotModifier :: BaseSpace c ~ v => Lens' (Axis c) (Endo (StyledPlot v))+plotModifier :: BaseSpace c ~ v => Lens' (Axis b c n) (Endo (StyledPlot b v n)) plotModifier = lens _plotModifier (\a f -> a {_plotModifier = f}) -- Axis instances ------------------------------------------------------ -type instance V (Axis c) = BaseSpace c-type instance N (Axis c) = Double+type instance V (Axis b v n) = BaseSpace v+type instance N (Axis b v n) = n -instance (Applicative f, Traversable c) => HasTicks f (Axis c) where+instance (Applicative f, Traversable c) => HasTicks f (Axis b c n) where bothTicks = axes . traverse . bothTicks -instance (Applicative f, Traversable c) => HasMajorTicks f (Axis c) where+instance (Applicative f, Traversable c) => HasMajorTicks f (Axis b c n) where majorTicks = axes . traverse . majorTicks -instance (Applicative f, Traversable c) => HasMinorTicks f (Axis c) where+instance (Applicative f, Traversable c) => HasMinorTicks f (Axis b c n) where minorTicks = axes . traverse . minorTicks -instance (Applicative f, Traversable c) => HasGridLines f (Axis c) where+instance (Applicative f, Traversable c) => HasGridLines f (Axis b c n) where gridLines = axes . traverse . gridLines -instance (Applicative f, Traversable c) => HasMajorGridLines f (Axis c) where+instance (Applicative f, Traversable c) => HasMajorGridLines f (Axis b c n) where majorGridLines = axes . traverse . majorGridLines -instance (Applicative f, Traversable c) => HasMinorGridLines f (Axis c) where+instance (Applicative f, Traversable c) => HasMinorGridLines f (Axis b c n) where minorGridLines = axes . traverse . minorGridLines -instance (Applicative f, Traversable c) => HasAxisLine f (Axis c) where- axisLine = axes . traverse . axisLine--instance (Applicative f, Traversable c) => HasAxisLabel f (Axis c) where+instance (Applicative f, Traversable c) => HasAxisLabel f (Axis b c n) b where axisLabel = axes . traverse . axisLabel -instance (Applicative f, Traversable c) => HasTickLabels f (Axis c) where+instance (Applicative f, Traversable c) => HasTickLabels f (Axis b c n) b where tickLabel = axes . traverse . tickLabel -instance (Applicative f, Traversable c) => HasAxisScaling f (Axis c) where+instance (Applicative f, Traversable c) => HasAxisScaling f (Axis b c n) where axisScaling = axes . traverse . axisScaling -instance Settable f => HasPlotOptions f (Axis c) where+instance Settable f => HasPlotOptions f (Axis b c n) b where plotOptions = finalPlots . plotOptions -instance Settable f => HasPlotStyle f (Axis c) where+instance Settable f => HasPlotStyle f (Axis b c n) b where plotStyle = finalPlots . plotStyle -instance HasLegend (Axis c) where+instance HasLegend (Axis b c n) b where legend = lens _legend (\a l -> a {_legend = l}) -instance HasTitle (Axis c) where+instance HasTitle (Axis b c n) b where title = lens _axisTitle (\a t -> a {_axisTitle = t}) -- | The size used for the rendered axis.-axisSize :: HasLinearMap c => Lens' (Axis c) (SizeSpec c Double)-axisSize = axes . column renderSize . iso mkSizeSpec getSpec+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 automatically set -- when using 'heatMap' or 'heatMap''-colourBarRange :: Lens' (Axis v) (Double,Double)+colourBarRange :: Lens' (Axis b v n) (n,n) colourBarRange = lens _colourBarR (\a r -> a {_colourBarR = r}) -instance HasAxisStyle (Axis v) where+instance HasAxisStyle (Axis b v n) b where axisStyle = lens _axisStyle (\a sty -> a {_axisStyle = sty}) -instance HasColourBar (Axis v) where+instance HasColourBar (Axis b v n) b where colourBar = lens _colourBar (\a cb -> a {_colourBar = cb}) -- Axis functions ------------------------------------------------------@@ -352,11 +338,11 @@ -- $plotable -- The 'Plotable' class defines ways of converting the data type to a -- diagram for some axis. There are several variants for adding an axis--- with constraints @('InSpace' v a, 'Plotable' a b)@:+-- with constraints @('InSpace' v n a, 'Plotable' a b)@: -- -- @--- 'addPlotable' :: a -> 'PlotState' a b -> 'AxisState' v--- 'addPlotable'' :: a -> 'AxisState' v+-- 'addPlotable' :: a -> 'PlotState' a b -> 'AxisState' b v n+-- 'addPlotable'' :: a -> 'AxisState' b v n -- @ -- -- The last argument is a 'PlotState' so you can use @do@ notation to@@ -377,23 +363,23 @@ -- | Add a 'Plotable' 'Plot' to an 'Axis'. addPlot- :: (InSpace (BaseSpace c) Double p, MonadState (Axis c) m, Plotable p)- => Plot p -- ^ the plot- -> m () -- ^ add plot to the 'Axis'+ :: (InSpace (BaseSpace c) n p, MonadState (Axis b c n) m, Plotable p b)+ => Plot p b -- ^ the plot+ -> m () -- ^ add plot to the 'Axis' addPlot p = axisPlots <>= [DynamicPlot p] -- | Add something 'Plotable' to the 'Axis' with a stateful modification -- of the 'Plot'. addPlotable- :: (InSpace (BaseSpace c) Double p, MonadState (Axis c) m, Plotable p, HasLinearMap (BaseSpace c))+ :: (InSpace (BaseSpace c) n p, MonadState (Axis b c n) m, Plotable p b) => p -- ^ the raw plot- -> State (Plot p) () -- ^ changes to the plot+ -> State (Plot p b) () -- ^ changes to the plot -> m () -- ^ add plot to the 'Axis' addPlotable p s = addPlot $ execState s (mkPlot p) -- | Simple version of 'AddPlotable' without any changes 'Plot'. addPlotable'- :: (InSpace (BaseSpace c) Double p, MonadState (Axis c) m, Plotable p, HasLinearMap (BaseSpace c))+ :: (InSpace (BaseSpace v) n p, MonadState (Axis b v n) m, Plotable p b) => p -- ^ the raw plot -> m () -- ^ add plot to the 'Axis' addPlotable' p = addPlotable p (return ())@@ -403,7 +389,11 @@ ------------------------------------------------------------------------ -- | The default axis for plots in the 'V2' coordinate system.-r2Axis :: Axis V2+r2Axis+ :: (TypeableFloat n,+ Renderable (Text n) b,+ Renderable (Path V2 n) b)+ => Axis b V2 n r2Axis = Axis { _axisStyle = fadedColours , _colourBar = defColourBar@@ -417,110 +407,95 @@ , _axes = pure def } --- | The default axis for plots in the 'V2' coordinate system.-r3Axis :: Axis V3-r3Axis = Axis- { _axisStyle = fadedColours3D- , _colourBar = defColourBar- , _colourBarR = (0,1)- , _axisTitle = def-- , _legend = def- , _axisPlots = []- , _plotModifier = mempty-- , _axes = pure def- }- -- The x-axis ---------------------------------------------------------- -- | Lens onto the x-axis of an 'Axis'.-xAxis :: R1 c => Lens' (Axis c) (SingleAxis (BaseSpace c))+xAxis :: R1 c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n) xAxis = axes . _x -- | The label for the x-axis. Shorthand for @'xAxis' . 'axisLabelText'@.-xLabel :: R1 c => Lens' (Axis c) String+xLabel :: R1 c => Lens' (Axis b c n) String xLabel = xAxis . axisLabelText -- | The minimum x value for the axis. If the value if 'Nothing' (the -- 'Default'), the bounds will be infered by the plots in the axis.-xMin :: R1 c => Lens' (Axis c) (Maybe Double)+xMin :: R1 c => Lens' (Axis b c n) (Maybe n) xMin = xAxis . boundMin -- | The minimum x value for the axis. If the value if 'Nothing' (the -- 'Default'), the bounds will be infered by the plots in the axis.-xMax :: R1 c => Lens' (Axis c) (Maybe Double)+xMax :: R1 c => Lens' (Axis b c n) (Maybe n) xMax = xAxis . boundMax -- The y-axis ---------------------------------------------------------- -- | Lens onto the y-axis of an 'Axis'.-yAxis :: R2 c => Lens' (Axis c) (SingleAxis (BaseSpace c))+yAxis :: R2 c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n) yAxis = axes . _y -- | The label for the y-axis. Shorthand for @'yAxis' . 'axisLabelText'@.-yLabel :: R2 c => Lens' (Axis c) String+yLabel :: R2 c => Lens' (Axis b c n) String yLabel = yAxis . axisLabelText -- | The minimum y value for the axis. If the value if 'Nothing' (the -- 'Default'), the bounds will be infered by the plots in the axis.-yMin :: R2 c => Lens' (Axis c) (Maybe Double)+yMin :: R2 c => Lens' (Axis b c n) (Maybe n) yMin = yAxis . boundMin -- | The minimum y value for the axis. If the value if 'Nothing' (the -- 'Default'), the bounds will be infered by the plots in the axis.-yMax :: R2 c => Lens' (Axis c) (Maybe Double)+yMax :: R2 c => Lens' (Axis b c n) (Maybe n) yMax = yAxis . boundMax -- The z-axis ---------------------------------------------------------- -- | Lens onto the z-axis of an 'Axis'.-zAxis :: R3 c => Lens' (Axis c) (SingleAxis (BaseSpace c))+zAxis :: R3 c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n) zAxis = axes . _z -- | The label for the z-axis. Shorthand for @'zAxis' . 'axisLabelText'@.-zLabel :: R3 c => Lens' (Axis c) String+zLabel :: R3 c => Lens' (Axis b c n) String zLabel = zAxis . axisLabelText -- | The minimum z value for the axis. If the value if 'Nothing' (the -- 'Default'), the bounds will be infered by the plots in the axis.-zMin :: R3 c => Lens' (Axis c) (Maybe Double)+zMin :: R3 c => Lens' (Axis b c n) (Maybe n) zMin = zAxis . boundMin -- | The minimum z value for the axis. If the value if 'Nothing' (the -- 'Default'), the bounds will be infered by the plots in the axis.-zMax :: R3 c => Lens' (Axis c) (Maybe Double)+zMax :: R3 c => Lens' (Axis b c n) (Maybe n) zMax = zAxis . boundMax -- The r-axis ---------------------------------------------------------- -- | Lens onto the radial axis of an 'Axis'.-rAxis :: Radial c => Lens' (Axis c) (SingleAxis (BaseSpace c))+rAxis :: Radial c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n) rAxis = axes . _radial -- | The label for the radial axis. Shorthand for @'rAxis' . 'axisLabelText'@.-rLabel :: Radial c => Lens' (Axis c) String+rLabel :: Radial c => Lens' (Axis b c n) String rLabel = rAxis . axisLabelText -- | The minimum z value for the axis. If the value if 'Nothing' (the -- 'Default'), the bounds will be infered by the plots in the axis.--- rMin :: R3 c => Lens' (Axis c) (Maybe Double)+-- rMin :: R3 c => Lens' (Axis b c n) (Maybe n) -- rMin = zAxis . boundMin -- | The minimum radial value for the axis. If the value if 'Nothing' -- (the 'Default'), the bounds will be infered by the plots in the -- axis.-rMax :: Radial c => Lens' (Axis c) (Maybe Double)+rMax :: Radial c => Lens' (Axis b c n) (Maybe n) rMax = rAxis . boundMax -- The theta-axis ------------------------------------------------------ -- | Lens onto the radial axis of an 'Axis'.-thetaAxis :: Circle c => Lens' (Axis c) (SingleAxis (BaseSpace c))+thetaAxis :: Circle c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n) thetaAxis = axes . el etheta -- | The label for the radial axis. Shorthand for @'rAxis' . 'axisLabelText'@.-thetaLabel :: Circle c => Lens' (Axis c) String+thetaLabel :: Circle c => Lens' (Axis b c n) String thetaLabel = thetaAxis . axisLabelText @@ -546,7 +521,11 @@ -- R3 Axis -polarAxis :: Axis Polar+polarAxis+ :: (TypeableFloat n,+ Renderable (Text n) b,+ Renderable (Path V2 n) b)+ => Axis b Polar n polarAxis = Axis { _axisStyle = fadedColours , _colourBar = defColourBar
src/Plots/Axis/ColourBar.hs view
@@ -39,8 +39,9 @@ import Data.Bool (bool) import qualified Data.Foldable as F--- import Diagrams.Core.Transform (fromSymmetric)-import Diagrams.Prelude hiding (orient)+import Data.Typeable+import Diagrams.Core.Transform (fromSymmetric)+import Diagrams.Prelude hiding (gap) import Diagrams.TwoD.Text import Plots.Axis.Grid import Plots.Axis.Labels@@ -49,30 +50,29 @@ import Plots.Types import Plots.Util -import Geometry.TwoD.Transform- -- | Options for drawing a colour bar. Note that for an axis, the -- 'ColourMap' is stored in the 'AxisStyle'. These options are for -- other aspects of the bar, not the colours used.-data ColourBar = ColourBar+data ColourBar b n = ColourBar { cbPlacement :: Placement , cbVisible :: Bool- , cbTicks :: MajorTicks V2- , cbMinorTicks :: MinorTicks V2- , cbGridLines :: MajorGridLines V2- , cbTickLabels :: TickLabels V2- , cbDraw :: ColourMap -> Diagram V2- , cbWidth :: Double- , cbLengthFun :: Double -> Double- , cbGap :: Double- , cbStyle :: Style V2 Double+ , cbTicks :: MajorTicks V2 n+ , cbMinorTicks :: MinorTicks V2 n+ , cbGridLines :: MajorGridLines V2 n+ , cbTickLabels :: TickLabels b V2 n+ , cbDraw :: ColourMap -> QDiagram b V2 n Any+ , cbWidth :: n+ , cbLengthFun :: n -> n+ , cbGap :: n+ , cbStyle :: Style V2 n } -type instance V ColourBar = V2-type instance N ColourBar = Double+type instance V (ColourBar b n) = V2+type instance N (ColourBar b n) = n -- | The default colour bar.-defColourBar :: ColourBar+defColourBar :: (Renderable (Text n) b, Renderable (Path V2 n) b, TypeableFloat n)+ => ColourBar b n defColourBar = ColourBar { cbPlacement = rightMid , cbVisible = False@@ -87,9 +87,9 @@ , cbStyle = mempty } -class HasColourBar a where+class HasColourBar a b | a -> b where -- | Lens onto the 'ColourBar'.- colourBar :: Lens' a ColourBar+ colourBar :: Lens' a (ColourBar b (N a)) -- | How to draw the colour bar. Expects a 1 by 1 box with the -- gradient going from left to right, without an outline with origin@@ -100,40 +100,40 @@ -- 'Plots.Style.axisColourMap' from "Plots.Style" -- -- Default is 'gradientColourBar'.- colourBarDraw :: Lens' a (ColourMap -> Diagram V2)+ colourBarDraw :: Lens' a (ColourMap -> QDiagram b V2 (N a) Any) colourBarDraw = colourBar . lens cbDraw (\c a -> c {cbDraw = a}) -- | The width (orthogonal to the colour bar direction) of the colour -- bar. -- -- 'Default' is @20@.- colourBarWidth :: Lens' a Double+ colourBarWidth :: Lens' a (N a) colourBarWidth = colourBar . lens cbWidth (\c a -> c {cbWidth = a}) -- | Set the length of the colour bar given the length of the axis the -- colour bar is aligned to. -- -- 'Default' is 'id'.- colourBarLengthFunction :: Lens' a (Double -> Double)+ colourBarLengthFunction :: Lens' a (N a -> N a) colourBarLengthFunction = colourBar . lens cbLengthFun (\c a -> c {cbLengthFun = a}) -- | Gap between the axis and the colour bar (if rendered with an axis). -- -- 'Default' is @20@.- colourBarGap :: Lens' a Double+ colourBarGap :: Lens' a (N a) colourBarGap = colourBar . lens cbGap (\c a -> c {cbGap = a}) -- | Style used for the outline of a colour bar.- colourBarStyle :: Lens' a (Style V2 Double)+ colourBarStyle :: Lens' a (Style V2 (N a)) colourBarStyle = colourBar . lens cbStyle (\c a -> c {cbStyle = a}) -instance HasColourBar ColourBar where+instance HasColourBar (ColourBar b n) b where colourBar = id -instance HasGap ColourBar where+instance HasGap (ColourBar b n) where gap = colourBarGap -instance HasPlacement ColourBar where+instance HasPlacement (ColourBar b n) where placement = lens cbPlacement (\c p -> c {cbPlacement = p}) -- This is a kinda strange instance that I'm using as an experiment.@@ -153,7 +153,7 @@ -- When reversing the direction we map E <-> S and N <-> W. The gap -- direction is rotated to match the new position and anchor has its x -- and y flipped.-instance HasOrientation ColourBar where+instance HasOrientation (ColourBar b n) where orientation = lens getter setter where getter p@@ -183,32 +183,32 @@ & placementAnchor %~ flipX_Y & gapDirection ._Dir %~ flipX_Y -instance ApplyStyle ColourBar-instance HasStyle ColourBar where- style = colourBarStyle+instance Typeable n => HasStyle (ColourBar b n) where+ applyStyle sty = colourBarStyle %~ applyStyle sty -instance Functor f => HasMajorTicks f ColourBar where+instance Functor f => HasMajorTicks f (ColourBar b n) where majorTicks = lens cbTicks (\c a -> c {cbTicks = a}) -instance Functor f => HasMinorTicks f ColourBar where+instance Functor f => HasMinorTicks f (ColourBar b n) where minorTicks = lens cbMinorTicks (\c a -> c {cbMinorTicks = a}) -instance Functor f => HasMajorGridLines f ColourBar where+instance Functor f => HasMajorGridLines f (ColourBar b n) where majorGridLines = lens cbGridLines (\c a -> c {cbGridLines = a}) -instance Functor f => HasTickLabels f ColourBar where+instance Functor f => HasTickLabels f (ColourBar b n) b where tickLabel = lens cbTickLabels (\c a -> c {cbTickLabels = a}) -instance HasVisibility ColourBar where+instance HasVisibility (ColourBar b n) where visible = lens cbVisible (\c a -> c {cbVisible = a}) -- | Add a colour bar to an object, using the bounding box for the object. addColourBar- :: BoundingBox V2 Double -- ^ bounding box to place against- -> ColourBar+ :: (TypeableFloat n, Renderable (Path V2 n) b)+ => BoundingBox V2 n -- ^ bounding box to place against+ -> ColourBar b n -- -> ColourMap- -> (Double,Double)- -> Diagram V2+ -> (n,n)+ -> QDiagram b V2 n Any addColourBar bb cbo@ColourBar {..} cm bnds | cbVisible = placeAgainst bb cbPlacement cbGap cb | otherwise = mempty@@ -224,11 +224,12 @@ -- | Render a colour bar by it's self at a given width. Note this -- ignores 'colourBarGap' and 'colourBarLengthFunction'. renderColourBar- :: ColourBar -- ^ options for colour bar- -> ColourMap -- ^ map to use- -> (Double,Double) -- ^ bounds of the values on the colour bar- -> Double -- ^ length of the colour bar- -> Diagram V2+ :: (TypeableFloat n, Renderable (Path V2 n) b)+ => ColourBar b n -- ^ options for colour bar+ -> ColourMap -- ^ map to use+ -> (n,n) -- ^ bounds of the values on the colour bar+ -> n -- ^ length of the colour bar+ -> QDiagram b V2 n Any renderColourBar cb@ColourBar {..} cm bnds@(lb,ub) l | cbVisible = bar # xy id reflectY # o id (reflectY . _reflectX_Y)@@ -257,7 +258,7 @@ bar = outline <> tks <> minorTks <> gLines <> colours -- the outline- outline = rect l w # applyStyle (cbStyle & _fillTexture ?~ _AC ## transparent)+ outline = rect l w # applyStyle (cbStyle & _fillTexture .~ _AC ## transparent) -- displaying the colour map colours = cbDraw cm # centerXY # scaleX l # scaleY w@@ -268,6 +269,7 @@ 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@@ -280,17 +282,17 @@ someTick tType d = case tType of TickSpec (fromRational -> aa) (fromRational -> bb)- -> fromVertices [mkP2 0 (-d*bb), mkP2 0 (d*aa)]- AutoTick -> fromVertices [mkP2 0 (-d) , mkP2 0 d ]+ -> mkP2 0 (-d*bb) ~~ mkP2 0 (d*aa)+ AutoTick -> mkP2 0 (-d) ~~ mkP2 0 d -- grid lines gridXs = filter inRange $ view majorGridLinesFunction cbGridLines tickXs bnds gLines | cbGridLines ^. hidden = mempty | otherwise = F.foldMap mkGridLine gridXs- # (stroke :: Path V2 Double -> Diagram V2)+ # strokePath # applyStyle (cbGridLines ^. majorGridLinesStyle)- mkGridLine x = fromVertices [mkP2 (f x) (-w/2), mkP2 (f x) (w/2)]+ mkGridLine x = mkP2 (f x) (-w/2) ~~ mkP2 (f x) (w/2) -- tick labels tickLabelXs = view tickLabelFunction cbTickLabels tickXs' bnds@@ -319,21 +321,22 @@ -- This may not be supported by all backends. -- -- <<diagrams/src_Plots_Axis_ColourBar_gradientColourBarExample.svg#diagram=gradientColourBarExample&width=600>>-gradientColourBar :: ColourMap -> Diagram V2+gradientColourBar :: (TypeableFloat n, Renderable (Path V2 n) b) => ColourMap -> QDiagram b V2 n Any gradientColourBar cm = rect 1 1 # fillTexture grad # lw none where- stops = map (\(x,c) -> (c,fromRational x)) (colourList cm)- grad = mkLinearGradient stops origin unitX -- defaultLG & _LG . lGradStops .~ stops+ stops = map (\(x,c) -> GradientStop (SomeColor c) (fromRational x)) (colourList cm)+ grad = defaultLG & _LG . lGradStops .~ stops -- | Construct a colour bar made up of @n@ solid square paths. The final -- diagram is 1 by 1, with origin at the middle of the left side. This -- can be used as the 'colourBarDraw' function. -- -- <<diagrams/src_Plots_Axis_ColourBar_pathColourBarExample.svg#diagram=pathColourBarExample&width=600>>-pathColourBar :: Int -> ColourMap -> Diagram V2+pathColourBar :: (TypeableFloat n, Renderable (Path V2 n) b)+ => Int -> ColourMap -> QDiagram b V2 n Any pathColourBar n cm = ifoldMap mkR xs where mkR i x = rect d' 1@@ -355,7 +358,7 @@ flipX_Y (V2 x y) = V2 (-y) (-x) _reflectionX_Y :: (Additive v, R2 v, Num n) => Transformation v n-_reflectionX_Y = undefined -- fromSymmetric $ (_xy %~ flipX_Y) <-> (_xy %~ flipX_Y)+_reflectionX_Y = fromSymmetric $ (_xy %~ flipX_Y) <-> (_xy %~ flipX_Y) _reflectX_Y :: (InSpace v n t, R2 v, Transformable t) => t -> t _reflectX_Y = transform _reflectionX_Y
src/Plots/Axis/Grid.hs view
@@ -63,14 +63,14 @@ -- Major grid lines ------------------------------------------------------------------------ -data MajorGridLines v = MajorGridLines- { magFun :: GridLineFunction Double- , magStyle :: Style v Double+data MajorGridLines v n = MajorGridLines+ { magFun :: GridLineFunction n+ , magStyle :: Style v n , magVisible :: Bool } deriving Typeable -type instance V (MajorGridLines v) = v-type instance N (MajorGridLines v) = Double+type instance V (MajorGridLines v n) = v+type instance N (MajorGridLines v n) = n class HasMajorGridLines f a where -- | The options for how to draw the grid lines. This can be used on@@ -81,46 +81,45 @@ -- 'majorGridLines' :: 'Lens'' ('SingleAxis' b v n) ('GridLines' v n) -- 'majorGridLines' :: 'Lens'' ('GridLines' v n) ('GridLines' v n) -- @- majorGridLines :: LensLike' f a (MajorGridLines (V a))+ majorGridLines :: LensLike' f a (MajorGridLines (V a) (N a)) -- | The function to calculate location of the major grid lines given -- location of the major ticks and bounds.- majorGridLinesFunction :: Functor f => LensLike' f a (GridLineFunction Double)+ majorGridLinesFunction :: Functor f => LensLike' f a (GridLineFunction (N a)) majorGridLinesFunction = majorGridLines . lens magFun (\gl maf -> gl {magFun = maf}) -- | The style applied to the major grid lines.- majorGridLinesStyle :: Functor f => LensLike' f a (Style (V a) Double)+ majorGridLinesStyle :: Functor f => LensLike' f a (Style (V a) (N a)) majorGridLinesStyle = majorGridLines . lens magStyle (\gl sty -> gl {magStyle = sty}) -instance HasMajorGridLines f (MajorGridLines v) where+instance HasMajorGridLines f (MajorGridLines v n) where majorGridLines = id -instance Default (MajorGridLines v) where+instance (Typeable n, Floating n) => Default (MajorGridLines v n) where def = MajorGridLines { magFun = onTicksGridLineFunction , magStyle = mempty # lwO 0.8 , magVisible = True } -instance HasVisibility (MajorGridLines v) where+instance HasVisibility (MajorGridLines v n) where visible = lens magVisible (\gl b -> gl {magVisible = b}) -instance ApplyStyle (MajorGridLines v)-instance HasStyle (MajorGridLines v) where- style = majorGridLinesStyle+instance Typeable n => HasStyle (MajorGridLines v n) where+ applyStyle s = majorGridLinesStyle %~ applyStyle s ------------------------------------------------------------------------ -- Minor grid lines ------------------------------------------------------------------------ -data MinorGridLines v = MinorGridLines- { migFun :: GridLineFunction Double- , migStyle :: Style v Double+data MinorGridLines v n = MinorGridLines+ { migFun :: GridLineFunction n+ , migStyle :: Style v n , migVisible :: Bool } deriving Typeable -type instance V (MinorGridLines v) = v-type instance N (MinorGridLines v) = Double+type instance V (MinorGridLines v n) = v+type instance N (MinorGridLines v n) = n class HasMinorGridLines f a where -- | The options for how to draw the grid lines. This can be used on@@ -131,22 +130,22 @@ -- 'minorGridLines' :: 'Lens'' ('SingleAxis' b v n) ('GridLines' v n) -- 'minorGridLines' :: 'Lens'' ('GridLines' v n) ('GridLines' v n) -- @- minorGridLines :: LensLike' f a (MinorGridLines (V a))+ minorGridLines :: LensLike' f a (MinorGridLines (V a) (N a)) -- | The function to calculate location of the minor grid lines given -- location of the minor ticks and bounds.- minorGridLinesFunction :: Functor f => LensLike' f a (GridLineFunction Double)+ minorGridLinesFunction :: Functor f => LensLike' f a (GridLineFunction (N a)) minorGridLinesFunction = minorGridLines . lens migFun (\gl mif -> gl {migFun = mif}) -- | The style applied to the minor grid lines.- minorGridLinesStyle :: Functor f => LensLike' f a (Style (V a) Double)+ minorGridLinesStyle :: Functor f => LensLike' f a (Style (V a) (N a)) minorGridLinesStyle = minorGridLines . lens migStyle (\gl sty -> gl {migStyle = sty}) -instance HasMinorGridLines f (MinorGridLines v) where+instance HasMinorGridLines f (MinorGridLines v n) where minorGridLines = id -instance Default (MinorGridLines v) where+instance (Typeable n, Floating n) => Default (MinorGridLines v n) where def = MinorGridLines { migFun = onTicksGridLineFunction , migStyle = mempty # lwO 0.5@@ -154,12 +153,11 @@ } -- | Hidden by default.-instance HasVisibility (MinorGridLines v) where+instance HasVisibility (MinorGridLines v n) where visible = lens migVisible (\gl b -> gl {migVisible = b}) -instance ApplyStyle (MinorGridLines v)-instance HasStyle (MinorGridLines v) where- style = minorGridLinesStyle+instance Typeable n => HasStyle (MinorGridLines v n) where+ applyStyle s = minorGridLinesStyle %~ applyStyle s ------------------------------------------------------------------------ -- Grid lines helpers@@ -186,7 +184,7 @@ -- @ gridLinesVisible :: (HasGridLines f a, Applicative f) => LensLike' f a Bool gridLinesVisible = gridLines . vis where- vis :: Traversal' (GridLines v) Bool+ vis :: Traversal' (GridLines v n) Bool vis f a = (\m mn -> a & majorGridLines . visible .~ m & minorGridLines . visible .~ mn) <$> f (a ^. majorGridLines . visible) <*> f (a ^. minorGridLines . visible)@@ -196,33 +194,33 @@ ------------------------------------------------------------------------ -- | Type holding information about both major and minor grid lines.-data GridLines v = GridLines- { majGrid :: MajorGridLines v- , minGrid :: MinorGridLines v+data GridLines v n = GridLines+ { majGrid :: MajorGridLines v n+ , minGrid :: MinorGridLines v n } deriving Typeable -type instance V (GridLines v) = v-type instance N (GridLines v) = Double+type instance V (GridLines v n) = v+type instance N (GridLines v n) = n class (HasMinorGridLines f a, HasMajorGridLines f a) => HasGridLines f a where- gridLines :: LensLike' f a (GridLines (V a))+ gridLines :: LensLike' f a (GridLines (V a) (N a)) -instance Functor f => HasGridLines f (GridLines v) where+instance Functor f => HasGridLines f (GridLines v n) where gridLines = id -instance Default (GridLines v) where+instance (Typeable n, Floating n) => Default (GridLines v n) where def = GridLines { majGrid = def , minGrid = def } -instance Functor f => HasMajorGridLines f (GridLines v) where+instance Functor f => HasMajorGridLines f (GridLines v n) where majorGridLines = lens majGrid (\g a -> g {majGrid = a}) -instance Functor f => HasMinorGridLines f (GridLines v) where+instance Functor f => HasMinorGridLines f (GridLines v n) where minorGridLines = lens minGrid (\g a -> g {minGrid = a}) -instance ApplyStyle (GridLines v) where+instance Typeable n => HasStyle (GridLines v n) where applyStyle s = (majorGridLines %~ applyStyle s) . (minorGridLines %~ applyStyle s) -- | Hide both major and minor grid lines.@@ -250,9 +248,9 @@ majorGridLines . visible .= True -- | 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) Double)+gridLinesStyle :: (HasGridLines f a, Applicative f) => LensLike' f a (Style (V a) (N a)) gridLinesStyle = gridLines . styles where- styles :: Traversal' (GridLines v) (Style v Double)+ styles :: Traversal' (GridLines v n) (Style v n) styles f a = (\m mn -> a & majorGridLinesStyle .~ m & minorGridLinesStyle .~ mn) <$> f (a ^. majorGridLinesStyle) <*> f (a ^. minorGridLinesStyle)
src/Plots/Axis/Labels.hs view
@@ -46,7 +46,7 @@ -- | Function to render the axis label from a string. This is very basic -- now and will be replace by a more sophisticated system.-type TextFunction v = TextAlignment Double -> String -> Diagram v+type TextFunction b v n = TextAlignment n -> String -> QDiagram b v n Any ------------------------------------------------------------------------ -- Axis labels@@ -74,45 +74,45 @@ -- @ -- -- See 'HasAxisLabel' for more advanced settings.-data AxisLabel v = AxisLabel- { alFun :: TextFunction v+data AxisLabel b v n = AxisLabel+ { alFun :: TextFunction b v n , alText :: String- , alStyle :: Style v Double- , alGap :: Double+ , alStyle :: Style v n+ , alGap :: n , alPos :: AxisLabelPosition , alPlacement :: AxisLabelPlacement , alVisible :: Bool } -type instance V (AxisLabel v) = v-type instance N (AxisLabel v) = Double+type instance V (AxisLabel b v n) = v+type instance N (AxisLabel b v n) = n -class HasAxisLabel f a where+class HasAxisLabel f a b | a -> b where -- | The options for the label of the axis. This can be used on -- various levels of the axis: -- -- @ -- 'axisLabel' :: 'Traversal'' ('Axis' b c n) ('AxisLabel' ('BaseSpace' c) n)- -- 'axisLabel' :: 'Lens'' ('SingleAxis' v) ('AxisLabel' v n)+ -- 'axisLabel' :: 'Lens'' ('SingleAxis' b v n) ('AxisLabel' v n) -- 'axisLabel' :: 'Lens'' ('AxisLabel' v n) ('AxisLabel' v n) -- @- axisLabel :: LensLike' f a (AxisLabel (V a))+ axisLabel :: LensLike' f a (AxisLabel b (V a) (N a)) -- | The text to use when labeling the axis. axisLabelText :: Functor f => LensLike' f a String axisLabelText = axisLabel . lens alText (\al txt -> al {alText = txt}) -- | The 'TextFunction' to render the text of the axis label.- axisLabelTextFunction :: Functor f => LensLike' f a (TextFunction (V a))+ axisLabelTextFunction :: Functor f => LensLike' f a (TextFunction b (V a) (N a)) axisLabelTextFunction = axisLabel . lens alFun (\al f -> al {alFun = f}) -- | The gap between the axis and the labels, in the direction -- corresponding to the 'axisLabelPosition'.- axisLabelGap :: Functor f => LensLike' f a Double+ axisLabelGap :: Functor f => LensLike' f a (N a) axisLabelGap = axisLabel . lens alGap (\al sty -> al {alGap = sty}) -- | The 'Style' to use on the rendered text.- axisLabelStyle :: Functor f => LensLike' f a (Style (V a) Double)+ 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 to the axis.@@ -124,37 +124,25 @@ axisLabelPlacement :: Functor f => LensLike' f a AxisLabelPosition axisLabelPlacement = axisLabel . lens alPos (\al sty -> al {alPos = sty}) -instance HasAxisLabel f (AxisLabel v) where+instance HasAxisLabel f (AxisLabel b v n) b where axisLabel = id -instance ApplyStyle (AxisLabel v)-instance HasStyle (AxisLabel v) where- style = axisLabelStyle+instance Typeable n => HasStyle (AxisLabel b v n) where+ applyStyle = over axisLabelStyle . applyStyle -instance HasVisibility (AxisLabel v) where+instance HasVisibility (AxisLabel b v n) where visible = lens alVisible (\al b -> al {alVisible = b}) -instance HasGap (AxisLabel v) where+instance HasGap (AxisLabel b v n) where gap = axisLabelGap -instance Default (AxisLabel V2) where+instance (TypeableFloat n, Renderable (Text n) b)+ => Default (AxisLabel b V2 n) where def = AxisLabel { alFun = mkText , alText = "" , alStyle = mempty & fontSize (output 11)- & backupFillColor black- , alGap = 30- , alPos = MiddleAxisLabel- , alPlacement = OutsideAxisLabel- , alVisible = True- }--instance Default (AxisLabel V3) where- def = AxisLabel- { alFun = mempty- , alText = ""- , alStyle = mempty & fontSize (output 11)- -- & backupFillColor black+ & recommendFillColor black , alGap = 30 , alPos = MiddleAxisLabel , alPlacement = OutsideAxisLabel@@ -167,32 +155,32 @@ -- | 'TickLabels' describes how to draw the labels next to ticks. See -- 'HasTickLabels' for more options.-data TickLabels v = TickLabels- { tlFun :: [Double] -> (Double,Double) -> [(Double, String)]- , tlTextFun :: TextFunction v- , tlStyle :: Style v Double- , tlGap :: Double+data TickLabels b v n = TickLabels+ { tlFun :: [n] -> (n,n) -> [(n, String)]+ , tlTextFun :: TextFunction b v n+ , tlStyle :: Style v n+ , tlGap :: n , tlVisible :: Bool } deriving Typeable -type instance V (TickLabels v) = v-type instance N (TickLabels v) = Double+type instance V (TickLabels b v n) = v+type instance N (TickLabels b v n) = n -class HasTickLabels f a where+class HasTickLabels f a b | a -> b where -- | The options for the label of ticks. This can be used on various -- levels of the axis: -- -- @- -- 'tickLabel' :: 'Traversal'' ('Tick' c) ('TickLabels' ('BaseSpace' c))- -- 'tickLabel' :: 'Lens'' ('SingleAxis' v) ('TickLabels' v)- -- 'tickLabel' :: 'Lens'' ('TickLabel' v) ('TickLabels' v)+ -- 'tickLabel' :: 'Traversal'' ('Tick' b c n) ('TickLabels' ('BaseSpace' c) n)+ -- 'tickLabel' :: 'Lens'' ('SingleAxis' b v n) ('TickLabels' v n)+ -- 'tickLabel' :: 'Lens'' ('TickLabel' v n) ('TickLabels' v n) -- @- tickLabel :: LensLike' f a (TickLabels (V a))+ tickLabel :: LensLike' f a (TickLabels b (V a) (N a)) -- | The 'TextFunction' to render the text. -- -- 'Default' is 'mkText'.- tickLabelTextFunction :: Functor f => LensLike' f a (TextFunction (V a))+ 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 have@@ -200,48 +188,39 @@ -- position of the tick and label to use at that position. -- -- 'Default' is @'atMajorTicks' 'floatShow'@- tickLabelFunction :: Functor f => LensLike' f a ([Double] -> (Double, Double) -> [(Double, String)])+ tickLabelFunction :: Functor f => LensLike' f a ([N a] -> (N a, N a) -> [(N a, String)]) tickLabelFunction = tickLabel . lens tlFun (\tl f -> tl {tlFun = f}) -- | The 'Style' to use on the rendered text. -- -- 'Default' is @'fontSize' ('output' 11)@.- tickLabelStyle :: Functor f => LensLike' f a (Style (V a) Double)+ tickLabelStyle :: Functor f => LensLike' f a (Style (V a) (N a)) tickLabelStyle = tickLabel . lens tlStyle (\tl sty -> tl {tlStyle = sty}) -- | The gap between the axis and the tick labels. -- -- 'Default' is @12@.- tickLabelGap :: Functor f => LensLike' f a Double+ tickLabelGap :: Functor f => LensLike' f a (N a) tickLabelGap = tickLabel . lens tlGap (\tl n -> tl {tlGap = n}) -instance HasTickLabels f (TickLabels v) where+instance HasTickLabels f (TickLabels b v n) b where tickLabel = id -instance HasGap (TickLabels v) where+instance HasGap (TickLabels b v n) where gap = tickLabelGap -instance Default (TickLabels V2) where+instance (TypeableFloat n, Renderable (Text n) b)+ => Default (TickLabels b V2 n) where def = TickLabels { tlFun = atMajorTicks floatShow , tlTextFun = mkText , tlStyle = mempty & fontSize (output 11)- & backupFillColor black- , tlGap = 12- , tlVisible = True- }--instance Default (TickLabels V3) where- def = TickLabels- { tlFun = atMajorTicks floatShow- , tlTextFun = mempty- , tlStyle = mempty & fontSize (output 11)- -- & sc black+ & recommendFillColor black , tlGap = 12 , tlVisible = True } -instance HasVisibility (TickLabels v) where+instance HasVisibility (TickLabels b v n) where visible = lens tlVisible (\tl b -> tl {tlVisible = b}) -- | Setter over the final positions the major ticks. This is not as@@ -258,7 +237,8 @@ -- If you want to change or add normal ticks see 'majorTicksFunction'. -- tickLabelPositions- :: (HasTickLabels f a, Settable f) => LensLike' f a [(Double, String)]+ :: (HasTickLabels f a b, Settable f)+ => LensLike' f a [(N a, String)] tickLabelPositions = tickLabelFunction . mapped . mapped -- | Numbers are shown as 'Float's to reduce the chance of numbers like@@ -268,7 +248,7 @@ -- | Make a 'TickLabelFunction' by specifying how to draw a single label -- from a position on the axis.-atMajorTicks :: (Double -> String) -> [Double] -> (Double,Double) -> [(Double, String)]+atMajorTicks :: (n -> String) -> [n] -> (n,n) -> [(n, String)] atMajorTicks f ticks _ = map ((,) <*> f) ticks -- -- | Use the list of strings as the labels for the axis, starting at 1
src/Plots/Axis/Line.hs view
@@ -48,20 +48,20 @@ def = BoxAxisLine -- | Information about position and style of axis lines.-data AxisLine v = AxisLine+data AxisLine v n = AxisLine { alType :: AxisLineType- -- , alArrowOpts :: Maybe ArrowOpts+ , alArrowOpts :: Maybe (ArrowOpts n) , alVisible :: Bool- , alStyle :: Style v Double+ , alStyle :: Style v n } deriving Typeable -type instance V (AxisLine v) = v-type instance N (AxisLine v) = Double+type instance V (AxisLine v n) = v+type instance N (AxisLine v n) = n -- | Class of object that have an 'AxisLine'. class HasAxisLine f a where -- | Lens onto the 'AxisLine'.- axisLine :: LensLike' f a (AxisLine (V a))+ axisLine :: LensLike' f a (AxisLine (V a) (N a)) -- | The position of the axis line around the axis. --@@ -75,32 +75,28 @@ -- 'Default' is 'Nothing'. -- -- XXX (feature not currently implimented)- -- axisLineArrowOpts :: Functor f => LensLike' f a (Maybe (ArrowOpts (N a)))- -- axisLineArrowOpts = axisLine . lens alArrowOpts (\al sty -> al {alArrowOpts = sty})+ axisLineArrowOpts :: Functor f => LensLike' f a (Maybe (ArrowOpts (N a)))+ axisLineArrowOpts = axisLine . lens alArrowOpts (\al sty -> al {alArrowOpts = sty}) -- | The 'Style' applied to the axis line- axisLineStyle :: Functor f => LensLike' f a (Style (V a) Double)+ axisLineStyle :: Functor f => LensLike' f a (Style (V a) (N a)) axisLineStyle = axisLine . lens alStyle (\al sty -> al {alStyle = sty}) -instance HasAxisLine f (AxisLine v) where+instance HasAxisLine f (AxisLine v n) where axisLine = id -instance ApplyStyle (AxisLine v)-instance HasStyle (AxisLine v) where- style = axisLineStyle- -- Note this is different from 'NoAxisLine'. Other parts that are -- tied to the axis line will still be present when -- 'axisLineVisible' is 'False'. But if 'NoAxisLine' is set, there -- never any line for those things to attach to, so they don't -- exist.-instance HasVisibility (AxisLine v) where+instance HasVisibility (AxisLine v n) where visible = lens alVisible (\al b -> al {alVisible = b}) -instance Default (AxisLine v) where+instance Typeable n => Default (AxisLine v n) where def = AxisLine { alType = def- -- , alArrowOpts = def+ , alArrowOpts = def , alVisible = True , alStyle = mempty }
src/Plots/Axis/Render.hs view
@@ -39,9 +39,8 @@ import Data.List (sort) import Data.Typeable -import Geometry.BoundingBox+import Diagrams.BoundingBox import Diagrams.Prelude-import Geometry.Envelope import Diagrams.TwoD.Text import Linear hiding (rotate, translation) @@ -63,65 +62,37 @@ import Prelude -import qualified Numeric.Interval.NonEmpty as I--import Geometry.TwoD.Transform-import Geometry.TwoD.Ellipse--import Diagrams.Types (Prim (..), mkQD)- ------------------------------------------------------------------------ -- Mainable instances ------------------------------------------------------------------------ -instance WithOutcome (Axis Polar)-instance WithOutcome (Axis V2)-instance WithOutcome (Axis V3)--instance RenderOutcome t (Diagram V2) => RenderOutcome t (Axis Polar) where- type MainOpts t (Axis Polar) = MainOpts t (Diagram V2)- resultParser t _ = resultParser t (Proxy :: Proxy (Diagram V2))- renderOutcome t opts axis = renderOutcome t opts (renderPolarAxis axis)--instance RenderOutcome t (Diagram V2) => RenderOutcome t (Axis V2) where- type MainOpts t (Axis V2) = MainOpts t (Diagram V2)- resultParser t _ = resultParser t (Proxy :: Proxy (Diagram V2))- renderOutcome t opts axis = renderOutcome t opts (renderAxis axis)--instance RenderOutcome t (Diagram V3) => RenderOutcome t (Axis V3) where- type MainOpts t (Axis V3) = MainOpts t (Diagram V3)- resultParser t _ = resultParser t (Proxy :: Proxy (Diagram V3))- renderOutcome t opts axis = renderOutcome t opts (renderAxis axis)---strokePathV :: (Typeable v, Metric v, Typeable n, OrderedField n) => Path v n -> QDiagram v n Any-strokePathV path = mkQD (Prim path) (getEnvelope path) mempty mempty---- instance (TypeableFloat n, Mainable (Diagram V2))--- => Mainable (Axis b Polar n) where--- type MainOpts (Axis b Polar n) = MainOpts (Diagram V2)+instance (TypeableFloat n,+ Renderable (Path V2 n) b,+ Mainable (QDiagram b V2 n Any))+ => Mainable (Axis b Polar n) where+ type MainOpts (Axis b Polar n) = MainOpts (QDiagram b V2 n Any) --- mainRender opts = mainRender opts . renderAxis+ mainRender opts = mainRender opts . renderAxis --- instance (TypeableFloat n,--- Renderable (Path V2 n) b,--- Mainable (Diagram V2))--- => Mainable (Axis b V2 n) where--- type MainOpts (Axis b V2 n) = MainOpts (Diagram V2)+instance (TypeableFloat n,+ Renderable (Path V2 n) b,+ Mainable (QDiagram b V2 n Any))+ => Mainable (Axis b V2 n) where+ type MainOpts (Axis b V2 n) = MainOpts (QDiagram b V2 n Any) --- mainRender opts = mainRender opts . renderAxis+ mainRender opts = mainRender opts . renderAxis --- instance ToResult (Axis b v n) where--- type Args (Axis b v n) = ()--- type ResultOf (Axis b v n) = Axis b v n+instance ToResult (Axis b v n) where+ type Args (Axis b v n) = ()+ type ResultOf (Axis b v n) = Axis b v n --- toResult d _ = d+ toResult d _ = d -- | 'mainWith' specialised to a 2D Axis. r2AxisMain- :: RenderOutcome t (Diagram V2)- => t- -> Axis V2+ :: (Parseable (MainOpts (QDiagram b V2 Double Any)),+ Mainable (Axis b V2 Double))+ => Axis b V2 Double -> IO () r2AxisMain = mainWith @@ -137,7 +108,7 @@ -- legend entries can be obtained with 'styledPlotLegends'. This is -- what 'renderAxis' can uses internally but might be useful for -- debugging or generating your own legend.-buildPlots :: BaseSpace c ~ v => Axis c -> [StyledPlot v]+buildPlots :: BaseSpace c ~ v => Axis b c n -> [StyledPlot b v n] buildPlots a = map (appEndo $ a ^. plotModifier) $ zipWith styleDynamic (a ^.. axisStyles) (a ^. axisPlots) -- TODO: correct order@@ -147,21 +118,21 @@ ------------------------------------------------------------------------ -- | Renderable axes.-class RenderAxis c where+class RenderAxis b v n where -- | Render an axis to a diagram. The size of the diagram is -- determined by the 'axisSize'.- renderAxis :: Axis c -> Diagram (BaseSpace c)---- R2 rendering --------------------------------------------------------+ renderAxis :: Axis b v n -> QDiagram b (BaseSpace v) n Any -- | The 'RenderAxis' class provides a default way to render an axis for -- each space.-instance RenderAxis V2 where+instance (TypeableFloat n, Renderable (Path V2 n) b)+ => RenderAxis b V2 n where -- | Render an axis and its plots, as well as the legend and colour -- bar. renderAxis = renderR2Axis -renderR2Axis :: Axis V2 -> Diagram V2+renderR2Axis :: (TypeableFloat n, Renderable (Path V2 n) b)+ => Axis b V2 n -> QDiagram b V2 n Any renderR2Axis a = frame 40 $ leg <> ttl@@ -188,41 +159,6 @@ -- styledPlots = buildPlots a --- R3 rendering -----------------------------------------------------------instance RenderAxis V3 where- renderAxis = renderR3Axis--renderR3Axis :: Axis V3 -> Diagram V3-renderR3Axis a = -- frame 15- -- -- $ legend- (plots :: Diagram V3)- <> (drawAxis ex ey LowerLabels :: Diagram V3)- <> (drawAxis ey ex UpperLabels :: Diagram V3)- <> (drawAxis ez ey LowerLabels :: Diagram V3)- <> (drawAxis ey ez NoLabels :: Diagram V3)- <> (drawAxis ez ex NoLabels :: Diagram V3)- <> (drawAxis ex ez NoLabels :: Diagram V3)- where- spec = AxisSpec xs t (a^.axes . column logScale) (a ^. axisColourMap)- plots = foldMap (renderStyledPlot spec) styledPlots- drawAxis ll ll2 = axisOnBasis origin xs (a^.axes.el ll) (a^.axes.column logScale) t ll ll2- --- (xs, tv, t') = calculateScaling (a^.axes.column axisScaling) (boundingBox styledPlots)- t = tv <> t'- --- -- bb = fromCorners (P . apply t $ fmap fst xs) (P . apply t $ fmap snd xs)- -- leg = drawLegend bb (styledPlotLegends styledPlots) (a ^. legend)- ---- -- The colour bar- -- cBar = addColourBar bb (a^.colourBar) (a ^. axisColourMap) (a^.colourBarRange)- -- title- -- ttl = drawTitle bb (a^.title)- --- styledPlots = buildPlots a- -- | The position of axis labels for a data LabelPosition = NoLabels@@ -233,22 +169,23 @@ deriving (Show, Eq, Typeable) axisOnBasis- :: forall v. (HasLinearMap v, Typeable v)- => Point v Double -- start of axis- -> v (Double, Double) -- calculated bounds- -> SingleAxis v -- axis data+ :: forall b v n. (v ~ V2, TypeableFloat n, HasLinearMap v, Metric v,+ Renderable (Path V2 n) b, n ~ N (v n), v ~ V (v n), OrderedField n)+ => Point v n -- start of axis+ -> v (n, n) -- calculated bounds+ -> SingleAxis b v n -- axis data -> v LogScale -- log scale- -> Transformation v Double -- transformation to apply to positions of things+ -> T2 n -- transformation to apply to positions of things -> E v -- direction of axis -> E v -- orthogonal direction of axis -> LabelPosition -- where (if at all) should labels be placed?- -> Diagram v -- resulting axis+ -> QDiagram b V2 n Any -- resulting axis axisOnBasis p bs a ls t e eO lp | a ^. hidden = phantom axis | otherwise = axis where axis = tickLabels <> axLabels <> ticks <> line <> grid- tStroke = strokePathV . transform t+ tStroke = stroke . transform t -- axis labels (x,y etc.) axLabels@@ -326,13 +263,13 @@ maTicks | a ^. majorTicks . hidden = mempty | otherwise = foldMap (positionTick majorTick) majorTickXs'- # strokePathV+ # stroke # applyStyle (a ^. majorTicksStyle) -- miTicks | a ^. minorTicks . hidden = mempty | otherwise = foldMap (positionTick minorTick) minorTickXs'- # strokePathV+ # stroke # applyStyle (a ^. minorTicksStyle) -- minorTick = someTick (a ^. minorTicksAlignment) (a ^. minorTicksLength)@@ -363,16 +300,16 @@ | a ^. axisLine . hidden = mempty | otherwise = foldMap mkline (map snd ys) -- merge with ticks? # transform t- # strokePathV+ # stroke # lineCap LineCapSquare # applyStyle (a^.axisLineStyle) where -- TODO: Arrow for R3 mkline y = pathFromVertices- $ map (\x -> over lensP ((el e .~ x) . (el eO .~ y)) p) [x0, x1] :: Path v Double+ $ map (\x -> over lensP ((el e .~ x) . (el eO .~ y)) p) [x0, x1] :: Path v n -- measurements- b@(x0,x1) = bs ^. el e :: (Double, Double) -- bounds+ b@(x0,x1) = bs ^. el e :: (n, n) -- bounds coscale = ep e %~ coscaleNum coscaleNum = scaleNum (bs ^. el e) (ls ^. el e) yb@(y0,y1) = bs ^. el eO . if lp == UpperLabels@@ -427,7 +364,8 @@ -- Polar ------------------------------------------------------------------------ -instance RenderAxis Polar where+instance (TypeableFloat n, Renderable (Path V2 n) b)+ => RenderAxis b Polar n where renderAxis = renderPolarAxis -- | An lower and upper bound for the bounding radius using @n@ envelope@@ -435,15 +373,15 @@ -- the bound. boundingRadiusR :: (InSpace V2 n a, Enveloped a) => Int -> a -> (n, n) boundingRadiusR (max 3 -> n) e =- case getEnvelope e of- EmptyEnvelope -> (0,0)- Envelope f ->+ case appEnvelope (getEnvelope e) of+ Nothing -> (0,0)+ Just f -> let thetas = map (@@rad) $ enumFromToN 0 tau n- vs = map angleDir thetas+ vs = map angleV thetas -- The lower bound is the maximum distance obtained from the -- envelope trials. We know the radius will be at least this far.- lowerBound = F.foldr (\v r -> max (I.sup $ f v) r) 0 vs+ lowerBound = F.foldr (\v r -> max (f v) r) 0 vs -- In the worst case, there will be a point at the intersection of -- two neighbouring bounding planes from the envelope calculations.@@ -456,7 +394,9 @@ in (lowerBound, upperBound) -renderPolarAxis :: Axis Polar -> Diagram V2+renderPolarAxis+ :: (TypeableFloat n, Renderable (Path V2 n) b)+ => Axis b Polar n -> QDiagram b V2 n Any renderPolarAxis a = frame 15 $ leg -- <> colourBar@@ -480,7 +420,9 @@ styledPlots = map (appEndo $ a ^. plotModifier) $ zipWith styleDynamic (a ^.. axisStyles) (a ^. axisPlots) -drawPolarAxis :: AxisSpec V2 -> Polar (SingleAxis V2) -> Diagram V2+drawPolarAxis+ :: forall b n. (Renderable (Path V2 n) b, TypeableFloat n)+ => AxisSpec V2 n -> Polar (SingleAxis b V2 n) -> QDiagram b V2 n Any drawPolarAxis spec (Polar (V2 rA thetaA)) = fcA transparent $ rAx <> thetaAx where -- use a radius of the upper x bound for the axis (this is not ideal)@@ -507,9 +449,8 @@ where -- XXX for now the radial axis is on the theta=0 line. Need some -- way to change this- line = fromVertices [origin, mkP2 r 0]- # applyStyle (rA^.axisLineStyle)- # transform t+ line = (origin ~~ mkP2 r 0) # applyStyle (rA^.axisLineStyle)+ # transform t -- Radial axis label ------------------------------------------------- @@ -554,8 +495,8 @@ someTick tType d = case tType of TickSpec (fromRational -> aa) (fromRational -> bb)- -> fromVertices [mkP2 0 (-d*bb), mkP2 0 (d*aa)]- AutoTick -> fromVertices [mkP2 0 (-d) , mkP2 0 d ]+ -> mkP2 0 (-d*bb) ~~ mkP2 0 (d*aa)+ AutoTick -> mkP2 0 (-d) ~~ mkP2 0 d -- Radial grid lines ------------------------------------------------- @@ -566,7 +507,7 @@ majorGridRs = view majorGridLinesFunction rA majorTickRs (0,r) majorGridRs' = map (*s) $ filter rInRange majorGridRs - rMajorGridLines :: Diagram V2+ rMajorGridLines :: QDiagram b V2 n Any rMajorGridLines | rA ^. majorGridLines . hidden = mempty | otherwise = F.foldMap circle (filter (>0) majorGridRs')@@ -574,7 +515,7 @@ minorGridRs = view minorGridLinesFunction rA minorTickRs (0,r) minorGridRs' = map (*s) $ filter rInRange minorGridRs- rMinorGridLines :: Diagram V2+ rMinorGridLines :: QDiagram b V2 n Any rMinorGridLines | rA ^. minorGridLines . hidden = mempty | otherwise = F.foldMap circle (filter (>0) minorGridRs')@@ -582,17 +523,17 @@ -- Radial tick labels ------------------------------------------------ - rAxTickLabels :: Diagram V2+ rAxTickLabels :: QDiagram b V2 n Any rAxTickLabels | rA ^. tickLabel . hidden = mempty | otherwise = F.foldMap rDrawTickLabel tickLabelRs -- The positions of the tick labels.- tickLabelRs :: [(Double, String)]+ tickLabelRs :: [(n, String)] tickLabelRs = view tickLabelFunction rA (filter rInRange majorTickRs) (0,r) -- Draw a single tick label given the position and the string to use- rDrawTickLabel :: (Double,String) -> Diagram V2+ rDrawTickLabel :: (n,String) -> QDiagram b V2 n Any rDrawTickLabel (x,label) = view tickLabelTextFunction rA (BoxAlignedText 0.5 1) label # translate (V2 (s*x) (- view axisLabelGap rA))@@ -666,8 +607,8 @@ someThetaTick tType d = case tType of TickSpec (fromRational -> aa) (fromRational -> bb)- -> fromVertices [mkP2 (-d*bb) 0, mkP2 (d*aa) 0]- AutoTick -> fromVertices [mkP2 (-d) 0 , mkP2 d 0 ]+ -> mkP2 (-d*bb) 0 ~~ mkP2 (d*aa) 0+ AutoTick -> mkP2 (-d) 0 ~~ mkP2 d 0 -- Angular grid lines ------------------------------------------------ @@ -679,35 +620,35 @@ majorGridThetas = view majorGridLinesFunction thetaA majorTickThetas (0,theta) majorGridThetas' = filter thetaInRange majorGridThetas - thetaMajorGridLines :: Diagram V2+ thetaMajorGridLines :: QDiagram b V2 n Any thetaMajorGridLines | thetaA ^. majorGridLines . hidden = mempty- | otherwise = F.foldMap (\phi -> fromVertices [origin, mkP2 r 0] # rotate (phi@@rad)) majorGridThetas'+ | otherwise = F.foldMap (\phi -> origin ~~ mkP2 r 0 # rotate (phi@@rad)) majorGridThetas' # transform t # applyStyle (thetaA ^. majorGridLinesStyle) minorGridThetas = view minorGridLinesFunction thetaA minorTickThetas (0,theta) minorGridThetas' = filter thetaInRange minorGridThetas- thetaMinorGridLines :: Diagram V2+ thetaMinorGridLines :: QDiagram b V2 n Any thetaMinorGridLines | thetaA ^. minorGridLines . hidden = mempty- | otherwise = F.foldMap (\phi -> fromVertices [origin, mkP2 r 0] # rotate (phi@@rad)) minorGridThetas'+ | otherwise = F.foldMap (\phi -> origin ~~ mkP2 r 0 # rotate (phi@@rad)) minorGridThetas' # transform t # applyStyle (thetaA ^. minorGridLinesStyle) -- Angular tick labels ----------------------------------------------- - thetaAxTickLabels :: Diagram V2+ thetaAxTickLabels :: QDiagram b V2 n Any thetaAxTickLabels | thetaA ^. tickLabel . hidden = mempty | otherwise = F.foldMap thetaDrawTickLabel tickLabelThetas -- The positions of the tick labels.- tickLabelThetas :: [(Double, String)]+ tickLabelThetas :: [(n, String)] tickLabelThetas = view tickLabelFunction thetaA majorTickThetas' (0,theta) -- Draw a single tick label given the position and the string to use- thetaDrawTickLabel :: (Double, String) -> Diagram V2+ thetaDrawTickLabel :: (n, String) -> QDiagram b V2 n Any thetaDrawTickLabel (x,label) = view tickLabelTextFunction thetaA a label # translate v
src/Plots/Axis/Scale.hs view
@@ -29,7 +29,7 @@ , LogScale (..) , logNumber , logPoint- -- , logDeform+ , logDeform -- * Low level calculations -- | These functions are used by "Plots.Axis.Render".@@ -44,7 +44,7 @@ import Data.Default import Data.Distributive import Data.Maybe--- import qualified Data.Foldable as F+import qualified Data.Foldable as F import Diagrams import Linear@@ -71,23 +71,23 @@ -- | Data type used that concerns everything to do with the size or -- scale of the axis.-data AxisScaling = Scaling- { asRatio :: Maybe Double+data AxisScaling n = Scaling+ { asRatio :: Maybe n , asMode :: ScaleMode- , asEnlarge :: Extending- , asBoundMin :: Maybe Double- , asBoundMax :: Maybe Double- , asSize :: Maybe Double+ , asEnlarge :: Extending n+ , asBoundMin :: Maybe n+ , asBoundMax :: Maybe n+ , asSize :: Maybe n , asLogScale :: LogScale -- backup bound in case there's no inferred bounds to go by- , asBackupBoundMax :: Double- , asBackupBoundMin :: Double+ , asBackupBoundMax :: n+ , asBackupBoundMin :: n } -type instance N AxisScaling = Double+type instance N (AxisScaling n) = n -instance Default AxisScaling where+instance Fractional n => Default (AxisScaling n) where def = Scaling { asRatio = Nothing , asMode = AutoScale@@ -101,24 +101,24 @@ } -- | How much to extend the bounds beyond any inferred bounds.-data Extending- = AbsoluteExtend !Double- | RelativeExtend !Double- deriving (Show, Ord, Eq)+data Extending n+ = AbsoluteExtend n+ | RelativeExtend n+ deriving (Show, Ord, Eq, Functor) -- | Do not extend the axis beyond the inferred bounds.-noExtend :: Extending+noExtend :: Num n => Extending n noExtend = AbsoluteExtend 0 -- | Class of things that have an 'AxisScaling'. class HasAxisScaling f a where -- | The way to scale in one direction.- axisScaling :: LensLike' f a AxisScaling+ axisScaling :: LensLike' f a (AxisScaling (N a)) -- | The ratio relative to other axis. If no ratios are set, the ratio -- is not enforced. If at least one is set, 'Nothing' ratios are -- @1@.- scaleAspectRatio :: Functor f => LensLike' f a (Maybe Double)+ scaleAspectRatio :: Functor f => LensLike' f a (Maybe (N a)) scaleAspectRatio = axisScaling . lens asRatio (\as r -> as {asRatio = r}) -- | The mode to determine how to scale the bounds in a direction.@@ -137,7 +137,7 @@ -- | How much to extend the bounds over infered bounds. This is -- ignored if a 'boundMax' or 'boundMin' is set.- axisExtend :: Functor f => LensLike' f a Extending+ axisExtend :: Functor f => LensLike' f a (Extending (N a)) axisExtend = axisScaling . lens asEnlarge (\as r -> as {asEnlarge = r}) -- | The maximum bound the axis. There are helper functions for@@ -149,7 +149,7 @@ -- @ -- -- Default is 'Nothing'.- boundMin :: Functor f => LensLike' f a (Maybe Double)+ boundMin :: Functor f => LensLike' f a (Maybe (N a)) boundMin = axisScaling . lens asBoundMin (\as b -> as {asBoundMin = b}) -- | The maximum bound the axis. There are helper functions for@@ -162,30 +162,31 @@ -- @ -- -- Default is 'Nothing'.- boundMax :: Functor f => LensLike' f a (Maybe Double)+ boundMax :: Functor f => LensLike' f a (Maybe (N a)) boundMax = axisScaling . lens asBoundMax (\as b -> as {asBoundMax = b}) -- | The size of the rendered axis. Default is @'Just' 400@.- renderSize :: Functor f => LensLike' f a (Maybe Double)+ renderSize :: Functor f => LensLike' f a (Maybe (N a)) renderSize = axisScaling . lens asSize (\as s -> as {asSize = s}) -- -- backup bound in case there's no inferred bounds to go by -- asBackupBoundMax :: n -- asBackupBoundMax :: n -asSizeSpec :: HasLinearMap v => Lens' (v AxisScaling) (SizeSpec v Double)+asSizeSpec :: (HasLinearMap v, Num n, Ord n) => Lens' (v (AxisScaling n)) (SizeSpec v n) asSizeSpec = column renderSize . iso mkSizeSpec getSpec -instance HasAxisScaling f AxisScaling where+instance HasAxisScaling f (AxisScaling n) where axisScaling = id -- calculating bounds -------------------------------------------------- -- | Calculating the bounds for an axis. calculateBounds- :: AxisScaling -- ^ Scaling to use for this axis- -> Maybe (Double, Double) -- ^ Inferred bounds (from any plots)- -> (Double, Double) -- ^ Lower and upper bounds to use for this axis+ :: OrderedField n+ => AxisScaling n -- ^ Scaling to use for this axis+ -> Maybe (n, n) -- ^ Inferred bounds (from any plots)+ -> (n, n) -- ^ Lower and upper bounds to use for this axis calculateBounds Scaling {..} mInferred = (l', u') where -- bounds are only enlarged when min/max bound wasn't set l' = l & whenever (isNothing asBoundMin) (subtract x)@@ -214,10 +215,10 @@ -- - scale to match desired 'scaleAspectRatio' -- - scale to match desired 'asSizeSpec' calculateScaling- :: (HasLinearMap v, Applicative v)- => v AxisScaling -- ^ axis scaling options- -> BoundingBox v Double -- ^ bounding box from the axis plots- -> (v (Double,Double), Transformation v Double, Transformation v Double)+ :: (HasLinearMap v, OrderedField n, Applicative v)+ => v (AxisScaling n) -- ^ axis scaling options+ -> BoundingBox v n -- ^ bounding box from the axis plots+ -> (v (n,n), Transformation v n, Transformation v n) calculateScaling aScaling bb = (bounds, aspectScaling, sizeScaling) where -- final bounds of the axis@@ -230,8 +231,8 @@ -- aScaling. Otherwise no ratios are set, ignore them and scale -- such that each axis is the same length | anyOf (folded . scaleAspectRatio) isJust aScaling- = scalingV $ view (scaleAspectRatio . non 1) <$> aScaling- | otherwise = inv $ scalingV v+ = vectorScaling $ view (scaleAspectRatio . non 1) <$> aScaling+ | otherwise = inv $ vectorScaling v -- scaling used so the axis fits in the size spec sizeScaling = requiredScaling szSpec v'@@ -241,6 +242,11 @@ v' = apply aspectScaling v szSpec = view asSizeSpec aScaling +-- | Scale transformation using the respective scale coefficients in the vector.+vectorScaling :: (Additive v, Fractional n) => v n -> Transformation v n+vectorScaling v = fromLinear f f+ where f = liftI2 (*) v <-> liftI2 (flip (/)) v+ -- | Apply a function if the predicate is true. whenever :: Bool -> (a -> a) -> a -> a whenever b f = bool id f b@@ -277,9 +283,9 @@ -- | Deform an object according to the axis scale. Does nothing for -- linear scales.--- logDeform :: (InSpace v n a, F.Foldable v, Floating n, Deformable a a)--- => v LogScale -> a -> a--- logDeform v--- | allOf folded (== LinearAxis) v = id--- | otherwise = deform (Deformation $ logPoint v)+logDeform :: (InSpace v n a, F.Foldable v, Floating n, Deformable a a)+ => v LogScale -> a -> a+logDeform v+ | allOf folded (== LinearAxis) v = id+ | otherwise = deform (Deformation $ logPoint v)
src/Plots/Axis/Ticks.hs view
@@ -52,6 +52,7 @@ ) where import Control.Lens hiding (transform, ( # ))+import Data.Data import Data.Default import Data.Foldable as F import Data.Ord@@ -103,15 +104,15 @@ ------------------------------------------------------------------------ -- | The big ticks on the axis line.-data MajorTicks v = MajorTicks- { matFunction :: (Double,Double) -> [Double]+data MajorTicks v n = MajorTicks+ { matFunction :: (n,n) -> [n] , matAlign :: TicksAlignment- , matLength :: Double- , matStyle :: Style v Double+ , matLength :: n+ , matStyle :: Style v n , matVisible :: Bool } -instance Default (MajorTicks v) where+instance TypeableFloat n => Default (MajorTicks v n) where def = MajorTicks { matFunction = linearMajorTicks 5 , matAlign = autoTicks@@ -120,20 +121,20 @@ , matVisible = True } -type instance V (MajorTicks v) = v-type instance N (MajorTicks v) = Double+type instance V (MajorTicks v n) = v+type instance N (MajorTicks v n) = n -- | Class of things that have a 'MajorTicks'. class HasMajorTicks f a where -- | Lens onto the 'MajorTicks' of something.- majorTicks :: LensLike' f a (MajorTicks (V a))+ majorTicks :: LensLike' f a (MajorTicks (V a) (N a)) -- | The function used to place ticks for this axis, given the bounds -- of the axis. The result of these major ticks are also used as -- guides for 'MinorTicks', 'MajorGridLines' and 'MinorGridLines'. -- -- Default is @'linearMinorTicks' 5@.- majorTicksFunction :: Functor f => LensLike' f a ((Double, Double) -> [Double])+ majorTicksFunction :: Functor f => LensLike' f a ((N a, N a) -> [N a]) majorTicksFunction = majorTicks . lens matFunction (\mat a -> mat {matFunction = a}) -- | Alignment of the major ticks. Choose between 'autoTicks'@@ -144,42 +145,38 @@ -- | The total length the major ticks. -- -- Default is @7@.- majorTicksLength :: Functor f => LensLike' f a Double+ majorTicksLength :: Functor f => LensLike' f a (N a) majorTicksLength = majorTicks . lens matLength (\mat a -> mat {matLength = a}) -- | The style used to render the major ticks. -- -- Default is @'lwO' 0.6 'mempty'@ (subject to change).- majorTicksStyle :: Functor f => LensLike' f a (Style (V a) Double)+ majorTicksStyle :: Functor f => LensLike' f a (Style (V a) (N a)) majorTicksStyle = majorTicks . lens matStyle (\mat sty -> mat {matStyle = sty}) -instance HasMajorTicks f (MajorTicks v) where+instance HasMajorTicks f (MajorTicks v n) where majorTicks = id -instance HasVisibility (MajorTicks v) where+instance HasVisibility (MajorTicks v n) where visible = lens matVisible (\mat b -> mat {matVisible = b}) -instance ApplyStyle (MajorTicks v) where-instance HasStyle (MajorTicks v) where- style = majorTicksStyle- ------------------------------------------------------------------------ -- Minor ticks ------------------------------------------------------------------------ -- | The small ticks on the axis line.-data MinorTicks v = MinorTicks- { mitFunction :: [Double] -> (Double,Double) -> [Double]+data MinorTicks v n = MinorTicks+ { mitFunction :: [n] -> (n,n) -> [n] , mitAlign :: TicksAlignment- , mitLength :: Double- , mitStyle :: Style v Double+ , mitLength :: n+ , mitStyle :: Style v n , mitVisible :: Bool } -type instance V (MinorTicks v) = v-type instance N (MinorTicks v) = Double+type instance V (MinorTicks v n) = v+type instance N (MinorTicks v n) = n -instance Default (MinorTicks v) where+instance TypeableFloat n => Default (MinorTicks v n) where def = MinorTicks { mitFunction = minorTicksHelper 4 , mitAlign = autoTicks@@ -191,13 +188,13 @@ -- | Class of things that have a single 'MinorTicks'. class HasMinorTicks f a where -- | Lens onto the 'MinorTicks' of something.- minorTicks :: LensLike' f a (MinorTicks (V a))+ minorTicks :: LensLike' f a (MinorTicks (V a) (N a)) -- | The function used to place ticks for this axis, given the result -- of 'majorTicksFunction' and the bounds of the axis. -- -- Default is @'linearMinorTicks' 3@.- minorTicksFunction :: Functor f => LensLike' f a ([Double] -> (Double, Double) -> [Double])+ minorTicksFunction :: Functor f => LensLike' f a ([N a] -> (N a, N a) -> [N a]) minorTicksFunction = minorTicks . lens mitFunction (\mit a -> mit {mitFunction = a}) -- | Alignment of the minor ticks. Choose between 'autoTicks'@@ -208,56 +205,52 @@ -- | The total length the minor ticks. -- -- Default is @3@.- minorTicksLength :: Functor f => LensLike' f a Double+ minorTicksLength :: Functor f => LensLike' f a (N a) minorTicksLength = minorTicks . lens mitLength (\mit a -> mit {mitLength = a}) -- | The style used to render the minor ticks. -- -- Default is @'lwO' 0.4 'mempty'@ (subject to change).- minorTicksStyle :: Functor f => LensLike' f a (Style (V a) Double)+ minorTicksStyle :: Functor f => LensLike' f a (Style (V a) (N a)) minorTicksStyle = minorTicks . lens mitStyle (\mit sty -> mit {mitStyle = sty}) -instance HasMinorTicks f (MinorTicks v) where+instance HasMinorTicks f (MinorTicks v n) where minorTicks = id -instance HasVisibility (MinorTicks v) where+instance HasVisibility (MinorTicks v n) where visible = lens mitVisible (\mit sty -> mit {mitVisible = sty}) -instance ApplyStyle (MinorTicks v) where-instance HasStyle (MinorTicks v) where- style = minorTicksStyle- ------------------------------------------------------------------------ -- Both ticks ------------------------------------------------------------------------ -- | Both 'MajorTicks' and 'MinorTicks' together.-data Ticks v = Ticks (MajorTicks v) (MinorTicks v)+data Ticks v n = Ticks (MajorTicks v n) (MinorTicks v n) -- Ticks are originally split up into major and minor so we can reuse -- major for the colour bar. I'm still undecided whether it's worth all -- the extra boilerplate here. -type instance V (Ticks v) = v-type instance N (Ticks v) = Double+type instance V (Ticks v n) = v+type instance N (Ticks v n) = n -- | Class of things with both 'MajorTicks' and 'MinorTicks'. class (HasMinorTicks f a, HasMajorTicks f a) => HasTicks f a where- bothTicks :: LensLike' f a (Ticks (V a))+ bothTicks :: LensLike' f a (Ticks (V a) (N a)) -instance Functor f => HasTicks f (Ticks v) where+instance Functor f => HasTicks f (Ticks v n) where bothTicks = id -instance Functor f => HasMajorTicks f (Ticks v) where+instance Functor f => HasMajorTicks f (Ticks v n) where majorTicks f (Ticks ma mi) = f ma <&> \ma' -> Ticks ma' mi -instance Functor f => HasMinorTicks f (Ticks v) where+instance Functor f => HasMinorTicks f (Ticks v n) where minorTicks f (Ticks ma mi) = f mi <&> \mi' -> Ticks ma mi' -instance Default (Ticks v) where+instance TypeableFloat n => Default (Ticks v n) where def = Ticks def def -instance ApplyStyle (Ticks v) where- applyStyle = over ticksStyle . applyStyle+instance Typeable n => HasStyle (Ticks v n) where+ applyStyle s = over ticksStyle (applyStyle s) -- | Traversal over both major and minor tick alignment. ticksAlign :: (HasTicks f a, Applicative f) => LensLike' f a TicksAlignment@@ -267,7 +260,7 @@ <$> f (a ^. majorTicksAlignment) <*> f (a ^. minorTicksAlignment) -- | Traversal over both major and minor tick styles.-ticksStyle :: (HasTicks f a, Applicative f) => LensLike' f a (Style (V a) Double)+ticksStyle :: (HasTicks f a, Applicative f) => LensLike' f a (Style (V a) (N a)) ticksStyle = bothTicks . styles where styles f a = (\m mn -> a & majorTicksStyle .~ m & minorTicksStyle .~ mn)@@ -298,7 +291,7 @@ -- you want to add or modify existing tick positions. majorTickPositions :: (HasMajorTicks f a, Settable f)- => LensLike' f a [Double]+ => LensLike' f a [N a] majorTickPositions = majorTicksFunction . mapped -- | Setter over the final positions the major ticks. This is not as@@ -307,7 +300,7 @@ -- you want to add or modify existing tick positions. minorTickPositions :: (HasMinorTicks f a, Settable f)- => LensLike' f a [Double]+ => LensLike' f a [N a] minorTickPositions = minorTicksFunction . mapped . mapped ------------------------------------------------------------------------
src/Plots/Axis/Title.hs view
@@ -30,17 +30,18 @@ import Diagrams.TwoD.Text import Plots.Types -data Title v = Title+data Title b v n = Title { tVisible :: Bool , tTxt :: String- , tTxtFun :: TextAlignment Double -> String -> Diagram v- , tStyle :: Style v Double+ , tTxtFun :: TextAlignment n -> String -> QDiagram b v n Any+ , tStyle :: Style v n , tPlacement :: Placement- , tAlignment :: TextAlignment Double- , tGap :: Double+ , tAlignment :: TextAlignment n+ , tGap :: n } deriving Typeable -instance Default (Title V2) where+instance (Renderable (Text n) b, TypeableFloat n)+ => Default (Title b V2 n) where def = Title { tVisible = True , tTxt = ""@@ -51,31 +52,20 @@ , tGap = 20 } -instance Default (Title V3) where- def = Title- { tVisible = True- , tTxt = ""- , tTxtFun = mempty- , tStyle = mempty # fontSize (output 11)- , tPlacement = midAbove- , tAlignment = BoxAlignedText 0.5 0- , tGap = 20- }--type instance V (Title v) = v-type instance N (Title v) = Double+type instance V (Title b v n) = v+type instance N (Title b v n) = n -instance HasVisibility (Title v) where+instance HasVisibility (Title b v n) where visible = lens tVisible (\t b -> t {tVisible = b}) -instance HasGap (Title v) where+instance HasGap (Title b v n) where gap = lens tGap (\t g -> t {tGap = g}) -instance HasPlacement (Title v) where+instance HasPlacement (Title b v n) where placement = titlePlacement -class HasTitle a where- title :: Lens' a (Title (V a))+class HasTitle a b | a -> b where+ title :: Lens' a (Title b (V a) (N a)) -- | The text used for the title. If the string is empty, no title is -- drawn.@@ -87,7 +77,7 @@ -- | The style applied to the title. -- -- Default is 'mempty'.- titleStyle :: Lens' a (Style (V a) Double)+ titleStyle :: Lens' a (Style (V a) (N a)) titleStyle = title . lens tStyle (\t s -> t {tStyle = s}) -- | The placement of the title against the axis.@@ -99,30 +89,31 @@ -- | The function used to draw the title text. -- -- Default is 'mkText'.- titleTextFunction :: Lens' a (TextAlignment Double -> String -> Diagram (V a))+ 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 Double)+ 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'.- titleGap :: Lens' a Double+ titleGap :: Lens' a (N a) titleGap = title . lens tGap (\t s -> t {tGap = s}) -instance HasTitle (Title v) where+instance HasTitle (Title b v n) b where title = id -- | Render the title and place it around the bounding box. drawTitle- :: BoundingBox V2 Double- -> Title V2- -> Diagram V2+ :: TypeableFloat n+ => BoundingBox V2 n+ -> Title b V2 n+ -> QDiagram b V2 n Any drawTitle bb t | t ^. hidden || nullOf titleText t = mempty | otherwise = placeAgainst
src/Plots/Legend.hs view
@@ -23,58 +23,58 @@ import Data.Typeable import Diagrams.TwoD.Text -import Geometry.BoundingBox-import Diagrams.Prelude hiding (orient)+import Diagrams.BoundingBox+import Diagrams.Prelude import Plots.Types -- | The data type to describe how to draw a legend. For legend entries -- see 'Plots.Types.LegendEntry'.-data Legend = Legend+data Legend b n = Legend { lPlacement :: Placement- , lGap :: Double- , lStyle :: Style V2 Double- , lSpacing :: Double- , lTextWidth :: Double- , lTextF :: String -> Diagram V2- , lTextStyle :: Style V2 Double+ , lGap :: n+ , lStyle :: Style V2 n+ , lSpacing :: n+ , lTextWidth :: n+ , lTextF :: String -> QDiagram b V2 n Any+ , lTextStyle :: Style V2 n , lOrientation :: Orientation , lVisible :: Bool } deriving Typeable -type instance V Legend = V2-type instance N Legend = Double+type instance V (Legend b n) = V2+type instance N (Legend b n) = n -class HasLegend a where+class HasLegend a b | a -> b where -- | Lens onto the 'Legend' of something.- legend :: Lens' a Legend+ legend :: Lens' a (Legend b (N a)) -- | The 'Placement' of the legend relative to the 'Plots.Axis.Axis'. legendPlacement :: Lens' a Placement legendPlacement = legend . lens lPlacement (\l a -> l {lPlacement = a}) -- | The gap between the legend and the axis.- legendGap :: Lens' a Double+ legendGap :: Lens' a (N a) legendGap = legend . lens lGap (\l a -> l {lGap = a}) -- | The style applied to the surronding box of the legend.- legendStyle :: Lens' a (Style V2 Double)+ legendStyle :: Lens' a (Style V2 (N a)) legendStyle = legend . lens lStyle (\l a -> l {lStyle = a}) -- | The spacing between entries in the legend.- legendSpacing :: Lens' a Double+ legendSpacing :: Lens' a (N a) legendSpacing = legend . lens lSpacing (\l a -> l {lSpacing = a}) -- | The space given for the text in the legend.- legendTextWidth :: Lens' a Double+ legendTextWidth :: Lens' a (N a) legendTextWidth = legend . lens lTextWidth (\l a -> l {lTextWidth = a}) -- | The function to generate the legend text.- legendTextFunction :: Lens' a (String -> Diagram V2)+ legendTextFunction :: Lens' a (String -> QDiagram b V2 (N a) Any) legendTextFunction = legend . lens lTextF (\l a -> l {lTextF = a}) -- | The style applied to the legend text.- legendTextStyle :: Lens' a (Style V2 Double)+ legendTextStyle :: Lens' a (Style V2 (N a)) legendTextStyle = legend . lens lTextStyle (\l a -> l {lTextStyle = a}) -- | The way the legend entries are listed. (This will likely be@@ -82,16 +82,16 @@ legendOrientation :: Lens' a Orientation legendOrientation = legend . lens lOrientation (\l a -> l {lOrientation = a}) -instance HasLegend Legend where+instance HasLegend (Legend b n) b where legend = id -instance HasGap Legend where+instance HasGap (Legend b n) where gap = legendGap -instance HasPlacement Legend where+instance HasPlacement (Legend b n) where placement = legendPlacement -instance Default Legend where+instance (TypeableFloat n, Renderable (Text n) b) => Default (Legend b n) where def = Legend { lPlacement = rightTop , lGap = 20@@ -104,26 +104,24 @@ , lVisible = True } -instance HasVisibility Legend where+instance HasVisibility (Legend b n) where visible = lens lVisible (\l a -> l {lVisible = a}) -instance ApplyStyle Legend---- | The style for the bounding box of the legend.-instance HasStyle Legend where- style = legendStyle- {-# INLINE style #-}+instance TypeableFloat n => HasStyle (Legend b n) where+ applyStyle sty = over legendStyle (applyStyle sty) -instance HasOrientation Legend where+instance HasOrientation (Legend b n) where orientation = legendOrientation -- | Draw a legend to the bounding box using the legend entries and -- legend options. drawLegend- :: BoundingBox V2 Double -- ^ bounding box to place legend against- -> [(Diagram V2, String)] -- ^ diagram pictures along with their key- -> Legend -- ^ options for drawing the legend- -> Diagram V2 -- ^ rendered legend+ :: (TypeableFloat n,+ Renderable (Path V2 n) b)+ => BoundingBox V2 n -- ^ bounding box to place legend against+ -> [(QDiagram b V2 n Any, String)] -- ^ diagram pictures along with their key+ -> Legend b n -- ^ options for drawing the legend+ -> QDiagram b V2 n Any -- ^ rendered legend drawLegend bb entries l | l ^. hidden || null entries = mempty | otherwise = placeAgainst
src/Plots/Name.hs view
@@ -3,48 +3,48 @@ module Plots.Name where --- import Control.Lens--- -- import Data.Map (Map)--- import Data.Ord (comparing)--- import Data.Function--- import Data.Typeable--- import Diagrams.Types.Names--- import Diagrams.Prelude hiding (view)+import Control.Lens+-- import Data.Map (Map)+import Data.Ord (comparing)+import Data.Function+import Data.Typeable+import Diagrams.Core.Names+import Diagrams.Prelude hiding (view) --- data PlotName = PlotName--- { _plotName :: String--- , _namedSize2D :: SizeSpec V2 Double--- , _namedT2 :: T2 Double--- } deriving Typeable+data PlotName n = PlotName+ { _plotName :: String+ , _namedSize2D :: SizeSpec V2 n+ , _namedT2 :: T2 n+ } deriving Typeable --- makeLenses ''PlotName+makeLenses ''PlotName --- instance Show PlotName where--- show pn = "Plot: " ++ view plotName pn+instance Show (PlotName n) where+ show pn = "Plot: " ++ view plotName pn --- -- equating :: Eq b => (a -> b) -> a -> a -> Bool--- -- equating = on (==)+-- equating :: Eq b => (a -> b) -> a -> a -> Bool+-- equating = on (==) --- instance Eq PlotName where--- (==) = on (==) (view plotName)+instance Eq (PlotName n) where+ (==) = on (==) (view plotName) --- instance Ord PlotName where--- compare = comparing (view plotName)+instance Ord (PlotName n) where+ compare = comparing (view plotName) --- instance IsName PlotName+instance Typeable n => IsName (PlotName n) --- -- _AName :: IsName a => Prism' AName a--- -- _AName = prism' AName (\(AName a) -> cast a)+-- _AName :: IsName a => Prism' AName a+-- _AName = prism' AName (\(AName a) -> cast a) --- -- _Names :: IsName a => Traversal' Name a--- -- _Names = _Wrapped' . traverse . _AName+-- _Names :: IsName a => Traversal' Name a+-- _Names = _Wrapped' . traverse . _AName --- -- _NamedString :: Traversal' Name String--- -- _NamedString = _Names+-- _NamedString :: Traversal' Name String+-- _NamedString = _Names --- -- _NamedPlot :: Typeable n => Traversal' Name (PlotName n)--- -- _NamedPlot = _Names+-- _NamedPlot :: Typeable n => Traversal' Name (PlotName n)+-- _NamedPlot = _Names --- -- diaNames :: OrderedField n => QDiagram b V2 n Any -> Map Name [P2 n]--- -- diaNames = over (mapped . traversed) location . view (subMap . _Wrapped')+-- diaNames :: OrderedField n => QDiagram b V2 n Any -> Map Name [P2 n]+-- diaNames = over (mapped . traversed) location . view (subMap . _Wrapped')
src/Plots/Style.hs view
@@ -29,7 +29,6 @@ -- ** Predefined styles , fadedColours- , fadedColours3D , vividColours , blackAndWhite @@ -83,10 +82,6 @@ import Diagrams.Prelude hiding (magma) import Linear -import Diagrams.ThreeD.Attributes--import Geometry- -- | Plot styles are used to style each plot in an axis. Every 'Axis' -- comes with a list of plots styles (contained in the 'AxisStyle') -- which get applied the plots upon rendering.@@ -126,23 +121,23 @@ -- 'histogramPlot') -- * 'markerStyle' - style used for markers in 'scatterPlot' -- * 'plotMarker' - marker used in 'scatterPlot'-data PlotStyle v = PlotStyle+data PlotStyle b v n = PlotStyle { _plotColour :: Colour Double- , _lineStyle :: Colour Double -> Style v Double- , _markerStyle :: Colour Double -> Style v Double- , _areaStyle :: Colour Double -> Style v Double- , _textStyle :: Colour Double -> Style v Double- , _plotMarker :: Diagram v+ , _lineStyle :: Colour Double -> Style v n+ , _markerStyle :: Colour Double -> Style v n+ , _areaStyle :: Colour Double -> Style v n+ , _textStyle :: Colour Double -> Style v n+ , _plotMarker :: QDiagram b v n Any } deriving Typeable -- XXX link to examples in haddock? -type instance V (PlotStyle v) = v-type instance N (PlotStyle v) = Double+type instance V (PlotStyle b v n) = v+type instance N (PlotStyle b v n) = n -- | Class for objects that contain a 'PlotStyle'.-class HasPlotStyle f a where+class HasPlotStyle f a b | a -> b where -- | Lens onto the 'PlotStyle'.- plotStyle :: LensLike' f a (PlotStyle (V a))+ plotStyle :: LensLike' f a (PlotStyle b (V a) (N a)) -- | The 'plotColour' is the overall colour of the plot. This is passed -- to the other styles ('lineStyle', 'markerStyle' etc.) to give an@@ -157,60 +152,61 @@ -- | This style is applied to any plots made up of lines only (like -- 'Path' plots). This is a less general version of -- 'lineStyleFunction'.- lineStyle :: Settable f => LensLike' f a (Style (V a) Double)+ lineStyle :: Settable f => LensLike' f a (Style (V a) (N a)) lineStyle = lineStyleFunction . mapped -- | A version 'lineStyle' with access to the current 'plotColour' -- when 'applyLineStyle' is used.- lineStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double)+ lineStyleFunction :: Functor f => LensLike' f a (Colour Double ->+ Style (V a) (N a)) lineStyleFunction = plotStyle . lens _lineStyle (\p f -> p {_lineStyle = f}) -- | This style is applied to any markers in the plot (usually the -- 'plotMarker'). This is a less general version of -- 'markerStyleFunction'.- markerStyle :: Settable f => LensLike' f a (Style (V a) Double)+ markerStyle :: Settable f => LensLike' f a (Style (V a) (N a)) markerStyle = markerStyleFunction . mapped -- | A version 'lineStyle' with access to the current 'plotColour' when -- 'applyMarkerStyle' is used.- markerStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double)+ markerStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) (N a)) markerStyleFunction = plotStyle . lens _markerStyle (\p f -> p {_markerStyle = f}) -- | This style is applied to any filled areas in a plot (like -- 'Plots.Types.Bar' or 'Plots.Styles.Ribbon'). This is a less -- general version of 'areaStyleFunction'.- areaStyle :: Settable f => LensLike' f a (Style (V a) Double)+ areaStyle :: Settable f => LensLike' f a (Style (V a) (N a)) areaStyle = areaStyleFunction . mapped -- | A version 'areaStyle' with access to the current 'plotColour' when -- 'applyAreaStyle' is used.- areaStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double)+ areaStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) (N a)) areaStyleFunction = plotStyle . lens _areaStyle (\p f -> p {_areaStyle = f}) -- | This style is applied to text plots. This is a less general -- version of 'textStyleFunction'.- textStyle :: Settable f => LensLike' f a (Style (V a) Double)+ textStyle :: Settable f => LensLike' f a (Style (V a) (N a)) textStyle = textStyleFunction . mapped -- | A version 'textStyle' with access to the current 'plotColour' when -- 'applyAreaStyle' is used.- textStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double)+ textStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) (N a)) textStyleFunction = plotStyle . lens _textStyle (\p f -> p {_textStyle = f}) -- | This diagram is used as any markers in a plot (like -- 'Plots.Types.Scatter'). The 'markerStyle' will be applied to this -- marker when the plot gets rendered.- plotMarker :: Functor f => LensLike' f a (Diagram (V a))+ plotMarker :: Functor f => LensLike' f a (QDiagram b (V a) (N a) Any) plotMarker = plotStyle . lens _plotMarker (\p f -> p {_plotMarker = f}) -- | A traversal over all the styles ('lineStyle', 'markerStyle', -- 'areaStyle' and 'textStyle') of a 'PlotStyle'. This is a less -- general version of 'plotStyleFunctions'.- plotStyles :: Settable f => LensLike' f a (Style (V a) Double)+ plotStyles :: Settable f => LensLike' f a (Style (V a) (N a)) plotStyles = plotStyleFunctions . mapped -- | A version of 'plotStyles' with access to the 'plotColour'.- plotStyleFunctions :: Applicative f => LensLike' f a (Colour Double -> Style (V a) Double)+ plotStyleFunctions :: Applicative f => LensLike' f a (Colour Double -> Style (V a) (N a)) plotStyleFunctions = plotStyle . t where t f PlotStyle {..} = PlotStyle@@ -221,7 +217,7 @@ <*> f _textStyle <*> pure _plotMarker -instance HasPlotStyle f (PlotStyle v) where+instance HasPlotStyle f (PlotStyle b v n) b where plotStyle = id -- Applying styles -----------------------------------------------------@@ -229,48 +225,48 @@ -- | Apply the 'lineStyle' from a 'PlotStyle'. -- -- @--- applyLineStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t+-- applyLineStyle :: (InSpace v n t, HasStyle t) => PlotStyle b v n -> t -> t -- @ applyLineStyle- :: (InSpace v Double t, ApplyStyle t)- => PlotStyle v -> t -> t+ :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)+ => a -> t -> t applyLineStyle (view plotStyle -> sty) = applyStyle $ (sty ^. lineStyleFunction) (sty ^. plotColour) -- | Apply the 'markerStyle' from a 'PlotStyle'. -- -- @--- applyMarkerStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t+-- applyMarkerStyle :: (InSpace v n t, HasStyle t) => PlotStyle b v n -> t -> t -- @ applyMarkerStyle- :: (InSpace v Double t, ApplyStyle t)- => PlotStyle v -> t -> t+ :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)+ => a -> t -> t applyMarkerStyle (view plotStyle -> sty) = applyStyle $ (sty ^. markerStyleFunction) (sty ^. plotColour) -- | Apply the 'areaStyle from a 'PlotStyle'. -- -- @--- applyLineStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t+-- applyLineStyle :: (InSpace v n t, HasStyle t) => PlotStyle b v n -> t -> t -- @ applyAreaStyle- :: (InSpace v Double t, ApplyStyle t)- => PlotStyle v -> t -> t+ :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)+ => a -> t -> t applyAreaStyle (view plotStyle -> sty) = applyStyle $ (sty ^. areaStyleFunction) (sty ^. plotColour) -- | Apply the 'textStyle' from a 'PlotStyle'. -- -- @--- applyTextStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t+-- applyTextStyle :: (InSpace v n t, HasStyle t) => PlotStyle b v n -> t -> t -- @ applyTextStyle- :: (InSpace v Double t, ApplyStyle t)- => PlotStyle v -> t -> t+ :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)+ => a -> t -> t applyTextStyle (view plotStyle -> sty) = applyStyle $ (sty ^. textStyleFunction) (sty ^. plotColour) -instance (Metric v, Traversable v) => Transformable (PlotStyle v) where+instance (Metric v, Traversable v, OrderedField n) => Transformable (PlotStyle b v n) where transform t = (plotMarker %~ transform t) . (plotStyles %~ transform t) ------------------------------------------------------------------------@@ -279,15 +275,15 @@ -- | The 'AxisStyle' determines the 'Style's of the plots in an axis. -- There are various predefined styles to change the look of the plot.-data AxisStyle v = AxisStyle ColourMap [PlotStyle v]+data AxisStyle b v n = AxisStyle ColourMap [PlotStyle b v n] -type instance V (AxisStyle v) = v-type instance N (AxisStyle v) = Double+type instance V (AxisStyle b v n) = v+type instance N (AxisStyle b v n) = n -- | Class of things that have an 'AxisStyle'.-class HasAxisStyle a where+class HasAxisStyle a b | a -> b where -- | Lens onto the 'AxisStyle'.- axisStyle :: Lens' a (AxisStyle (V a))+ axisStyle :: Lens' a (AxisStyle b (V a) (N a)) -- | The 'ColourMap' is used to draw the 'Plots.Axis.ColourBar' and -- render plots like 'Plots.HeatMap'.@@ -297,14 +293,14 @@ -- | Traversal over the 'PlotStyle's in an 'AxisStyle'. There are always -- an infinite number of 'PlotStyle's in an 'AxisStyle'.- axisStyles :: IndexedTraversal' Int a (PlotStyle (V a))+ axisStyles :: IndexedTraversal' Int a (PlotStyle b (V a) (N a)) axisStyles = axisStyle . stys . traversed where stys f (AxisStyle c ss) = f ss <&> \ss' -> AxisStyle c ss' -instance HasAxisStyle (AxisStyle v) where+instance HasAxisStyle (AxisStyle b v n) b where axisStyle = id -instance Applicative f => HasPlotStyle f (AxisStyle v) where+instance Applicative f => HasPlotStyle f (AxisStyle b v n) b where plotStyle = axisStyles ------------------------------------------------------------------------@@ -331,7 +327,7 @@ -- | Theme using 'funColours' with faded fills and thick lines. -- -- <<diagrams/src_Plots_Style_fadedColourPic.svg#diagram=fadedColourPic&width=600>>-fadedColours :: AxisStyle V2+fadedColours :: (TypeableFloat n, Renderable (Path V2 n) b) => AxisStyle b V2 n fadedColours = AxisStyle viridis $ zipWith mkStyle (cycle colours1) (cycle $ map stroke filledMarkers) where@@ -340,20 +336,10 @@ fadeS c = mempty # fc (blend 0.1 white c) # lc c # lwO 1 fillS c = mempty # fc c # lw none -fadedColours3D :: AxisStyle V3-fadedColours3D = AxisStyle viridis $- zipWith mkStyle (cycle colours1) shapeMarkers- where- mkStyle c = PlotStyle c lineS fadeS fadeS fillS- lineS c = mempty # lwO 3 :: Style V3 Double- fadeS c = mempty # sc (blend 0.1 white c) # lwO 3 :: Style V3 Double- fillS c = mempty # sc c # lw none :: Style V3 Double-- -- | Theme using 'funColours' with no lines on 'areaStyle. -- -- <<diagrams/src_Plots_Style_vividColourPic.svg#diagram=vividColourPic&width=600>>-vividColours :: AxisStyle V2+vividColours :: (TypeableFloat n, Renderable (Path V2 n) b) => AxisStyle b V2 n vividColours = AxisStyle viridis $ zipWith mkStyle (cycle colours2) (cycle $ map (scale 1.2 . stroke) filledMarkers) where@@ -365,7 +351,7 @@ -- | Theme without any colours, useful for black and white documents. -- -- <<diagrams/src_Plots_Style_blackAndWhitePic.svg#diagram=blackAndWhitePic&width=600>>-blackAndWhite :: AxisStyle V2+blackAndWhite :: (TypeableFloat n, Renderable (Path V2 n) b) => AxisStyle b V2 n blackAndWhite = AxisStyle greys $ zipWith3 mkStyle (cycle colours) (cycle lineStyles) (cycle $ map stroke filledMarkers) where@@ -411,18 +397,9 @@ -- | Markers which have a filling, used for 'fadedColours' and -- 'vividColours'.-shapeMarkers :: [Diagram V3]-shapeMarkers = scale 11 $ cycle- [ cube- , sphere- , cone- ]---- | Markers which have a filling, used for 'fadedColours' and--- 'vividColours'. filledMarkers :: RealFloat n => [Path V2 n]-filledMarkers = scale 11 . map (centerXY . toPath) $ cycle- [ circle 0.5 :: RealFloat n => Trail V2 n+filledMarkers = scale 11 . map (centerXY . pathFromTrail) $ cycle+ [ circle 0.5 , square 1 , triangle 1 , diamond (1 / sqrt 2)@@ -454,27 +431,27 @@ asterisk n x = mconcat . take n . iterate (rotateBy (1/fromIntegral n))- $ fromVertices [origin, mkP2 0 x]+ $ (0 ^& 0) ~~ (0 ^& x) -- | A rotated 'square'.-diamond :: (InSpace V2 n t, FromTrail t, OrderedField n) => n -> t-diamond = fromLocTrail . rotateBy (1/8) . square+diamond :: (InSpace V2 n t, TrailLike t) => n -> t+diamond = trailLike . rotateBy (1/8) . square -- | A rotated 'plus'.-crossShape :: (InSpace V2 n t, FromTrail t, OrderedField n) => n -> t-crossShape = fromLocTrail . rotateBy (1/8) . plus+crossShape :: (InSpace V2 n t, TrailLike t) => n -> t+crossShape = trailLike . rotateBy (1/8) . plus -- | Filled in @+@ symbol.-plus :: (InSpace V2 n t, FromTrail t, OrderedField n) => n -> t-plus x = fromLocLoop . (`at` mkP2 (x/6) (x/6))- . glueLine . mconcat . take 4- . iterate (rotateBy (1/4)) . (^?! _init)+plus :: (InSpace V2 n t, TrailLike t) => n -> t+plus x = trailLike . (`at` mkP2 (x/6) (x/6))+ . wrapTrail . glueLine . mconcat . take 4+ . iterate (rotateBy (1/4)) . onLineSegments init $ square (x/3) -- | A filled in five sided start of size x.-star' :: (InSpace V2 n t, FromTrail t, OrderedField n) => n -> t-star' x = fromLocLoop . (`at` mkP2 (-x/6) (x/6))- . glueLine . mconcat . take 5+star' :: (InSpace V2 n t, TrailLike t) => n -> t+star' x = trailLike . (`at` mkP2 (-x/6) (x/6))+ . wrapTrail . glueLine . mconcat . take 5 . iterate (rotateBy (-1/5)) $ spoke where spoke = fromOffsets . map r2 $ [(x/6,x/2), (x/6,-x/2)]@@ -611,8 +588,8 @@ (b,_) = M.findMax cm normalise x = (x - a) / (b - a) -toStops :: ColourMap -> [GradientStop]-toStops = map (\(x,c) -> GradientStop (opaque c) (fromRational x))+toStops :: Fractional n => ColourMap -> [GradientStop n]+toStops = map (\(x,c) -> GradientStop (SomeColor c) (fromRational x)) . colourList -- Colour maps ---------------------------------------------------------
src/Plots/Types.hs view
@@ -22,19 +22,19 @@ -- -- This module defines the various types for holding plots: ----- [@'PlotOptions' v@]+-- [@'PlotOptions' b v n@] -- Generic options all plots have. ----- [@'PlotMods' v@]+-- [@'PlotMods' b v n@] -- Includes 'PlotOptions' along with modifications to the 'PlotStyle'. ----- [@'Plot' p@]+-- [@'Plot' p b@] -- A 'rawPlot' @p@ grouped with a 'PlotMods'. ----- [@'DynamicPlot' v@]+-- [@'DynamicPlot' b v n@] -- A wrapped up 'Plot' so it can be stored in an 'Axis'. ----- [@'StyledPlot' v@]+-- [@'StyledPlot' b v n@] -- A 'DynamicPlot' with a concrete 'PlotStyle', ready to be rendered. -- -- As well as other things like the 'Plotable' class, 'LegendEntries',@@ -131,18 +131,12 @@ import Data.Ord (comparing) import Data.Orphans () import Data.Typeable-import Diagrams.Prelude as D hiding (orient)+import Diagrams.Prelude as D import Plots.Axis.Scale import Plots.Style import Plots.Util --- XXX shouldn't need to import these-import Diagrams.Combinators as D-import Geometry.TwoD.Shapes--import Diagrams.Types- -- Orientation --------------------------------------------------------- data Orientation = Horizontal | Vertical@@ -178,16 +172,16 @@ class HasGap a where -- | The value of the gap when rendering.- gap :: Lens' a Double+ gap :: Lens' a (N a) -- | A 'Position' is a point on an axis together with an anchor and a -- direction for the gap. data Placement = Placement { pAt :: V2 Rational , pAnchor :: V2 Rational- , pGapDir :: Direction V2 Double+ , pGapDir :: Direction V2 Rational }- deriving (Show, Eq)+ deriving (Show, Read, Eq, Ord) -- In the future the axis position may be replaced by a reader-like -- anchor system where you can choose parts of the rendered axis as a -- position.@@ -210,7 +204,7 @@ placementAnchor = placement . lens pAnchor (\p a -> p {pAnchor = a}) -- | The direction to extend the 'gap' when positioning.- gapDirection :: Lens' a (Direction V2 Double)+ gapDirection :: Lens' a (Direction V2 Rational) gapDirection = placement . lens pGapDir (\p a -> p {pGapDir = a}) instance HasPlacement Placement where@@ -223,11 +217,11 @@ pInside v = Placement { pAt = v , pAnchor = v- , pGapDir = dirBetween' (P $ fromRational <$> v) origin+ , pGapDir = dirBetween' (P v) origin } -- | @dirBetween p q@ returns the directions from @p@ to @q@-dirBetween' :: (Metric v, Floating n) => Point v n -> Point v n -> Direction v n+dirBetween' :: (Additive v, Num n) => Point v n -> Point v n -> Direction v n dirBetween' p q = direction $ q .-. p @@ -266,11 +260,12 @@ -- | A tool for aligned one object to another. Positions @b@ around the -- bounding box of @a@ by translating @b@. placeAgainst- :: (InSpace V2 n a, SameSpace a b, Enveloped a, Enveloped b, HasOrigin b)+ :: (InSpace V2 n a, SameSpace a b, Enveloped a,+ HasOrigin b, Alignable b) => a -> Placement -> n -> b -> b placeAgainst a (Placement (V2 px py) (V2 ax ay) d) n b = b # anchor- # moveTo (pos .+^ n *^ fromDirection (realToFrac <$> d))+ # moveTo (pos .+^ n *^ fromDirection (fmap fromRational d)) where pos = mkP2 (lerp' px xu xl) (lerp' py yu yl) anchor = alignBy unitX (fromRational ax) . alignBy unitY (fromRational ay)@@ -285,26 +280,26 @@ -- | Type allowing use of the default legend picture (depending on the -- plot) or a custom legend picture with access to the 'PlotStyle'.-data LegendPic v+data LegendPic b v n = DefaultLegendPic- | CustomLegendPic (PlotStyle v -> Diagram v)+ | CustomLegendPic (PlotStyle b v n -> QDiagram b v n Any) -instance Default (LegendPic v) where+instance Default (LegendPic b v n) where def = DefaultLegendPic -- | Data type for holding a legend entry.-data LegendEntry v = LegendEntry- { lPic :: LegendPic v+data LegendEntry b v n = LegendEntry+ { lPic :: LegendPic b v n , lText :: String- , lPrecedence :: Double+ , lPrecedence :: n } deriving Typeable -- | The picture used in the legend entry.-legendPicture :: Lens' (LegendEntry v) (LegendPic v)+legendPicture :: Lens' (LegendEntry b v n) (LegendPic b v n) legendPicture = lens lPic (\l pic -> l {lPic = pic}) -- | The text used in the legend entry.-legendText :: Lens' (LegendEntry v) String+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 precedences@@ -312,15 +307,15 @@ -- axis. -- -- Default is @0@.-legendPrecedence :: Lens' (LegendEntry v) Double+legendPrecedence :: Lens' (LegendEntry b v n) n legendPrecedence = lens lPrecedence (\l n -> l {lPrecedence = n}) -type instance V (LegendEntry v) = v-type instance N (LegendEntry v) = Double+type instance V (LegendEntry b v n) = v+type instance N (LegendEntry b v n) = n -- | Make a legend entry with a default 'legendPicture' and -- 'legendPrecedence' 0 using the string as the 'legendText'.-mkLegendEntry :: String -> LegendEntry v+mkLegendEntry :: Num n => String -> LegendEntry b v n mkLegendEntry x = LegendEntry DefaultLegendPic x 0 ------------------------------------------------------------------------@@ -330,24 +325,24 @@ -- Generic Plot info -- | Data type for holding information all plots must contain.-data PlotOptions v = PlotOptions+data PlotOptions b v n = PlotOptions { poName :: Name , poClipPlot :: Bool- , poLegend :: [LegendEntry v]+ , poLegend :: [LegendEntry b v n] , poVisible :: Bool- , poTransform :: Transformation v Double+ , poTransform :: Transformation v n -- , poPostPlotBoundingBox :: BoundingBox v n -> BoundingBox v n- -- , poPlotPostProduction :: QDiagram v Any -> QDiagram v Any+ -- , poPlotPostProduction :: QDiagram b v n Any -> QDiagram b v n Any } deriving Typeable -type instance V (PlotOptions v) = v-type instance N (PlotOptions v) = Double+type instance V (PlotOptions b v n) = v+type instance N (PlotOptions b v n) = n -- | Class of things that have 'PlotOptions'.-class HasPlotOptions f a where+class HasPlotOptions f a b | a -> b where {-# MINIMAL plotOptions #-} -- | Lens onto the 'PlotOptions'.- plotOptions :: LensLike' f a (PlotOptions (V a))+ plotOptions :: LensLike' f a (PlotOptions b (V a) (N a)) -- | The 'Name' applied to the plot. This gives a way to reference a -- specific plot in a rendered axis.@@ -367,7 +362,7 @@ -- | The legend entries to be used for the current plot. -- -- 'Default' is 'mempty'.- legendEntries :: Functor f => LensLike' f a [LegendEntry (V a)]+ legendEntries :: Functor f => LensLike' f a [LegendEntry b (V a) (N a)] legendEntries = plotOptions . lens poLegend (\g a -> g {poLegend = a}) {-# INLINE legendEntries #-} @@ -375,7 +370,7 @@ -- coordinates. -- -- 'Default' is 'mempty'.- plotTransform :: Functor f => LensLike' f a (Transformation (V a) Double)+ plotTransform :: Functor f => LensLike' f a (Transformation (V a) (N a)) plotTransform = plotOptions . lens poTransform (\g a -> g {poTransform = a}) {-# INLINE plotTransform #-} @@ -387,7 +382,7 @@ plotVisible = plotOptions . lens poVisible (\po b -> po {poVisible = b}) {-# INLINE plotVisible #-} -instance (HasBasis v, Foldable v) => Default (PlotOptions v) where+instance (Additive v, Num n) => Default (PlotOptions b v n) where def = PlotOptions { poName = mempty , poClipPlot = True@@ -398,25 +393,25 @@ -- , poPlotPostProduction = id } -instance HasPlotOptions f (PlotOptions v) where+instance HasPlotOptions f (PlotOptions b v n) b where plotOptions = id {-# INLINE plotOptions #-} -instance HasLinearMap v => Transformable (PlotOptions v) where+instance (HasLinearMap v, Num n) => Transformable (PlotOptions b v n) where transform = over plotTransform . transform --- instance HasBounds (PlotOptions v) v where+-- instance HasBounds (PlotOptions b v n) v where -- bounds = plotBounds -- | Move origin by applying to @plotTransform@.-instance Additive v => HasOrigin (PlotOptions v) where+instance (Additive v, Num n) => HasOrigin (PlotOptions b v n) where moveOriginTo = over plotTransform . moveOriginTo -instance Qualifiable (PlotOptions v) where+instance Qualifiable (PlotOptions b v n) where n .>> p = over plotName (n .>>) p -- XXX template haskell getting in the way--- instance HasVisibility (PlotOptions v) where+-- instance HasVisibility (PlotOptions b v n) where -- visible = plotVisible -- | Add a 'LegendEntry' to something with 'PlotOptions' using the@@ -424,27 +419,27 @@ -- some typical examples: -- -- @--- 'key' :: 'String' -> 'State' ('Plot' ('ScatterPlot' v)) ()--- 'key' :: 'String' -> 'State' ('DynamicPlot' v) ()--- 'key' :: 'String' -> 'State' ('PlotMods' v) ()+-- 'key' :: 'String' -> 'State' ('Plot' ('ScatterPlot' v n) b) ()+-- 'key' :: 'String' -> 'State' ('DynamicPlot' b v n) ()+-- 'key' :: 'String' -> 'State' ('PlotMods' b v n) () -- @ -- -- If you only care about the name of the legend, use 'key'.-key :: (HasPlotOptions Identity a, MonadState a m) => String -> m ()+key :: (HasPlotOptions Identity a b, MonadState a m, Num (N a)) => String -> m () key = addLegendEntry . mkLegendEntry -- | Add a 'LegendEntry' to something with 'PlotOptions'. Here are some -- typical examples: -- -- @--- 'addLegendEntry' :: 'LegendEntry' v -> 'State' ('Plot' ('ScatterPlot' v)) ()--- 'addLegendEntry' :: 'LegendEntry' v -> 'State' ('DynamicPlot' v) ()+-- 'addLegendEntry' :: 'LegendEntry' b v n -> 'State' ('Plot' ('ScatterPlot' v n) b) ()+-- 'addLegendEntry' :: 'LegendEntry' b v n -> 'State' ('DynamicPlot' b v n) () -- @ -- -- If you only care about the name of the legend, use 'key'. addLegendEntry- :: (HasPlotOptions Identity a, MonadState a m)- => LegendEntry (V a)+ :: (HasPlotOptions Identity a b, MonadState a m)+ => LegendEntry b (V a) (N a) -> m () addLegendEntry l = legendEntries <>= [l] @@ -456,17 +451,17 @@ ------------------------------------------------------------------------ -- | Information from the 'Plots.Axis.Axis' necessary to render a 'Plotable'.-data AxisSpec v = AxisSpec- { _specBounds :: v (Double, Double)- , _specTrans :: Transformation v Double+data AxisSpec v n = AxisSpec+ { _specBounds :: v (n, n)+ , _specTrans :: Transformation v n , _specScale :: v LogScale , _specColourMap :: ColourMap } makeLenses ''AxisSpec -type instance V (AxisSpec v) = v-type instance N (AxisSpec v) = Double+type instance V (AxisSpec v n) = v+type instance N (AxisSpec v n) = n -- | Scale a number by log10-ing it and linearly scaling it so it's -- within the same range.@@ -477,9 +472,7 @@ where d = b - a -- | Apply log scaling and the transform to a point.-specPoint- :: (Applicative v, Additive v, Foldable v)- => AxisSpec v -> Point v Double -> Point v Double+specPoint :: (Applicative v, Additive v, Floating n) => AxisSpec v n -> Point v n -> Point v n specPoint (AxisSpec bs tr ss _) p = papply tr $ over _Point (scaleNum <$> bs <*> ss <*>) p @@ -488,38 +481,36 @@ ------------------------------------------------------------------------ -- | Class defining how plots should be rendered.-class (Typeable p, Enveloped p, N p ~ Double) => Plotable p where+class (Typeable p, Enveloped p) => Plotable p b where -- | Render a plot according to the 'AxisSpec', using the 'PlotStyle'. renderPlotable- :: InSpace v Double p- => AxisSpec v- -> PlotStyle v+ :: InSpace v n p+ => AxisSpec v n+ -> PlotStyle b v n -> p- -> Diagram v+ -> QDiagram b v n Any -- | The default legend picture when the 'LegendPic' is -- 'DefaultLegendPic'. defLegendPic- :: InSpace v Double p- => PlotStyle v+ :: InSpace v n p+ => PlotStyle b v n -> p- -> Diagram v+ -> QDiagram b v n Any defLegendPic = mempty -instance (Typeable v, HasLinearMap v) => Plotable (Diagram v) where+instance (Typeable b, Typeable v, Metric v, Typeable n, OrderedField n)+ => Plotable (QDiagram b v n Any) b where renderPlotable s _ dia = dia # transform (s^.specTrans) -strokePathV :: (Typeable v, Metric v, Typeable n, OrderedField n) => Path v n -> QDiagram v n Any-strokePathV path = mkQD (Prim path) (getEnvelope path) mempty mempty--instance (Typeable v, R1 v, HasLinearMap v) => Plotable (Path v Double) where+instance (TypeableFloat n, Renderable (Path V2 n) b) => Plotable (Path V2 n) b where renderPlotable s sty path- = strokePathV path+ = stroke path # transform (s^.specTrans) # applyLineStyle sty defLegendPic sty _- = strokePathV (fromVertices [(-10) *^ unitX, 10 *^ unitX])+ = (p2 (-10,0) ~~ p2 (10,0)) # applyLineStyle sty ------------------------------------------------------------------------@@ -536,26 +527,26 @@ hidden = visible . involuted not {-# INLINE hidden #-} -instance HasVisibility (PlotOptions v) where+instance HasVisibility (PlotOptions b v n) where visible = plotVisible -instance HasVisibility (PlotMods v) where+instance HasVisibility (PlotMods b v n) where visible = plotVisible -instance HasVisibility (Plot p) where+instance HasVisibility (Plot p b) where visible = plotVisible -instance HasVisibility (DynamicPlot v) where+instance HasVisibility (DynamicPlot b v n) where visible = plotVisible -instance HasVisibility (StyledPlot v) where+instance HasVisibility (StyledPlot b v n) where visible = plotVisible -- | Set 'visible' to 'False' for the given setter. -- -- @--- 'hide' 'minorTicks' :: 'State' ('Axis' v) ()--- 'hide' ('xAxis' . 'gridLines') :: 'State' ('Axis' v) ()+-- 'hide' 'minorTicks' :: 'State' ('Axis' b v n) ()+-- 'hide' ('xAxis' . 'gridLines') :: 'State' ('Axis' b v n) () -- @ hide :: (MonadState s m, HasVisibility a) => ASetter' s a -> m () hide l = l . visible .= False@@ -563,8 +554,8 @@ -- | Set 'visible' to 'True' for the given setter. -- -- @--- 'display' 'minorGridLines' :: 'State' ('Axis' v) ()--- 'display' 'colourBar' :: 'State' ('Axis' v) ()+-- 'display' 'minorGridLines' :: 'State' ('Axis' b v n) ()+-- 'display' 'colourBar' :: 'State' ('Axis' b v n) () -- @ display :: (MonadState s m, HasVisibility a) => ASetter' s a -> m () display l = l . visible .= True@@ -574,20 +565,20 @@ ------------------------------------------------------------------------ -- | A 'PlotOptions' with modifications to a 'PlotStyle'.-data PlotMods v- = PlotMods (PlotOptions v) (PlotStyle v -> PlotStyle v)+data PlotMods b v n+ = PlotMods (PlotOptions b v n) (PlotStyle b v n -> PlotStyle b v n) -type instance V (PlotMods v) = v-type instance N (PlotMods v) = Double+type instance V (PlotMods b v n) = v+type instance N (PlotMods b v n) = n -instance Functor f => HasPlotOptions f (PlotMods v) where+instance Functor f => HasPlotOptions f (PlotMods b v n) b where plotOptions f (PlotMods opts sty) = f opts <&> \opts' -> PlotMods opts' sty -instance Settable f => HasPlotStyle f (PlotMods v) where+instance Settable f => HasPlotStyle f (PlotMods b v n) b where plotStyle = sty . mapped where sty f (PlotMods opts s) = f s <&> \s' -> PlotMods opts s' -instance (HasBasis v, Foldable v) => Default (PlotMods v) where+instance (Additive v, Num n) => Default (PlotMods b v n) where def = PlotMods def id ------------------------------------------------------------------------@@ -596,35 +587,35 @@ -- | A parameterised plot, together with a 'PlotMods'. This type has an -- instance of many classes for modifying specific plots.-data Plot p =+data Plot p b = Plot p- (PlotOptions (V p))- (PlotStyle (V p) -> PlotStyle (V p))+ (PlotOptions b (V p) (N p))+ (PlotStyle b (V p) (N p) -> PlotStyle b (V p) (N p)) deriving Typeable -type instance V (Plot p) = V p-type instance N (Plot p) = Double+type instance V (Plot p b) = V p+type instance N (Plot p b) = N p -instance Functor f => HasPlotOptions f (Plot p) where+instance Functor f => HasPlotOptions f (Plot p b) b where plotOptions f (Plot p opts sty) = f opts <&> \opts' -> Plot p opts' sty -instance Settable f => HasPlotStyle f (Plot p) where+instance Settable f => HasPlotStyle f (Plot p b) b where plotStyle = sty . mapped where sty f (Plot p opts s) = f s <&> \s' -> Plot p opts s' -instance HasOrientation p => HasOrientation (Plot p) where+instance HasOrientation p => HasOrientation (Plot p b) where orientation = rawPlot . orientation -- | Make a 'Plot' with 'Default' 'PlotOptions'.-mkPlot :: (InSpace v Double p, HasBasis v, Foldable v) => p -> Plot p+mkPlot :: (Additive (V p), Num (N p)) => p -> Plot p b mkPlot p = Plot p def id -- | Lens onto the raw 'Plotable' inside a 'Plot'.-rawPlot :: SameSpace p p' => Lens (Plot p) (Plot p') p p'+rawPlot :: SameSpace p p' => Lens (Plot p b) (Plot p' b) p p' rawPlot f (Plot p opts ps) = f p <&> \p' -> Plot p' opts ps -- | The modifications to the 'PlotOptions' and 'PlotStyle' in a 'Plot'.-plotMods :: Lens' (Plot p) (PlotMods (V p))+plotMods :: Lens' (Plot p b) (PlotMods b (V p) (N p)) plotMods f (Plot p opts ps) = f (PlotMods opts ps) <&> \(PlotMods opts' ps') -> Plot p opts' ps' @@ -633,38 +624,38 @@ ------------------------------------------------------------------------ -- | A wrapped up 'Plot', used to store plots in an 'Axis'.-data DynamicPlot v where- DynamicPlot :: (InSpace v Double p, Plotable p) => Plot p -> DynamicPlot v+data DynamicPlot b v n where+ DynamicPlot :: (InSpace v n p, Plotable p b) => Plot p b -> DynamicPlot b v n deriving Typeable -type instance V (DynamicPlot v) = v-type instance N (DynamicPlot v) = Double+type instance V (DynamicPlot b v n) = v+type instance N (DynamicPlot b v n) = n -- | Prism for a 'DynamicPlot'.-_DynamicPlot :: Plotable p => Prism' (DynamicPlot (V p)) (Plot p)+_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 -- '_DynamicPlot' has.-dynamicPlot :: forall p. Typeable p => Traversal' (DynamicPlot (V p)) (Plot p)+dynamicPlot :: forall p b. (Typeable p, Typeable b)+ => Traversal' (DynamicPlot b (V p) (N p)) (Plot p b) dynamicPlot f d@(DynamicPlot p) = case eq p of Just Refl -> f p <&> \p' -> DynamicPlot p' Nothing -> pure d- where eq :: Typeable a => a -> Maybe (a :~: Plot p)+ where eq :: Typeable a => a -> Maybe (a :~: Plot p b) eq _ = eqT--instance Functor f => HasPlotOptions f (DynamicPlot v) where+instance Functor f => HasPlotOptions f (DynamicPlot b v n) b where plotOptions f (DynamicPlot (Plot p opts sty)) = f opts <&> \opts' -> DynamicPlot (Plot p opts' sty) -instance Settable f => HasPlotStyle f (DynamicPlot v) where+instance Settable f => HasPlotStyle f (DynamicPlot b v n) b where plotStyle = sty . mapped where- sty :: Setter' (DynamicPlot v) (PlotStyle v -> PlotStyle v)+ sty :: Setter' (DynamicPlot b v n) (PlotStyle b v n -> PlotStyle b v n) sty f (DynamicPlot (Plot p opts s)) = f s <&> \s' -> DynamicPlot (Plot p opts s') -- | The modifications to the 'PlotOptions' and 'PlotStyle' in a 'DynamicPlot'.-dynamicPlotMods :: Lens' (DynamicPlot v) (PlotMods v)+dynamicPlotMods :: Lens' (DynamicPlot b v n) (PlotMods b v n) dynamicPlotMods f (DynamicPlot (Plot p opts ps)) = f (PlotMods opts ps) <&> \(PlotMods opts' ps') -> DynamicPlot (Plot p opts' ps') @@ -677,32 +668,32 @@ -- with 'styledPlotLegend'. -- -- You can make a 'StyledPlot' with 'styleDynamic'-data StyledPlot v where+data StyledPlot b v n where StyledPlot- :: Plotable p+ :: Plotable p b => p- -> PlotOptions (V p)- -> PlotStyle (V p)- -> StyledPlot (V p)+ -> PlotOptions b (V p) (N p)+ -> PlotStyle b (V p) (N p)+ -> StyledPlot b (V p) (N p) -type instance V (StyledPlot v) = v-type instance N (StyledPlot v) = Double+type instance V (StyledPlot b v n) = v+type instance N (StyledPlot b v n) = n -instance Functor f => HasPlotOptions f (StyledPlot v) where+instance Functor f => HasPlotOptions f (StyledPlot b v n) b where plotOptions f (StyledPlot p opts sty) = f opts <&> \opts' -> StyledPlot p opts' sty -instance HasLinearMap v => Enveloped (StyledPlot v) where+instance (Metric v, OrderedField n) => Enveloped (StyledPlot b v n) where getEnvelope (StyledPlot p opts _) = getEnvelope p & transform (poTransform opts) -instance Functor f => HasPlotStyle f (StyledPlot v) where+instance Functor f => HasPlotStyle f (StyledPlot b v n) b where plotStyle f (StyledPlot p opts sty) = 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 successful.-styledPlot :: forall p. Typeable p => Traversal' (StyledPlot (V p)) p+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 Just Refl -> f p <&> \p' -> StyledPlot p' opts sty@@ -711,17 +702,21 @@ eq _ = eqT -- | Give a 'DynamicPlot' a concrete 'PlotStyle'.-styleDynamic :: PlotStyle v -> DynamicPlot v -> StyledPlot v+styleDynamic :: PlotStyle b v n -> DynamicPlot b v n -> StyledPlot b v n styleDynamic sty (DynamicPlot (Plot p opts styF)) = StyledPlot p opts (styF sty) -- | Render a 'StyledPlot' given an and 'AxisSpec'.-renderStyledPlot :: HasLinearMap v => AxisSpec v -> StyledPlot v -> Diagram v+renderStyledPlot+ :: TypeableFloat n+ => AxisSpec V2 n+ -> StyledPlot b V2 n+ -> QDiagram b V2 n Any renderStyledPlot aSpec (StyledPlot p opts sty) = renderPlotable aSpec sty p- & whenever (opts^.hidden) D.phantom- -- & whenever (opts^.clipPlot) (clipTo $ specRect aSpec) XXX ADD CLIPTO XXX+ & whenever (opts^.hidden) phantom+ & whenever (opts^.clipPlot) (clipTo $ specRect aSpec) -specRect :: AxisSpec V2 -> Path V2 Double+specRect :: TypeableFloat n => AxisSpec V2 n -> Path V2 n specRect aSpec = rect (xU - xL) (yU - yL) # moveTo (mkP2 ((xU+xL)/2) ((yU+yL)/2))@@ -733,7 +728,9 @@ -- | Get the legend rendered entries from a single styled plot. The -- resulting entries are in no particular order. See also -- 'styledPlotLegends'.-singleStyledPlotLegend :: StyledPlot v -> [(Double, Diagram v, String)] -- ^ @(z-order, legend pic, legend text)@+singleStyledPlotLegend+ :: StyledPlot b v n+ -> [(n, QDiagram b v n Any, String)] -- ^ @(z-order, legend pic, legend text)@ singleStyledPlotLegend (StyledPlot p opts sty) = map mk (opts ^. legendEntries) where@@ -744,7 +741,10 @@ CustomLegendPic f -> f sty -- | Render a list of legend entries, in order.-styledPlotLegends :: [StyledPlot v] -> [(Diagram v, String)] -- ^ @[(legend pic, legend text)]@+styledPlotLegends+ :: Ord n+ => [StyledPlot b v n]+ -> [(QDiagram b v n Any, String)] -- ^ @[(legend pic, legend text)]@ styledPlotLegends = map (\(_,p,t) -> (p,t)) . sortOn (view _1)
src/Plots/Types/Bar.hs view
@@ -80,12 +80,10 @@ import Plots.Util import qualified Data.List as List--- import Diagrams.Core.Transform (fromSymmetric)--- import Linear.V2 (_yx)--import Geometry.TwoD.Transform+import Diagrams.Core.Transform (fromSymmetric)+import Linear.V2 (_yx) -import Diagrams.Prelude hiding (orient)+import Diagrams.Prelude -- Single bar ---------------------------------------------------------- @@ -99,9 +97,9 @@ -- representation of a bar and is not intended to be used directly. -- | Construct a rectangle of size v with the bottom centre at point p.-rectB :: (InSpace V2 n t, Fractional n, FromTrail t) => Point V2 n -> V2 n -> t+rectB :: (InSpace V2 n t, TrailLike t) => Point V2 n -> V2 n -> t rectB p (V2 x y) =- fromLocTrail $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p .-^ V2 (x/2) 0+ trailLike $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p .-^ V2 (x/2) 0 ------------------------------------------------------------------------ -- Bar layout@@ -109,49 +107,49 @@ -- | The way an individual bar plot or a group of bars plots are laid -- out on the axis.-data BarLayout = BarLayout+data BarLayout n = BarLayout { bOrient :: Orientation- , bWidth :: Double- , bSpacing :: Double- , bStart :: Double+ , bWidth :: n+ , bSpacing :: n+ , bStart :: n } deriving Typeable -instance Default BarLayout where+instance Fractional n => Default (BarLayout n) where def = BarLayout Horizontal 0.8 1 1 -type instance N BarLayout = Double+type instance N (BarLayout n) = n -instance HasOrientation BarLayout where+instance HasOrientation (BarLayout n) where orientation = lens bOrient (\bl o -> bl {bOrient = o}) -- | Class of things that have a modifiable 'BarLayout'. class HasOrientation a => HasBarLayout a where -- | Lens onto the 'BarLayout'- barLayout :: Lens' a BarLayout+ barLayout :: Lens' a (BarLayout (N a)) -- | The width bar for single / stacked bars or the width of a group -- for grouped bar plot. -- -- Default is @0.8@- barWidth :: Lens' a Double+ barWidth :: Lens' a (N a) barWidth = barLayout . lens bWidth (\bl w -> bl {bWidth = w}) -- | The spacing between each bar or group of bars. -- -- Default is @1@- barSpacing :: Lens' a Double+ barSpacing :: Lens' a (N a) barSpacing = barLayout . lens bSpacing (\bl s -> bl {bSpacing = s}) -- | The distance from the axis to centre of the first bar. -- -- Default is @1@- barStart :: Lens' a Double+ barStart :: Lens' a (N a) barStart = barLayout . lens bStart (\bl x -> bl {bStart = x}) -instance HasBarLayout BarLayout where+instance HasBarLayout (BarLayout n) where barLayout = id -instance HasBarLayout a => HasBarLayout (Plot a) where+instance HasBarLayout a => HasBarLayout (Plot a b) where barLayout = rawPlot . barLayout ------------------------------------------------------------------------@@ -165,18 +163,18 @@ -- A 'BarPlot' is not intended to be constructed directly, instead use -- one of the helper functions.-data BarPlot = BarPlot- { bpData :: [(Double,Double)]- , bpLayout :: BarLayout+data BarPlot n = BarPlot+ { bpData :: [(n,n)]+ , bpLayout :: BarLayout n } deriving Typeable -type instance V BarPlot = V2-type instance N BarPlot = Double+type instance V (BarPlot n) = V2+type instance N (BarPlot n) = n -instance HasOrientation BarPlot where+instance HasOrientation (BarPlot n) where orientation = barLayout . orientation -instance Enveloped BarPlot where+instance OrderedField n => Enveloped (BarPlot n) where getEnvelope BarPlot {..} = getEnvelope . orient bpLayout _reflectXY id . (id :: Path v n -> Path v n) $ ifoldMap drawBar bpData@@ -184,7 +182,8 @@ drawBar i (a,b) = rectB (mkP2 x a) (V2 (view barWidth bpLayout) (b - a)) where x = view barStart bpLayout + fromIntegral i * view barSpacing bpLayout -instance Plotable BarPlot where+instance (TypeableFloat n, Renderable (Path V2 n) b)+ => Plotable (BarPlot n) b where renderPlotable s sty BarPlot {..} = ifoldMap drawBar bpData # orient bpLayout _reflectXY id@@ -206,9 +205,9 @@ | otherwise = rect 4 10 -- The legend bars don't look right if the line width is too big so we limit it- sty' = sty & areaStyle . _lw . mapped %~ atMost (local 0.8)+ sty' = sty & areaStyle . _lw %~ atMost (local 0.8) -instance HasBarLayout BarPlot where+instance HasBarLayout (BarPlot n) where barLayout = lens bpLayout (\bp l -> bp {bpLayout = l}) ------------------------------------------------------------------------@@ -216,11 +215,11 @@ ------------------------------------------------------------------------ -- | Create equidistant bars using the values.-mkBars :: F.Foldable f => BarLayout -> f Double -> BarPlot+mkBars :: (F.Foldable f, Num n) => BarLayout n -> f n -> BarPlot n mkBars bl (F.toList -> ns) = mkFloatingBars bl (map (0,) ns) -- | Create equidistant bars with lower and upper bounds for each bar.-mkFloatingBars :: F.Foldable f => BarLayout -> f (Double,Double) -> BarPlot+mkFloatingBars :: F.Foldable f => BarLayout n -> f (n,n) -> BarPlot n mkFloatingBars bl (F.toList -> ns) = BarPlot { bpData = ns , bpLayout = bl@@ -229,9 +228,10 @@ -- | Create uniform bars from groups of data, placing one group after -- the other. mkRunningBars- :: BarLayout- -> [[(Double, Double)]]- -> [BarPlot]+ :: Num n+ => BarLayout n+ -> [[(n,n)]]+ -> [BarPlot n] mkRunningBars bl = snd . foldr f (view barStart bl, []) where f d (x, bs) = (x + dx, mkFloatingBars bl {bStart = x} d : bs)@@ -241,9 +241,10 @@ -- other. The first list will be the same as @mkUniformBars opts (map -- (0,) ys)@, subsequent lists will be placed on top. mkStackedBars- :: BarLayout- -> [[Double]] -- values- -> [BarPlot]+ :: Num n+ => BarLayout n+ -> [[n]] -- values+ -> [BarPlot n] mkStackedBars bl = snd . List.mapAccumR f (repeat 0) where -- y0s are the base values for this set of bars, these accumulate@@ -254,10 +255,11 @@ -- | Similar to 'mkMultiStacked' but stack has the same height. mkStackedEqualBars- :: Double -- ^ value each bar reaches- -> BarLayout- -> [[Double]] -- ^ values- -> [BarPlot]+ :: Fractional n+ => n -- ^ value each bar reaches+ -> BarLayout n+ -> [[n]] -- ^ values+ -> [BarPlot n] mkStackedEqualBars yM bl yss = mkStackedBars bl yss' where -- Multiplier for each bar to reach the desired height.@@ -271,10 +273,11 @@ -- as a single bar when using the 'BarPlotsOpts'. There is an addition -- parameter to adjust the width of each individual bar. mkGroupedBars- :: Double -- ^ width factor of individual bars (1 = touching)- -> BarLayout- -> [[Double]]- -> [BarPlot]+ :: Fractional n+ => n -- ^ width factor of individual bars (1 = touching)+ -> BarLayout n+ -> [[n]]+ -> [BarPlot n] mkGroupedBars w bl xs = flip imap xs $ \i ns -> mkBars@@ -291,10 +294,10 @@ -- temporary functions that will be in next lib release -_reflectionXY :: (HasLinearMap v, R2 v, Num n) => Transformation v n-_reflectionXY = reflectionX <> reflectionY+_reflectionXY :: (Additive v, R2 v, Num n) => Transformation v n+_reflectionXY = fromSymmetric $ (_xy %~ view _yx) <-> (_xy %~ view _yx) -_reflectXY :: (InSpace v n t, R2 v, HasLinearMap v, Transformable t) => t -> t+_reflectXY :: (InSpace v n t, R2 v, Transformable t) => t -> t _reflectXY = transform _reflectionXY ----------------------------------------------------------------------------------@@ -318,9 +321,11 @@ -- -- > barExample = renderAxis barAxis barPlot- :: (MonadState (Axis V2) m, F.Foldable f)- => f Double -- ^ bar heights- -> State (Plot BarPlot) () -- ^ changes to the bars+ :: (MonadState (Axis b V2 n) m,+ Plotable (BarPlot n) b,+ F.Foldable f)+ => f n -- ^ bar heights+ -> State (Plot (BarPlot n) b) () -- ^ changes to the bars -> m () -- ^ changes to the 'Axis' barPlot ns = addPlotable (mkBars def ns) @@ -339,9 +344,11 @@ -- -- > barExample' = renderAxis barAxis' barPlot'- :: (MonadState (Axis V2) m, F.Foldable f)- => f Double -- ^ bar heights- -> m () -- ^ changes to the 'Axis'+ :: (MonadState (Axis b V2 n) m,+ Plotable (BarPlot n) b,+ F.Foldable f)+ => f n -- ^ bar heights+ -> m () -- ^ changes to the 'Axis' barPlot' ns = addPlotable' (mkBars def ns) -- | A add 'BarPlot' to an 'Axis' while naming the bars.@@ -361,9 +368,11 @@ -- > -- > namedBarExample = renderAxis namedBarAxis namedBarPlot- :: (MonadState (Axis V2) m, F.Foldable f)- => f (String, Double) -- ^ bar heights with name- -> State (Plot BarPlot) () -- ^ changes to the bars+ :: (MonadState (Axis b V2 n) m,+ Plotable (BarPlot n) b,+ F.Foldable f)+ => f (String,n) -- ^ bar heights with name+ -> State (Plot (BarPlot n) b) () -- ^ changes to the bars -> m () -- ^ changes to the 'Axis' namedBarPlot d s = do addPlot bp@@ -387,16 +396,20 @@ -- -- > namedBarExample' = renderAxis namedBarAxis' namedBarPlot'- :: (MonadState (Axis V2) m, F.Foldable f)- => f (String, Double) -- ^ bar heights with name- -> m () -- ^ add plot to the 'Axis'+ :: (MonadState (Axis b V2 n) m,+ Plotable (BarPlot n) b,+ F.Foldable f)+ => f (String,n) -- ^ bar heights with name+ -> m () -- ^ add plot to the 'Axis' namedBarPlot' ns = namedBarPlot ns (return ()) -- | Same as 'barPlot' but with lower and upper bounds for the bars. floatingBarPlot- :: (MonadState (Axis V2) m, F.Foldable f)- => f (Double,Double) -- ^ bar limits- -> State (Plot BarPlot) () -- ^ changes to the bars+ :: (MonadState (Axis b V2 n) m,+ Plotable (BarPlot n) b,+ F.Foldable f)+ => f (n,n) -- ^ bar limits+ -> State (Plot (BarPlot n) b) () -- ^ changes to the bars -> m () floatingBarPlot ns = addPlotable (mkFloatingBars def ns) @@ -429,26 +442,26 @@ -- -- * Add labels to each (group of) bars with 'labelBars'. ---data MultiBarState a = MultiBarState- { mbsLayout :: BarLayout+data MultiBarState b n a = MultiBarState+ { mbsLayout :: BarLayout n -- ^ options for building bar plots - , mbsMods :: [(a, Endo (PlotMods V2))]+ , mbsMods :: [(a, Endo (PlotMods b V2 n))] -- ^ the data along with an adjustment to the plot properties , mbsLabels :: [String] -- ^ labels to be placed at the bottom of each bar - , mbsBarFun :: BarLayout -> [[Double]] -> [BarPlot]+ , mbsBarFun :: BarLayout n -> [[n]] -> [BarPlot n] -- ^ function used to build bar plots } -type instance N (MultiBarState a) = Double+type instance N (MultiBarState b n a) = n -instance HasOrientation (MultiBarState a) where+instance HasOrientation (MultiBarState b n a) where orientation = barLayout . orientation -instance HasBarLayout (MultiBarState a) where+instance HasBarLayout (MultiBarState b n a) where barLayout = lens mbsLayout (\mbs l -> mbs {mbsLayout = l}) -- > import Plots@@ -479,7 +492,7 @@ -- Adding to axis ------------------------------------------------------ -multiFun :: Lens' (MultiBarState a) (BarLayout -> [[Double]] -> [BarPlot])+multiFun :: Lens' (MultiBarState b n a) (BarLayout n -> [[n]] -> [BarPlot n]) multiFun = lens mbsBarFun (\mbs f -> mbs {mbsBarFun = f}) -- | Bars that are grouped together such that each group is a single@@ -490,7 +503,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_groupedBarsExample.svg#diagram=groupedBarsExample&height=400>> -groupedBars :: State (MultiBarState a) ()+groupedBars :: Fractional n => State (MultiBarState b n a) () groupedBars = groupedBars' 1 -- | Bars that are grouped together such that each group is a single@@ -502,7 +515,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_groupedBarsExample'.svg#diagram=groupedBarsExample'&height=400>> ---groupedBars' :: Double -> State (MultiBarState a) ()+groupedBars' :: Fractional n => n -> State (MultiBarState b n a) () groupedBars' n = multiFun .= mkGroupedBars n -- | Bars stacked on top of each other.@@ -511,7 +524,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_stackedBarsExample.svg#diagram=stackedBarsExample&height=400>> ---stackedBars :: State (MultiBarState a) ()+stackedBars :: Num n => State (MultiBarState b n a) () stackedBars = multiFun .= mkStackedBars -- | Bars stacked on top of each other where every bar is the given@@ -522,7 +535,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_stackedEqualBarsExample.svg#diagram=stackedEqualBarsExample&height=400>> ---stackedEqualBars :: Double -> State (MultiBarState a) ()+stackedEqualBars :: Fractional n => n -> State (MultiBarState b n a) () stackedEqualBars n = multiFun .= mkStackedEqualBars n -- | Normal 'bars' where each data set follows the last.@@ -531,7 +544,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_runningBarsExample.svg#diagram=runningBarsExample&height=400>> ---runningBars :: State (MultiBarState a) ()+runningBars :: Num n => State (MultiBarState b n a) () runningBars = multiFun .= \l xs -> mkRunningBars l (map (map (0,)) xs) -- | Construct multiple bars, grouped together. See 'MultiBarState' for@@ -567,10 +580,13 @@ -- -- > multiBarExample = renderAxis multiBarAxis multiBars- :: (MonadState (Axis V2) m, F.Foldable f, F.Foldable g)+ :: (MonadState (Axis b V2 n) m,+ Plotable (BarPlot n) b,+ F.Foldable f,+ F.Foldable g) => f a -- ^ data for multi plot- -> (a -> g Double) -- ^ extract bar heights from each data set- -> State (MultiBarState a) () -- ^ state to make changes to the plot+ -> (a -> g n) -- ^ extract bar heights from each data set+ -> State (MultiBarState b n a) () -- ^ state to make changes to the plot -> m () -- ^ changes to the 'Axis' multiBars (F.toList -> as) f st = do -- add the plots@@ -598,7 +614,9 @@ -- | Place labels under the centre of each bar using the 'BarLayout' by -- changing that 'axisTickLabels', using the provided string in order.-barLayoutAxisLabels :: MonadState (Axis V2) m => BarLayout -> [String] -> m ()+barLayoutAxisLabels+ :: (MonadState (Axis b V2 n) m, Fractional n)+ => BarLayout n -> [String] -> m () barLayoutAxisLabels bl ls = unless (null ls) $ axes . orient bl _y _x &= do@@ -621,11 +639,11 @@ -- * 'key' - add a legend entry for that group of bars -- onBars- :: (a -> State (PlotMods V2) ())+ :: (a -> State (PlotMods b V2 n) ()) -- ^ Modifier the 'PlotOptions' and 'PlotStyle' for the bars -- associated with the data from @a@. - -> State (MultiBarState a) ()+ -> State (MultiBarState b n a) () -- ^ Changes to each data set when executing 'multiBars'. onBars f = mods . mapped %= \(a, endo) -> (a, endo <> Endo (execState (f a)))@@ -634,7 +652,7 @@ class HasLabels a where labels :: Lens' a [String] -instance HasLabels (MultiBarState a) where+instance HasLabels (MultiBarState b n a) where labels = lens mbsLabels (\mbs ls -> mbs {mbsLabels = ls}) -- | Labels to use for each bar (or group of bars) along the axis.
src/Plots/Types/HeatMap.hs view
@@ -45,13 +45,13 @@ , pixelHeatRender' -- * Heat matrix- , HeatMatrix (..)+ , HeatMatrix , heatImage , hmPoints+ , hmSize -- * Low level construction , mkHeatMap- , mkHeatSurface , mkHeatMatrix , mkHeatMatrix' @@ -76,12 +76,8 @@ import Plots.Style import Plots.Types -import Diagrams.TwoD.Image--import Geometry.ThreeD.Shapes- --------------------------------------------------------------------------- HeatMap+-- Heatmap ------------------------------------------------------------------------ -- | 2D Array of 'Double's.@@ -200,10 +196,16 @@ -- > myHM = mkHeatMatrix (V2 5 5) f -- > in pixelHeatRender myHM viridis ---pixelHeatRender :: HeatMatrix -> ColourMap -> Diagram V2-pixelHeatRender hm cm = alignBL $ imageEmb (ImageRGB8 img)+pixelHeatRender+ :: (Renderable (DImage n Embedded) b, TypeableFloat n)+ => HeatMatrix+ -> ColourMap+ -> QDiagram b V2 n Any+pixelHeatRender hm cm =+ alignBL . image $ DImage (ImageRaster (ImageRGB8 img)) x y mempty where- img = heatImage hm cm+ img = heatImage hm cm+ V2 x y = hmSize hm -- | Render an heatmap as an 'ImageRGB8' with @n@ pixels per heat matrix -- point.@@ -219,11 +221,17 @@ -- > myHM = mkHeatMatrix (V2 5 5) f -- > in pixelHeatRender' 10 myHM viridis ---pixelHeatRender' :: Int -> HeatMatrix -> ColourMap -> Diagram V2+pixelHeatRender'+ :: (Renderable (DImage n Embedded) b, TypeableFloat n)+ => Int+ -> HeatMatrix+ -> ColourMap+ -> QDiagram b V2 n Any pixelHeatRender' n hm cm =- scale (1/fromIntegral n) . alignBL $ imageEmb (ImageRGB8 img)+ scale (1/fromIntegral n) . alignBL . image $ DImage (ImageRaster (ImageRGB8 img)) (x*n) (y*n) mempty where- img = scaleImage n $ heatImage hm cm+ img = scaleImage n $ heatImage hm cm+ V2 x y = hmSize hm -- | Scale an image so each pixel takes (n*n) pixels. This can be -- useful for using 'heatImage' on small heat matrices to give a@@ -320,7 +328,11 @@ -- > myHM = mkHeatMatrix (V2 5 5) f -- > in pathHeatRender myHM viridis ---pathHeatRender :: HeatMatrix -> ColourMap -> Diagram V2+pathHeatRender+ :: (Renderable (Path V2 n) b, TypeableFloat n)+ => HeatMatrix+ -> ColourMap+ -> QDiagram b V2 n Any pathHeatRender hm@(HeatMatrix _ _ a b) cm = ifoldMapOf hmPoints mk hm # lwO 0 where normalise d = (d - a) / (b - a)@@ -343,23 +355,23 @@ -- | A mapping from points in a 2D axis do 'Double's. These 'Double's -- are converted to colours using the axis 'ColourMap'.-data HeatMap v = HeatMap+data HeatMap b n = HeatMap { hMatrix :: HeatMatrix- , hStart :: P2 Double- , hSize :: V2 Double- , hGridSty :: Style v Double+ , hStart :: P2 n+ , hSize :: V2 n+ , hGridSty :: Style V2 n , hGridVisible :: Bool , hLimits :: Maybe (Double,Double)- , hDraw :: HeatMatrix -> ColourMap -> Diagram v+ , hDraw :: HeatMatrix -> ColourMap -> QDiagram b V2 n Any } deriving Typeable -type instance V (HeatMap v) = v-type instance N (HeatMap v) = Double+type instance V (HeatMap b n) = V2+type instance N (HeatMap b n) = n -- | Class of things that let you change the heatmap options.-class HasHeatMap f a where+class HasHeatMap f a b | a -> b where -- | Lens onto the heatmap options.- heatMapOptions :: LensLike' f a (HeatMap (V a))+ heatMapOptions :: LensLike' f a (HeatMap b (N a)) -- | Whether there should be grid lines draw for the heat map. --@@ -371,19 +383,19 @@ -- visible. -- -- Default is 'mempty'.- heatMapGridStyle :: Functor f => LensLike' f a (Style (V a) Double)+ heatMapGridStyle :: Functor f => LensLike' f a (Style V2 (N a)) heatMapGridStyle = heatMapOptions . lens hGridSty (\s b -> (s {hGridSty = b})) -- | The size of each individual square in the heat map. -- -- Default is @'V2' 1 1@.- heatMapSize :: Functor f => LensLike' f a (V2 Double)+ heatMapSize :: Functor f => LensLike' f a (V2 (N a)) heatMapSize = heatMapOptions . lens hSize (\s b -> (s {hSize = b})) -- | The size of the full extent of the heat map. -- -- Default is extent of the heat matrix.- heatMapExtent :: Functor f => LensLike' f a (V2 Double)+ heatMapExtent :: (Functor f, Fractional (N a)) => LensLike' f a (V2 (N a)) heatMapExtent = heatMapOptions . l where l f hm = f (hSize hm * s) <&> \x -> hm { hSize = x / s } where s = fmap fromIntegral (hmSize $ hMatrix hm)@@ -391,11 +403,11 @@ -- | The starting point at the bottom left corner of the heat map. -- -- Default is 'origin'- heatMapStart :: Functor f => LensLike' f a (P2 Double)+ heatMapStart :: Functor f => LensLike' f a (P2 (N a)) heatMapStart = heatMapOptions . lens hStart (\s b -> (s {hStart = b})) -- | The center point of the heat map.- heatMapCentre :: Functor f => LensLike' f a (P2 Double)+ heatMapCentre :: (Functor f, Fractional (N a)) => LensLike' f a (P2 (N a)) heatMapCentre = heatMapOptions . l where l f hm = f (hStart hm .+^ v) <&> \p -> hm { hStart = p .-^ v } where v = fmap fromIntegral (hmSize $ hMatrix hm) * hSize hm / 2@@ -409,31 +421,26 @@ -- 'pixelHeatRender'. -- -- Default is 'pathHeatRender'.- heatMapRender :: Functor f => LensLike' f a (HeatMatrix -> ColourMap -> Diagram (V a))+ heatMapRender :: Functor f => LensLike' f a (HeatMatrix -> ColourMap -> QDiagram b V2 (N a) Any) heatMapRender = heatMapOptions . lens hDraw (\s b -> (s {hDraw = b})) -instance HasHeatMap f (HeatMap v) where+instance HasHeatMap f (HeatMap b n) b where heatMapOptions = id -instance (Functor f, HasHeatMap f a) => HasHeatMap f (Plot a) where+instance (Functor f, HasHeatMap f a b) => HasHeatMap f (Plot a b) b where heatMapOptions = rawPlot . heatMapOptions -instance Enveloped (HeatMap V2) where+instance OrderedField n => Enveloped (HeatMap b n) where getEnvelope hm = getEnvelope (fromCorners p (p .+^ v)) where p = view heatMapStart hm v = view heatMapExtent hm -instance Enveloped (HeatMap V3) where- getEnvelope hm = getEnvelope (fromCorners (v3 p) (v3 $ p .+^ v))- where p = view heatMapStart hm- v = view heatMapExtent hm- v3 (P (V2 x y)) = P $ V3 x y 0--instance Plotable (HeatMap V2) where+instance (Typeable b, TypeableFloat n, Renderable (Path V2 n) b)+ => Plotable (HeatMap b n) b where renderPlotable s _sty HeatMap {..} = transform (s^.specTrans) $ grid <> hDraw matrix' (s^.specColourMap)- # scaleV hSize+ # transform (scaleV hSize) # moveTo hStart where --- TODO@@ -449,30 +456,13 @@ -- XXX make better defLegendPic sty HeatMap {..} = square 5 # applyAreaStyle sty -instance Plotable (HeatMap V3) where- renderPlotable s _sty HeatMap {..} =- transform (s^.specTrans) $- grid <> hDraw matrix' (s^.specColourMap)- # scaleV (v3 hSize)- # moveTo (p3 hStart)- where- v3 (V2 x y) = V3 x y 1- p3 (P (V2 x y)) = P $ V3 x y 0- --- TODO- grid = mempty-- --- XXX need to give _range to the axis somehow (for colour bar range)- matrix' = case hLimits of- -- Just r@(a,b) -> (r, hMatrix { hmFun = (/ (b - a)) . (+a) . hmFun hMatrix })- -- Nothing -> normaliseHeatMatrix hMatrix- Just (a,b) -> hMatrix { hmBoundLower = a, hmBoundUpper = b }- Nothing -> hMatrix-- -- XXX make better- defLegendPic sty HeatMap {..} = cube # scale 5 # applyAreaStyle sty+scaleV :: (Additive v, Fractional n) => v n -> Transformation v n+scaleV v = fromLinear f f+ where f = (liftU2 (*) v) <-> (\u -> liftU2 (/) u v) --- | Construct a 'HeatMap' using the given 'HeatMatrix'.-mkHeatMap :: HeatMatrix -> HeatMap V2+-- | Construct a 'Heatmap' using the given 'HeatMatrix'.+mkHeatMap :: (Renderable (Path V2 n) b, TypeableFloat n)+ => HeatMatrix -> HeatMap b n mkHeatMap mat = HeatMap { hMatrix = mat , hStart = origin@@ -483,17 +473,6 @@ , hDraw = pathHeatRender } -mkHeatSurface :: HeatMatrix -> HeatMap V3-mkHeatSurface mat = HeatMap- { hMatrix = mat- , hStart = origin- , hSize = V2 1 1- , hGridSty = mempty- , hGridVisible = False- , hLimits = Nothing- , hDraw = undefined- }- -- Adding to axis ------------------------------------------------------ -- | Add a 'HeatMap' plot using the extent of the heatmap and a@@ -521,9 +500,12 @@ heatMap :: (F.Foldable f, F.Foldable g,- MonadState (Axis V2) m)+ TypeableFloat n,+ Typeable b,+ MonadState (Axis b V2 n) m,+ Renderable (Path V2 n) b) => f (g Double)- -> State (Plot (HeatMap V2)) ()+ -> State (Plot (HeatMap b n) b) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' heatMap xss s = do@@ -533,21 +515,6 @@ -- (don't like this way of doing it) colourBarRange .= over both realToFrac (a,b) -heatSurface- :: (F.Foldable f,- F.Foldable g,- MonadState (Axis V3) m)- => f (g Double)- -> State (Plot (HeatMap V3)) ()- -- ^ changes to plot options- -> m () -- ^ add plot to 'Axis'-heatSurface xss s = do- let hm@(HeatMatrix _ _ a b) = mkHeatMatrix' xss- addPlotable (mkHeatSurface hm) s-- -- (don't like this way of doing it)- colourBarRange .= over both realToFrac (a,b)- -- | Add a 'HeatMap' plot using the extent of the heatmap and a -- generating function. --@@ -574,7 +541,10 @@ heatMap' :: (F.Foldable f, F.Foldable g,- MonadState (Axis V2) m)+ TypeableFloat n,+ Typeable b,+ MonadState (Axis b V2 n) m,+ Renderable (Path V2 n) b) => f (g Double) -> m () -- ^ add plot to 'Axis' heatMap' xss = heatMap xss (return ())@@ -604,10 +574,13 @@ -- heatMapIndexed :: (VectorLike V2 Int i,- MonadState (Axis V2) m)+ TypeableFloat n,+ Typeable b,+ MonadState (Axis b V2 n) m,+ Renderable (Path V2 n) b) => i -- ^ extent of array -> (i -> Double) -- ^ heat from index- -> State (Plot (HeatMap V2)) ()+ -> State (Plot (HeatMap b n) b) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' heatMapIndexed i f s = do@@ -643,14 +616,12 @@ -- heatMapIndexed' :: (VectorLike V2 Int i,- MonadState (Axis V2) m)+ TypeableFloat n,+ Typeable b,+ MonadState (Axis b V2 n) m,+ Renderable (Path V2 n) b) => i -- ^ extent of array -> (i -> Double) -- ^ heat from index -> m () -- ^ add plot to 'Axis' heatMapIndexed' i f = heatMapIndexed i f (return ())---- heatMapRender :: Functor f => LensLike' f a (HeatMatrix -> ColourMap -> Diagram (V a))---- surfaceRender :: HeatMatrix -> ColourMap -> Diagram V3--- surfaceRender hm cm =
src/Plots/Types/Histogram.hs view
@@ -64,7 +64,8 @@ import qualified Data.Vector as V import qualified Statistics.Sample.Histogram as Stat -import Diagrams.Prelude hiding (orient)+import Diagrams.Core.Transform (fromSymmetric)+import Diagrams.Prelude import Linear.V2 (_yx) import Plots.Axis@@ -72,38 +73,38 @@ import Plots.Types import Plots.Util -import Geometry.TwoD.Transform -- | Construct a rectangle of size $v$ with the bottom left at point $p$.-rectBL :: (InSpace V2 n t, FromTrail t) => Point V2 n -> V2 n -> t+rectBL :: (InSpace V2 n t, TrailLike t) => Point V2 n -> V2 n -> t rectBL p (V2 x y) =- fromLocTrail $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p+ trailLike $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p ------------------------------------------------------------------------ -- GHistogram plot ------------------------------------------------------------------------ -- | Simple histogram type supporting uniform bins.-data HistogramPlot = HistogramPlot- { hWidth :: Double- , hStart :: Double- , hValues :: [Double]+data HistogramPlot n = HistogramPlot+ { hWidth :: n+ , hStart :: n+ , hValues :: [n] , hOrient :: Orientation } deriving Typeable -type instance V HistogramPlot = V2-type instance N HistogramPlot = Double+type instance V (HistogramPlot n) = V2+type instance N (HistogramPlot n) = n -instance Enveloped HistogramPlot where+instance OrderedField n => Enveloped (HistogramPlot n) where getEnvelope HistogramPlot {..} =- -- don't like this reduntent code- getEnvelope . orient hOrient _reflectXY id . (id :: Path V2 Double -> Path V2 Double) $+ -- don't like this redundant code+ getEnvelope . orient hOrient _reflectXY id . (id :: Path v n -> Path v n) $ ifoldMap drawBar hValues where drawBar i h = rectBL (mkP2 x 0) (V2 hWidth h) where x = hStart + fromIntegral i * hWidth -instance Plotable HistogramPlot where+instance (TypeableFloat n, Renderable (Path V2 n) b)+ => Plotable (HistogramPlot n) b where renderPlotable s sty HistogramPlot {..} = ifoldMap drawBar hValues # orient hOrient _reflectXY id@@ -120,9 +121,9 @@ $ alignB (rect 4 7) ||| alignB (rect 4 10) ||| alignB (rect 4 6) where -- The legend bars don't look right if the line width is too big so we limit it- sty' = sty & areaStyle . _lw . mapped %~ atMost (local 0.8)+ sty' = sty & areaStyle . _lw %~ atMost (local 0.8) -instance HasOrientation HistogramPlot where+instance HasOrientation (HistogramPlot n) where orientation = lens hOrient $ \hp o -> hp {hOrient = o} ------------------------------------------------------------------------@@ -131,21 +132,23 @@ -- | Plot an already computed histogram with equally sized bins. computedHistogram- :: (MonadState (Axis V2) m, F.Foldable f)- => Double -- ^ start of first bin- -> Double -- ^ width of each bin- -> f Double -- ^ heights of the bins- -> State (Plot HistogramPlot) ()+ :: (MonadState (Axis b V2 n) m,+ Plotable (HistogramPlot n) b,+ F.Foldable f)+ => n -- ^ start of first bin+ -> n -- ^ width of each bin+ -> f n -- ^ heights of the bins+ -> State (Plot (HistogramPlot n) b) () -> m () computedHistogram x0 w xs = addPlotable (mkComputedHistogram x0 w xs) -- | Construct a 'HistogramPlot' from raw histogram data. mkComputedHistogram :: F.Foldable f- => Double -- ^ start of first bin- -> Double -- ^ width of each bin- -> f Double -- ^ heights of the bins- -> HistogramPlot+ => n -- ^ start of first bin+ -> n -- ^ width of each bin+ -> f n -- ^ heights of the bins+ -> HistogramPlot n mkComputedHistogram x0 w xs = HistogramPlot x0 w (F.toList xs) Horizontal ----------------------------------------------------------------------------@@ -189,7 +192,7 @@ -- | The way to normalise the data from a histogram. The default method -- is 'count'. newtype NormalisationMethod =- NM { runNM :: Double -> V.Vector Double -> V.Vector Double }+ NM { runNM :: forall n. Fractional n => n -> V.Vector n -> V.Vector n } -- width -> heights -> normalised heights instance Default NormalisationMethod where@@ -252,17 +255,17 @@ -- | Options for binning histogram data. For now only very basic -- histograms building is supported.-data HistogramOptions = HistogramOptions+data HistogramOptions n = HistogramOptions { hBins :: Int- , hRange :: Maybe (Double, Double)+ , hRange :: Maybe (n, n) , hNorm :: NormalisationMethod , oOrient :: Orientation } -type instance V HistogramOptions = V2-type instance N HistogramOptions = Double+type instance V (HistogramOptions n) = V2+type instance N (HistogramOptions n) = n -instance Default HistogramOptions where+instance Default (HistogramOptions n) where def = HistogramOptions { hBins = 10 , hRange = Nothing@@ -270,12 +273,12 @@ , oOrient = Vertical } -instance HasOrientation HistogramOptions where+instance HasOrientation (HistogramOptions n) where orientation = lens oOrient $ \ho o -> ho {oOrient = o} class HasOrientation a => HasHistogramOptions a where -- | Options for building the histogram from data.- histogramOptions :: Lens' a HistogramOptions+ histogramOptions :: Lens' a (HistogramOptions (N a)) -- | The number of bins (bars) to use for the histogram. Must be -- positive.@@ -288,7 +291,7 @@ -- data outside the range is ignored. -- -- 'Default' is 'Nothing'.- binRange :: Lens' a (Maybe (Double, Double))+ binRange :: Lens' a (Maybe (N a, N a)) binRange = histogramOptions . lens hRange (\ho r -> ho {hRange = r}) -- | Should the resulting histogram be normalised so the total area is@@ -298,15 +301,17 @@ normaliseSample :: Lens' a NormalisationMethod normaliseSample = histogramOptions . lens hNorm (\ho b -> ho {hNorm = b}) -instance HasHistogramOptions HistogramOptions where+instance HasHistogramOptions (HistogramOptions n) where histogramOptions = id -instance HasHistogramOptions a => HasHistogramOptions (Plot a) where+instance HasHistogramOptions a => HasHistogramOptions (Plot a b) where histogramOptions = rawPlot . histogramOptions -- | Create a histogram by binning the data using the -- 'HistogramOptions'.-mkHistogramPlot :: F.Foldable f => HistogramOptions -> f Double -> HistogramPlot+mkHistogramPlot+ :: (F.Foldable f, RealFrac n)+ => HistogramOptions n -> f n -> HistogramPlot n mkHistogramPlot HistogramOptions {..} xs = HistogramPlot { hWidth = w@@ -321,9 +326,10 @@ (a,b) = fromMaybe (range hBins v) hRange -- Taken from Statistics, which was limited to 'Double'.-range :: Int -- ^ Number of bins (must be positive).- -> V.Vector Double -- ^ Sample data (cannot be empty).- -> (Double, Double)+range :: (Ord n, Fractional n)+ => Int -- ^ Number of bins (must be positive).+ -> V.Vector n -- ^ Sample data (cannot be empty).+ -> (n, n) range nBins xs | nBins < 1 = error "Plots.Types.Histogram: invalid bin count" | V.null xs = error "Plots.Types.Histogram: empty sample"@@ -371,40 +377,40 @@ -- -- > histogramExample = renderAxis histogramAxis histogramPlot- :: (MonadState (Axis V2) m, F.Foldable f)- => f Double -- ^ data- -> State (Plot HistogramOptions) () -- ^ changes to plot options+ :: (MonadState (Axis b V2 n) m, Plotable (HistogramPlot n) b, F.Foldable f, RealFrac n)+ => f n -- ^ data+ -> State (Plot (HistogramOptions n) b) () -- ^ changes to plot options -> m () -- ^ add plot to axis histogramPlot ns s = addPlot (hoPlot & rawPlot %~ \ho -> mkHistogramPlot ho ns) where hoPlot = mkPlot def &~ s -- | Make a 'HistogramPlot' without changes to the plot options. histogramPlot'- :: (MonadState (Axis V2) m, F.Foldable f)- => f Double -- ^ data+ :: (MonadState (Axis b V2 n) m, Plotable (HistogramPlot n) b, F.Foldable f, RealFrac n)+ => f n -- ^ data -> m () -- ^ add plot to axis histogramPlot' d = histogramPlot d (return ()) -- | Add a 'HistogramPlot' using a fold over the data. histogramPlotOf- :: (MonadState (Axis V2) m)- => Fold s Double -- ^ fold over the data+ :: (MonadState (Axis b V2 n) m, Plotable (HistogramPlot n) b, RealFrac n)+ => Fold s n -- ^ fold over the data -> s -- ^ data to fold- -> State (Plot HistogramOptions) () -- ^ change to the plot+ -> State (Plot (HistogramOptions n) b) () -- ^ change to the plot -> m () -- ^ add plot to the 'Axis' histogramPlotOf f s = histogramPlot (toListOf f s) -- | Same as 'histogramPlotOf' without any changes to the plot. histogramPlotOf'- :: MonadState (Axis V2) m- => Fold s Double -> s -> m ()+ :: (MonadState (Axis b V2 n) m, Plotable (HistogramPlot n) b, RealFrac n)+ => Fold s n -> s -> m () histogramPlotOf' f s = histogramPlotOf f s (return ()) -- temporary functions that will be in next lib release -_reflectionXY :: (HasLinearMap v, R2 v, Num n) => Transformation v n-_reflectionXY = reflectionX <> reflectionY+_reflectionXY :: (Additive v, R2 v, Num n) => Transformation v n+_reflectionXY = fromSymmetric $ (_xy %~ view _yx) <-> (_xy %~ view _yx) -_reflectXY :: (InSpace v n t, HasLinearMap v, R2 v, Transformable t) => t -> t+_reflectXY :: (InSpace v n t, R2 v, Transformable t) => t -> t _reflectXY = transform _reflectionXY
src/Plots/Types/Line.hs view
@@ -29,8 +29,8 @@ -- * Line plots from points , linePlot , linePlot'- -- , smoothLinePlot- -- , smoothLinePlot'+ , smoothLinePlot+ , smoothLinePlot' -- * Construction utilities @@ -55,46 +55,47 @@ import Plots.Axis import Plots.Types -import Data.Typeable-import Geometry.Path-import qualified Data.Sequence as S (fromList, singleton)- ------------------------------------------------------------------------ -- Trails and Paths ------------------------------------------------------------------------ -trail2Path :: Located (Trail v n) -> Path v n-trail2Path = Path . S.singleton- -- | Add a 'Trail' as a 'Plot' to an 'Axis'. trailPlot- :: (BaseSpace c ~ v, MonadState (Axis c) m, HasLinearMap v, Typeable v, R1 v)- => Located (Trail v Double) -- ^ trail to plot- -> State (Plot (Path v Double)) () -- ^ changes to plot options+ :: (BaseSpace c ~ v,+ Plotable (Path v n) b,+ MonadState (Axis b c n) m)+ => Trail v n -- ^ trail to plot+ -> State (Plot (Path v n) b) () -- ^ changes to plot options -> m () -- ^ add plot to the 'Axis'-trailPlot = pathPlot . trail2Path+trailPlot = pathPlot . toPath -- | Add a 'Trail' as a 'Plot' to an 'Axis' without changes to the plot -- options. trailPlot'- :: (BaseSpace c ~ v, MonadState (Axis c) m, HasLinearMap v, Typeable v, R1 v)- => Located (Trail v Double) -- ^ trail to plot+ :: (BaseSpace c ~ v,+ Plotable (Path v n) b,+ MonadState (Axis b c n) m)+ => Trail v n -- ^ trail to plot -> m () -- ^ add plot to the 'Axis'-trailPlot' = pathPlot' . trail2Path+trailPlot' = pathPlot' . toPath -- | Add a 'Path' as a 'Plot' to an 'Axis'. pathPlot- :: (BaseSpace c ~ v, MonadState (Axis c) m, HasLinearMap v, Typeable v, R1 v)- => Path v Double -- ^ path to plot- -> State (Plot (Path v Double)) () -- ^ changes to plot options+ :: (BaseSpace c ~ v,+ Plotable (Path v n) b,+ MonadState (Axis b c n) m)+ => Path v n -- ^ path to plot+ -> State (Plot (Path v n) b) () -- ^ changes to plot options -> m () -- ^ add plot to the 'Axis' pathPlot = addPlotable -- | Add a 'Path' as a 'Plot' to an 'Axis' without changes to the plot -- options. pathPlot'- :: (BaseSpace c ~ v, MonadState (Axis c) m, HasLinearMap v, Typeable v, R1 v)- => Path v Double -- ^ path to plot+ :: (BaseSpace c ~ v,+ Plotable (Path v n) b,+ MonadState (Axis b c n) m)+ => Path v n -- ^ path to plot -> m () -- ^ add plot to the 'Axis' pathPlot' = addPlotable' @@ -105,56 +106,54 @@ -- | Add a 'Path' plot from a list of points. linePlot :: (BaseSpace c ~ v,- HasLinearMap v,+ Metric v, F.Foldable f,- R1 v,- PointLike v Double p,- MonadState (Axis c) m)+ PointLike v n p,+ Plotable (Path v n) b,+ MonadState (Axis b c n) m) => f p -- ^ points to turn into trail- -> State (Plot (Path v Double)) () -- ^ changes to plot options+ -> State (Plot (Path v n) b) () -- ^ changes to plot options -> m () -- ^ add plot to the 'Axis' linePlot = addPlotable . toPath . mkTrail -- | Add a 'Path' plot from a list of points. linePlot' :: (BaseSpace c ~ v,- HasLinearMap v,+ Metric v, F.Foldable f,- R1 v,- PointLike v Double p,- MonadState (Axis c) m)+ PointLike v n p,+ Plotable (Path v n) b,+ MonadState (Axis b c n) m) => f p -- ^ points to turn into trail -> m () -- ^ add plot to the 'Axis' linePlot' = addPlotable' . toPath . mkTrail -- | Add a smooth 'Path' plot from a list of points using 'cubicSpline'.--- smoothLinePlot--- :: (BaseSpace c ~ v,--- F.Foldable f,--- Typeable v,--- HasLinearMap v,--- PointLike v Double p,--- R1 v,--- Fractional (v Double), -- needs fixing in diagrams-lib--- MonadState (Axis c) m)--- => f p -- ^ points to turn into trail--- -> State (Plot (Path v Double)) () -- ^ changes to plot options--- -> m () -- ^ add plot to the 'Axis'--- smoothLinePlot = addPlotable . cubicSpline False . toListOf (folded . unpointLike)+smoothLinePlot+ :: (BaseSpace c ~ v,+ F.Foldable f,+ Metric v,+ PointLike v n p,+ Plotable (Path v n) b,+ Fractional (v n), -- needs fixing in diagrams-lib+ MonadState (Axis b c n) m)+ => f p -- ^ points to turn into trail+ -> State (Plot (Path v n) b) () -- ^ changes to plot options+ -> m () -- ^ add plot to the 'Axis'+smoothLinePlot = addPlotable . cubicSpline False . toListOf (folded . unpointLike) -- | Add a smooth 'Path' plot from a list of points using 'cubicSpline' -- without changes to the plot options.--- smoothLinePlot'--- :: (BaseSpace c ~ v,--- F.Foldable f,--- PointLike v Double p,--- Typeable v,--- R1 v,--- Fractional (v Double), -- needs fixing in diagrams-lib--- MonadState (Axis c) m)--- => f p -- ^ points to turn into trail--- -> m () -- ^ add plot to the 'Axis'--- smoothLinePlot' xs = smoothLinePlot xs (return ())+smoothLinePlot'+ :: (BaseSpace c ~ v,+ F.Foldable f,+ PointLike v n p,+ Plotable (Path v n) b,+ Fractional (v n), -- needs fixing in diagrams-lib+ MonadState (Axis b c n) m)+ => f p -- ^ points to turn into trail+ -> m () -- ^ add plot to the 'Axis'+smoothLinePlot' xs = smoothLinePlot xs (return ()) ------------------------------------------------------------------------ -- Trail and path@@ -174,5 +173,5 @@ -- | Construct a localed trail from a fold over points. mkPathOf :: (PointLike v n p, OrderedField n) => Fold s t -> Fold t p -> s -> Path v n-mkPathOf f1 f2 as = Path . S.fromList $ map (mkTrailOf f2) (toListOf f1 as)+mkPathOf f1 f2 as = Path $ map (mkTrailOf f2) (toListOf f1 as)
+ src/Plots/Types/Pie.hs view
@@ -0,0 +1,308 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# LANGUAGE UndecidableInstances #-}++{-# LANGUAGE StandaloneDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module : Plots.Types.Line+-- Copyright : (C) 2016 Christopher Chalmers+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Christopher Chalmers+-- Stability : experimental+-- Portability : non-portable+--+-- A pie plot is a circular statistical graphic, which is divided into+-- slices to illustrate numerical proportion.+--+-- <<diagrams/src_Plots_Types_Pie_piePlotExample.svg#diagram=piePlotExample&height=350>>+--+-- (see 'piePlot' example for code to make this plot)+--+----------------------------------------------------------------------------++module Plots.Types.Pie+ ( -- * Pie plot+ PieState+ , piePlot+ , piePlot'+ , onWedges+ , wedgeKeys++ -- * Wedges+ , Wedge+ , mkWedge+ , HasWedge (..)+ , wedgePlot++ ) where++import Control.Monad.State.Lazy++import Data.Typeable+import qualified Data.Foldable as F+import qualified Data.List as List++import Diagrams.Coordinates.Isomorphic+import Diagrams.Coordinates.Polar+import Diagrams.Prelude hiding (r2)++import Plots.Style+import Plots.Types+import Plots.Axis++------------------------------------------------------------------------+-- Pie wedge+------------------------------------------------------------------------++-- | Contains information to draw a single wedge of a pie. It is not+-- intended to be drawn directly. Instead use 'piePlot'.+data Wedge n = Wedge+ { sEndR :: n+ , sStartR :: n+ , sOffset :: n+ , sDir :: Direction V2 n+ , sWidth :: Angle n+ } deriving Typeable++type instance V (Wedge n) = V2+type instance N (Wedge n) = n++instance RealFloat n => Enveloped (Wedge n) where+ getEnvelope Wedge {..} = getEnvelope shape # translate off where+ shape+ | sStartR == 0 = wedge sEndR sDir sWidth :: Path V2 n+ | otherwise = annularWedge sEndR sStartR sDir sWidth+ off+ | sOffset == 0 = zero+ | otherwise = sOffset *^ fromDir (rotate (sWidth ^/ 2) sDir)++instance (TypeableFloat n, Renderable (Path V2 n) b)+ => Plotable (Wedge n) b where+ renderPlotable s sty Wedge {..} =+ shape+ # applyAreaStyle sty+ # translate off+ # transform (s^.specTrans)+ where+ shape+ | sStartR == 0 = wedge sEndR sDir sWidth+ | otherwise = annularWedge sEndR sStartR sDir sWidth+ off+ | sOffset == 0 = zero+ | otherwise = sOffset *^ fromDir (rotate (sWidth ^/ 2) sDir)++ defLegendPic sty Wedge {..}+ = square 5 # applyAreaStyle sty++-- | Create a pie wedge with unit radius, starting at direction @d@ with+-- width @theta@.+mkWedge+ :: Num n+ => Direction V2 n -- ^ starting direction+ -> Angle n -- ^ width of wedge+ -> Wedge n -- ^ resulting wedge+mkWedge d theta = Wedge+ { sEndR = 1+ , sStartR = 0+ , sOffset = 0+ , sDir = d+ , sWidth = theta+ }++class HasWedge f a where+ -- | Description on how to draw a wedge.+ pieWedge :: LensLike' f a (Wedge (N a))++ -- | The outside radius of the wedge. Default is @1@.+ wedgeOuterRadius :: Functor f => LensLike' f a (N a)+ wedgeOuterRadius = pieWedge . lens sEndR (\p r -> p {sEndR = r})++ -- | The inside radius of the wedge. Default is $0$.+ wedgeInnerRadius :: Functor f => LensLike' f a (N a)+ wedgeInnerRadius = pieWedge . lens sStartR (\p r -> p {sStartR = r})++ -- | The offset of the wedge from the center.+ wedgeOffset :: Functor f => LensLike' f a (N a)+ wedgeOffset = pieWedge . lens sOffset (\p x -> p {sOffset = x})++ -- | The width of the wedge, starting from the 'wedgeDirection'.+ wedgeWidth :: Functor f => LensLike' f a (Angle (N a))+ wedgeWidth = pieWedge . lens sWidth (\p x -> p {sWidth = x})++ -- | The inititial direction of the wedge.+ wedgeDirection :: Functor f => LensLike' f a (Direction V2 (N a))+ wedgeDirection = pieWedge . lens sDir (\p x -> p {sDir = x})++instance HasWedge f (Wedge n) where+ pieWedge = id++instance (Functor f, HasWedge f a) => HasWedge f (Plot a b) where+ pieWedge = rawPlot . pieWedge++instance Applicative f => HasWedge f (PieState b n a) where+ pieWedge = stateMods . traversed . _2 . pieWedge++instance (Applicative f, Typeable b, v ~ V2, Typeable n)+ => HasWedge f (DynamicPlot b v n) where+ pieWedge = (dynamicPlot :: Traversal' (DynamicPlot b v n) (Plot (Wedge n) b))+ . pieWedge++instance (v ~ V2, Applicative f, Typeable n)+ => HasWedge f (StyledPlot b v n) where+ pieWedge = (styledPlot :: Traversal' (StyledPlot b v n) (Wedge n))++instance (BaseSpace c ~ V2, Settable f, Typeable n)+ => HasWedge f (Axis b c n) where+ pieWedge = finalPlots . pieWedge++------------------------------------------------------------------------+-- Full pie+------------------------------------------------------------------------++-- | The state used to draw a part chart made of multiple pie wedges.+data PieState b n a = PieState+ { psMods :: [(a, Plot (Wedge n) b)] -- non-empty list+ }++type instance V (PieState b n a) = V2+type instance N (PieState b n a) = n++-- internal lens+stateMods :: Lens' (PieState b n a) [(a, Plot (Wedge n) b)]+stateMods = lens psMods (\ps ms -> ps {psMods = ms})++-- -- | The direction for the first entry in the pie. Default is 'xDir'.+-- startingDirection :: Lens' (PieState b n a) (Direction V2 n)+-- startingDirection = lens psStart (\ps d -> ps {psStart = d})++-- -- | The ending direction of the final wedge. This can be used to make a+-- finalDirection ::++-- | Modify the state for each wedge given the data entry.+--+-- Some common lenses to use on the 'Wedge':+--+-- * 'plotColour' - change the colour of the bars+--+-- * 'areaStyle' - modify the style of the bars+--+-- * 'key' - add a legend entry for that group of bars+--+-- * 'wedgeOffset' - the offset of the wedge from the center+--+onWedges :: (a -> State (Plot (Wedge n) b) ()) -> State (PieState b n a) ()+onWedges f = stateMods %= map (\(a, p) -> (a, execState (f a) p))++-- | Add a legend entry for each item given a function that extracts the+-- item's name.+wedgeKeys :: Num n => (a -> String) -> State (PieState b n a) ()+wedgeKeys f = onWedges $ \a -> key (f a)++-- | Make a pie plot from a list of data by making a series of wedge+-- plots.+--+-- === __Example__+--+-- <<diagrams/src_Plots_Types_Pie_piePlotExample.svg#diagram=piePlotExample&height=350>>+--+-- > import Plots+-- >+-- > pieData = [("red", 3), ("blue", 4), ("green", 2), ("purple", 5)]+-- >+-- > piePlotAxis :: Axis B Polar Double+-- > piePlotAxis = polarAxis &~ do+-- > piePlot pieData snd $ wedgeKeys fst+-- > hide (axes . traversed)+--+-- > piePlotExample = renderAxis piePlotAxis+piePlot+ :: (MonadState (Axis b Polar n) m,+ Plotable (Wedge n) b,+ F.Foldable f)+ => f a -- ^ data for each wedge+ -> (a -> n) -- ^ extract weight of each wedge+ -> State (PieState b n a) ()+ -> m ()+piePlot (F.toList -> as) f st = F.forM_ ps addPlot+ where+ -- calculate pie widths+ ns = map f as+ x = F.sum ns+ wedges = snd $ List.mapAccumR wedgeAccum xDir as+ wedgeAccum d a = (d', wdg)+ where theta = (f a / x) @@ turn+ d' = d # rotate theta+ wdg = mkWedge d theta++ -- run pie state+ ps = map snd . psMods $ execState st ps0+ ps0 = PieState { psMods = zip as (map mkPlot wedges) }++-- | Make a pie plot from list of values without any changes.+--+-- === __Example__+--+-- <<diagrams/src_Plots_Types_Pie_pieExample'.svg#diagram=pieExample'&height=350>>+--+-- > import Plots+-- >+-- > piePlotAxis' :: Axis B Polar Double+-- > piePlotAxis' = polarAxis &~ do+-- > piePlot' [1,3,5,2]+-- > wedgeInnerRadius .= 0.5+-- > hide (axes . traversed)+--+-- > pieExample' = renderAxis piePlotAxis'+piePlot'+ :: (MonadState (Axis b Polar n) m,+ Plotable (Wedge n) b,+ F.Foldable f)+ => f n -- ^ weight of each wedge+ -> m ()+piePlot' ns = piePlot ns id (return ())++------------------------------------------------------------------------+-- Wedge+------------------------------------------------------------------------++-- $ pieplot+-- Pie plots display data as wedges and annular wedges.+-- Pie plots have the following lenses:+--+-- @+-- * 'strokeArc' :: 'Lens'' ('BoxPlot' v n) 'Bool' - False+-- @++-- | Add a single 'PiePlot' to the 'AxisState' from a data set.+--+-- === __Example__+--+-- <<diagrams/src_Plots_Types_Pie_wedgeExample.svg#diagram=wedgeExample&height=350>>+--+-- > import Plots+-- >+-- > wedgePlotAxis :: Axis B Polar Double+-- > wedgePlotAxis = polarAxis &~ do+-- > wedgePlot xDir (38@@deg) $ key "wedge"+--+-- > wedgeExample = renderAxis wedgePlotAxis+wedgePlot+ :: (v ~ BaseSpace c, v ~ V2,+ PointLike v n (Polar n),+ MonadState (Axis b c n) m,+ Plotable (Wedge n) b+ )+ => Direction V2 n -> Angle n -> State (Plot (Wedge n) b) () -> m ()+wedgePlot r theta = addPlotable (mkWedge r theta)+
src/Plots/Types/Scatter.hs view
@@ -80,8 +80,6 @@ import Plots.Style import Plots.Types -import Diagrams.Types (mkQD, Prim (..))- -- config -- > import Plots @@ -91,30 +89,31 @@ -- | A general data type for scatter plots. Allows storing different -- types of data as well as allowing transforms depending on the data.-data ScatterPlot v where- ScatterPlot :: Typeable a => ScatterOptions v a -> ScatterPlot v+data ScatterPlot v n where+ ScatterPlot :: Typeable a => ScatterOptions v n a -> ScatterPlot v n deriving Typeable -type instance V (ScatterPlot v) = v-type instance N (ScatterPlot v) = Double+type instance V (ScatterPlot v n) = v+type instance N (ScatterPlot v n) = n -- | A general data type for scatter plots. Allows storing different -- types of data as well as allowing transforms depending on the data.-data ScatterOptions v a = ScatterOptions+data ScatterOptions v n a = ScatterOptions { oData :: [a]- , oPos :: a -> Point v Double- , oTr :: a -> Transformation v Double- , oSty :: a -> Style v Double+ , oPos :: a -> Point v n+ , oTr :: a -> Transformation v n+ , oSty :: a -> Style v n , oLine :: Bool } deriving Typeable -type instance V (ScatterOptions v a) = v-type instance N (ScatterOptions v a) = Double+type instance V (ScatterOptions v n a) = v+type instance N (ScatterOptions v n a) = n -instance Metric v => Enveloped (ScatterPlot v) where+instance (Metric v, OrderedField n) => Enveloped (ScatterPlot v n) where getEnvelope (ScatterPlot (ScatterOptions {..})) = getEnvelope (map oPos oData) -instance Plotable (ScatterPlot V2) where+instance (TypeableFloat n, Renderable (Path V2 n) b)+ => Plotable (ScatterPlot V2 n) b where renderPlotable s sty (ScatterPlot (ScatterOptions {..})) = markers <> line where@@ -134,44 +133,21 @@ sty ^. plotMarker & applyMarkerStyle sty -strokeV3 :: Path V3 Double -> Diagram V3-strokeV3 path = mkQD (Prim path) (getEnvelope path) mempty mempty--instance Plotable (ScatterPlot V3) where- renderPlotable s sty (ScatterPlot (ScatterOptions {..})) =- markers <> line- where- markers = F.foldMap mk oData # applyMarkerStyle sty- --- mk a = marker # transform (oTr a)- # applyStyle (oSty a)- # moveTo (specPoint s $ oPos a)- marker = sty ^. plotMarker- --- line- | not oLine = mempty- | otherwise = strokeV3 (fromVertices points) # applyLineStyle sty- points = map (specPoint s . oPos) oData-- defLegendPic sty (ScatterPlot (ScatterOptions {..})) =- sty ^. plotMarker- & applyMarkerStyle sty- ------------------------------------------------------------------------ -- Generating scatter options ------------------------------------------------------------------------ -- | Low level construction of 'ScatterOptions'. mkScatterOptions- :: (PointLike v Double p, F.Foldable f)+ :: (PointLike v n p, F.Foldable f, Fractional n) => f a -> (a -> p)- -> ScatterOptions v a+ -> ScatterOptions v n a mkScatterOptions xs pf = ScatterOptions { oData = F.toList xs , oPos = view unpointLike . pf , oTr = mempty- , oSty = const mempty+ , oSty = const (_Wrapped ## mempty) , oLine = False } @@ -187,100 +163,100 @@ -- 'lineStyle' from the 'PlotStyle'. connectingLine :: Functor f => LensLike' f a Bool -instance HasConnectingLine f (ScatterOptions v a) where+instance HasConnectingLine f (ScatterOptions v n a) where connectingLine = lens oLine (\o b -> o {oLine = b}) -instance HasConnectingLine f (ScatterPlot v) where+instance HasConnectingLine f (ScatterPlot v n) where connectingLine f (ScatterPlot o@(ScatterOptions {..})) = f oLine <&> \b -> ScatterPlot o {oLine = b} -instance HasConnectingLine f p => HasConnectingLine f (Plot p) where+instance HasConnectingLine f p => HasConnectingLine f (Plot p b) where connectingLine = rawPlot . connectingLine -instance (Applicative f, Typeable v)- => HasConnectingLine f (DynamicPlot v) where- connectingLine = (dynamicPlot :: Traversal' (DynamicPlot v) (Plot (ScatterPlot v)))+instance (Applicative f, Typeable b, Typeable v, Typeable n)+ => HasConnectingLine f (DynamicPlot b v n) where+ connectingLine = (dynamicPlot :: Traversal' (DynamicPlot b v n) (Plot (ScatterPlot v n) b)) . connectingLine -instance (Applicative f, Typeable v)- => HasConnectingLine f (StyledPlot v) where- connectingLine = (styledPlot :: Traversal' (StyledPlot v) (ScatterPlot v))+instance (Applicative f, Typeable v, Typeable n)+ => HasConnectingLine f (StyledPlot b v n) where+ connectingLine = (styledPlot :: Traversal' (StyledPlot b v n) (ScatterPlot v n)) . connectingLine -instance (Settable f, Typeable (BaseSpace c))- => HasConnectingLine f (Axis c) where+instance (Settable f, Typeable (BaseSpace c), Typeable n)+ => HasConnectingLine f (Axis b c n) where connectingLine = finalPlots . connectingLine -- Options ------------------------------------------------------------- class HasScatterOptions f a d where -- | Lens onto the 'ScatterOptions' for a general scatter plot.- gscatterOptions :: LensLike' f a (ScatterOptions (V a) d)+ gscatterOptions :: LensLike' f a (ScatterOptions (V a) (N a) d) -- | Apply a transform to the markers using the associated data.- scatterTransform :: Functor f => LensLike' f a (d -> Transformation (V a) Double)+ scatterTransform :: Functor f => LensLike' f a (d -> Transformation (V a) (N a)) scatterTransform = gscatterOptions . lens oTr (\o tr -> o {oTr = tr}) -- | Apply a style to the markers using the associated data.- scatterStyle :: Functor f => LensLike' f a (d -> Style (V a) Double)+ scatterStyle :: Functor f => LensLike' f a (d -> Style (V a) (N a)) scatterStyle = gscatterOptions . lens oSty (\o sty -> o {oSty = sty}) -- | Change the position of the markers depending on the data.- scatterPosition :: Functor f => LensLike' f a (d -> Point (V a) Double)+ scatterPosition :: Functor f => LensLike' f a (d -> Point (V a) (N a)) scatterPosition = gscatterOptions . lens oPos (\o pos -> o {oPos = pos}) -instance d ~ d' => HasScatterOptions f (ScatterOptions v d) d' where+instance d ~ d' => HasScatterOptions f (ScatterOptions v n d) d' where gscatterOptions = id -instance (Applicative f, Typeable v, Typeable d)- => HasScatterOptions f (ScatterPlot v) d where+instance (Applicative f, Typeable v, Typeable n, Typeable d)+ => HasScatterOptions f (ScatterPlot v n) d where gscatterOptions f s@(ScatterPlot p) = case eq p of Just Refl -> ScatterPlot <$> f p Nothing -> pure s where- eq :: Typeable a => a -> Maybe (a :~: ScatterOptions v d)+ eq :: Typeable a => a -> Maybe (a :~: ScatterOptions v n d) eq _ = eqT -instance (Functor f, HasScatterOptions f p a) => HasScatterOptions f (Plot p) a where+instance (Functor f, HasScatterOptions f p a) => HasScatterOptions f (Plot p b) a where gscatterOptions = rawPlot . gscatterOptions -instance (Applicative f, Typeable v, Typeable a)- => HasScatterOptions f (DynamicPlot v) a where+instance (Applicative f, Typeable b, Typeable v, Typeable n, Typeable a)+ => HasScatterOptions f (DynamicPlot b v n) a where gscatterOptions = dynamicPlot . rawPlot -instance (Applicative f, Typeable (BaseSpace c), Typeable a)- => HasScatterOptions f (Axis c) a where+instance (Applicative f, Typeable b, Typeable (BaseSpace c), Typeable n, Typeable a)+ => HasScatterOptions f (Axis b c n) a where gscatterOptions = axisPlots . traverse . gscatterOptions -- Pure scatter lenses ------------------------------------------------- -- | Lens onto a scatter plot of points.-scatterOptions :: (InSpace v Double a, HasScatterOptions f a (Point v Double))- => LensLike' f a (ScatterOptions v (Point v Double))+scatterOptions :: (InSpace v n a, HasScatterOptions f a (Point v n))+ => LensLike' f a (ScatterOptions v n (Point v n)) scatterOptions = gscatterOptions -- -- | Lens onto a transform of a scatter plot of points. This is a -- -- specialised version of 'scatterTransform' for better type -- -- inference. -- _scatterTransform--- :: (InSpace v a, PointLike v p, Functor f, HasScatterOptions f a (Point v))--- => LensLike' f a (p -> Transformation v)+-- :: (InSpace v n a, PointLike v n p, Functor f, HasScatterOptions f a (Point v n))+-- => LensLike' f a (p -> Transformation v n) -- _scatterTransform = scatterTransform . lmapping unpointLike -- -- | Lens onto a transform of a scatter plot of points. This is a -- -- specialised version of 'scatterPosition' for better type inference. -- _scatterPosition--- :: (InSpace v a, PointLike v p, Functor f, HasScatterOptions f a (Point v))+-- :: (InSpace v n a, PointLike v n p, Functor f, HasScatterOptions f a (Point v n)) -- => LensLike' f a (p -> p) -- _scatterPosition = scatterPos . dimapping unpointLike pointLike -- -- | Lens onto a style function of a scatter plot of points. This is a -- -- specialised version of 'scatterStyle' for better type inference. -- _scatterStyle--- :: (InSpace v a, PointLike v p, Functor f, HasScatterOptions f a (Point v))--- => LensLike' f a (p -> Style v)+-- :: (InSpace v n a, PointLike v n p, Functor f, HasScatterOptions f a (Point v n))+-- => LensLike' f a (p -> Style v n) -- _scatterStyle = scatterStyle . lmapping unpointLike ------------------------------------------------------------------------@@ -299,9 +275,9 @@ -- | Add a 'ScatterPlot' to the 'AxisState' from a data set. -- -- @--- 'scatterPlot' :: [('Double', 'Double')] -> 'State' ('Plot' ('ScatterOptions' 'V2' ('P2' 'Double')) b) () -> 'State' ('Axis' 'V2') ()--- 'scatterPlot' :: ['V2' 'Double'] -> 'State' ('Plot' ('ScatterOptions' 'V2' ('P2' 'Double')) b) () -> 'State' ('Axis' 'V2') ()--- 'scatterPlot' :: ['P2' 'Double'] -> 'State' ('Plot' ('ScatterOptions' 'V2' ('P2' 'Double')) b) () -> 'State' ('Axis' 'V2') ()+-- '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__@@ -313,7 +289,7 @@ -- > mydata2 = mydata1 & each . _1 *~ 0.5 -- > mydata3 = [V2 1.2 2.7, V2 2 5.1, V2 3.2 2.6, V2 3.5 5] ----- > scatterAxis :: Axis V2+-- > scatterAxis :: Axis B V2 Double -- > scatterAxis = r2Axis &~ do -- > scatterPlot mydata1 $ key "data 1" -- > scatterPlot mydata2 $ key "data 2"@@ -322,12 +298,13 @@ -- > scatterExample = renderAxis scatterAxis scatterPlot :: (BaseSpace c ~ v,- PointLike v Double p,- MonadState (Axis c) m,- Plotable (ScatterPlot v),+ PointLike v n p,+ Typeable n,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b, F.Foldable f) => f p -- ^ points to plot- -> State (Plot (ScatterOptions v (Point v Double))) ()+ -> State (Plot (ScatterOptions v n (Point v n)) b) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' scatterPlot xs = gscatterPlot (xs ^.. folded . unpointLike) id@@ -359,9 +336,10 @@ -- > scatterExample' = renderAxis scatterAxis' scatterPlot' :: (BaseSpace c ~ v,- PointLike v Double p,- MonadState (Axis c) m,- Plotable (ScatterPlot v),+ PointLike v n p,+ Typeable n,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b, F.Foldable f) => f p -- ^ points to plot -> m () -- ^ add plot to 'Axis'@@ -370,12 +348,13 @@ -- | Version of 'scatterPlot' that accepts a 'Fold' over the data. scatterPlotOf :: (BaseSpace c ~ v,- PointLike v Double p,- Plotable (ScatterPlot v),- MonadState (Axis c) m)+ PointLike v n p,+ Typeable n,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b) => Fold s p -- ^ fold over points -> s -- ^ data to fold- -> State (Plot (ScatterOptions v (Point v Double))) () -- ^ changes to plot options+ -> State (Plot (ScatterOptions v n (Point v n)) b) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' scatterPlotOf f s = scatterPlot (toListOf f s) @@ -383,9 +362,10 @@ -- without any changes to the 'ScatterOptions'. scatterPlotOf' :: (BaseSpace c ~ v,- PointLike v Double p,- MonadState (Axis c) m,- Plotable (ScatterPlot v))+ PointLike v n p,+ Typeable n,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b) => Fold s p -- ^ fold over points -> s -- ^ data to fold -> m () -- ^ add plot to axis@@ -396,15 +376,15 @@ ------------------------------------------------------------------------ -- | A bubble plot is a scatter plot using point together with a scalar.-type BubbleOptions v = ScatterOptions v (Double, Point v Double)+type BubbleOptions v n = ScatterOptions v n (n, Point v n) -- | 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) b) () -> 'State' ('Axis' b 'V2' 'Double') ()--- 'bubblePlot' :: [('Double', 'V2' 'Double')] -> 'State' ('Plot' ('BubbleOptions' v) b) () -> 'State' ('Axis' b 'V2' 'Double') ()--- 'bubblePlot' :: [('Double', 'P2' 'Double')] -> 'State' ('Plot' ('BubbleOptions' v) b) () -> 'State' ('Axis' b 'V2' 'Double') ()+-- '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__@@ -426,12 +406,13 @@ -- > bubbleExample = renderAxis bubbleAxis bubblePlot :: (BaseSpace c ~ v,- PointLike v Double p,- MonadState (Axis c) m,- Plotable (ScatterPlot v),+ PointLike v n p,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b,+ Typeable n, F.Foldable f)- => f (Double, p) -- ^ fold over points with a size- -> State (Plot (BubbleOptions v)) () -- ^ changes to the options+ => f (n, p) -- ^ fold over points with a size+ -> State (Plot (BubbleOptions v n) b) () -- ^ changes to the options -> m () -- ^ add plot to 'Axis' bubblePlot xs s = gscatterPlot (xs ^.. folded . mapping unpointLike) snd $ do@@ -447,23 +428,25 @@ -- bubblePlot' :: (v ~ BaseSpace c,- PointLike v Double p,- MonadState (Axis c) m,- Plotable (ScatterPlot v),+ PointLike v n p,+ Typeable n,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b, F.Foldable f)- => f (Double, p) -- ^ fold over points with a size+ => f (n, p) -- ^ fold over points with a size -> m () -- ^ add plot to 'Axis' bubblePlot' xs = bubblePlot xs (return ()) -- | Version of 'bubblePlot' using a 'Fold' over the data. bubblePlotOf :: (BaseSpace c ~ v,- PointLike v Double p,- Plotable (ScatterPlot v),- MonadState (Axis c) m)- => Fold s (Double,p) -- ^ fold over the data+ PointLike v n p,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b,+ Typeable n)+ => Fold s (n,p) -- ^ fold over the data -> s -- ^ data- -> State (Plot (BubbleOptions v)) ()+ -> State (Plot (BubbleOptions v n) b) () -- ^ changes to the options -> m () -- ^ add plot to 'Axis' bubblePlotOf f s = bubblePlot (toListOf f s)@@ -472,12 +455,13 @@ -- changes to the 'BubbleOptions'. bubblePlotOf' :: (BaseSpace c ~ v,- PointLike v Double p,- MonadState (Axis c) m,- Plotable (ScatterPlot v))- => Fold s (Double,p) -- ^ fold over the data+ PointLike v n p,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b,+ Typeable n)+ => Fold s (n,p) -- ^ fold over the data -> s -- ^ data- -> State (Plot (BubbleOptions v)) ()+ -> State (Plot (BubbleOptions v n) b) () -- ^ changes to the options -> m () -- ^ add plot to 'Axis' bubblePlotOf' f s = bubblePlot (toListOf f s)@@ -485,43 +469,43 @@ -- Bubble scatter lenses ----------------------------------------------- -- | LensLike onto into a 'ScatterOptions' made up of a scaler @n@, and--- a point, @'Point' v@+-- a point, @'Point' v n@ -- -- @--- 'bubbleOptions' :: 'Lens'' ('Plot' ('BubbleOptions' v) v) ('BubbleOptions' v)+-- 'bubbleOptions' :: 'Lens'' ('Plot' ('BubbleOptions' v n) v) ('BubbleOptions' v n) -- @-bubbleOptions :: (InSpace v Double a, HasScatterOptions f a (Double, Point v Double))- => LensLike' f a (BubbleOptions v)+bubbleOptions :: (InSpace v n a, HasScatterOptions f a (n, Point v n))+ => LensLike' f a (BubbleOptions v n) bubbleOptions = gscatterOptions -- | Setter over the transform function for a 'bubblePlot'. Default is 'scale'. -- -- @--- 'bubbleOptions' :: 'Setter'' ('Plot' ('BubbleOptions' v) v) (n -> 'Transformation' v)+-- 'bubbleOptions' :: 'Setter'' ('Plot' ('BubbleOptions' v n) v) (n -> 'Transformation' v n) -- @ -- -- Note that this is the less general version of @'bubblePlot' . -- 'scatterTransform'@, which would give a 'LensLike' onto @(n,--- 'Point' v) -> 'Transformation' v@.+-- 'Point' v n) -> 'Transformation' v n@. -- bubbleTransform- :: (InSpace v Double a, HasScatterOptions f a (Double, Point v Double), Settable f)- => LensLike' f a (Double -> Transformation v Double)+ :: (InSpace v n a, HasScatterOptions f a (n, Point v n), Settable f)+ => LensLike' f a (n -> Transformation v n) bubbleTransform = bubbleOptions . scatterTransform . sets nOnly where nOnly f g (n,p) = f (\n' -> g (n', p)) n -- | Setter over the style function for a 'bubblePlot'. Default is 'mempty'. -- -- @--- 'bubbleStyle' :: 'Setter'' ('Plot' ('BubbleOptions' v) v) (n -> 'Style' v)+-- 'bubbleStyle' :: 'Setter'' ('Plot' ('BubbleOptions' v n) v) (n -> 'Style' v n) -- @ -- -- Note that this is the less general version of @'bubblePlot' . -- 'scatterTransform'@, which would give a 'LensLike' onto @(n,--- 'Point' v) -> 'Style' v@.+-- 'Point' v n) -> 'Style' v n@. ---bubbleStyle :: (InSpace v Double a, Settable f, HasScatterOptions f a (Double, Point v Double))- => LensLike' f a (Double -> Style v Double)+bubbleStyle :: (InSpace v n a, Settable f, HasScatterOptions f a (n, Point v n))+ => LensLike' f a (n -> Style v n) bubbleStyle = bubbleOptions . scatterStyle . sets nOnly where nOnly f g (n,p) = f (\n' -> g (n', p)) n @@ -533,14 +517,14 @@ -- the 'scatterTransform' and 'scatterStyle'. gscatterPlot :: (BaseSpace c ~ v,- PointLike v Double p,- MonadState (Axis c) m,+ PointLike v n p,+ MonadState (Axis b c n) m,+ Plotable (ScatterPlot v n) b, Typeable d,- Plotable (ScatterPlot v), F.Foldable f) => f d -- ^ data -> (d -> p) -- ^ extract point from data- -> State (Plot (ScatterOptions v d)) ()+ -> State (Plot (ScatterOptions v n d) b) () -- ^ options for plot -> m () -- ^ add plot to 'Axis' gscatterPlot xs pf s = addPlot $ over rawPlot ScatterPlot p1@@ -551,7 +535,7 @@ -- | Helper to traverse over a general scatter plot where the type of d -- is not infered. gscatterOptionsFor- :: (InSpace v Double a, HasScatterOptions f a d)- => proxy d -> LensLike' f a (ScatterOptions v d)+ :: (InSpace v n a, HasScatterOptions f a d)+ => proxy d -> LensLike' f a (ScatterOptions v n d) gscatterOptionsFor _ = gscatterOptions